87 files changed, 219420 insertions, 0 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
new file mode 100644
index 000000000..d7fbc56cd
--- /dev/null
+++ b/gcc/fortran/ChangeLog
@@ -0,0 +1,1417 @@
+2013-04-12  Release Manager
+
+	* GCC 4.6.4 released.
+
+2013-03-15  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/56615
+	* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Pack arrays
+	if they are not simply contiguous.
+
+2013-03-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/56575
+	* expr.c (gfc_default_initializer): Check that a class declared
+	type has any components.
+	* resolve.c (resolve_fl_derived0): On failing the test for C437
+	set the type to BT_UNKNOWN to prevent repeat error messages.
+
+2013-03-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/55362
+	* check.c (array_check): It is an error if a procedure is
+	passed.
+
+2013-02-23  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/56385
+	* trans-array.c (structure_alloc_comps): Handle procedure-pointer
+	components with allocatable result.
+
+2013-02-15  Tobias Burnus  <burnus@net-b.de>
+	    Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/56318
+	* simplify.c (gfc_simplify_matmul): Fix result shape
+	and matmul result.
+
+2013-02-13  Tobias Burnus  <burnus@net-b.de>
+
+	Backported from mainline
+	2013-01-07  Tobias Burnus  <burnus@net-b.de>
+		    Thomas Koenig  <tkoenig@gcc.gnu.org>
+		    Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/55852
+	* expr.c (gfc_build_intrinsic_call): Avoid clashes
+	with user's procedures.
+	* gfortran.h (gfc_build_intrinsic_call): Update prototype.
+	(GFC_PREFIX): Define.
+	* simplify.c (gfc_simplify_size): Update call.
+
+2013-02-03  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	Backport from trunk
+	PR fortran/50627
+	PR fortran/56054
+	* decl.c (gfc_match_end):  Remove half-ready namespace
+	from parent if the end of a block is missing.
+	* parse.c (parse_module):  Do not put namespace into
+	gsymbol on error.
+
+2013-01-14  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/55072
+	* trans-array.c (gfc_conv_array_parameter): No packing was done for
+	full arrays of derived type.
+
+2013-01-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/55618
+	* trans-expr.c (gfc_conv_procedure_call): Dereference scalar
+	character function arguments to elemental procedures in
+	scalarization loops.
+
+2013-01-08  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/42769
+	PR fortran/45836
+	PR fortran/45900
+	* module.c (read_module): Don't reuse local symtree if the associated
+	symbol isn't exactly the one wanted.  Don't reuse local symtree if it is
+	ambiguous.
+	* resolve.c (resolve_call): Use symtree's name instead of symbol's to
+	lookup the symtree.
+
+2013-01-07  Steven G. Kargl  <kargl@gcc.gnu.org>
+	    Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/55827
+	* trans-expr.c (gfc_conv_function_expr): Init sym earlier. Use it.
+
+2012-11-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/55314
+	Backport from trunk
+	* resolve.c (resolve_allocate_deallocate):  Compare all
+	subscripts when deciding if to reject a (de)allocate
+	statement.
+
+2012-09-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/54225
+	PR fortran/53306
+	* array.c (match_subscript, gfc_match_array_ref): Fix
+	diagnostic of coarray's '*'.
+
+2012-09-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/54556
+	* resolve.c (gfc_impure_variable): Don't check gfc_pure such
+	that the function also works for gfc_implicit_pure procedures.
+
+2012-09-12  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/54208
+	* simplify.c (simplify_bound_dim): Resolve array spec before
+	proceeding with simplification.
+
+2012-07-14  Mikael Morin  <mikael@gcc.gnu.org>
+
+	Backport from trunk:
+	2012-01-09  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/51758
+	* trans-array.c (gfc_walk_elemental_function_args):
+	Skip over NULL() actual arguments.
+
+2012-06-14  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/53597
+	* decl.c (match_attr_spec): Only mark module variables
+	as SAVE_IMPLICIT for Fortran 2008 and later.
+
+2012-06-05  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/50619
+	* resolve.c (build_default_init_expr): Don't initialize
+	ASSOCIATE names.
+
+2012-06-01  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/53521
+	* trans.c (gfc_deallocate_scalar_with_status): Properly
+	handle the case size == 0.
+
+2012-05-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/53389
+	* trans-array.c (gfc_add_loop_ss_code): Don't evaluate
+	expression, if ss->is_alloc_lhs is set.
+
+2012-05-02  Tobias Burnus  <burnus@net-b.de>
+
+	Backport from mainline
+	2012-04-12  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52864
+	* expr.c (gfc_check_vardef_context): Fix assignment check for
+	pointer components.
+
+2012-03-10  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52469
+	* trans-types.c (gfc_get_function_type): Handle backend_decl
+	of a procedure pointer.
+
+2012-03-06  Tobias Burnus  <burnus@net-b.de>
+
+	Backport from mainline
+	2012-03-02  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52452
+	* resolve.c (resolve_intrinsic): Don't search for a
+	function if we know that it is a subroutine.
+
+2012-03-01  Release Manager
+
+	* GCC 4.6.3 released.
+
+2012-02-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/52386
+	* trans-expr.c (fcncall_realloc_result): Dereference the
+	descriptor if needed.
+
+2012-02-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52335
+	* io.c (gfc_match_open): Remove bogus F2003 DELIM= check.
+
+2012-02-09  Jakub Jelinek  <jakub@redhat.com>
+
+	Backported from mainline
+	2011-12-15  Jakub Jelinek  <jakub@redhat.com>
+
+	PR debug/51517
+	* trans-decl.c (gfc_get_symbol_decl): Don't set DECL_INITAL on span.
+	(gfc_trans_deferred_vars): Instead add its runtime initialization
+	here.
+
+2012-02-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52151
+	* trans-expr.c (fcncall_realloc_result): Set also the stride.
+
+2012-02-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52093
+	* simplify.c (gfc_simplify_size): Handle INTRINSIC_PARENTHESES.
+
+2012-02-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/52012
+	* trans-expr.c (fcncall_realloc_result): Correct calculation of
+	result offset. If variable shape is correct, retain the bounds,
+	whatever they are.
+
+2012-01-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52022
+	* trans-expr.c (gfc_conv_procedure_call): Fix passing
+	of functions, which return allocatables.
+
+2012-01-25  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/51966
+	* resolve.c (resolve_structure_cons): Only create an
+	array constructors for nonscalars.
+
+2012-01-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/51948
+	* check.c (variable_check): Fix checking for
+	result variables and deeply nested BLOCKs.
+
+2012-01-21  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/51913
+	* interface.c (compare_parameter): Fix CLASS comparison.
+
+2012-01-19  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/51904
+	*expr.c (gfc_build_intrinsic_call): Also set the symtree.
+
+2012-01-14  Tobias Burnus  <burnus@net-b.de>
+
+	Backported from mainline
+	2012-01-14  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/51800
+	* resolve.c (build_default_init_expr): Also initialize
+	nonconstant-length strings with -finit-character=<n>.
+
+2012-01-01  Thomas König  <tkoenig@gcc.gnu.org>
+
+	Backport from trunk
+	PR fortran/51502
+	* expr.c (gfc_check_vardef_context):  When determining
+	implicit pure status, also check for variable definition
+	context.  Walk up namespaces until a procedure is
+	found to reset the implict pure attribute.
+	* resolve.c (gfc_implicit_pure):  Walk up namespaces
+	until a procedure is found.
+
+2011-12-22  Toon Moene  <toon@moene.org>
+
+	PR fortran/51310
+	* resolve.c (build_default_init_expr): Allow non-allocatable,
+	non-compile-time-constant-shape arrays to have a default
+	initializer.
+	* invoke.texi: Delete the restriction on automatic arrays not
+	being initialized by -finit-<type>=<constant>.
+
+2011-12-15  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/51550
+	PR fortran/47545
+	PR fortran/49050
+	PR fortran/51075
+	* resolve.c (resolve_fl_derived0): Print not-implemented error
+	for deferred-length character components.
+
+2011-12-11  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/50923
+	* trans-decl.c (generate_local_decl): Set TREE_NO_WARNING only
+	if the front end has printed a warning.
+	(gfc_generate_function_code): Fix unset-result warning.
+
+2011-12-11  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/51338
+	Backport from trunk
+	* dependency.c (are_identical_variables):  Handle case where
+	end fields of substring references are NULL.
+
+2011-12-08  Toon Moene  <toon@moene.org>
+
+	PR fortran/51310
+	* invoke.texi: Itemize the cases for which
+	-finit-<type>=<constant> doesn't work.
+
+2011-12-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/51448
+	* fortran/trans-array.c (get_std_lbound): Fix handling of
+	conversion functions.
+
+2011-12-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/51435
+	* expr.c (gfc_has_default_initializer): Fix handling of
+	DT with initialized pointer components.
+
+2011-12-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/50684
+	* check.c (variable_check): Fix intent(in) check.
+
+2011-11-25  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/50408
+	* trans-decl.c (gfc_get_module_backend_decl): Also copy
+	ts.u.derived from the gsym if the ts.type is BT_CLASS.
+	(gfc_get_extern_function_decl): Copy also the backend_decl
+	for the symbol's ts.u.{derived,cl} from the gsym.
+	* trans-types.c (gfc_copy_dt_decls_ifequal): Directly
+	return if "from" and "to" are the same.
+
+2011-11-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/51218
+	* gfortran.dg/implicit_pure_1.f90: New.
+
+2011-10-26  Release Manager
+
+	* GCC 4.6.2 released.
+
+2011-10-17  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47023
+	* primary.c (match_kind_param): Detect ISO_C_BINDING kinds.
+	(get_kind): Pass on 'is_iso_c' flag.
+	(match_integer_constant,match_real_constant,match_logical_constant):
+	Set 'ts.is_c_interop'.
+
+2011-10-15  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/50570
+	* expr.c (gfc_check_vardef_context): Don't throw an error on
+	non-pointer assignments involving an intent(in) pointer dummy.
+
+2011-10-15  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/50718
+	* gfortran.dg/pointer_check_11.f90: New.
+	* gfortran.dg/pointer_check_12.f90: New.
+
+2011-10-12  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/50659
+	* expr.c (replace_symbol): Only do replacement if the symbol is a dummy.
+
+2011-10-11  Tobias Burnus  <burnus@net-b.de>
+	    Janus Weil  <janus@gcc.gnu.org>
+
+	* invoke.texi (-fwhole-file): Update wording since -fwhole-file
+	is now enabled by default.
+
+2011-10-11  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/50273
+	* trans-common.c (translate_common): Fix -Walign-commons check.
+
+2011-10-07  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/50585
+	* interface.c (get_expr_storage_size): Check if 'length' component is
+	associated.
+
+	PR fortran/50625
+	* class.c (gfc_build_class_symbol): Fix whitespace.
+	* module.c (mio_symbol): Set 'class_ok' attribute.
+	* trans-decl.c (gfc_get_symbol_decl): Make sure the backend_decl has
+	been built for class symbols.
+
+2011-10-04  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/48706
+	* module.c (write_dt_extensions): Do not write extended types which
+	are local to a subroutine.
+
+2011-08-26  Mikael Morin  <mikael.morin@gcc.gnu.org>
+
+	PR fortran/50050
+	* expr.c (gfc_free_shape): Do nothing if shape is NULL.
+	(free_expr0): Remove redundant NULL shape check.
+	* resolve.c (check_host_association): Ditto.
+	* trans-expr.c (gfc_trans_subarray_assign): Assert that shape is
+	non-NULL.
+	* trans-io.c (transfer_array_component): Ditto.
+
+2011-08-25  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/50163
+	* check_init_expr (check_init_expr): Return when an error occured.
+
+2011-08-22  Mikael Morin  <mikael.morin@gcc.gnu.org>
+
+	PR fortran/50050
+	* gfortran.h (gfc_clear_shape, gfc_free_shape): New prototypes.
+	* expr.c (gfc_clear_shape, gfc_free_shape): New functions.
+	(free_expr0): Re-use gfc_free_shape.
+	* trans-expr.c (gfc_trans_subarray_assign): Ditto.
+	* trans-io.c (transfer_array_component): Ditto.
+	* resolve.c (check_host_association): Ditto.
+	(gfc_expr_to_initialize): Don't force the rank value and free the shape
+	after updating the expression. Recalculate shape and rank.
+	(resolve_where_shape): Re-use gfc_clear_shape.
+	* array.c (gfc_array_ref_shape): Ditto.
+
+2011-08-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	Backport from trunk
+	PR fortran/50130
+	* resolve.c (resolve_array_ref):  Don't calculate upper bound
+	if the stride is zero.
+
+2011-08-20  Mikael Morin  <mikael.morin@sfr.fr>
+
+	PR fortran/50129
+	* parse.c (parse_where): Undo changes after emitting an error.
+
+2011-08-19  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/49792
+	* trans-expr.c (gfc_trans_assignment_1): Set OMPWS_SCALARIZER_WS
+	bit in ompws_flags only if loop.temp_ss is NULL, and clear it if
+	lhs needs reallocation.
+	* trans-openmp.c (gfc_trans_omp_workshare): Don't return early if
+	code is NULL, emit a barrier if workshare emitted no code at all
+	and NOWAIT clause isn't present.
+
+2011-08-05  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/49112
+	* resolve.c (resolve_structure_cons): Don't do the full dt resolution,
+	only call 'resolve_fl_derived0'.
+	(resolve_typebound_procedures): Resolve typebound procedures of
+	parent type.
+	(resolve_fl_derived0): New function, which does a part of the work
+	for 'resolve_fl_derived'.
+	(resolve_fl_derived): Call 'resolve_fl_derived0' and do some additional
+	things.
+
+2011-08-03  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/49885
+	* trans-array.c (gfc_trans_auto_array_allocation): Change
+	gfc_start_block to gfc_init_block to avoid spurious extra-scope.
+
+2011-07-30  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	Backport from trunk.
+	PR fortran/48876
+	* expr.c (gfc_simplify_expr):  If end of a string is less
+	than zero, set it to zero.
+
+2011-07-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45586
+	* trans-types.c (gfc_get_derived_type): Ensure that pointer
+	component types are marked as nonrestricted.
+
+2011-07-23  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/49708
+	* resolve.c (resolve_allocate_expr): Fix diagnostics for pointers.
+
+2011-07-18  Mikael Morin  <mikael.morin@sfr.fr>
+
+	PR fortran/49648
+	* resolve.c (resolve_symbol): Force resolution of function result's
+	array specification.
+
+2011-07-11  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/49698
+	* trans-stmt.c (gfc_trans_pointer_assign_need_temp): Initialize
+	inner_size to gfc_index_one_node instead of integer_one_node.
+
+2011-07-10  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/49690
+	* intrinsic.c (add_functions): Use BT_VOID for 2nd argument of SIGNAL.
+
+2011-07-10  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/49562
+	* expr.c (gfc_check_vardef_context): Handle type-bound procedures.
+
+2011-07-09  Uros Bizjak  <ubizjak@gmail.com>
+
+	PR fortran/48926
+	* expr.c (gfc_get_corank): Change return value to int.
+	* gfortran.h (gfc_get_corank): Update function prototype.
+
+2011-07-04  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/49623
+	* gfortranspec.c (lang_specific_driver): Ignore options with
+	CL_ERR_MISSING_ARG errors.
+
+	Backported from mainline
+	2011-06-30  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/49540
+	* gfortran.h (gfc_constructor): Add repeat field.
+	* trans-array.c (gfc_conv_array_initializer): Handle repeat > 1.
+	* array.c (current_expand): Add repeat field.
+	(expand_constructor): Copy repeat.
+	* constructor.c (node_free, node_copy, gfc_constructor_get,
+	gfc_constructor_lookup): Handle repeat field.
+	(gfc_constructor_lookup_next, gfc_constructor_remove): New functions.
+	* data.h (gfc_assign_data_value): Add mpz_t * argument.
+	(gfc_assign_data_value_range): Removed.
+	* constructor.h (gfc_constructor_advance): Removed.
+	(gfc_constructor_lookup_next, gfc_constructor_remove): New prototypes.
+	* data.c (gfc_assign_data_value): Add REPEAT argument, handle it and
+	also handle overwriting a range with a single entry.
+	(gfc_assign_data_value_range): Removed.
+	* resolve.c (check_data_variable): Adjust gfc_assign_data_value
+	call.  Use gfc_assign_data_value instead of
+	gfc_assign_data_value_expr.
+
+2011-07-02  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/49466
+	* trans-array.c (structure_alloc_comps): Make sure sub-components
+	and extended types are correctly deallocated.
+
+2011-06-27  Release Manager
+
+	* GCC 4.6.1 released.
+
+2011-06-21  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/49112
+	* class.c (gfc_find_derived_vtab): Make vtab and default initialization
+	symbols SAVE_IMPLICIT.
+
+2011-06-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47601
+	* module.c (mio_component_ref): Handle components of extended types.
+	* symbol.c (gfc_find_component): Return if sym is NULL.
+
+	PR fortran/48699
+	* check.c (gfc_check_move_alloc): If 'TO' argument is polymorphic,
+	make sure the vtab is present.
+
+	PR fortran/49074
+	* interface.c (gfc_extend_assign): Propagate the locus from the
+	assignment to the type-bound procedure call.
+
+	PR fortran/49417
+	* module.c (mio_component): Make sure the 'class_ok' attribute is set
+	for use-associated CLASS components.
+	* parse.c (parse_derived): Check for 'class_ok' attribute.
+	* resolve.c (resolve_fl_derived): Ditto.
+
+2011-06-17  Tobias Burnus
+
+	PR fortran/49324
+	* trans-expr.c (gfc_trans_assignment_1): Tell
+	gfc_trans_scalar_assign to also deep-copy RHS nonvariables
+	with allocatable components.
+	* trans-array.c (gfc_conv_expr_descriptor): Ditto.
+
+2011-06-06  Asher Langton  <langton2@llnl.gov>
+
+	PR fortran/49268
+	* trans-decl.c (gfc_trans_deferred_vars): Treat assumed-size Cray
+	pointees as AS_EXPLICIT.
+
+2011-06-02  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/49265
+	* decl.c (gfc_match_modproc):  Allow for a double colon in a module
+	procedure statement.
+	* parse.c ( decode_statement): Deal with whitespace around :: in
+	gfc_match_modproc.
+
+2011-05-31  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	Backport from trunk
+	PR fortran/45786
+	* interface.c (gfc_equivalent_op):  New function.
+	(gfc_check_interface):  Use gfc_equivalent_op instead
+	of switch statement.
+	* decl.c (access_attr_decl):  Also set access to an
+	equivalent operator.
+
+2011-05-26  Paul Thomas  <pault@gcc.gnu.org>
+	    Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/48955
+	* trans-expr.c (gfc_trans_assignment_1): GFC_REVERSE_NOT_SET
+	changed to GFC_ENABLE_REVERSE.
+	* trans-array.c (gfc_init_loopinfo): GFC_CANNOT_REVERSE changed
+	to GFC_INHIBIT_REVERSE.
+	* gfortran.h : Enum gfc_reverse is now GFC_ENABLE_REVERSE,
+	GFC_FORWARD_SET, GFC_REVERSE_SET and GFC_INHIBIT_REVERSE.
+	* dependency.c (gfc_dep_resolver): Change names for elements of
+	gfc_reverse as necessary. Change the logic so that forward
+	dependences are remembered as well as backward ones. When both
+	have appeared, force a temporary.
+
+2011-05-11  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/48889
+	* expr.c (gfc_is_constant_expr): Use e->value.function.esym
+	instead of e->symtree->n.sym, if available.
+
+2011-05-04  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/48720
+	* gfortran.texi: Document the 'Q' exponent-letter extension.
+	* invoke.texi: Document -Wreal-q-constant.
+	* lang.opt: Add -Wreal-q-constant option.
+	* gfortran.h: Add warn_real_q_constant to option struct.
+	* primary.c (match_real_constant):  Use it.  Accept 'Q' as
+	exponent-letter for REAL(16) real-literal-constant with a
+	fallback to REAL(10) or error if REAL(10) is not available.
+	* options.c (gfc_init_options, set_Wall) Set it.
+	(gfc_handle_option): Handle new option.
+
+2011-04-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/48462
+	PR fortran/48746
+	* trans-expr.c ( arrayfunc_assign_needs_temporary): Need a temp
+	if automatic reallocation on assignement is active, the lhs is a
+	target and the rhs an intrinsic function.
+	(realloc_lhs_bounds_for_intrinsic_call): Rename as next.
+	(fcncall_realloc_result): Renamed version of above function.
+	Free the original descriptor data after the function call.Set the bounds and the
+	offset so that the lbounds are one.
+	(gfc_trans_arrayfunc_assign): Call renamed function.
+
+2011-04-29  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/48810
+	* resolve.c (resolve_typebound_generic_call): Don't check access
+	flags of the specific function.
+
+	PR fortran/48800
+	* resolve.c (resolve_formal_arglist): Don't change AS_DEFERRED
+	to AS_ASSUMED_SHAPE for function results.
+	(resolve_fl_var_and_proc): Print also for function results with
+	AS_DEFERRED an error, if they are not a pointer or allocatable.
+	(resolve_types): Make sure arguments of procedures in interface
+	blocks are resolved.
+
+2011-04-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/48112
+	* resolve.c (resolve_fl_var_and_proc): Print diagnostic of
+	function results only once.
+	(resolve_symbol): Always resolve function results.
+
+	PR fortran/48279
+	* expr.c (gfc_check_vardef_context): Fix handling of generic
+	EXPR_FUNCTION.
+	* interface.c (check_interface0): Reject internal functions
+	in generic interfaces, unless -std=gnu.
+
+2011-04-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/48788
+	* resolve.c (resolve_global_procedure): Error recovery -
+	avoid segfault for (non)character-returning functions.
+
+2011-04-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/48588
+	* parse.c (resolve_all_program_units): Skip modules.
+	(translate_all_program_units): Handle modules.
+	(gfc_parse_file): Defer code generation for modules.
+	* module.c (fix_mio_expr): Commit created symbol.
+
+2011-04-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/48360
+	PR fortran/48456
+	* trans-array.c (get_std_lbound): For derived type variables
+	return array valued component lbound.
+
+2011-04-05  Duncan Sands  <baldrick@free.fr>
+
+	* f95-lang.c (build_builtin_fntypes): Swap frexp parameter types.
+
+2011-04-04  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/48291
+	* class.c (get_unique_hashed_string): Adjust maximum allowable length
+	for unique type string.
+
+2011-03-25  Release Manager
+
+	* GCC 4.6.0 released.
+
+2011-03-12  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/48059
+	* trans-expr.c (gfc_apply_interface_mapping_to_expr): Replace base type
+	for polymorphic arguments.
+
+2011-03-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/48054
+	* intrinsic.texi: Clarify doc of logarithm functions.
+
+2011-03-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/47552
+	* trans-intrinsic.c (gfc_conv_intrinsic_ctime): Fix type of
+	the string length variable.
+
+2011-03-11  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47768
+	* module.c (ab_attribute,attr_bits): Add AB_PROC_POINTER_COMP.
+	(mio_symbol_attribute): Handle attribute 'proc_pointer_comp'.
+
+2011-03-06  Paul Thomas  <pault@gcc.gnu.org>
+	    Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/47850
+	* expr.c (gfc_is_constant_expr): Only use gfc_constant_ac if
+	the expression has an iterator.  Otherwise, iterate through the
+	array, checking for constant expressions for each element.
+
+2011-03-04  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR libfortran/47802
+	* intrinsic.texi: Update CTIME and FDATE documentation.
+
+2011-03-03  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
+
+	* invoke.texi (Option Summary, Fortran Dialect Options)
+	(Preprocessing Options, Runtime Options, Code Gen Options):
+	Fix vertical list spacing by using @itemx for additinoal
+	items, empty line before @table.  Fix typos.
+
+2011-02-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/47894
+	* intrinsic.texi: Fix doc of the VERIFY intrinsic.
+
+2011-02-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47846
+	* trans-stmt.c (gfc_trans_allocate): Fix allocation with
+	type-spec of deferred-length strings.
+
+2011-02-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47886
+	* openmp.c (gfc_resolve_omp_directive): Resolve if()
+	condition of OpenMP's task.
+
+2011-02-26  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/47894
+	* intrinsic.texi: Fix doc of the VERIFY intrinsic.
+
+2011-02-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47872
+	* intrinsic.texi (ALLOCATED, ATAN, BESSEL_JN, BESSEL_YN): Add
+	multitable for linebreak between different syntax variants.
+
+2011-02-24  Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/47839
+	* f95-lang.c (pushdecl): For externs in non-global scope push
+	a copy of the decl into the BLOCK.
+
+2011-02-23  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/40850
+	* trans.c (gfc_prepend_expr_to_block): New function.
+	* trans.h (gfc_prepend_expr_to_block): Declare.
+	* trans-array.c (gfc_conv_array_parameter): Replace
+	gfc_add_expr_to_block with gfc_prepend_expr_to_block.
+
+2011-02-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/45743
+	* trans-decl.c (gfc_get_extern_function_decl): Don't use the
+	gsymbol backend_decl if the procedure has a formal argument
+	that is a procedure.
+
+2011-02-22  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41359
+	* trans-stmt.c (gfc_trans_if_1): Use correct line for
+	expressions in the if condition.
+
+2011-02-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47797
+	* trans-decl.c (gfc_trans_deferred_vars): Use gfc_set_backend_locus and
+	gfc_restore_backend_locus to have better debug locations.
+	* trans-array.c (gfc_trans_deferred_array): Ditto.
+
+2011-02-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/45077
+	PR fortran/44945
+	* trans-types.c (gfc_get_derived_type): Remove code that looks
+	for decls in gsym and add call to gfc_get_module_backend_decl.
+	* trans.h : Add prototype for gfc_get_module_backend_decl.
+	* trans-decl.c (gfc_get_module_backend_decl): New function.
+	(gfc_get_symbol_decl): Call it.
+
+2011-02-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/47348
+	* trans-array.c (get_array_ctor_all_strlen): Move up in file.
+	(get_array_ctor_var_strlen): Add block dummy and add call to
+	get_array_ctor_all_strlen instead of giving up on substrings.
+	Call gcc_unreachable for default case.
+	(get_array_ctor_strlen): Add extra argument to in call to
+	get_array_ctor_var_strlen.
+
+2011-02-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47789
+	* primary.c (gfc_match_structure_constructor): Handle empty parent
+	types.
+
+2011-02-18  Tobias Burnus
+
+	PR fortran/47775
+	* trans-expr.c (arrayfunc_assign_needs_temporary): Use
+	esym to check whether the specific procedure returns an
+	allocatable or pointer.
+
+2011-02-18  Michael Matz  <matz@suse.de>
+
+	PR fortran/45586
+	* gfortran.h (struct gfc_component): Add norestrict_decl member.
+	* trans.h (struct lang_type): Add nonrestricted_type member.
+	* trans-expr.c (gfc_conv_component_ref): Search fields with correct
+	parent type.
+	* trans-types.c (mirror_fields, gfc_nonrestricted_type): New.
+	(gfc_sym_type): Use it.
+
+2011-02-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47768
+	* resolve.c (resolve_transfer): Reject variables with procedure pointer
+	components.
+
+2011-02-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47767
+	* gfortran.h (gfc_check_access): Removed prototype.
+	(gfc_check_symbol_access): Added prototype.
+	* module.c (gfc_check_access): Renamed to 'check_access', made static.
+	(gfc_check_symbol_access): New function, basically a shortcut for
+	'check_access'.
+	(write_dt_extensions,write_symbol0,write_generic,write_symtree): Use
+	'gfc_check_symbol_access'.
+	(write_operator,write_module): Renamed 'gfc_check_access'.
+	* resolve.c (resolve_fl_procedure,resolve_fl_derived,
+	resolve_fl_namelist,resolve_symbol,resolve_fntype): Use
+	'gfc_check_symbol_access'.
+
+2011-02-16  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47745
+	* class.c (gfc_build_class_symbol): Set 'class_ok' attribute.
+	* decl.c (build_sym,attr_decl1): Move setting of 'class_ok' into
+	'gfc_build_class_symbol'.
+	(gfc_match_decl_type_spec): Reject unlimited polymorphism.
+	* interface.c (matching_typebound_op): Check for 'class_ok' attribute.
+	* match.c (select_type_set_tmp): Move setting of 'class_ok' into
+	'gfc_build_class_symbol'.
+	* primary.c (gfc_variable_attr): Check for 'class_ok' attribute.
+
+2011-02-15  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/47633
+	. simplify.c (gfc_simplify_compiler_version): Fix off-by-one issue.
+
+2011-02-14  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47730
+	* parse.c (gfc_build_block_ns): Commit 'block@' symbol.
+
+2011-02-14  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47728
+	* class.c (gfc_build_class_symbol): Give a fatal error on polymorphic
+	arrays.
+	* primary.c (gfc_match_varspec): Avoid ICE for invalid class
+	declaration.
+
+2011-02-14  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47349
+	* interface.c (get_expr_storage_size): Handle derived-type components.
+
+2011-02-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47569
+	* interface.c (compare_parameter): Avoid ICE with
+	character components.
+
+2011-02-12  Janus Weil  <janus@gcc.gnu.org>
+
+	* class.c (gfc_build_class_symbol): Reject polymorphic arrays.
+	* decl.c (build_sym,build_struct,attr_decl1): Use return value of
+	'gfc_build_class_symbol'.
+
+2011-02-12  Michael Matz  <matz@suse.de>
+	    Janus Weil  <janus@gcc.gnu.org>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45586
+	* trans-expr.c (conv_parent_component_references): Avoid unintendent
+	skipping of parent compounds.
+
+2011-02-11  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47550
+	* resolve.c (resolve_formal_arglist): PURE with VALUE
+	and no INTENT: Add -std= diagnostics.
+
+2011-02-09  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47352
+	* resolve.c (resolve_procedure_interface): If interface has a result
+	variable, copy the typespec and set result pointer to self.
+
+2011-02-09  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47463
+	* resolve.c (resolve_typebound_subroutine): Remove erroneous line.
+
+2011-02-09  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47637
+	* trans-decl.c (init_intent_out_dt): Handle CLASS arguments.
+
+2011-02-08  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	* io.c (match_io_element): Do not set dt if not inquire.
+
+2011-02-08  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45290
+	* expr.c (gfc_check_assign_symbol): Reject pointers as pointer
+	initialization target.
+
+2011-02-07  Janne Blomqvist  <jb@gcc.gnu.org>
+	    Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
+
+	* gfortran.texi (Thread-safety): texinfo styling fixes.
+	* intrinsic.texi: Likewise.
+
+2011-02-06  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	* gfortran.texi (Compiler Characteristics): Add reference to
+	thread-safety section.
+
+2011-02-06  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	* gfortran.texi (Thread-safety): New section.
+	* intrinsic.texi (EXECUTE_COMMAND_LINE): Mention thread-safety.
+	(GETENV): Likewise.
+	(GET_ENVIRONMENT_VARIABLE): Likewise.
+	(SYSTEM): Likewise.
+
+2011-02-06  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/47592
+	* trans-stmt.c (gfc_trans_allocate): For deferred character
+	length allocations with SOURCE, store to the values and string
+	length to avoid calculating twice.  Replace gfc_start_block
+	with gfc_init_block to avoid unnecessary contexts and to keep
+	declarations of temporaries where they should be. Tidy up the
+	code a bit.
+
+2011-02-05  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/42434
+	* intrinsic.texi (SYSTEM_CLOCK): Update documentation.
+
+2011-02-02  Janus Weil  <janus@gcc.gnu.org>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/47082
+	* trans-expr.c (gfc_trans_class_init_assign): Add call to
+	gfc_get_derived_type.
+	* module.c (read_cleanup): Do not use unique_symtrees for vtabs
+	or vtypes.
+
+2011-02-02  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47572
+	* resolve.c (resolve_fl_variable): Handle polymorphic allocatables.
+
+2011-02-01  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47565
+	* trans-expr.c (gfc_conv_structure): Handle constructors for procedure
+	pointer components with allocatable result.
+
+2011-01-31  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47455
+	* trans-expr.c (gfc_conv_procedure_call): Handle procedure pointers
+	with pointer or allocatable result.
+
+2011-01-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/47519
+	* trans-stmt.c (gfc_trans_allocate): Improve handling of
+	deferred character lengths with SOURCE.
+	* iresolve.c (gfc_resolve_repeat): Calculate character
+	length from source length and ncopies.
+	* dump-parse-tree.c (show_code_node): Show MOLD and SOURCE
+	expressions for ALLOCATE.
+
+2011-01-31  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47463
+	* resolve.c (resolve_typebound_subroutine): Bug fix for the case of
+	an argument of a typebound assignment being a component.
+
+2011-01-31  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
+
+	* gfortranspec.c (add_arg_libgfortran) [HAVE_LD_STATIC_DYNAMIC] Use
+	LD_STATIC_OPTION, LD_DYNAMIC_OPTION.
+
+2011-01-31  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47042
+	* resolve.c (resolve_fl_procedure): Reject stmt functions
+	with pointer/allocatable attribute.
+
+2011-01-31  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47042
+	* interface.c (gfc_procedure_use): Add explicit interface check for
+	pointer/allocatable functions.
+
+2011-01-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/47523
+	* trans-expr.c (gfc_trans_assignment_1): If the rhs is an op
+	expr and is assigned to a deferred character length scalar,
+	make sure that the function is called before reallocation,
+	so that the length is available. Include procedure pointer
+	and procedure pointer component rhs as well.
+
+	PR fortran/45170
+	PR fortran/35810
+	PR fortran/47350
+	* gfortran.dg/allocatable_function_5.f90: New test not added by
+	mistake on 2011-01-28.
+
+2011-01-29  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47531
+	* check.c (gfc_check_shape): Support kind argument in SHAPE.
+	* intrinsic.c (add_functions): Ditto.
+	* resolve.c (gfc_resolve_shape): Ditto.
+	* simplify.c (gfc_simplify_shape): Ditto.
+	* intrinsic.h (gfc_check_shape, gfc_resolve_shape,
+	gfc_simplify_shape): Update prototypes.
+	* intrinisc.text (SHAPE): Document kind argument.
+
+2011-01-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47507
+	* resolve.c (resolve_formal_arglist): Allow arguments with VALUE
+	attribute also without INTENT.
+
+2011-01-28  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi (Fortran 2003 status): Mention support for
+	nonconstant namelist variables.
+
+2011-01-28  Paul Thomas  <pault@gcc.gnu.org>
+	    Tobias Burnus  <burnus@gcc.gnu.org>
+
+	PR fortran/45170
+	PR fortran/35810
+	PR fortran/47350
+	* interface.c (compare_actual_formal): An allocatable or pointer
+	deferred length actual is only allowed if the formal argument
+	is also deferred length. Clean up whitespace.
+	* trans-expr.c (gfc_conv_procedure_call): Pass string length for
+	deferred character length formal arguments by reference. Do the
+	same for function results.
+	(gfc_trans_pointer_assignment): Do not do runtime check of lhs
+	and rhs character lengths, if deferred length lhs.  In this case
+	set the lhs character length to that of the rhs.
+	(gfc_conv_string_parameter): Remove assert that string length is
+	an integer type.
+	(is_scalar_reallocatable_lhs): New function.
+	(alloc_scalar_allocatable_for_assignment): New function.
+	(gfc_trans_assignment_1): Call above new function. If the rhs is
+	a deferred character length itself, makes ure that the function
+	is called before reallocation, so that the length is available.
+	(gfc_trans_asssignment): Remove error about assignment to
+	deferred length character variables.
+	* gfortran.texi : Update entry about (re)allocation on
+	assignment.
+	* trans-stmt.c (gfc_trans_allocate): Add code to handle deferred
+	length character variables.
+	* module.c (mio_typespec): Transfer deferred characteristic.
+	* trans-types.c (gfc_get_function_type): New code to generate
+	hidden typelist, so that those character lengths that are
+	passed by reference get the right type.
+	* resolve.c (resolve_contained_fntype): Supress error for
+	deferred character length functions.
+	(resolve_function, resolve_fl_procedure) The same.
+	(check_symbols): Remove the error that support for
+	entity with deferred type parameter is not yet implemented.
+	(resolve_fl_derived): The same.
+	match.c (alloc_opt_list): Allow MOLD for deferred length object.
+	* trans-decl.c (gfc_get_symbol_decl): For deferred character
+	length dummies, generate a local variable for string length.
+	(create_function_arglist): Hidden length can be a pointer.
+	(gfc_trans_deferred_vars): For deferred character length
+	results and dummies, assign the string length to the local
+	variable from the hidden argument on entry and the other way
+	round on exit, as appropriate.
+
+2011-01-27  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47474
+	* trans-decl.c (gfc_generate_function_code): Fix init
+	of allocatable result variable with allocatable components.
+
+2011-01-27  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47472
+	* options.c (gfc_handle_module_path_options): Save
+	module path without trailing slash as include path.
+
+2011-01-25  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47448
+	* interface.c (gfc_check_operator_interface): Fix
+	defined-assignment check.
+
+2011-01-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47421
+	* trans-decl.c (gfc_trans_deferred_vars): Do not nullify
+	scalar allocatable dummy arguments.
+
+2011-01-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/38536
+	* resolve.c (gfc_iso_c_func_interface):  For C_LOC,
+	check for array sections followed by component references
+	which are illegal.  Also check for coindexed arguments.
+
+2011-01-22  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47399
+	* primary.c (gfc_match_varspec): Relax gcc_assert to allow for
+	PARAMETER TBP.
+
+2011-01-21  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47394
+	* error.c (gfc_error_now, gfc_fatal_error, gfc_error_check):
+	Use defined instead of magic number exit status codes.
+	* scanner.c (include_line, gfc_new_file): Ditto.
+
+2011-01-21  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47377
+	* expr.c (gfc_check_pointer_assign): Reject expr data-targets
+	without pointer attribute.
+
+2011-01-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47240
+	* resolve.c (expression_rank): Fix rank of procedure poiner components.
+	* trans-expr.c (gfc_conv_procedure_call): Take care of procedure
+	pointer components as actual arguments.
+
+2011-01-17  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/47331
+	* gfortran.h (struct gfc_omp_saved_state): New type.
+	(gfc_omp_save_and_clear_state, gfc_omp_restore_state): New prototypes.
+	* resolve.c (resolve_global_procedure): Call it around gfc_resolve
+	call.
+	* openmp.c (gfc_omp_save_and_clear_state, gfc_omp_restore_state): New
+	functions.
+
+2011-01-17  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47327
+	* invoke.texi (Options to request or suppress errors
+	and warnings): Fix cross link.
+
+2011-01-15  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi: Update Fortran 2003 Status section.
+
+	PR fortran/47177
+	* invoke.texi: Add missing "-E" to the -dM example.
+
+2011-01-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47268
+	* intrinsic.texi (get_command_argument, get_environment_variable):
+	Mark arguments as optional in the Arguments section.
+
+2011-01-13  Kai Tietz  <kai.tietz@onevision.com>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/47260
+	* trans-decl.c (gfc_get_extern_function_decl,
+	build_function_decl): Set TREE_PUBLIC/TREE_EXTERNAL before
+	calling decl_attributes.
+
+2011-01-13  Tobias Burnus  <burnus@net-b.de>
+	    Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/45848
+	PR fortran/47204
+	* gfortran.h (gfc_code): Move union ext's case_list into
+	the struct block.
+	* dump-parse-tree.c (show_code_node): Adapt by prefixing case_list
+	by "block.".
+	* frontend-passes.c (gfc_code_walker): Ditto.
+	* match.c (gfc_match_goto, gfc_match_call, gfc_match_case,
+	gfc_match_type_is, gfc_match_class_is): Ditto.
+	* resolve.c (resolve_select, resolve_select_type): Ditto.
+	* st.c (gfc_free_statement): Ditto.
+	* trans-stmt.c (gfc_trans_integer_select, gfc_trans_logical_select,
+	gfc_trans_character_select): Ditto.
+	* parse.c (resolve_all_program_units): For error recovery, avoid
+	segfault is proc_name is NULL.
+
+2011-01-11  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/47051
+	* trans-array.c (gfc_alloc_allocatable_for_assignment): Change
+	to be standard compliant by testing for shape rather than size
+	before skipping reallocation. Improve comments.
+
+2011-01-09  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47224
+	* resolve.c (resolve_actual_arglist): Remove unneeded and buggy piece
+	of code.
+
+2011-01-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/38536
+	* resolve.c (is_scalar_expr_ptr):  For a substring reference,
+	use gfc_dep_compare_expr to compare start and end expession.
+	Add FIXME for using gfc_deb_compare_expr elsewhere.
+
+2011-01-09  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46313
+	* class.c (get_unique_type_string): Make type name start with upper
+	case letter.
+
+2011-01-08  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/46405
+	* invoke.texi:  Mention -ffree-line-length-none and
+	-ffixed-line-length-none for preprocessing.
+
+2011-01-08  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/46896
+	* trans-expr.c (gfc_conv_procedure_call): With a non-copying
+	procedure argument (eg TRANSPOSE) use a temporary if there is
+	any chance of aliasing due to host or use association.
+	(arrayfunc_assign_needs_temporary): Correct logic for function
+	results and do not use a temporary for implicitly PURE
+	variables.  Use a temporary for Cray pointees.
+	* symbol.c (gfc_add_save): Explicit SAVE not compatible with
+	implicit pureness of containing procedure.
+	* decl.c (match_old_style_init, gfc_match_data): Where decl
+	would fail in PURE procedure, set implicit_pure to zero.
+	* gfortran.h : Add implicit_pure to structure symbol_attr and
+	add prototype for function gfc_implicit_pure.
+	* expr.c (gfc_check_pointer_assign, gfc_check_vardef_context):
+	Where decl would fail in PURE procedure, reset implicit_pure.
+	* io.c (match_vtag, gfc_match_open, gfc_match_close,
+	gfc_match_print, gfc_match_inquire, gfc_match_wait): The same.
+	* match.c (gfc_match_critical, gfc_match_stopcode,
+	sync_statement, gfc_match_allocate, gfc_match_deallocate): The
+	same.
+	* parse.c (decode_omp_directive): The same.
+	(parse_contained): If not PURE, set implicit pure attribute.
+	* resolve.c (resolve_formal_arglist, resolve_structure_cons,
+	resolve_function, resolve_ordinary_assign) : The same.
+	(gfc_implicit_pure): New function.
+	* module.c (mio_symbol_attribute): Introduce AB_IMPLICIT_PURE
+	to ab_attribute enum and use it in this function.
+
+2011-01-08  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/45777
+	* symbol.c (gfc_symbols_could_alias):  Strip gfc_ prefix,
+	make static and move in front of its only caller, to ...
+	* trans-array.c (symbols_could_alias): ... here.
+	Pass information about pointer and target status as
+	arguments.  Allocatable arrays don't alias anything
+	unless they have the POINTER attribute.
+	(gfc_could_be_alias):  Keep track of pointer and target
+	status when following references.  Also check if typespecs
+	of components match those of other components or symbols.
+
+2011-01-07  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41580
+	* class.c (gfc_build_class_symbol): Mark __vtab as attr.vtab.
+	* intrinsic.c (add_functions): Use simplify functions for
+	EXTENDS_TYPE_OF and SAME_TYPE_AS.
+	* intrinsic.h (gfc_simplify_extends_type_of,
+	gfc_simplify_same_type_as): New prototypes.
+	* simplify.c (is_last_ref_vtab, gfc_simplify_extends_type_of,
+	gfc_simplify_same_type_as): New functions.
+
+2011-01-07  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47189
+	PR fortran/47194
+	* gfortran.h (gfc_lval_expr_from_sym): Moved prototype.
+	* class.c (gfc_class_null_initializer): Initialize _vptr to declared
+	type.
+	* expr.c (gfc_lval_expr_from_sym): Moved here from symbol.c.
+	* resolve.c (resolve_deallocate_expr): _data component will be added
+	at translation stage.
+	* symbol.c (gfc_lval_expr_from_sym): Moved to expr.c.
+	* trans-stmt.c (gfc_trans_deallocate): Reset _vptr to declared type.
+
+2011-01-06  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/33117
+	PR fortran/46478
+	* parse.c (parse_interface): Remove check for procedure types.
+	* interface.c (check_interface0): Verify that procedures are
+	either all SUBROUTINEs or all FUNCTIONs.
+
+2011-01-05  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47180
+	* trans-expr.c (gfc_trans_class_assign): Bugfix for r168524 (make sure
+	'vtab' is initialized).
+
+2011-01-05  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47180
+	* trans-expr.c (gfc_trans_class_assign): For a polymorphic NULL pointer
+	assignment, set the _vptr component to the declared type.
+
+2011-01-05  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/46017
+	* resolve.c (resolve_allocate_deallocate): Follow references to
+	check for duplicate occurence of allocation/deallocation objects.
+
+2011-01-05  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47024
+	* trans-decl.c (gfc_trans_deferred_vars): Initialize the _vpr component
+	of polymorphic allocatables according to their declared type.
+
+2011-01-04  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46448
+	* class.c (gfc_find_derived_vtab): Set the module field for the copying
+	routine to make sure it receives module name mangling.
+
+2011-01-03  Jakub Jelinek  <jakub@redhat.com>
+
+	* gfortranspec.c (lang_specific_driver): Update copyright notice
+	dates.
+
+2011-01-03  Janus Weil  <janus@gcc.gnu.org>
+
+	* intrinsic.texi (LEADZ): Fix example.
+
+2011-01-02  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46408
+	* class.c (gfc_find_derived_vtab): Use EXEC_INIT_ASSIGN for __copy_
+	routine.
+
+
+Copyright (C) 2011 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved.
diff --git a/gcc/fortran/ChangeLog-2002 b/gcc/fortran/ChangeLog-2002
new file mode 100644
index 000000000..fdee6e644
--- /dev/null
+++ b/gcc/fortran/ChangeLog-2002
@@ -0,0 +1,340 @@
+2002-12-29  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c: Document calling convention for arrays.
+
+2002-12-19  Paul Brook  <paul@nowt.org>
+
+	* trans-intrinsic.c (g95_conv_intrsinsic_function): Remove incorrect
+	assertion. Remove intrinsic subroutine G95_ISYM_* cases. Always pass
+	optional parameters for some intrinsics.
+	(g95_is_intrinsic_libcall): Add G95_ISYM_RESHAPE.
+	* trans-expr.c (g95_conv_function_call): Pass NULL for absent
+	optional parameters.
+	* trans.h (g95_se): Add ignore_optional flag.
+
+2002-12-15  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_conv_array_parameter): Fix partial rank sections.
+	* trans-decl.c (g95_generate_function_code): Use TDI_original.
+
+2002-12-14  Paul Brook  <paul@nowt.org>
+
+	* trans-stmt.c (g95_trans_call): Use resolved symbol name.
+
+2002-12-12  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_trans_array_constructor_subarray): Fully
+	initialize the scalarizer.
+	(various): Update to new format of g95_expr->value.constructor.
+
+2002-12-08  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_put_offset_into_var): New function.
+	(g95_trans_array_constructor_subarray): New function.
+	(g95_trans_array_constructor_value): Use it.
+	(g95_array_cons_size): Don't abort() on array components.
+
+2002-12-08  Paul Brook  <paul@nowt.org>
+
+	* Make-lang.in (F95_ADDITIONAL_OBJS): Remove tree-dchain.o.
+	* support.c: Update #includes.
+	(statement_code_p, c_size_in_bytes, s_size_type_node): Remove.
+	* trans-array.c: Update #includes.
+	* trans.c: Ditto.
+	* trans-const.c: Ditto.
+	* trans-io.c: Ditto.
+	* trans-types.c: Ditto.
+	(g95_init_types): Set size_type_node.
+	* trans-decl.c: Update #includes.
+	(gfor_fndecl_adjust{l,r}): Declare and initialize.
+	* trans-stmt.c: Update #includes.
+	(g95_trans_do_while): Generate LABEL_EXPR, not GOTO_EXPR.
+	(g95_trans_select): Fix check for unbounded ranges.
+	* trans-expr.c: Update #includes.
+	(g95_conv_string_tmp): New function.
+	(g95_conv_concat_op): Use it.
+	* trans.h (g95_conv_string_tmp, gfor_fndecl_adjust{l,r}): Declare.
+	* Trans-intrisic.c: Update #includes.
+	(g95_conv_intrinsic_strcmp): New function.
+	(g95_conv_intrinsic_adjust): Ditto.
+	(g95_conv_intrinsic_function: Use them.
+
+2002-11-30  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_walk_function_expr): Handle non-array return by
+	reference.
+	* trans-dec.c (g95_build_function_decl): Handle character return
+	parammeters.
+	(g95_get_fake_result_decl): Ditto.
+	(g95_trans_deferred_vars): Ditto.
+	* trans-expr.c (g95_conv_function_call): Ditto.
+	(g95_trans_arrayfunc_assign) Limit to array valued functions.
+	* trans-intrinsic.c (g95_conv_intrinsic_char): New function.
+	(g95_conv_intrinsic_function): Use it.
+	* trans-types.c (g95_sym_type): Handle functions returning strings.
+	(g95_return_by_reference): Ditto.
+	(g95_get_function_type): Ditto.
+
+2002-11-18  Paul Brook  <paul@nowt.org>
+
+	* trans-stmt.c (g95_trans_if): Fix IF statements when the condition
+	requires a temporary.
+	(g95_trans_select): Handle computed gotos.
+	* trans-types.c (g95_build_array_type): Warn about non-functional
+	assumed shape arrays.
+	* trans-expr.c (g95_trans_scalar_assign): Correctly handle post
+	blocks.
+	* trans-intrinsic.c (g95_conv_intrinsic_round): New function.
+	(g95_conv_intrinsic_int): New function.
+	(g95_conv_intrinsic_mod): New function.
+	(g95_conv_intrinsic_ichar): New function.
+	(g95_conv_intrinsic_function): Use them.
+	(g95_conv_intrinsic_dim): Use g95_evaluate_now.
+
+2002-11-17  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* trans-types.c (g95_build_array_type): Assumed
+	sized arrays can have rank > 1.
+	* trans.c (g95_trans_code): Remove erroneous
+	warning about CONTINUE.
+	* trans-expr.c (g95_conv_variable): Remove
+	erroneous assert.
+
+2002-11-15  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_conv_array_parameter): Check for NULL stride.
+
+2002-10-31  Paul Brook  <paul@nowt.org>
+
+	* f95-tree.c: Remove tree copying stuff that's now in gimple.c
+	* trans-expr.c (g95_conv_component_ref): Handle character string
+	components.
+	(g95_conv_string_parameter): Ditto.
+	* trans-types.c (g95_get_derived_type): Add length decl to caracter
+	string components.
+
+2002-10-10  Paul Brook  <paul@nowt.org>
+
+	* trans-decl.c (gfor_fndecl_size?): Declare and initialize.
+	* trans-expr.c (g95_conv_function_call): Remove unreliable return value
+	check.
+	* trans-intrinsic.c (g95_conv_intrinsic_size): New function.
+	(g95_conv_intrinsic_function): Handle size and shape intrinsics.
+	(g95_is_intrinsic_libcall): Add G95_ISYM_SHAPE.
+	* trans-types.c (pvoid_type_node): Declare and initialize.
+	* trans-array.c: Fix typo COMPONENT_REF->REF_COMPONENT
+	(g95_array_allocate): Fix when base==data.
+	(g95_conv_array_parameter): Correctly handle reduced rank sections.
+	* trans-io.c (g95_trans_write): Correctly handle string modifiers.
+
+2002-10-09  Paul Brook  <paul@nowt.org>
+
+	* (g95_conv_expr_reference): Handle character strings correctly.
+
+2002-10-07  Paul Brook  <paul@nowt.org>
+
+	(g95_expand_decl): Rename from f95_expand_decl_stmt and use as
+	langhook.
+	* trans-array.c (g95_build_array_initializer): Remove.
+	(g95_conv_array_initializer): New Function.
+	(g95_trans_auto_arry_allocation): Cleanup.
+	(g95_trans_init_character_array): Remove.
+	* g95spec.c: Link in libgforbegin.
+	* trans.c (g95_generate_code): Rename main function to MAIN__.
+	(g95_create_var): New function.
+	(g95_create_var_np): New function.
+	(g95_evaluate_now): New function.
+	(g95_start_block): New function.
+	(g95_finish_block): New function.
+	(g95_add_expr_to_block): New function.
+	(g95_add_block_to_block): New function.
+	* trans-expr.c (g95_conv_componen_ref): New function.
+	* Make-lang.in (F95_ADDITIONAL_OBJS): Add gimplify.o.
+	(F95_OBJS): Add dependency.o.
+	* f95-lang.c (g95_is_simple_stmt): Remove.
+	* f95-tree.c (mark_not_simple): New function.
+	(unshare_all_trees): New function.
+	(create_tmp_var, create_tmp_alias_var): Remove.
+	* support.c (declare_tmp_vars, tree_last_decl): Remove.
+	* trans*: Convert to new IR using GENERIC trees.  Don't bother about
+	SIMPLE/GIMPLE rules, this is now done by Lang-independant code.
+
+2002-10-01  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c: Add support for descriptorless arrays.
+	(g95_conv_array_data): New function.
+	(g95_conv_array_base): New function.
+	* trans-array.h: Declare these here.
+	* trans-decl.c(g95_create_mopdule_variable): Perform variable
+	initialization and creation here.
+	(g95_create_module_vars): Instead of here.
+	* trans.h (G95_TYPE_ARRAY_*: Rename from G95_TYPE_DESCRIPTOR_*.
+	* trans-intrinsic.c: Ditto.
+	* trans-types.c (g95_is_nodesc_array): New function.
+	(g95_get_nodesc_array_type): New function.
+	(g95_sym_type, g95_get_derived_type): Use them.
+	* trans-const.c (g95_conv_mpf_to_tree): Remove workaround.
+
+2002-09-28  Paul Brook  <paul@nowt.org>
+
+	* trans-const.c (g95_conv_mpf_to_tree): Work around backend bug.
+	* trans-intrinsic.c (g95_conv_intrinsic_abs): Correctly detect complex
+	parameters.
+
+2002-09-24  Paul Brook  <paul@nowt.org>
+
+	* f95-lang.c (listify): Remove declaration.
+	(expand_function_body): Use optimize >=1 instead of flag_tree_saa.
+	(listify)
+	* f95-tree.c (get_name): New function.
+	* trans.c (module_namespace): Remove.
+	* trans-decl.c: Use g95_chainon_list rather than chainon(listify()).
+	* trans-types.c: Ditto.
+
+2002-09-19  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_get_array_cons_size): New Function.
+	(g95_con_ss_startstride): Handle Array constructors.
+	(g95_conv_loop_setup): Ditto.
+	(g95_conv_array_parameter): Ditto.
+	* tras-decl.c (g95_finish_var_decl): Make initializes variables
+	static.
+
+2002-09-19  Paul Brook  <paul@nowt.org>
+
+	* trans.c (g95_simple_fold_tmp): Detect variables inside
+	NON_LVALUE_EXPR.
+	* trans-stmt.c (g95_trans_arithmetic_if): Implement this.
+
+2002-09-18  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* Make-lang.in (F95_ADDITIONAL_OBJS): Add tree-ssa-dce.o
+
+2002-09-14  Paul Brook  <paul@nowt.org>
+
+	* trans.c (g95_create_module_variable): Move to trans-decl.c.
+	* trans-const.c (g95_conv_string_init): New Function.
+	* trans-const.h: Declare it.
+	* trans-decl.c (g95_get_symbol_decl): Handle initializers for static
+	variables. Don't bail on intrinsic symbols.
+	(get_extern_function_decl): Handle specific intrinsic functions.
+	* trans-types.c (g95_sym_type): Dummy functions don't return
+	reference types.
+	* trans-array.c (g95_build_array_initializer): New Function.
+	(g95_trans_auto_array_allocation): Build initializer for static decls.
+	Don't use mpz_addmul, it's GMP4 only.
+
+2002-09-12  Paul Brook  <paul@nowt.org>
+
+	* trans-decl.c (g95_generate_code): Fix thinko with return variable.
+	(g95_get_extern_function_decl, g95_build_function_decl): Mangle
+	assembler names for module procedures.
+
+2002-09-11  Tobias Schlueter  <Tobias.Schlueter@physik.uni-muenchen.de>
+
+	* trans-array.c,h trans-expr.c, trans-stmt.c: Correct spelling of
+	dependency/
+
+2002-09-10  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c: Change format of G95_SS_TEMP strictures.
+	(g95_check_fncall_dependancy): New function.
+	(trans_dummy_array_bias): stride[n], not stride[n-1]. for calculating
+	offsets.
+	* trans-decl.c (g95_get_symbol_decl): move assertion after handling of
+	result variables.
+	(g95_build_function_decl): Don't assume result arrays are packed.
+	(g95_trans-deferred-vars): Handle array result variables.
+	(g95_generate_fuction_code): Clear saved_function_decls.
+	* trans-expr.c (g95_conv_fnction_call): Handle direct array return by
+	reference.
+	(g95_trans_arrayfunc_assign): New function.
+	(g95_trans_assignment): Use it.
+	* trans.h (g95_ss): Add temp struct for G95_SS_TEMP.
+	(g95_se): Add direct_byref.
+	* trans-types.c: Use sym->result rather than sym where appropriate.
+	* trans-intrinsic.c (g95_conv_intrinsic_funcall): New function.
+	Update other functions to use this.
+	(g95_is_intrinsic_libcall): New function.
+	(g95_conv_intrinsic_function): Add MATMUL and PRODUCT intrinsics.
+	(g95_walk_intrinsic_function): Ditto.
+
+2002-09-08  Paul Brook  <paul@nowt.org>
+
+	* trans-types.c: Change rank field to dtype field in array descriptor.
+	* trans-array.c: Implement filling of dtype array descriptor field.
+	* trans-intrinsic.c: Fix broken LEN intrinsic.
+
+2002-09-07  Paul Brook  <paul@nowt.org>
+
+	* trans-intrinsic.c: Remove outdated todo intrinsic list.
+	(g95_get_symbol_for_expr): Remove hack for fortran based intrinsics.
+	(g95_walk_intrinsic_function): Add MINLOC and MAXLOC.
+
+2002-09-06  Paul Brook  <paul@nowt.org>
+
+	* Make-lang.in (F95_ADDITIONAL_OBJS): Add tree_alias_comon.o.
+	(gt-f95-trans-types.h): Add dependancy information.
+	* config-lang.in (gtfiles): Add trans-types.c
+	* f95-lang.c (g95_be_parse_file): Pass error and warning counts
+	back to top-level code.
+	* trans-array.c, trans-types.c: Change format of array descriptor.
+	(g95_conv_descriptor_dimension): New function.
+	* trans-types.h (g95_conv_descriptor_rank): define.
+	* trans-intrinsic.c: Implement PRODUCT, COUNT. MINLOC and MAXLOC
+	intrinsics.
+
+2002-09-02  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* trans-array.c, trans-types.c:	Add rank information to descriptor.
+
+2002-09-06  Tobias Schlueter  <Tobias.Schlueter@physik.uni-muenchen.de>
+
+	* trans-stmt.c (g95_trans_allocate): Fix when ref==NULL.
+
+2002-09-04  Paul Brook  <paul@nowt.org>
+
+	* f95-lang.c (g95_create_decls): New function.
+	(g95_init):  Move initialization of external decls to above, and call
+	from g95_be_parse_file.
+	* trans.c (g95_finish_stmt): Don't amputate the decl chain.
+	* trans-types.c (g95_init_types): Always name integer and char types.
+	(g95_get_array_type_bounds): TYPE_NAME may be a TYPE_DECL.
+
+2002-09-02  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* Make-lang.in: Add options.c to F95_PARSER_OBJS
+
+2002-09-02  Paul Brook  <paul@nowt.org>
+
+	* g95_generate_code: Clear the attr for __fortran_main.
+	* trans-types.c (g95_finish_type): New function.
+	* g95_init_io_state_type: Use g95_finish_type.
+	* g95_conv_intrinsic_anyall: Fix thinko in result initialization.
+
+2002-09-01  Paul Brook  <paul@nowt.org>
+
+	* README.backend: Warn about the dangers of extra config.h files.
+	Remove obsolete libgfor stuff.
+	* config-lang.in: Add target-libgfor dependancy.
+	* g95_conv_mpf_to_tree: Use & free allocated buffer p rather than buff.
+
+2002-09-01  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* g95_conv_mpz_to_tree: Free storage pointed to by q,
+	not by buff.
+
+2002-08-30  Paul Brook  <paul@nowt.org>
+
+	* trans-intrinsic.c (g95_conv_intrinsic_function,
+	g95_walk_intrinsic_function): Added ANY and ALL.
+	(g95_conv_intrinsic_anyall): New function.
+	* iresolve.c (g95_resolve_any, g95_resolve_all): Include rank in
+	mangled name
+
+
+Copyright (C) 2002 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved.
diff --git a/gcc/fortran/ChangeLog-2003 b/gcc/fortran/ChangeLog-2003
new file mode 100644
index 000000000..051ebb88f
--- /dev/null
+++ b/gcc/fortran/ChangeLog-2003
@@ -0,0 +1,2346 @@
+2003-12-26  Feng Wang  <fengwang@nudt.edu.cn>
+
+	* dump-parse-tree.c (gfc_show_code_node): Add ASSIGN and ASSIGNED GOTO
+	dumping.
+	* gfortran.h (gfc_statement): New ST_LABEL_ASSIGNMENT.
+	(gfc_exec_op): New EXEC_LABEL_ASSIGN.
+	(symbol_attribute):New variable attribute: assign.
+	* io.c (resolve_tag):Integer variable is allowed.
+	(match_dt_format): Add ASSIGN statement. Set assign flag.
+	* match.c (gfc_match_if): Change ST_NONE to ST_LABEL_ASSIGNMENT.
+	(gfc_match_assign): Add ASSIGN statement. Set assign flag.
+	(gfc_match_goto): Add ASSIGNED GOTO statement. Set assign flag.
+	* parse.c (decode_statement): Add ST_LABEL_ASSIGNMENT.
+	(next_statement): Add ST_LABEL_ASSIGNMENT.
+	(gfc_ascii_statement): Add ST_LABEL_ASSIGNMENT.
+	* resolve.c (resolve_code): Resolve ASSIGN and ASSIGNED GOTO statement.
+	(resolve_blocks): Resolve ASSIGNED GOTO statement label list.
+	* st.c (gfc_free_statement): Add EXEC_LABEL_ASSIGN.
+	* trans-decl.c (gfc_get_symbol_decl): Create the shadow variable for
+	assign.  Put them into the stuct lang_decl.
+	* trans-io.c (set_string): Add the assign statement.
+	* trans-stmt.c (gfc_trans_label_assign): New function.
+	(gfc_trans_goto): Translate ASSIGNED GOTO statement.
+	* trans-stmt.h (gfc_trans_label_assign): Added function prototype.
+	* trans.c (gfc_trans_code): Add EXEC_LABEL_ASSIGN.
+	* trans.h (lang_decl):Add shadow variable decl tree needed by assign.
+	(GFC_DECL_ASSIGN_ADDR(node)): New macro to access this.
+	(GFC_DECL_ASSIGN(node)): New macro to access flag.
+
+2003-12-31  Huang Chun  <chunhuang73@hotmail.com>
+
+	PR fortran/13434
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxval): Fixed bug in
+	minval/maxval.
+
+2003-12-22  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* options.c (gfc_init_options): Set flag_argument_noalias to 2, to indicate
+	that arguments to subroutines/functions can't alias themselves, nor global
+	memory.
+
+2003-12-20  Steven Bosscher  <stevenb@suse.de>
+
+	* trans-expr.c (gfc_conv_expr_op): Fold the result expression.
+	* trans.c (gfc_add_modify_expr, gfc_add_expr_to_block): Likewise.
+
+2003-12-12  Huang Chun  <chunhuang73@hotmail.com>
+
+	* primary.c (match_substring): Fix substring bug for start point
+	or end point is NULL.
+	* trans-expr.c (gfc_conv_substring): Ditto
+	* trans-types.c (gfc_sym_type): Get correct type of scalar
+	character variables.
+	* trans-intrinsic.c (gfc_conv_intrinsic_len): Handle character in
+	derived type.
+
+2003-12-10  Richard Henderson  <rth@redhat.com>
+
+	* options.c (gfc_post_options): Don't ever use rtl inlining.
+
+2003-12-05  Canqun Yang  <canqun@nudt.edu.cn>
+
+	* trans-common.c: Re-implement COMMON blocks and EQUIVALENCE lists.
+	* trans-equivalence.c: Remove.
+	* trans-decl.c (gfc_get_symbol_decl): Update to match.
+	(gfc_generate_function_code): Ditto.
+	* trans-array.c (gfc_conv_array_parameter): Ditto.
+	* Make-lang.in (F95_OBJS): Remove fortran/trans-equivalence.o
+	(F95_ADDITIONAL_OBJS): Add stor-layout.o
+	* trans.h (gfc_trans_equivalence): Remove.
+	* gfortran.h (struct gfc_equiv): Add used field.
+	(struct gfc_symbol): Remove addr_base, addr_offset, equiv_ring,
+	equiv_offset fields.
+
+2003-12-05  Richard Henderson  <rth@redhat.com>
+
+	* trans.c (gfc_build_addr_expr): New.
+	(gfc_build_indirect_ref, gfc_build_array_ref): New.
+	* trans.h: Declare them.
+	* trans-array.c, trans-expr.c, trans-intrinsic.c, trans-io.c,
+	trans-stmt.c, trans.c (*): Use them.
+
+	* f95-lang.c (gfc_post_options): Remove dead prototype.
+	* trans-array.c (gfc_trans_deferred_vars): Remove unused variable.
+	* trans-stmt.c (gfc_evaluate_where_mask): Fix temporary_list
+	allocation size.
+
+2003-12-01  Feng Wang  <fengwang@nudt.edu.cn>
+
+	* io.c (gfc_match_format): Check for missing format label.
+
+2003-11-30 Huang Chun  <chunhuang73@hotmail.com>
+
+	PR fortran/13155
+	* trans-decl.c (gfc_sym_mangled_function_id): Don't mangle symbols
+	from interfaces in modules.
+
+2003-11-30  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (gfc_trans_g77_array): Make non-static.
+	(gfc_trans_assumed_size): Remove.
+	(gfc_trans_dummy_array_bias): Explicitly free temporary.
+	* trans-array.h (gfc_trans_g77_array): Add prototype.
+	(gfc_trans_assumed_size): Remove.
+	* trans-decls.c (gfor_fndecl_push_context): Remove.
+	(gfor_fndecl_pop_context): Remove.
+	(gfc_build_function)decls): Don't create them.
+	(gfc_trans_deferred_vars): Update to match. Remove dead	code.
+	* trans-stmt.c (gfc_trans_pointer_assign_need_temp): Free temp.
+
+2003-11-30  Kejia Zhao  <kejia_zh@nudt.edu.cn>
+
+	* trans-array.c (gfc_conv_array_parameter): Simplify
+	array argument passing for array name actual argument.
+	* trans-expr.c (gfc_conv_function_call): Ditto
+	* trans-types.c (gfc_is_nodesc_array):Ditto.
+
+2003-11-30  Paul Brook  <paul@nowt.org>
+
+	* f95-lang.c (gfc_post_options): Move ...
+	* options.c (gfc_post_options): .. to here.  Handle inlining options.
+	* gfortran.h (gfc_post_options): Add prototype.
+
+2003-11-28  Richard Henderson  <rth@redhat.com>
+
+	* trans.c (gfc_create_var_np): Use create_tmp_var_raw.
+
+2003-11-28 Huang Chun  <chunhuang73@hotmail.com>
+
+	* trans.h (has_alternate_specifier): New global variable.
+	* match.c (gfc_match_call): Handle actual arguments associated with
+	alternate return indicators.
+	* trans-expr.c (gfc_conv_function_call): Ditto
+	* trans-stmt.c (gfc_trans_call): Ditto
+	(gfc_trans_return): Handle return statement with value.
+	* trans-decl.c (gfc_generate_function_code): Handle functions with
+	asterisk dummy.
+	(gfc_get_fake_result_decl): Ditto
+	* trans-types.c (gfc_get_function_type): Ditto
+	* resolve.c (resolve_actual_arglist): Check alternate return indicators.
+	(resolve_formal_arglist): Check asterisk dummy.
+
+2003-11-27  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (gfc_tran_allocate_array_storage): Use new memory
+	allocation interface.
+	(gfc_conv_ array_parameter): Ditto.
+	(gfc_trans_auto_array_allocation): Ditto. Also free the memory.
+	* trans-array.c: Update prototype.
+	* trans-decl.c (gfc_build_builtin_function_decls): Update prototypes.
+	(gfc_trans_auto_character_variable): Use new memory alloc interface.
+	* trans-expr.c (gfc_conv_string_tmp): Ditto.
+	(gfc_conv_function_call): Use gfc_conv_string_tmp.
+	* trans-stmt.c (gfc_do_allocate):  Use new memory alloc interface.
+	* trans-intrinsic.c (gfc_conv_intrinsic_trim): Ditto.
+	* trans.h (gfc_ss_info): Remove unused pdata field.
+	* trans.c (gfc_create_var_np): Change T to V.
+
+2003-11-26  Richard Henderson  <rth@redhat.com>
+
+	* mathbuiltins.def: Move acos, asin, cosh, log10, sinh, tanh from ...
+	* trans-intrinsic.c (gfc_intrinsic_map): ... here.  Add SCALE,
+	FRACTION, NEAREST, SET_EXPONENT.
+	(gfc_intrinsic_map_t): Add libm_name, complex_available, is_constant.
+	Fix GTY marking.  Remove unnecessary const's.
+	(LIBM_FUNCTION): Rename from I_LIB.
+	(LIBF_FUNCTION): New.
+	(gfc_get_intrinsic_lib_fndecl): Handle libm and libgfortran naming
+	conventions.  Assume the expr signature is correct.  Mark const.
+	(gfc_conv_intrinsic_exponent): Use library functions.
+	(gfc_conv_intrinsic_set_exponent): Remove.
+	(gfc_conv_intrinsic_scale): Remove.
+	(gfc_conv_intrinsic_nearest): Remove.
+	(gfc_conv_intrinsic_fraction): Remove.
+	(gfc_conv_intrinsic_function): Update.
+	* trans-decl.c (gfor_fndecl_math_exponent4): New.
+	(gfor_fndecl_math_exponent8): New.
+	(gfc_build_intrinsic_function_decls): Set them.
+	* trans.h: Declare them.
+
+2003-11-25  Canqun Yang  <canqun@nudt.edu.cn>
+
+	* trans-common.c (gfc_layout_global_equiv): Locate the error for
+	underflow COMMON block.
+	(gfc_trans_one_common): Fix bug for size of COMMON block containing
+	EQUIVALENCE object. Also fix typo in an error message.
+
+2003-11-25  Diego Novillo  <dnovillo@redhat.com>
+
+	* Make-lang.in: Add check-gfortran to lang_checks.
+	(check-f95): Alias for check-gfortran.
+
+2003-11-25  Jason Merrill  <jason@redhat.com>
+
+	* Make-lang.in (f95.tags): Create TAGS.sub files in each
+	directory and TAGS files that include them for each front end.
+
+2003-11-24  Paul Brook  <paul@nowt.org>
+
+	PR fortran/13154
+	* trans-decl.c (gfc_greate_module_variable): Skip COMMON blocks.
+
+2003-11-24  Paul Brook  <paul@nowt.org>
+
+	* expr.c (simplify_const_ref): Return SUCCESS for things we don't
+	handle.
+	* resolve.c (gfc_resolve_expr): Resolve contents before rank/shape.
+
+2003-11-24  Paul Brook  <paul@nowt.org>
+
+	PR fortran/13105
+	* array.c (gfc_array_ref_shape): Handle elemental dimensions.
+	* trans-array.c (gfc_trans_preloop_setup): Use correct dim lookup.
+
+2003-11-20  Richard Henderson  <rth@redhat.com>
+
+	* trans-array.c (gfc_trans_allocate_array_storage): Use convert.
+	(gfc_conv_array_base): Likewise.
+	* trans-decl.c (gfc_trans_auto_character_variable): Likewise.
+	* trans-expr.c (gfc_conv_string_tmp): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_trim): Likewise.
+	* trans-stmt.c (gfc_trans_character_select): Likewise.
+
+2003-11-13  Paul Brook  <paul@nowt.org>
+
+	* trans-decl.c (gfc_sym_mangled_function_id): Dont mangle externals.
+
+2003-11-13  Canqun Yang  <canqun@nudt.edu.cn>
+
+	* resolve.c (gfc_resolve): Also resolve EQUIVALENCE objects.
+	(resolve_equivalence): New function.
+	(resolve_equivalence_derived): New function.
+
+2003-11-12  Richard Henderson  <rth@redhat.com>
+
+	* trans.c (gfc_trans_code): Use annotate_with_locus instead of
+	annotate_all_with_locus.
+
+2003-11-11  Canqun Yang  <canqun@nudt.edu.cn>
+
+	* options.c (gfc_init_options): Set flag_max_stack_var_size as 32768.
+	* trans-decl.c (gfc_finish_var_decl): Modified.
+
+2003-11-08  Paul Brook  <paul@nowt.org>
+
+	PR fortran/12704
+	* trans-intrinsic.c (gfc_conv_intrinsics_minmaxloc): Handle zero-size
+	arrays.
+
+2003-11-06  Paul Brook  <paul@nowt.org>
+
+	* trans-intrinsic.c (gfc_conv_intrinsics_minmaxloc): Initialize pos.
+
+2003-11-02  Canqun Yang  <canqun@nudt.edu.cn>
+
+	* match.c (gfc_match_stopcode): Assign '0' to stop_code.
+
+2003-10-27  Anthony Green  <green@redhat.com>
+
+	* Make-lang.in (f95.stageprofile): Use tabs, not spaces.
+	(f95.stagefeedback): Ditto.
+
+2003-10-27  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	PR fortran/12682
+	* Make-lang.in (f95.stageprofile): Add.
+	(f95.stagefeedback): Add.
+
+2003-10-23  Richard Henderson  <rth@redhat.com>
+
+	* f96-lang.c (gfc_gimplify_expr): Remove.
+	(LANG_HOOKS_GIMPLIFY_EXPR): Remove.
+	(LANG_HOOKS_GIMPLE_BEFORE_INLINING): New.
+
+2003-10-23  Richard Henderson  <rth@redhat.com>
+
+	* f95-lang.c (gfc_gimplify_expr): Return gimplify_status.
+
+2003-10-20  Paul Brook  <paul@nowt.org>
+
+	* trans-expr.c (gfc_conv_integer_power): Use boolean_type_node.
+	* trans-stmt.c (gfc_trans_do_while): Ditto.
+
+2003-10-17  Paul Brook  <paul@nowt.org>
+
+	* simplify.c (gfc_simplify_shape): Use gfc_array_dimen_size.
+
+2003-10-17  Paul Brook  <paul@nowt.org>
+
+	* trans-io.c (gfc_build_io_library_fndecls): Set TREE_PUBLIC.
+
+2003-10-17  Feng Wang  <wf_cs@yahoo.com>
+
+	* iresolve.c (gfc_resolve_maxloc): Change the result's kind and type.
+	(gfc_resolve_minloc): Ditto.
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Use correct types.
+	Return the value after subtracting the lower bound.
+
+2003-10-16  Richard Henderson  <rth@redhat.com>
+
+	* f95-lang.c (expand_function_body): Don't check flag_disable_gimple.
+
+2003-10-16  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* lang.c: Remove -M option for now, it's in the way for C.
+
+2003-10-14  Jason Merrill  <jason@redhat.com>
+
+	* Make-lang.in (f95.tags): New rule.
+
+2003-10-13  Richard Henderson  <rth@redhat.com>
+
+	* trans.c (gfc_trans_code): Use annotate_all_with_locus.
+
+2003-10-13  Paul Brook  <paul@nowt.org>
+
+	* trans-decl.c (generate_local_decl): Don't create junk variables.
+
+2003-10-13  Paul Brook  <paul@nowt.org>
+
+	* resolve.c (resolve_formal_arglist): Use function result decl in
+	preference to function decl.
+
+2003-10-12  Richard Henderson  <rth@redhat.com>
+
+	* f95-lang.c (gfc_define_builtin): New const_p argument.  Set
+	TREE_READONLY.  Update all callers.
+
+2003-10-12  Feng Wang  <wf_cs@yahoo.com>
+
+	* iresolve.c (gfc_resolve_cshift): Change to match implementation.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Remove CSHIFT.
+	(gfc_is_intrinsic_libcall): Add CSHIFT.
+
+2003-10-12  Richard Henderson  <rth@redhat.com>
+
+	* trans-array.c (gfc_trans_static_array_pointer): Set TREE_INVARIANT.
+	(gfc_trans_array_constructor_value): Likewise.
+	(gfc_conv_array_initializer): Likewise.
+	* trans-stmt.c (gfc_trans_character_select): Likewise.
+
+2003-11-12  Kejia Zhao  <kejia_zh@yahoo.com.cn>
+
+	* trans-intrinsic.c (integer_kind_info, real_kind_info): Remove.
+
+2003-10-11  Huang Chun  <jiwang@mail.edu.cn>
+
+	* check.c (gfc_check_repeat): Check arguments are scalar.
+	(gfc_check_trim): New function.
+	* intrinsic.h (gfc_check_trim): Add prototype.
+	* intrinsic.c (add_functions): Use it.
+	* trans.h (gfor_fndecl_string_trim, gfor_fndecl_string_repeat):
+	Decalare.
+	* trans-decl.c: Ditto.
+	(gfc_build_intrinsic_fucntion_decls): Set them.
+	* trans-intrinsic.c (gfc_conv_intrinsic_len): Handle result vars.
+	(gfc_conv_intrinsic_trim): New function.
+	(gfc_conv_intrinsic_repeat): New function.
+	(gfc_conv_intrinsic_function): Use them.
+
+2003-10-11  Huang Chun  <jiwang@mail.edu.cn>
+
+	* trans-types.c (gfc_sym_type): Handle result variables.
+
+2003-10-11  Huang Chun  <jiwang@mail.edu.cn>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_char): Don't use
+	gfc_get_character_type.
+
+2003-10-11  Feng Wang  <wf_cs@yahoo.com>
+
+	* trans-expr.c (gfc_conv_variable): Check sym->ts, not the decl.
+
+2003-10-11  Paul Brook  <paul@nowt.org>
+
+	* iresolve.c (gfc_resolve_dint, gfc_resolve_dnint): New functions.
+	(gfc_resolve_dprod): New function.
+	(gfc_resolve_aint, gfc_resolve_anint): Only base name on arg type.
+	* intrinsic.h (gfc_resolve_dint, gfc_resolve_dnint): Declare.
+	(gfc_resolve_dprod): Declare.
+	* intrinsic.c (add_functions): Use them.
+	* trans-decl.c (gfc_get_extern_function_decl): Only pass one arg.
+
+2003-10-06  Richard Henderson  <rth@redhat.com>
+
+	* f95-lang.c (gfc_init_builtin_functions): Add clzll.
+	* trans-intrinsic.c (call_builtin_clz): Use it.
+
+2003-10-05  Paul Brook  <paul@nowt.org>
+
+	* f95-lang.c (expand_function_body): Call (push|pop)_function_context.
+	* trans-decl.c (gfc_generate_function_code): Set
+	cfun->function_end_locus.
+
+2003-09-24  Jason Merrill  <jason@redhat.com>
+
+	* f95-lang.c, trans-decl.c: Use DECL_SOURCE_LOCATION instead of
+	TREE_LOCUS.
+
+2003-09-21  Lifang Zeng  <zlf605@hotmail.com>
+	Paul Brook  <paul@nowt.org>
+
+	* Make-lang.in (F95_OBJS): Add fortran/data.o.
+	* array.c (gfc_inser_constructor): New function.
+	(gfc_get_constructor): New function.
+	(gfc_free_constructor): Initialize offset and repeat.
+	(iterator_stack): Remove.
+	(expand_info): Add offset, component and repeat fields.
+	(expand_constructor): Set them.
+	(expand): Set new fields.
+	(gfc_copy_constructor): Ditto. Avoid recursion.
+	* gfortran.h: Add prototypes for new functions.
+	(gfc_constructor): Add offset, component and repeat.
+	(iteratio_stack): Move to here.
+	* resolve.c (check_data_variable): Convert data values into variable
+	initializers.
+	(traverse_data_list): Build implicit loop chain.
+	(gfc_resolve): Ditto.
+	* trans-array.c (gfc_conv_array_intializer): Handle repeat count.
+	* trans-decl.c (gfc_get_symbol_decl): Use gfc_conv_structure.
+	* trans-expr.c (gfc_conv_structure): Handle array initializers.
+	(gfc_conv_expr): Update to match.
+	* trans.h (gfc_conv_structure): Declare.
+	* data.c: New file.
+
+2003-09-20  Kejia Zhao  <kejia_zh@yahoo.com.cn>
+
+	* trans.h: Add declarations for gfor_fndecl_si_kind and
+	gfor_fndecl_sr_kind.
+	* trans-decl.c (g95_build_intrinsic_function_decls): Build them.
+	* trans-intrinsic.c (g95_conv_intrinsic_si_kind): New function.
+	(g95_conv_intrinsic_sr_kind): New function.
+	(g95_conv_intrinsic_function): Add SELECTED_INT_KIND and
+	SELECTED_REAL_KIND.
+
+2003-09-17  Lars Segerlund  <Lars.Segerlund@comsys.se>
+
+	* iresolve.c (gfc_resolve_random_number): Generate _r4 & _r8
+	instead of _4 and _8 as postfix for libgfortran calls.
+
+2003-09-16  Paul Brook  <paul@nowt.org>
+
+	* array.c (compare_bounds): New function.
+	(gfc_compare_array_spec): Use it.
+
+2003-09-14  Paul Brook  <paul@nowt.org>
+
+	* primary.c (gfc_match_rvalue): Make sure sym->result is set.
+	* trans-expr.c (gfc_conv_string_parameter): Also allow PRAM_DECLs.
+
+2003-09-14  Paul Brook  <paul@nowt.org>
+
+	* check.c (dim_rank_check): Allow assumed bounds if requested.
+	(gfc_check_lbound): Call it.
+	(gfc_check_ubound): Ditto.
+	(gfc_check_size): Change to match.
+	* simplify.c (gfc_simplify_bound): New function.
+	(gfc_simplify_lbound): New function.
+	(gfc_simplify_ubound): New function.
+	* intrinsic.h: Declare them.
+	* intrinsic.c (add_functions): Use them.
+
+2003-09-14  Paul Brook  <paul@nowt.org>
+
+	* io.c (format_lex): Initialize negative_flag.
+	(check_format): Intialize repeat.
+	* trans-io.c (gfc_new_nml_name_expr): Declare static.
+	(gfc_new_var_expr): Ditto.
+
+2003-09-14  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (gfc_conv_array_initializer): Handle derived types.
+	* trans-decl.c (gfc_get_symbol_decl): Only do local scalar values.
+
+2003-09-12  Paul Brook  <paul@nowt.org>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_sign): Call fold.
+
+2003-09-12  Zdenek Dvorak  <rakdver@atrey.karlin.mff.cuni.cz>
+
+	* fortran/trans.c (gfc_finish_block): Call rationalize_compound_expr
+	for a correct expression.
+
+2003-09-10  Kejia Zhao  <kejia_zh@yahoo.com.cn>
+
+	* trans-intrinsic.c (real_compnt_info): New struct.
+	(prepare_arg_info): New function.
+	(gfc_conv_intrinsic_set_exponent): New function.
+	(gfc_conv_intrinsic_scale): New function.
+	(gfc_conv_intrinsic_nearest): New function.
+	(gfc_conv_intrinsic_fraction): New function.
+	(gfc_conv_intrinsic_exponent): New function.
+	(gfc_conv_intrinsic_spacing): New function.
+	(gfc_conv_intrinsic_rrspacing): New function.
+	(gfc_conv_intrinsic_function): Use them.
+
+2003-08-24 XiaoQiang Zhang  (zhangapache@yahoo.com>
+
+	* trans-const.c (gfc_conv_mpz_to_tree): Fix bug, parameter for
+	build_int_2 changed from (high, low) to (low, high).
+	* trans-io.c (ioparm_namelist_name, ioparm_namelist_name_len,
+	ioparm_namelist_read_mode, iocall_set_nml_val_int,
+	iocall_set_nml_val_float, iocall_set_nml_val_char,
+	iocall_set_nml_val_complex, iocall_set_nml_val_log): New declaration.
+	(gfc_build_io_library_fndecls): Add variable initialization.
+	(gfc_new_nml_name_expr, get_new_var_expr): New function.
+	(build_dt): Add namelist support.
+	* io.c (value): New variable.
+	(check_format): Support FMT_H now.
+
+2003-09-07  Paul Brook  <paul@nowt.org>
+
+	* io.c (gfc_resolve_dt): Error if format label is not defined.
+
+2003-09-07  Kejia Zhao  <kejia_zh@yahoo.com.cn>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_aint): Fix two bugs. One is
+	about case_switch's break. The other is about building the condition
+	statement tree, which judges the argument in the range of the
+	corresponding integer type.
+	* trans-intrinsic.c (gfc_conv_intrinsic_mod): MOD and MODULO can work
+	for the large values.
+
+2003-09-05  Paul Brook  <paul@nowt.org>
+
+	* f95-lang.c (expand_function_body): Gimplify the function.
+
+2003-09-04  Jeff Law  <law@redhat.com>
+
+	* f95-lang.c (DEFINE_MATH_BUILTIN): C arrays start at
+	index zero!
+
+2003-09-04  Paul Brook  <paul@nowt.org>
+
+	* f95-lang.c (gfc_define_builtin): Also set implicit_built_in_decls.
+	(gfc_expand_stmt): New function.
+	(LANG_HOOKS_RTL_EXPAND_STMT): Define.
+	(expand_function_body): Use tree_rest_of_compilation.
+	* trans-decl.c (gfc_generate_function_code): Don't free cfun.
+
+2003-09-03  Jeff Law  <law@redhat.com>
+
+	* f95-lang.c (gfc_init_builtin_functions): C arrays start at
+	index zero!
+
+2003-08-30  Paul Brook  <paul@nowt.org>
+
+	* f95-lang.c (builtin_function): Remove #if 0 code.
+	(gfc_define_builtin): New function.
+	(gfc_init_builtin_functions): Use mathbuiltins.def not ../builtins.def.
+	* mathbuiltins.def: New file.
+	* trans-intrinsic.c (gfc_intrinsic_map_t): Add builtin code fields.
+	(gfc_intrinsic_map): Use mathbuiltins.def.
+	(gfc_intrinsic_builtin_t): Remove.
+	(gfc_build_intrinsic_lib_fndecls): Update.
+	* trans-types.c (gfc_init_types): Remove redundant initilaization of
+	signed_size_type_node.
+
+2003-08-29  Paul Brook  <paul@nowt.org>
+
+	* arith.c (gfc_real_kinds): Use correct minimum exponents.
+
+2003-08-22  Kejia Zhao  <kejia_zh@yahoo.com.cn>
+
+	* trans-instinsic.c (gfc_conv_intrinsic_mod): Also do MODULO.
+	(gfc_conv_intrinsic_function): Add MODULO.
+
+2003-08-22  Jason Merrill  <jason@redhat.com>
+
+	* trans-array.c (gfc_conv_expr_descriptor): Update use of predicates.
+
+2003-08-22  Andreas Jaeger  <aj@suse.de>
+
+	* Make-lang.in (f95.install-common): Add DESTDIR support.
+	* (f95.install-info): Likewise.
+	(f95.uninstall): Likewise.
+
+2003-08-19  Diego Novillo  <dnovillo@redhat.com>
+
+	* trans-types.c (gfc_init_types): Initialize
+	signed_size_type_node with size_type_node.
+
+2003-08-18  Paul Brook  <paul@nowt.org>
+
+	* dependency.c (gfc_dependency): New enum.
+	(check_another_array_ref): Remove.
+	(gfc_get_array_from_component): Remove.
+	(get_x): Remove.
+	(get_range): Remove.
+	(get_no_of_elements): Use mpz_t, not mpf_t.
+	(transform_sections): New function.
+	(gfc_check_range_range): Rename ...
+	(gfc_check_section_vs_section): ... to this.  Use new function.
+	(gfc_is_inside_range): Rewrite to match.
+	(gfc_check_element_vs_section): Ditto.
+	(gfc_check_element_vs_element): Ditto.
+	(get_deps): Ditto.
+	(gfc_dep_resolver): Ditto.  Remove unused parameter.
+	* Dependency.h (gfc_check_range_range, gfc_check_element_vs_section,
+	gfc_check_element_vs_element, gfc_is_inside_range,
+	gfc_get_array_from_component): Remove prototypes for static functions.
+	(gfc_dep_resolver): Update prototype.
+	* trans-array.c (gfc_conv_resolve_dependencies): Change to match.
+
+2003-08-15  Paul Brook  <paul@nowt.org>
+
+	* trans-decl.c (gfc_build_qualified_array): Don't add symbols for
+	return values to parent scope.
+	(gfc_build_dummy_array_decl): Ditto.
+
+2003-08-14  Paul Brook  <paul@nowt.org>
+
+	* trans-stmt.c (gfc_trans_allocate): Handle NULL refs. Allocate the
+	size of	the type, not the pointer.
+	* resolve.c (resolve_symbol): Give more accurate error message.
+
+2003-08-10  Paul Brook  <paul@nowt.org>
+
+	* trans-decl.c (gfc_build_function_decl): Only mangle global symbols.
+
+2003-08-10  Paul Brook  <paul@nowt.org>
+
+	* trans-stmt.c (gfc_trans_allocate): Correctly handle non-array derived
+	type components.
+
+2003-08-10  Chun Huang  <compiler@sohu.com>
+
+	* resolve.c (resolve_formal_arglist): Resolve STATEMENT function.
+	(resolve_symbol): Ditto.
+	* trans-expr.c (gfc_conv_statement_function): New function.
+	(gfc_conv_function_expr): Use it.
+
+2003-08-10  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (gfc_conv_ss_startstride): Handle functions.
+	(walk_function_expr): Set section rank.
+	* trans-intrinsic.c (gfc_walk_intrinsic_libfunc): Ditto.
+
+2003-08-10  Paul Brook  <paul@nowt.org>
+
+	* intrinsic.c (add_sym): Prefix names with correct string.
+	(add_sym_0s): New function.
+	(add_subroutines): Register abort.
+
+2003-08-10  Erik Schnetter  <schnetter@uni-tuebingen.de>
+
+	* gfortran.h: Introduce options to control the mangling.
+	* lang.opt: Likewise.
+	* options.c (gfc_init_options): Handle the options.
+	* trans-common.c (gfc_sym_mangled_common_id): New function.
+	(gfc_build_common_decl): Call it.
+	* trans-decl.c (gfc_sym_mangled_function_id): New function.
+	(gfc_get_extern_function_decl, gfc_build_function_decl): Call it.
+
+2003-08-09  Paul Brook  <paul@nowt.org>
+
+	* module.c (mio_symbol): Always ouput a namespace for formal args.
+	(load_needed): Namespace now belong to their proper symbol.
+	(gfc_dump_module): Change G95=>GFORTRAN.
+
+2003-08-05  Paul Brook  <paul@nowt.org>
+
+	* options.c: Force -fg77-calls.
+
+2003-08-02  Paul Brook  <paul@nowt.org>
+
+	* Makelang.in: Rename G95_* to GFORTRAN_*.
+	* All sources: Rename G95_* to GFC_*.
+
+2003-08-01  Paul Brook  <paul@nowt.org>
+
+	* fortran/Make-lang.in: Use GMPLIBS.
+	* fortran/config-lang.in: Set need_gmp.
+	* trans-expr.c (gfc_conv_variable): Remove incorrect assertion.
+
+2003-07-27  Andreas Jaeger  <aj@suse.de>
+
+	* trans-decl.c (gfc_generate_constructors): Convert prototype to
+	ISO C90.
+	* trans-const.c (gfc_init_constants): Likewise.
+	* trans-intrinsic.c (gfc_build_intrinsic_lib_fndecls): Likewise.
+
+	* gfortranspec.c: Convert to ISO C90.
+	(lang_specific_driver): Correct copyright, remove ALT_LIBM usage.
+
+2003-07-26  Paul Brook  <paul@nowt.org>
+
+	* lang.opt: Add -fdump-parse-tree.
+	* options.c (gfc_handle_option): Ditto.
+	* resolve.c (resolve_forall_iterators): Convert to proper type.
+	* trans-stmt.c (gfc_trans_forall_1): Create temp var with correct type.
+
+2003-07-26  Paul Brook  <paul@nowt.org>
+
+	* Makefile.in: Add build dependencies on files common with rest of gcc.
+
+2003-07-26  Lifang Zeng  <zlf605@hotmail.com>
+
+	* trans.h: Declare g95_trans_pointer_assignment.
+	* trans-expr.c (g95_trans_pointer_assignment): New function.
+	(g95_trans_pointer_assign): Use it.
+	* trans-stmt.c (g95_trans_forall_1): Handle pointer assignment.
+	(g95_trans_pointer_assign_need_temp): New function.
+
+2003-07-26  Paul Brook  <paul@nowt.org>
+
+	* gfortran.texi: Replace references to g95.
+
+2003-07-26  Paul Brook  <paul@nowt.org>
+
+	Rename g95_* to gfc_*.
+
+2003-07-25  Paul Brook  <paul@nowt.org>
+
+	* gfortran.h: Rename from g95.h.
+	* trans-types.c (boolean_type_node, booelan_true_node,
+	boolean_false_node): Remove.
+	* trans-types.h: Ditto.
+
+2003-07-25  Chun Huang  <compiler@sohu.com>
+
+	* parse.c (accept_statement): Implement BLOCK DATA statement.
+	* trans-expr.c (g95_conv_variable): Fix bug for dereference pointer
+	variables.
+
+2003-07-24  Lifang Zeng  <zlf605@hotmail.com>
+
+	* trans-stmt.c (temporary_list): Define.
+	(g95_trans_assign_need_temp): New function.
+	(g95_trans_forall_1): Modified for WHERE.
+	(g95_trans_where_assign): Modified.
+	(g95_trans_where_2): Modified.
+	(g95_evaluate_where_mask): Modified.
+	(g95_trans_where): Modified.
+	(g95_get_temp_expr): Removed.
+	(g95_add_to_where_stmt_list): Removed.
+	(compute_overall_iter_number): Modified for WHERE.
+	* trans.h: Remove where_stmt_list.
+
+2003-07-24  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* lang.opt: Correct description of options -J and -M.
+
+2003-07-23  Steven Bosscher   <steven@gcc.gnu.org>
+
+	* lang.opt: Move help text to here.
+	* lang-options.h: Remove.
+
+2003-07-23  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+	* iresolve.c (g95_resolve_transpose): Proper variable in switch.
+	* simplify.c (g95_simplify_nearest): Fix typo and use a correct test
+	on kind.
+
+2003-07-22  Steven Bosscher  <steven@gcc.gnu.org>
+	Paul Brook  <paul@nowt.org>
+
+	* check.c (check_rest): Use global pedantic flag.
+	* io.c (data_desc): Ditto.
+	* error.c (g95_warning, g95_warning_now): Use global flag.
+	* f95-lang.c (LANG_HOOKS_HANDLE_OPTION): Rename from DECODE.
+	(expand_function_body): Update to new prototypes.
+	(g95_init): Use new option names.
+	* g95.h (g95_option_t): Standardize names.
+	(g95_init_options, g95_handle_option): Update prototypes.
+	* interface.c: Use new option names.
+	* match.c: Ditto.
+	* module.c: Ditto.
+	* parse.c: Ditto.
+	* primary.c: Ditto.
+	* resolve.c: Ditto.
+	* scanner.c: Ditto.
+	* simplify.c: Ditto.
+	* symbol.c: Ditto.
+	* trans-array.c: Ditto.
+	* trans-expr.c: Ditto.
+	* trans-types.c: Ditto.
+	* trans-decl.c: Ditto.
+	(g95_build_library_function_decl): Remove obsolete VPARAMS.
+	* trans.h: Ditto.
+	* options.c (g95_display_help): Remove.
+	(g95_init_options): Convert to new scheme.
+	(set_Wall): Ditto
+	(g95module_option): Ditto, rename from g95_parse_arg.
+	(g95_handle_module_path_options): New function.
+	* trans-equivalence.c: Fix error message.
+	* lang.opt: Corrections.
+
+2003-07-21  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* lang.opt: New file.
+
+2003-07-21  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* decl.c (match_attr_spec): Set colon_seen.
+
+2003-07-14  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c: Update comment.
+	(g95_trans_array_constructor_subarray): Cleanup loopinfo data.
+	* trans-intrinsic.c (g95_conv_intrinsic_anyall,count,arith,
+	minmaxloc,minmaxval): Ditto.
+	* trans-io.c (g95_trans_transfer): Ditto.
+	* trans-stmt.c: Remove unneeded prototypes.
+	(generate_loop_for_lhs_to_rhs): Rename vars. Add loop post chain.
+	(generate_loop_for_rhs_to_temp): Rename vars. Don't share loopinfo.
+	(compute_inner_temp_size): Remove bits of dead code. Add comments.
+	Don't share loopinfo.
+	(compute_overall_iter_number): Declare as static.
+	(allocate_temp_for_forall_nest): Ditto.
+	(g95_trans_forall_1): Don't pass shared loopinfo.
+	* trans.c (g95_start_block): Expand comment.
+
+2003-07-12  Paul Brook  <paul@nowt.org>
+
+	* arith.c (g95_index_integer_kind): Remove unused initializer.
+	* trans-stmt.c (generate_loop_for_temp_to_lhs): Don't multiply array
+	index by size of element.
+	(generate_loop_for_rhs_to_temp): Ditto.
+	(allocate_temp_for_forall_nest): Use element size, not index size.
+
+2003-07-11  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* arith.c (g95_index_integer_kind): Add a TODO.
+	* simplify.c (g95_simplify_nearest): Add a TODO.
+
+2003-07-09  Chun Huang  <compiler@sohu.com>
+
+	* trans.h: Add declarations for gfor_fndecl_string_scan and
+	gfor_fndecl_string_verify.
+	* trans-decl.c (g95_build_intrinsic_function_decls): Build them.
+	* trans-intrinsic.c (g95_conv_intrinsic_scan): New function.
+	(g95_conv_intrinsic_verify): New function.
+	(g95_conv_intrinsic_function): Add SCAN and VERIFY.
+	* simplify.c (g95_simplify_scan, g95_simplify_verify): Fix bug in case
+	of parameter 'BACK=.TRUE.'
+
+2003-07-05  Lifang Zeng  <zlf605@hotmail.com>
+
+	* trans-stmt.c (iter_info, forall_info): Define.
+	(g95_trans_forall_block): Remove.
+	(g95_trans_forall_loop): Use forall info blocks.
+	(g95_trans_nested_forall_loop): New function.
+	(g95_do_allocate): Handle things other than logical masks.
+	(generate_loop_for_temp_to_lhs): New function.
+	(generate_loop_for_rsh_to_temp): New function.
+	(compute_inner_temp_size): New function.
+	(compute_overall_iter_number): New function.
+	(allocate_temp_for_forall_nest): New function.
+	(g95_trans_forall): Move body ...
+	(g95_trans_forall_1): ... to here.  Handle loops with temporaries.
+
+2003-07-02  Paul Brook  <paul@nowt.org>
+
+	* trans-decl.c (create_index_var, g95_build_qualified_array): Put vars
+       	in correct scope.  Change callers to match.
+	* trans-types.c (g95_get_dtype_cst): Allow rank 7 arrays.
+	* iresolve.c (g95_resolve_reshape): Only use constant shapes.
+
+2003-07-02  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_conv_loop_setup): Remove dead var.  Use
+	expression shape for all expressions.
+	* trans-decl.c (g95_symbol_init): Allow adding at very end of list.
+
+2003-07-03  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* g95.h (g95_option_t), lang-options.h, options.c (g95_init_options,
+	g95_parse_arg), intrinsic.c (g95_convert_type): support of
+	-Wconversion.
+	* intrinsic.c, g95.h: Add g95_convert_type_warn,
+	* resolve.c (g95_resolve_index): Call it.
+
+2003-07-02  Paul Brook  <paul@nowt.org>
+
+	* iresolve.c (g95_resolve_reshape): Set expression shape.
+	(g95_resolve_shape): Ditto.
+	* simplify.c (g95_simplify_shape): Move common code outside condition.
+	* trans-array.c (g95_conv_array_initializer): Teach it how to count.
+
+2003-07-01  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* array.c (g95_array_dimen_size): Deal with EXPR_ARRAY to improve
+	conformance checks.
+
+2003-06-29  Paul Brook  <paul@nowt.org>
+
+	* array.c (g95_simplify_iterator_var): Don't bother with return value.
+	* expr.c (find_array_element, find_component_ref): New functions.
+	(remove_subobject_ref): New function.
+	(simplify_const_ref): Use them.  Rename from simplify_component_ref.
+	(simplify_ref_chain): New function.
+	(g95_simplify_expr): Use it.  Simplify parameter variable subobjects.
+	(g95_specification_expr): Simplify the expression.
+	* resolve.c (resolve_operator): Check simplifications return code.
+	(g95_resolve_expr): Ditto.
+
+2003-06-26  Paul Brook  <paul@nowt.org>
+
+	* expr.c (simplify_component_ref): New function.
+	(g95_simplify_expr): Use it.
+	* resolve.c (resolve_structure_cons): Handle references.
+
+2003-06-25  Paul Brook  <paul@nowt.org>
+
+	* trans-io.c (build_dt): Handle internal units.
+
+2003-06-25  Canqun Yang  <canqun@yahoo.com.cn>
+
+	* trans-common.c (g95_build_common_decl): Array index range starts at 0.
+	(g95_build_common_decl, g95_layout_global_equiv, g95_trans_one_common):
+	Use g95_array_index_type instead of integer_type_node.
+	(g95_build_common_decl, g95_set_common_master_type): Use
+	g95_character1_type_node instead of char_type_node.
+	* trans-equivalence.c (g95_layout_local_equiv): As above.
+
+2003-06-24  Steven G. Kargl  <kargls@attbi.com>
+
+	* g95.h (g95_option_t), options.c (g95_init_options, g95_parse_arg):
+	remove last remains of -fquiet.
+
+2003-06-22  Paul Brook  <paul@nowt.org>
+
+	* resolve.c (resolve_operator): Don't fail if we can't simplify.
+	(g95_resolve_expr): Ditto.
+	(resolce_code): Mark as static.
+	* trans-stmt.c (g95_trans_chaaracter_select): Mark labels because the
+	gimplifer doesn't (yet).
+
+2003-06-20  Paul Brook  <paul@nowt.org>
+
+	* g95.h: Add ST_PAUSE and EXEC_PAUSE.
+	* match.c (g95_match_if): Add ST_PAUSE.
+	(g95_match_stopcode): New function.
+	(g95_match_pause, g95_match_stop): Use it.
+	* parse.c (g95_ascii_statement): Handle ST_PAUSE.
+	(decode_stmt, next_statement, parse_executable): Ditto.
+	* resolve.c (resolve_code): Ditto.
+	* st.c (g95_free_statement): Ditto.
+	* trans-stmt.c (g95_trans_pause): New function.
+	* trans-stmt.h: Declare it.
+	* trans.c (g95_trans_code): Use it.
+	* trans-decl.c (gfor_fndecl_pause_numeric, gfor_fndecl_pause_string):
+	Declare.
+	(g95_build_builtin_function_decls): Initialize them.
+	* trans.h: Ditto.
+	* dump-parse-tree.c (g95_show_code_node): Handle EXEC_PAUSE.
+
+2003-06-18  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* io.c (g95_match_open , g95_match_close, g95_match_inquire,
+	match_filepos): Fix error handling.
+
+2003-06-18  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* array.c (spec_dimen_size, ref_dimen_size, g95_array_dimen_size):
+	Add assertions on arguments.
+	* resolve.c (expression_shape): Remove useless &.
+	* simplify.c (get_kind, g95_simplify_bit_size, g95_simplify_digits,
+	g95_simplify_ibclr, g95_simplify_ibits, g95_simplify_ibset,
+	g95_simplify_ishft,g95_simplify_ishftc, g95_simplify_maxexponent,
+	g95_simplify_minexponent, g95_simplify_radix, g95_simplify_range
+	g95_simplify_rrspacing, g95_simplify_scale, g95_simplify_spacing,
+	g95_simplify_tan, g95_simplify_tiny): Clean predicates and assertions.
+	(g95_simplify_not, g95_simplify_scale): Add assertions.
+
+2003-06-15  Paul Brook  <paul@nowt.org>
+
+	Clean up stuff to work with the ssa optimizers.
+	* convert.c (convert): Handle BOOLEAN_TYPEs.
+	* f95-lang.c (g95_truthvalue_conversion): Implement.
+	* trans-array.c (g95_trans_array_constructor_value): Group multiple
+	scalar values.
+	* trans.h (g95_truthvalue_conversion): Declare.
+	* trans-intrinsic.c (g95_conv_intrinsic_anyall): Use bool constants.
+	* trans-stmt.c (g95_trans_character_select): Don't create array
+	assignments.  Mark labels as indirect jump targets.
+	* trans-types.h (g95_init_types): Use BOOLEAN_TYPE nodes.
+	(g95_get_dtype_cst): Handle LOGICAL types.
+
+2003-06-14  Paul Brook  <paul@nowt.org>
+
+	* f95-lang.c (g95_gimplify_expr): New function.
+	* trans-array.c (g95_trans_array_constructor_value): Don't create
+	array assignments.
+	(g95_conv_expr_descriptor): Rename simple->gimple.
+	* trans-expr.c (conv_expr_op): Use proper logical operators.
+	* trans-intrinsic.c (build_fixbound_expr): New function.
+	(build_fix_expr): Ditto.
+	(g95_conv_intinsic_aint): Use them. Use builtin functions.
+	(g95_conv_intrinsic_function): Add FLOOR and CEILING.
+
+2003-06-10  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* array.c (g95_compare_array_spec): Remove unreachable code.
+	* expr.c (g95_copy_expr): Likewise.
+	* intrinsic.c (g95_convert_type): Likewise.
+	* misc.c (g95_code2string): Likewise.
+	* simplify.c (g95_simplify_ishft, g95_simplify_real,
+	g95_simplify_reshape, g95_simplify_sign, g95_simplify_sqrt): Likewise.
+	* trans-stmt.c (g95_trans_select): Likewise.
+	* primary.c (extend_ref): Add an assertion.
+	* simplify.c (g95_convert_constant): Add const.
+	* intrinsic.h: Remove g95_check_x_ni.
+	* f95-lang.c (g95_finish): Call g95_release_include_path.
+
+2003-06-10  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* resolve.c (resolve_contained_functions): Fix typo introduced on
+	2003-01-13.
+
+2003-06-09  Paul Brook  <paul@nowt.org>
+
+	* g95.h: Include system.h not hwint.h.
+	* many: use safe-ctype.h not ctype.h.  Change isalpha -> ISALPHA, etc.
+	* misc.c (g95_getmem): Use xmalloc/memset instead of calloc.
+
+2003-06-09  Paul Brook  <paul@nowt.org>
+
+	* g95.h (g95_symbol): Add fields for COMMON and EQUIVALENCE variables.
+	* Make-lang.in (F95_OBJS): Add files for COMMON and EQUIVALENCE.
+	* trans-decl.c (g95_add_decl_to_functions): Make non-static.
+	(g95_get_symbol_decl): Handle COMMON and EQUIVALENCE objects.
+	(g95_generate_function_code): Translate COMMON and EQUIVALENCE
+	objects.
+	* trans.h (g95_trans_equivalence, g95_trans_common,
+	g95_add_decl_to_function): Declare.
+	* trans-common.c, trans-equivalence.c: New files.
+
+2003-06-08  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* intrinsic.c (g95_intrinsic_extension): Remove.
+	(add_functions): Substitute g95_check_x for g95_check_x_ni
+	everywhere.
+	(g95_init_expr_extensions): New function.
+	(g95_intrinsic_func_interface): Use it.
+	* intrinsic.h: Remove extern decl for g95_intrinsic_extension.
+	* check.c (g95_check_digit, g95_check_huge, g95_check_kind,
+	g95_check_precision, g95_check_present, g95_check_radix,
+	g95_check_range, g95_check_selected_real_kind): Do not set
+	g95_intrinsic_extension.
+	(g95_check_x_ni): Remove now duplicate of g95_check_x.
+
+	* expr.c (check_inquiry): Add FIXME, fixup some code style.
+
+2003-06-06  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* g95.h (ref_type): Name this type explicitly.
+	* module.c (MIO_NAME): Add specialisations of mio_name.
+	(mio_symbol_attribute, mio_typespec, mio_array_ref,
+	mio_array_spec, mio_ref, mio_expr, mio_symbol): Use them.
+	(ab_attribute): Name this type explicitly.
+	(mio_symbol_attribute, mio_expr): Add cast to call to find_enum.
+
+2003-06-05  Kejia Zhao  <kejia_zh@yahoo.com.cn>
+
+	* trans-intrinsic.c (g95_conv_allocated): New function.
+	(g95_conv_intrinsic_function): Make G95_ISYM_ALLOCATED work.
+
+2003-06-05  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* f95-lang.c: Don't include g95-support.h
+	(g95_mark_addressable): Add prototype.
+	(g95_init_decl_processing): Remove C front end hack.
+	* f95-tree.c: Remove file.
+	* support.c: Remove file.
+	* g95-support.h: Remove file.
+	* trans-types.c (g95_init_types): Set up boolean
+	type related tree nodes.
+	* Make-lang.in: Remove rules for dead files and
+	dependencies on them.
+
+2003-06-05  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* Make-lang.in (F95_ADDITIONAL_OBJS): Remove the final
+	C front end dependency.  Also, convert.c does not depend on
+	g95-support.h anymore.
+	* convert.c: Don't include c-common.h and g95-support.h
+	* f95-lang.c: Don't inlude c-common.h and c-common.def (3x).
+	(g95_stmt_tree, g95_scope_stmt_stack, anon_aggr_type_p,
+	stmts_are_full_exprs_p, current_stmt_tree,
+	current_scope_stmt_stack): Remove.
+	* g95-support.h (unsigned_conversion_warning): Kill proto.
+	(boolean_type_node, boolean_true_node, boolean_false_node):
+	Don't define here.  Instead, make then true tree nodes in
+	trans-types.
+	* support.c (c_global_trees): Die, C front end, die!!!
+	(g95_init_c_decl_hacks): Don't touch intmax_type_node,
+ 	uintmax_type_node, string_type_node and const_string_type_node.
+	(decl_constant_value, overflow_warning): Make static functions.
+	They are in death row too, though.
+	(default_conversion, c_expand_asm_operands): Remove.
+	* trans-array.c, trans-expr.c, trans-intrinsic.c, trans-stmt.c,
+	trans.c: Don't include c-common.h.
+	* trans-types.c (boolean_type_node, boolean_true_node,
+	boolean_false_node): Make them real tree nodes.
+	* trans-types.h (intmax_type_node, string_type_node,
+	const_string_type_node): Hack to work around C dependencies
+	in builtin-types.def.
+
+2003-06-04  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* decl.c (decl_types): Add some iterators-like sentinels.
+	* decl.c (match_attr_spec): Use them.
+	Use "decl_types" instead of "int".
+	Add cast in call to g95_match_strings.
+	* dump-parse-tree.c (g95_show_namespace):  Use "g95_intrinsic_op"
+	instead of "int".
+	* g95.h (g95_intrinsic_op): Add some iterators-like sentinels.
+	(g95_interface_info): Use "g95_intrinsic_op".
+	* dump-parse-tree.c (g95_show_namespace): Use them.
+	* interface.c (g95_check_interfaces): Use them.
+	* module.c (read_module, write_module): Use them.
+	* symbol.c (g95_get_namespace, g95_free_namespace): Use them.
+	Use "g95_intrinsic_op".
+	* interface.c (check_operator_interface): Use "g95_intrinsic_op".
+	Add a default case in switch statement.
+	* intrinsic.h (g95_generic_isym_id): Moved to...
+	* g95.h (g95_generic_isym_id): here.
+	(g95_intrinsic_sym): Use "g95_generic_isym_id".
+	* intrinsic.c (make_generic): Use "g95_generice_isym_id".
+	* trans-intrinsic.c (g95_intrinsic_map_t,
+	 g95_conv_intrinsic_lib_funtion): Use "g95_generice_isym_id".
+	* match.c (g95_match_intrinsic_op): Add cast in call to
+	g95_match_strings.
+
+2003-06-03  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* support.c (skip_evaluation, warn_conversion, lvalue_p,
+	lvalue_or_else, pedantic_lvalue_warning, warn_for_assignment,
+	constant_fits_type_p, convert_and_check,
+	unsigned_conversion_warning): Remove these ugly remnants
+	we inherited from the C front end.
+	(function_types_compatible): Remove '#if 0'-edcode.
+	(build_modify_expr): Likewise.
+	(convert_for_assignment): Don't use the deceased functions.
+	The parameter fundecl is now unused.
+	(decl_constant_value): Always just return decl.  In fact
+	this function is not used at present, but it might be in
+	the future, when we start using the tree inliner.
+	(overflow_warning, default_conversion, c_expand_asm_operands):
+	Abort when these are called, they are part of the C type
+	checking implementation and therefore poison to Fortran.
+
+2003-06-04  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* Make-lang.in (F95_ADDITIONAL_OBJS): Don't depend on
+	c-pretty-print.o and c-dump.o.  Add a comment on why we
+	depend on c-semantics.c.
+	* f95-lang.c (LANG_HOOKS_TREE_DUMP_DUMP_TREE_FN):
+	Don't use the C front end tree dumper hook to dump the
+	language specific tree representation -- we don't have
+	one.  So instead, inherit the default langhook.
+
+2003-06-02  Paul Brook  <paul@nowt.org>
+
+	* trans-expr.c (g95_conv_variable): Remove incorrent assertion.
+
+2003-06-02  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* check.c (g95_check_associated): Use proper types.  Remove
+	extraneous argument in call to g95_error().
+
+2003-06-02  Kejia Zhao  <kejia_zh@yahoo.com.cn>
+
+	* resolve.c (resolve_operator): Make logical operands convert to the
+	type with higher kind.
+
+2003-06-02  Kejia Zhao  <kejia_zh@yahoo.com.cn>
+
+	* check.c (g95_check_associated): Make sure both pointer and target has
+	the same type and rank. Null pointer or array section with vector
+	subscript as target are not allowed.
+	* trans.h: Declare gfor_fndecl_associated.
+	* trans-decl.c: (g95_build_builtin_function_decls): Initialize
+	gfor_fndecl_associated.
+	* trans-intrinsic.c (g95_conv_associated): New function.
+	(g95_conv_intrinsic_function): Make G95_ISYM_ASSOCIATED work.
+
+2003-06-02  Kejia Zhao  <kejia_zh@yahoo.com.cn>
+
+	* trans-array.c (g95_conv_expr_descriptor): Set the base of POINTER
+	according to POINTER itself rather than TARGET.
+	(g95_conv_expr_descriptor): Make lbound start at 1.
+	* trans-expr.c (g95_trans_pointer_assign): Fix a bug for Nullify.
+
+2003-06-01  Paul Brook  <paul@nowt.org>
+
+	* expr.c (g95_type_convert_binary): Make it match the standard.
+	* g95.texi: Remove dead link.
+
+2003-06-01  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* g95.texi: Cleanup somewhat in preparation for inclusion
+	in GCC CVS.
+
+2003-05-23  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+	    Canqun Yang  <canqun@yahoo.com.cn>
+
+	* resolve.c (compare_bound_int, resolve_where_shape): Proper return
+	type.
+	(g95_find_forall_index): Return proper value.
+	(g95_resolve_assign_in_forall, g95_resolve_forall): Use proper type to
+	compare the return value from g95_find_forall_index.
+
+2003-05-23  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+	* g95.h, io.c (g95_st_label): Remove "length".
+	(g95_symtree): Remove "link".
+	(g95_case): Remove "code".
+	* arith.c, arith.h (g95_compare_string, g95_convert_integer,
+	g95_convert_real): Make an argument pointer to const.
+	* decl.c (colon_seen): Add a TODO.
+	* interface.c (g95_compare_types): Fix typo.
+	* interface.c (compare_interfaces): Preserve value of "p".
+	* intrinsic.c (sort_actual): Remove "i".
+	* match.c (g95_match_assign): Proper type in call to g95_match().
+	* parse.c (next_free): Avoid duplicate call due to macro.
+	* parse.c (check_statement_label): wrong type in call to g95_error.
+	* primary.c (match_real_constant): Add a TODO.
+	* resolve.c (resolve_select):  Remove useless conditional.
+	* simplify.c (g95_simplify_repeat): Proper assignment to
+	"value.character.string".
+	* simplify.c (g95_simplify_reshape): Wrong variable in call to
+	g95_error.
+
+2003-05-20  Canqun Yang  <canqun@yahoo.com.cn>
+
+	* trans-stmt.c: Remove unnecessary include file defaults.h.
+
+2003-05-19  Lifang Zeng  <zlf605@hotmail.com>
+
+	* trans-stmt.c (g95_trans_forall_loop): Handle FORALL with negative
+	stride.
+	(g95_trans_forall): Allow arbitrary number of FORALL indexes and
+	actual variables used as FORALL indexes.
+
+2003-05-15  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_trans_static_array_pointer): Use
+	null_pointer_node.
+	(g95_trans_deferred_array): Initialize static array pointers.
+	* trans-expr.c (g95_conv_function_call): Use formal arglist to
+	correctly pass POINTER and absent CHARACTER arguments.
+
+2003-05-14  Lifang Zeng  <zlf605@hotmail.com>
+
+	* resolve.c (g95_resolve_forall): Resolve FORALL construct/statement.
+	(g95_resolve_forall_body): Resolve FORALL body.
+	(g95_resolve_where_code_in_forall): Resolve WHERE inside FORALL.
+	(g95_resolve_assign_in_forall): Resolve assignment inside FORALL.
+	(g95_find_forall_index): Check whether the FORALL index appears in
+	the expression or not.
+	(resolve_code): Modified.
+
+2003-05-14  Paul Brook  <paul@nowt.org>
+
+	* iresolve.c (g95_resolve_spread): Convert ncopies to index_type.
+
+2003-05-13  Paul Brook  <paul@nowt.org>
+
+	* trans-types.c (g95_max_array_element_size): Now a tree node.
+	(g95_init_types): Work out max size properly.
+	(g95_get_dtype_cst): Modify to match.
+
+2003-05-11  Paul Brook  <paul@nowt.org>
+
+	* trans-io.c (add_case): Create a label decl for case labels.
+
+2003-05-11  Paul Brook  <paul@nowt.org>
+
+	* arith.c (g95_integer_index_kind): New variable.
+	* f95-lang.c (g95_init): Move frontend initialization here ...
+	(g95_post_options): ... from here.
+	* g95.h (g95_index_integer_kind, g95_resolve_index): Declare.
+	* intrinsic.c (add_functions): Use index kinds.
+	* iresolve.c: Convert to index_kind where needed.
+	* resolve.c (g95_resolve_index): Make public, use index_kind.
+	(resolve_array_ref): Adjust to match.
+	* trans-array.c: Rename g95_array_index_kind to g95_index_integer_kind.
+	* trans-stmt.c: Ditto.
+	* trans-types.c: Ditto.
+	* trans-types.h (g95_array_index_kind): Remove declaration.
+	* trans-expr.c (g95_conv_expr_present): Use null_pointer_node.
+
+2003-05-07  Paul Brook  <paul@nowt.org>
+
+	* trans-const.c (g95_conv_mpz_to_tree): Typecast constant.
+	* trans-intrinsic.c (g95_conv_intrinsic_bound): Convert type
+	of bound indices.
+
+2003-05-07  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (trans_static_array_pointer,
+	g95_trans_array_constructor_value, g95_conv_array_initializer,
+	g95_conv_structure): CONSTRUCTOR nodes only have one operand.
+	(g95_add_loop_ss_code): Convert subscripts to the correct type.
+	* trans-stmt.c (g95_trans_character_select): Ditto.
+	* trans-types.c (g95_init_types): Ditto.
+
+2003-05-07  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* f95-lang.c (expand_function_body): Use input_line, not lineno.
+	* trans-decl.c (g95_generate_function_code,
+	g95_generate_constructors): Likewise.
+	* trans.c (g95_trans_runtime_check, g95_add_block_to_block,
+	g95_get_backend_locus, g95_set_backend_locus, g95_trans_code):
+	Likewise.
+
+2003-05-07  Kejia Zhao  <kejia_zh@yahoo.com.cn>
+	* trans-types.c (g95_get_derived_type): Fix bug for DERIVED type
+	with components point to the DERIVED type itself, and two DERIVED
+	type with components point to each other.
+	* trans-expr.c (g95_conv_componet_ref): Modified
+
+2003-05-07  Kejia Zhao  <kejia_zh@yahoo.com.cn>
+	* trans-expr.c (g95_conv_expr): Translate EXPR_NULL into
+	null_pointer_node.
+	(g95_trans_pointer_assign): Implement Nullify.
+
+2003-05-01  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_walk_function_expr): Cope with NULL esym.
+	* trans-decl.c (g95_get_symbol_decl): Don't mangle dummy functions.
+
+2003-05-01  Paul Brook  <paul@nowr.org>
+
+	* trans-array.c, trans.c, trans-expr.c, trans-intrinsic.c,
+	trans-stmt.c: Replace empty_stmt_node with build_empty_stmt () and
+	IS_EMPTY_STMT.
+
+2003-05-01  Canqun Yang  <canqun@yahoo.com.cn>
+
+	* trans-stmt.c (g95_trans_integer_select): Add a parameter to build
+	CASE_LABEL_EXPR.
+
+2003-04-28  Paul Brook  <paul@nowt.org>
+
+	* iresolve.c (g95_resolve_transpose): COMPLEX types are twice as big
+	as their kind suggests.
+	(g95_resolve_reshape): Ditto.
+
+2003-04-28  Chun Huang  <compiler@sohu.com>
+
+	* trans-expr.c (g95_conv_substring_expr): New function.
+	(g95_conv_expr): Use it.
+
+2003-04-28  Paul Brook  <paul@nowt.org>
+
+	* iresolve.c (g95_resolve_transpose): Make it match the
+	implementation.
+	* trans-intrinsic.c (g95_is_intrinsic_libcall): Add TRANSPOSE.
+
+2003-04-18  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* trans-types.c (g95_add_field_to_struct): New function to
+	add a field to a UNION_TYPE or RECORD_TYPE.
+	* trans-types.h (g95_add_field_to_struct): Prototype.
+	(g95_get_derived_type): Use g95_add_field_to_struct to add
+	components.
+	* trans-io.c (g95_add_field): Remove.
+	(ADD_FIELD): Use new g95_add_field_to_struct function.
+	(ADD_STRING): Likewise.
+	* trans-stmt.c (g95_trans_select): Likewise.
+	(g95_add_field): Remove duplicated function.
+
+2003-04-18  Canqun Yang  <canqun@yahoo.com.cn>
+
+	Port implementation for CHARACTER SELECT from Andy's tree.
+	* trans-stmt.c (g95_trans_character_select): Implement character
+	select. (g95_add_field): New function.
+	* trans-decl.c: Declare 'gfor_gndecl_select_string'.
+	(g95_build_builtin_function_decls): Add 'gfor_fndecl_select_string'.
+	* g95.h (struct g95_case): Add field 'int n'.
+	* trans.h: Declare 'gfor_fndecl_select_string'.
+
+2003-04-18  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* bbt.c (duplicate_key, g95_insert_bbt_with_overlap): Remove.
+	(g95_insert_bbd): Die on duplicates.
+	* g95.h (g95_insert_bbt_with_overlap): Delete prototype.
+
+2003-04-14  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* g95.texi: Require GMP 4.0 -- like we actually
+	do.  Explain the testsuite and what-goes-where.
+	Don't use undefined texinfo symbol.  Break very
+	long line.  Remove finished item from the list
+	of open projects.
+
+2003-04-11  Canqun Yang  <canqun@yahoo.com.cn>
+
+	* trans-stmt.c (g95_evaluate_where_mask): Give mask temporaries
+	LOGICAL type.
+
+2003-04-10  Canqun Yang  <canqun@yahoo.com.cn>
+
+	* trans-stmt.c (g95_trans_forall): Implement WHERE inside FORALL.
+	(g95_trans_forall_body): New function.
+
+2003-04-10  Canqun Yang  <canqun@yahoo.com.cn>
+
+	* resolve.c (resove_where): New function.
+	(resolve_where_shape): New function.
+	(resolve_code): Add call to 'resolve_where'
+	* trans-stmt.c (g95_trans_where): Modified.
+	(g95_trans_where_2): New function.
+	(g95_trans_where_assign): New function.
+	(g95_evaluate_where_mask): New function.
+	(g95_add_to_stmt_list): New function.
+	(g95_get_temp_expr): New function.
+	* trans.h (where_stmt_list): New structure.
+
+2003-04-10  Paul Brook  <paul@nowt.org>
+
+	* g95spec.c (DEFAULT_SWITCH_TAKES_ARG): Remove.
+	(DEFAULT_WORD_SWITCH_TAKES_ARG): Ditto.
+
+2003-04-10  Steven Bosscher  <steven@gcc.gnu.org>
+
+	Update after mainline -> tree-ssa-branch merge.
+	* f95-lang.c (g95_mark_addressable): Update put_var_into_stack
+	call.
+	(g95_init): Update for new lang_hooks definition.
+	(g95_post_options): New langhook.
+	(LANG_HOOK_POST_OPTIONS): Clear, then define to g95_post_options.
+	* scanner.c (g95_new_file): Comment update.
+
+2003-04-09  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* g95.h, lang-options.h: Add -Wimplicit-interface.
+	* options.c (g95_init_options, g95_parse_arg): Set it.
+	* interface.c (check_intents): Warn about call with implicit
+	interface.
+	* resolve.c (resolve_unknown_f, resolve_unknown_s): Call
+	g95_procedure_use.
+
+2003-04-05  Paul Brook  <paul@nowt.org>
+
+	* iresolve.c (g95_resolve_spread): Don't resole based on type.
+	* trans-intrinsic.c (g95_is_intrinsic_libcall): Add G95_ISYM_SPREAD.
+
+2003-03-29  Paul Brook  <paul@nowt.org>
+
+	* iresolve.c (g95_resolve_pack): Don't bother resolving based on type.
+	(g95_resolve_unpack): Ditto.
+	* trans-intrinsic.c (g95_conv_intrinsic_merge): New Function.
+	(g95_conv_intrinsic_function): Use it.  Remove PACK and UNPACK.
+	(g95_is_intrinsic_libcall): Add PACK and UNPACK.
+
+2003-03-25  Paul Brook  <paul@nowt.org>
+
+	* arith.c (g95_unary_user, g95_user): Remove dead functions.
+	* arith.h: Ditto.
+	* array.c (g95_free_array_ref): Ditto.
+	* g95.h: Ditto.
+	* symbol.c (g95_use_derived_tree): Ditto.
+	* intrinsic.c (add_functions): Use simplification for SCALE.
+	* primary.c (g95_match_rvalue): Test sym, not symtree.
+
+2003-03-25  Paul Brook  <paul@nowt.org>
+
+	* trans-decl.c (build_function_decl): Add parameter before it gets
+	turned into a constant.
+	* iresolve.c (g95_resolve_eoshift): Resolve to a useful name.
+	* trans-intrinsic.c (g95_is_intrinsic_libcall): Add G95_ISYM_EOSHIFT.
+	* trans-decl.c (g95_create_module_variable): Don't pushdecl constants.
+
+2003-03-22  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_conv_array_initializer): Allow scalar
+	expressions.
+	* trans-decl.c (g95_finish_var_decl): Result variables are not
+	module variables.
+	* trans-intrinsic.c (g95_conv_intrinsic_transfer): New function.
+	(g95_conv_intrinsic_function): Use it.
+	* trans-types.h (g95_type_spec): Remove dead declaration.
+
+2003-03-21  Paul Brook  <paul@nowt.org>
+
+	* trans-decl.c (g95_build_function_decl): Mark string parameters.
+
+2003-03-20  Paul Brook  <paul@nowt.org>
+
+	* trans-decl.c (g95_build_function_decl): Put character length
+	parameters at the end of the function declaration.
+	* trans-expr.c (g95_conv_function_call): Ditto.
+	* trans-types.c (g95_get_function_type): Ditto.
+
+2003-03-20  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* resolve.c (resolve_formal_arglist): Don't impose intent for
+	procedure arguments of pure functions.
+	(resolve_select): Remove redundant assignment.
+
+2003-03-19  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* arith.c (validate_logical), g95.h, options.c (g95_init_options):
+	Remove option l1.
+	* g95.h, intrinsic.c(g95_get_intrinsic_sub_symbol): Add const.
+	* iresolve.c(g95_resolve_cpu_time, g95_resolve_random_number): Add
+	const.
+	* lang-options.h: Remove -finline-repack-arrays. Add -fg77-calls.
+	Order list.
+	* symbol.c (g95_add_type): Fix typo in comment.
+
+
+2003-03-16  Paul Brook  <paul@nowt.org>
+
+	* dump-parse-tree.c (g95_show_code_node): Print resolved sym name.
+	* expr.c (g95_build_call): Remove.
+	* f95-lang.c (puchdecl_top_level): New function.
+	* g95.h (g95_code): Store resolved symbol, not just the name.
+	* intrinsic.c (g95_intrinsic_namespace): New global namespace.
+	(g95_intirinsic_init_1, g95_intrinsic_done_1): Use it.
+	(g95_get_intrinsic_sub_symbol): New function.
+	* iresolve.c (g95_resolve_cpu_time): Use it.
+	(g95_resolve_random_number): Ditto.
+	* resolve.c: Set code->resolved_sym instead of code->sub_name.
+	* trans-decl.c (g95_get_extern_function_decl): Give external decls
+	the correct DECL_CONTEXT.  Add global symbold to the global scope.
+	* trans-stmt.c (g95_trans_code): Remove hacks now the fronted is
+	fixed.
+
+2003-03-16  Paul Brook  <paul@nowt.org>
+
+	* g95.h (g95_option_t): Add g77_calls. Remove inline_repack_arrays.
+	* options.c (g95_parse_arg): Ditto.
+	* module.c (mio_symbol_attribute): Handle the always_explicit bit.
+	* resolve.c (resolve_formal_arglist): The always_explicit sould be set
+	for the procedure, not the parameter.
+	* trans-array.c (g95_trans_g77_array): New function.
+	(g95_trans_assumed_size): Use it.
+	(g95_trans_dummy_array_bias): Ditto.
+	(g95_conv_array_parameter): Handle g77 arrays. Move existing body ...
+	(g95_conv_expr_descriptor): ... to here.  Update callers.
+	* trans-decl.c (g95_build_dummy_array_decl): Handle g77 arrays.
+	(g95_get_symbol_decl): Avoid processing g77 arrays multiple times.
+	* trans-expr.c (g95_conv_function_call): Handle g77 arrays.
+	* trans-intrinsic.c (g95_get_symbol_for_expr): Never use g77 arrays.
+	* trans-types.c (g95_is_nodesc_array): Handle g77 arrays.
+	(g95_sym_type): Ditto.
+
+2003-03-15  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_walk_elemental_function_args): Don't amputate the
+	first chain.
+	* trans-expr.c (g95_conv_function_call): Use the resolved symbol.
+
+2003-03-14  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_array_is_packed): Remove.
+	(g95_conv_array_base): Correctly handle all descriptorless cases.
+	(g95_conv_array_stride): Use descriptorless strides.
+	(g95_trans_dummy_array_bias): Don't always repack the array.
+	(g95_build_dummy_array_decl): Automatic dummy arrays are only partial
+	packed.
+	* trans-types.c (g95_get_nodesc_array_type): Differentiate between
+	dummy and non-dummy arrays...
+	(g95_sym_type, g95_get_derived_type): ... like these.
+	(g95_get_array_type_bounds): Allow discontiguous arrays.
+
+2003-03-12  Paul Brook  <paul@nowt.org>
+
+	* array.c (g95_resolve_array_spec): Fix comment.
+	* g95.h (symbol_attributes): New flag always_explicit.
+	* resolve.c (resolve_formal_arglist): Set it always_explicit.
+	* iresolve.c (g95_resolve_lbound, g95_resolve_ubound): Simplify.
+	* trans-array.c (g95_conv_descriptor_dimension): Remove dead assert.
+	(g95_trans_array_bounds): Allow assumed shape arrays.
+	(g95_trans_repack_array): Remove.
+	(g95_trans_dummy_array_bias): Rewite to use descriptorless arrays.
+	* trans-decl.c (g95_build_qualified_array): Only ignore absent
+	bounds for assumed size arrays.
+	(g95_build_dummy_array_decl): Use descriptorless arrays.
+	* trans-expr.c (g95_conv_expr_present): Allow descriptorless arrays.
+	(g95_trans_pointer_assign): Fix typo.
+	* trans-intrinsic.c (g95_conv_intrinsic_function_args): Remove dead
+	code.
+	(g95_conv_intrinsic_bound): Rewrite to handle descriptorless arrays.
+	* trans-types.c (g95_get_nodesc_array_type): Allow non-packed arrays.
+	Also modify callers.
+	* trans-types.h (g95_get_nodesc_array_type): Modify prototype.
+
+2003-03-08  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_walk_elemental_functions): Don't reverse the SS.
+	(g95_conv_array_ubound): Provide dummy value for assumed size arrays.
+	* resolve.c (compare_spec_to_ref): Allow full array sections.
+
+2003-03-08  Paul Brook  <paul@nowt.org>
+
+	* expr.c (g95_simplify_expr): Also simplify array index and
+	substring expressions.
+	* resolve.c (compare_spec_to_ref): Check for assumed size bounds.
+	* trans-array.c (g95_trans_array_bounds): New function.
+	(g95_trans_auto_array_allocation): Use it.
+	(g95_trans_assumed_size): Rewrite.
+	* trans-decl.c (gfor_fndecl_in_pack, gfor_fndecl_in_unpack): Declare.
+	(gfor_fndecl_repack): Remove.
+	(g95_build_qualified_array): Handle absent upper bounds.
+	(g95_build_dummy_array_decl): Assumed shape arrays are descriptorless.
+	(g95_get_symbol_decl): Update.
+	(g95_build_intrinsic_function_decls): Initialize new decls.
+	* trans.h (gfor_fndecl_in_pack, gfor_fndecl_in_unpack): Declare.
+	(gfor_fndecl_repack): Remove.
+	* trans-io.c (g95_build_io_library_fndecls): Correct prototypes.
+	* trans-types.c: (g95_build_array_type): Merge duplicated code..
+	(g95_get_nodesc_array_type): Handle absent bounds.
+	* trans-types.h (g95_get_nodesc_array_type): Declare.
+
+2003-03-04  Paul Brook  <paul@nowt.org>
+
+	* f95-lang.c (DEF_FUNCTION_TYPE_VAR_3): Define before including
+	builtin-types.def.
+
+2003-03-02  Paul Brook  <paul@nowt.org>
+
+	* options.c (g95_init_options): Drfault to 1.
+	(g95_pasrse_arg): Add -frepack-arrays, use strcmp.
+	* trans-array.c (g95_conv_array_data, g95_conv_array_base,
+	g95_conv_array_stride,g95_conv_array_lbound, g95_conv_array_ubound):
+	Handle non-constant size automatic arrays.
+	(g95_conv_section_upper_bound, g95_conv_section_startstride): Use
+	generic bound functions.
+	(g95_trans_auto_array_allocation): Don't create a descriptor.
+	(g95_trans_assumed_size): New function (broken).
+	(g95_trans_dummy_array_bias): Remove unused var.
+	* trans-array.h (g95_trans_assumed_size): Declare.
+	* trans-decl.c (create_index_var): New fuction.
+	(g95_build_qualified_array): New function.
+	(g95_get_symbol_decl): Use it.
+	(g95_trans_deferred_vars): Handle assumed shape seperately.
+	* trans-types.c (get_element_type): Handle heap allocated arrays.
+	(g95_is_nodesc_array): Include non-const size arrays.
+	(g95_get_nodesc_array_type): Ditto.
+
+2003-02-23  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_array_init_size): Should use stride, not size of
+	last dimension.
+
+2003-02-18  Paul Brook  <paul@nowt.org>
+
+	* trans-expr.c (g95_trans_arrayfunc_assign): Nove elemental check
+	after intrinsic function check.
+
+2003-02-18  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* io.c (match_io): Fix missing return value and remove useless
+	assignment.
+	* match.c (g95_match): Remove useless assignment.
+	* module.c (parse_string):  Remove useless post increment.
+	* simplify.c (g95_simplify_verify): Remove useless assignment.
+
+2003-02-15  Paul Brook  <paul@nowt.org>
+
+	* expr.c (restricted_intrinsic): Handle bad values gracefully.
+	* g95.h (symbol_attribute): Add referenced member.
+	(g95_symbol): Add dummy_order member.
+	(g95_set_sym_referenced): Declare.
+	* match.c (g95_match_assignment, g95_match_call): Use it
+	* primary.c (match_actual_arg, g95_match_rvalue,
+	g95_match_variable): Ditto.
+	* symbol.c (next_dummy_order): New variable.
+	(g95_set_sym_referenced): New function.
+	(check_done): New function.
+	(g95_add_*): Use it.
+	* trans-decl.c: Make formatting conform to GCC standards.
+	(g95_defer_symbol_init): Add dummy variables in the right order.
+	(g95_get_symbol_decl): Only accept referenced variables.
+	(g95_create_module_variable): Module variables are always required.
+	(generatr_local_decls): New function.
+	(generate_local_vars): New function.
+	(g95_generate_function_code): Use it.
+
+2003-02-13  Paul Brook  <paul@nowt.org>
+
+	* trans-decl.c (g95_conv_struct_cons): Remove.
+	(g95_get_symbol_decl): Use g95_conv_expr for structure initializers.
+	* trans-expr.c (g95_conv_structure): New function.
+	(g95_conv_expr): Use it.
+
+2003-02-09  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_array_init_size): Don't evaluate the linit
+	expressions multiple times.
+	(g95_trans_auto_arry_allocation): Use pointer not tmp.
+
+2003-02-08  Paul Brook  <paul@nowt.org>
+
+	* module.c (mio_symtree_ref): Declare as static.
+	(mio_expr): Remove dead code.
+	(read_module): Set the symtree link for fixups.
+	* trans-intrinsic.c (g95_conv_intrinsic_round): Rename...
+	(build_round_expr): ... to this.
+	(g95_conv_intrinsic_aint): New function.
+	(g95_conv_intrinsic_function): Use it.
+
+2003-02-08  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_trans_array_constructor_value): Use the acutal
+	offset after modificaton, not the increment expression.
+	* dependency.c: Kill excess whitespace.
+
+2003-02-07  Sanjiv Gupta  <sanjivg@noida.hcltech.com>
+
+	* dependency.h: Remove some function declarations.
+	* dependency.c (get_no_of_elements): Change this function not to
+	return int.
+	* other: Add comments for all modified functions.
+
+2003-02-06  Paul Brook  <paul@nowt.org>
+
+	* g95spec.c (lang_specific_functions): Fix initializer warning.
+	* dump-parse-tree.c (g95_show_expr): Use typespec instead of symtree
+	for structure type names.
+	* trans-decl.c (g95_cons_structure_cons): New function.
+	(g95_get_symbol_decl): Use it.
+	* trans-expr.c (g95_conv_component_ref): Remove duplicate pointer
+	referencing code.
+
+2003-02-06  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* resolve.c (compare_cases): Add const to casts.
+
+2003-01-30  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* g95.h (g95_check_f): Change a1 to f1m.
+	* intrinsic.c (add_sym_1m, check_specific,
+	g95_intrinsic_func_interface): Use it.
+
+	* module.c (init_pi_tree): Remove useless cast.
+	(fp2): Fix argument type.
+
+	* parse.c (parse_select_block): Add comment.
+
+2003-02-05  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* lang-options.h: Fix warning involving C90 concatenated
+	strings.
+
+2003-02-06  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+	    Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* io.c (format_asterisk): Complete initializer to kill warning.
+	* arith.c (DEF_G95_INTEGER_KIND, DEF_G95_LOGICAL_KIND,
+	DEF_G95_REAL_KIND, MPZ_NULL, MPF_NULL): New #defines.
+	(g95_integer_kinds, g95_logical_kinds, g95_real_kinds): Use the
+	new defines to complete initializers.  Kills all warnings.
+
+	* Make-lang.in: Comment cleanup.
+
+2003-02-05  Paul Brook  <paul@nowt.org>
+
+	* array.c (g95_free_constructor): Handle NULL expressions.
+	* resolve.c (resolve_structure_cons): Ditto.
+	* decl.c (g95_match_null): New Function.
+	(variable_decl): Use it.
+	* module.c (mio_expr): Don't bother saving symtree for EXPR_STRUCTURE.
+	* primary.c (g95_match_runtime): Don't use symtree for EXPR_STRUCTURE.
+	* trans-types.c (g95_set_decl_attributes): Remove empty function.
+
+2003-02-05  Paul Brook  <paul@nowt.org>
+
+	* trans.h (build1_v): New macro.
+	(build_v): Remove pointless and incorrect prototype.
+	* various: Use build1_v for GOTO_EXPR and LABEL_EXPRs.
+	* f95-lang.c (g95_init_builtin_decls): DEF_BUILTIN takes 10 args.
+
+2003-02-01  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* Make-lang.in (F95_OBJS): Remove one more dead file.
+
+2003-02-01  Paul Brook  <paul@nowt.org>
+
+	* lang-specs.h: Don't pass -ffixed-form to the linker.
+	* trans-decl.c (g95_generate_function_code): Clear saved decl chain.
+
+2003-02-01  Paul Brook  <paul@nowt.org>
+
+	* Make-lang.in (F95_OBJS): Remove dead files.
+	* trans-array.c (g95_array_init_size): Do the right thing when
+	ubound=NULL.
+	* trans-decl.c (g95_generate_function_code): Initialize deffered
+	symbol list before translating contained subroutines.
+	* trans-expr.c (g95_conv_expr, g95_conv_expr_reference): Substitute
+	scalar invariant values	here...
+	(g95_conv_variable, g95_conv_function_call): ... instead of here ...
+	* trans-intrinsic.c (g95_conv_intrinsic_function_args): .. and here.
+
+2003-01-29  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_add_loop_code): Put pre code in the right block.
+	(g95_walk_elemental_function_args): Reverse chains before adding.
+	(g95_reverse_ss): Move about a bit.
+	* trans-expr.c (g95_conv_function_call): Handle scalar intrinsic
+	function arguments.
+
+2003-01-28  Paul Brook  <paul@nowt.org>
+
+	* intrinsic.c (resolve_intrinsic): Use correct union member.
+	* trans-array.c (g95_trans_dummy_array_bias): Don't touch absent
+	parameters.
+	* trans-decl.c (g95_get_symbol_decl): Don't translate initializers for
+	use associated variables.
+	* trans-intrinsic.c (g95_conv_intrinsic_present): Move body ...
+	* trans-expr.c (g95_conv_expr_present): ... to here.
+	* trans.h: Declare it.
+	* trans-types.c (g95_sym_type): Assume subroutine if not specified.
+
+2003-01-28  Arnaud Desitter  <arnaud.desitter@geography.oxford.ac.uk>
+
+	* array.c (expand_iterator): Suppress useless assignment.
+	* decl.c (match_char_spec): Ditto.
+	* io.c (match_io_iterator): Ditto.
+	* primary.c (match_real_constant): Ditto.
+	* interface.c (fold_unary, g95_free_interface, g95_extend_expr):
+	Ditto.  Also, use g95_intrinsic_op not int for intrinsic operators.
+	* matchexp.c (match_add_operand, match_level_5): Likewise.
+	* module.c (parse_atom, find_enum): Likewise.
+	* resolve.c: move #include <string.h>
+	(resolve_select): Fix serious typo.
+
+2003-01-28  Steven Bosscher  <s.bosscher@student.tudelft.n>
+
+	* Make-lang.in: Don't build with broken tree-ssa-pre.
+
+2003-01-28  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* resolve.c (resolve_index): Add a TODO.
+	* symbol.c: Remove useless "#include <ctype.h>".
+
+2003-01-27  Paul Brook  <paul@nowt.org>
+
+	* check.c (check_rest): Allow different type kinds as an extension.
+	* g95.h (g95_resolve_f): Add f1m.
+	* intrinsic.c (add_sym_1m, resolve_intrinsic): Use it.
+	* intrinsic.h: Chenge prototypes for MIN and MAX.
+	* iresolve.c (g95_resolve_minmax): New function.
+	(g95_resolve_min, g95_resolve_max): Use it.
+	* trans-intrinsic.c (g95_trans_intrinsic_minmax): Only evaluate
+	arguments once.
+	(g95_conv_intrinsic_present): Fix logic.
+
+2003-01-27  Steven Bossche  <s.bosscher@student.tudelft.nl>
+
+	* g95.h (g95_case): Don't be a tree, be a double linked list.
+	* match.c (match_case_selector): Remove redundant semantics check.
+	Clean up a few goto's to make it a tiny little bit faster.
+	* resolve.c (case_tree): Die.
+	(compare_cases): Accept and compare unbounded cases too.
+	(check_case_overlap): Don't build a tree.  Instead, merge-sort the
+	whole list of g95_cases passed from resolve_select.
+	(sane_logical_select): Die.
+	(check_case_expr): Return FAILURE if a CASE label is of the wrong
+	type kind.
+	(resolve_select): Fixup case expression for computed GOTOs, put it
+	in expr, not expr2, for easier handing in the parse tree dumper and
+	the code generator.  Rewrite the rest of the function: Kill
+	unreachable case labels and unreachable case blocks.
+	* dump-parse-tree.c (g95_show_code_node): Always dump expr for
+	an EXEC_SELECT, not case2 anymore.
+	* trans-const.c (g95_conv_constant_to_tree): New function.
+	(g95_conv_constant): Use it.
+	* trans-const.h: Declare prototype for the new function.
+	* trans-stmt.c (g95_trans_integer_select, g95_trans_logical_select,
+	g95_trans_character_select): New static functions.
+	(g95_trans_select): Rewrite.
+
+2003-01-26  Paul Brook  <paul@nowt.org>
+
+	* intrinsic.c (add_fnctions): Properly add dreal.
+	* trans-intrinsic.c (g95_conv_intrinsic_present): New function.
+	(g95_conv_intrinsic_function): Use it.
+	* trans-io.c (build_dt): Abort on internal files (unimplemented).
+
+2003-01-26  Paul Brook  <paul@nowt.org>
+
+	Widespread changes to the handling of symbols in expressions.  These
+	are now linked via g95_symtree nodes.
+	* parse.c (g95_fixup_sibling symbols): New function.
+	(parse_contained): Use it.
+	* g95.h (symbol_attribute): Add contained.  Indicates a symbol is a
+	contained procedure that has bee correctly fixed up.
+	(g95_code, g95_expr): Point to a g95_symtree, not a g95_symbol.
+
+2003-01-24  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_walk_expr): Function result attributes are in
+	sym->result.
+	* trans-expr.c (g95_conv_function_call,
+	g95_trans_arrayfunc_assign): Ditto.
+	* trans-decl.c (g95_get_symbol_for_expr): Set sym->result.
+
+2003-01-23  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* expr.c (check_restricted): Fix error message.
+	* symbol.c (free_st_labels): Plug memleak.
+
+2003-01-22  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* arith.c (reduce_unary, reduce_binary_ac, reduce_binary_ca,
+	reduce_binary_aa, reduce_binary, eval_intrinsic,
+	eval_intrinsic_f2): Use typesafe prototypes for eval functions.
+	* g95.h (g95_check_f, g95_simplify_f, g95_resolve_f): New unions
+	for typesafe intrinsics helper functions.
+	(g95_intrinsic_sym): Use them.
+	* intrinsic.c (do_check, add_sym, add_sym_0, add_sym_1,
+	add_sym_1s, add_sym_1m, add_sym_2, add_sym_3, add_sym_4,
+	add_sym_5, add_conv, resolve_intrinsic, do_simplify,
+	check_specific, g95_intrinsic_func_interface,
+	g95_intrinsic_sub_interface): Adjust all calls to intrinsics
+	helper functions.
+	* trans-decl.c (g95_get_extern_function_decl): Likewise.
+	* Make-lang.in: Don't disable warnings for strict prototypes
+	any longer, everything is typesafe now.
+
+2003-01-22  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* bbt.c (duplicate_node): Make static.
+	* module.c (module_name): Make static.
+	* scanner.c (include_dirs): Make static.
+
+2003-01-20  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	Hard coded _gfor_'s should not show up anymore.
+	* g95.h (PREFIX): New macro.
+	* iresolve.c (g95_resolve_cpu_time): Use PREFIX, not
+	hard-coded "_gfor".
+	(g95_resolve_random_number): Likewise.
+	* trans-decl.c (g95_build_intrinsic_function_decls): Likewise.
+	* trans-io.c: Remove 'prefix' macro.  Replace all uses with
+	the new PREFIX macro from g95.h.
+
+2003-01-20  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	The troubles of forking... Andy implemented this just now too.
+	Let's stick to that and keep the trees close.
+	* g95.h (g95_st_label): 'format' member is now a g95_expr.
+	* io.c: Revert previous changes.
+	(g95_match_format): Match the format string as a character
+	literal expression.
+	* match.h (g95_statement_label): Declare external.
+	* parse.c: Revert previous changes.
+	* symbol.c (g95_free_st_label): Free a g95_expr instead
+	if a 'char *'.
+	* trans-io.c: Revert previous changes.
+	(build_dt): Use set_string to set the format string.
+
+2003-01-20  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* io.c (format_string): Make non-static.
+	(g95_match_format): Remember the format string.
+	(terminate_io): Add I/O termination for empty I/O lists.
+	* match.h: Declare external format_string.
+	* parse.c (check_statement_label): Attack the format string
+	to a format label for FORMAT statements.
+	* trans-io.c (g95_add_field): Define prefix macro.  Replace
+	all uses of PREFIX define with a use of this macro.
+	(build_dt): Implement formatted I/O for format labels.
+
+2003-01-20  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* lang-options.h: Kill "-std=F".
+	* options.c: Remove unimplemented "-std=F".  Modify
+	web address.
+	* misc.c (g95_terminal_width): New function.
+	* error.c (g95_error_init_1): Use g95_terminal_width.
+	* g95.h: Add prototype for g95_terminal_width, remove
+	fmode flag.
+
+2003-01-19  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* Make-lang.in: Fix typo.
+
+2003-01-18  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* g95.h (struct g95_case): Remove unused cruft, new member
+	'where' to keep track of the locus of the default case.
+	* match.c (g95_match_case): Add locus to the current case.
+	(match_case_selector): Likewise.
+	* parse.c (parse_select_block): Move semantics check for
+	multiple DEFAULT cases out of here to...
+	* resolve.c (check_case_overlap): ...here.  Return sooner
+	when possible.
+	(check_case_expr): Take two g95_cases now, use to sure the
+	expression kinds are the same.
+	(resolve_select): Cleanup.
+
+2003-01-18  Paul Brook  <paul@nowt.org>
+
+	* trans-io.c: Fix typos in ported IO work (set_fla[tg]).
+	* trans-decl.c (g95_set_symbol_decl): Handle non-array result
+	variables.
+	(g95_get_extern_function_decl): Put decls in the correct context.
+
+2003-01-18  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* trans-io.c: Port changes from Andy to set ERR flag.
+
+2003-01-17  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c: Add various comments.
+	(g95_ss_terminator): Declare as const.
+	(g95_walk_expr): Remove first parameter and update all callers.
+	(g95_walk_op_expr): Initialize scalar SS properly.
+	* trans-array.h (g95_walk_expr): Update prototype.
+	* trans-expr.c: Update for new g95_walk_expr.
+	* trans-intrinsic.c: Ditto.
+	* trans-io.c: Ditto.
+	* trans.h: Various comments for SS chains.
+
+2003-01-17  Paul Brook  <paul@nowt.org>
+
+	* intrinsic.h (g95_generic_isym_id): Add G95_ISYM_S?_KIND, SPACING
+	and RRSPACING.
+	* intrinsic.c (add_functions): Use them.
+	* trans-intrinsic.c (g95_conv_intrinsic_function): Ditto.
+	* trans-expr.c (g95_conv_expr_lhs): Abort on impossible error.
+
+2003-01-17  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	Fallout of a small merge conflict:
+	* intrinsic.c: Un-revert lost patch (G95_ISYM_SCALE).
+
+2003-01-17  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* initrinsic.c: New add_sym_* functions for strong typing.
+	(add_conv): Make prototype strict.
+	* dump-parse-tree.c, dependency.c: Include config.h
+	* resolve.c, trans-io.c: Fix typos.
+
+2003-01-17  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* dump-parse-tree.c (g95_show_code_node): Show the
+	condition for a computed GOTO that was transformed
+	to a SELECT CASE construct.
+	* resolve.c (check_case_overlap): Revert previous switch
+	to treaps, it was too slow and didn't catch all trouble.
+	(resolve_symbol): Be more flexible about module procedures.
+	* symbol.c (check_conflict): Point to relevant section in
+	the standard for dubious conflict.  Allow procedure
+	dummy arguments to be optional again.
+	* trans-io (add_field): Rename to g95_add_field.  Change
+	all callers.
+	* trans-stmt (trans_select): Handle unbounded cases for
+	integer SELECT CASE constructs.  Fix/add more comment.
+
+2003-01-17  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* g95.h: Uses GCC's function attribute macros.
+	* error.c, module.c, parse.c, g95.h: More function attributes.
+
+2003-01-16  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+	Forgot a file...
+	* trans-decl.c (get_label_decl): Use TREE_LINENO instead
+	of DECL_SOURCE_LINE, and TREE_FILENAME instead of
+	DECL_SOURCE_FILE.
+
+2003-01-16  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* f95-lang.c (pushdecl): Use TREE_LINENO instead of
+	DECL_SOURCE_LINE.
+	* trans.c (g95_trans_code): Use annotate_all_with_file_line
+	instead of nowdead wrap_all_with_wfl.
+
+2003-01-14  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* parse.c (g95_parse_file): In verbose mode, dump the parse tree
+	before generating code, so we can still see it even if the code
+	generation phase dies.
+
+2003-01-14  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* decl.c (build_sym): Split out initialization expression parts...
+	(add_init_expr_to_sym): ...to here.
+	(variable_decl): Add the symbol following an attribute list to the
+	symbol tree before parsing the optional initialization expression
+	if the symbol is not of a derived type.
+	* primary.c (g95_match_rvalue): Don't assume a symbol always has
+	a value if it is a PARAMETER.
+
+2003-01-14  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* misc.c: Don't #include <mcheck.h>
+	* module.c: Ditto.  Kill uses of mtrace, muntrace.  If there
+	ever was a glibc bug, then either this was never reported to
+	glibc people, or it has been fixed for so long that there's
+	no information you can find about it, anywhere.
+
+2003-01-14  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	Fix warnings:
+	* module.c (attr_bits, bt_types, array_spec_types):
+	Switch 'const' and 'static'.
+	* iresolve.c (g95_resolve_reshape): Make __resolve0 non-'const'.
+
+	GNU'ify source code:
+	* trans-io.c: Numerous fixes, one fixed warning and a few
+	TODO markers so that we don't forget about them.
+
+2003-01-13  Paul Brook  <paul@nowt.org>
+
+	* intrinsic.c (add_functions): Add G95_ISYM_SCALE.
+	* intrinsic.h (g95_generic_isym_id): Remove bogus G95_ISYM_ANINIT.
+	Add G95_ISYM_SCALE.
+	* trans-intrinsic.c (g95_conv_intrinsic_function): Ditto
+	* match.c (g95_match_stop): Fix dumb == -> != error.
+
+2003-01-13  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* dump-parse-tree.c (show_indent): Add line breaks.  This
+	whole dumping process needs cleanups.
+	* f95-lang.c (g95_mark_addressable): Fix prototype to match
+	the langhook.  Fix 'return's accordingly.
+	* g95-support.h: Adjust prototype.
+	* g95.h: Add 'no_backend' member to 'g95_option_t' struct.
+	* lang-options.h: Add '-fsyntax-only'.
+	* options.c (g95_init_options): Init 'no_backend'.
+	(g95_parse_arg): Deal with '-fsyntax-only'.
+	* parse.c (g95_parse_file): Do not generate code if 'no_backend'
+	is set.
+
+2003-01-13  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+	Patch from Arnaud
+	* resolve.c (resolve_symbol): Assumed shape arrays must be dummy
+	arguments.  Also make sure that if a symbol is marked INTRINSIC,
+	an intrinsic with the symbol's name actually exists.
+	(check_conflict): Make EXTERNAL and DIMENSION attributes conflict.
+	Do not allow PROCEDURES to have the SAVE, POINTER, TARGET,
+	ALLOCATABLE, RESULT, IN_NAMESPACE, OPTIONAL or FUNCTION attribute.
+
+2003-01-13  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* resolve.c (resolve_contained_functions): Fix condition, don't
+	throw internal_error if a child namespace has no name.  Apparently
+	this can be the case?
+
+2003-01-11  Paul Brook  <paul@nowt.org>
+
+	Port changes from Andy's tree:
+	* g95.h (g95_code): Add stop_code.
+	* match.c (g95_match_stop): Detter syntax checking.
+	* resolve.c (resolve_generic_f0): Return match type.
+	(resolve_generic_f): Remove dead/duplicated code.
+	(resolve_specific_f): Ditto.
+	* dump-parse-tree.c (g95_show_code_node): Handle new STOP format.
+	* trans-decl.c (gfor_fndel_stop_*): New fndecl nodes.
+	* trans-stmt.c (g95_trans_stop): Handle new STOP format.
+
+2003-01-11  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c: Various documentation/comment changes.
+	* trans-stmt.c: Ditto.
+
+
+2003-01-10  Paul Brook  <paul@nowt.org>
+
+	* options.c/h: Add -fdump-parse-tree as alias of -v.
+
+2003-01-10  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* dump-parse-tree.c (g95_show_namespace): Fixed another
+	typo.  Sorry, it's Friday...
+
+2003-01-10  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	Spotted by Tobi:
+	* trans-array.c, trans-array.h, trans.c, trans-const.c,
+	trans-const.h, trans-decl.c, trans-expr.c, trans.h
+	trans-intrinsic.c, trans-io.c, trans-stmt.c, trans-stmt.h
+	trans-types.c: Fix bogus copyright years, add 2003.
+	* trans-types.h: Give copyright header.
+
+2003-01-10  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* dump-parse-tree.c (g95_show_namespace): Fixed typo.
+	* expr.c, options.c, scanner.c: Add some more 'const' markers.
+	* intrinsic.c: Some constant strings moved to read-only memory.
+	* io.c (format_asterisk): Move to...
+	* g95.h: ...here.
+
+2003-01-10  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* dump-parse-tree.c (g95_show_namespace): Dump implicit
+	types for ranges instead of per-letter.  Indent the
+	'CONTAINS' just like everything else.
+	* resolve.c (resolve_contained_functions): Clarify comment.
+	Explain non-obvious conditional expression.  Improve
+	diagnostics if tyoe cannot be resolved.
+	Port semi-fix from Andy's tree:
+	(was_declared): Move up before first use.
+	(generic_sym, specific_sym): New functions.  Code moved
+	out if procedure_kind.
+	(procedure_kind): Simplify using new functions.
+	(resolve_generic_f): Make sure the functions we find in
+	a parent namespace is generic.
+	(resolve_specific_f): Ditto for specific functions.
+
+2003-01-10  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* trans-stmt.c, trans.c: Fix some code style issues. Add
+	some more comment (but still not enough!).
+
+2003-01-10  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* symbol.c (flavors, procedures, intents, acces_types,
+	access_types, ifsrc_types): Make const.
+	* misc.c (g95_string2code): Make 'm' param 'const'.
+	* module.c (find_enum, write_atom, mio_name): Make
+	'm' param 'const'.
+	(attr_bits, bt_types, array_spec_types, array_ref_types,
+	ref_types, expr_types): Make const.
+	* g95.h: Adjust external decls.
+
+2003-01-09  Paul Brook  <paul@nowt.org>
+
+	* Testsuite: Add a load of new cases.
+
+2003-01-08  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* Make-file.in: Add dependency on back end header files;
+	a parallel build should work now.
+	* f95-lang-c (lang_identifier): Remove bogus comment.
+	(g95_be_parse_file): Fix prototype.
+	(g95_init): Make static.
+	(g95_finish): Make static.
+	* error.c (g95_syntax_error): Kill. Make define in...
+	* g95.h (g95_syntax_error): Define.
+	(g95.options): Make 'source' member 'const'.
+	* interface.c (g95_match_interface): Explain
+	hard-to-read condition.
+	(g95_match_end_interface): Ditto.
+	* trans_const.c (g95_build_string_const): Make 's' parameter
+	'const'.
+	* trans_const.h: Adjust protoype accordingly.
+	* trans-decl.c: Include tree-dump.h
+	(g95_generate_function_code): Build fixes for recent changes
+	in the tree-ssa branch.
+
+2003-01-08  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* format.c: Kill, move code from here...
+	* io.c: ...to here.
+	* Make-lang.in: Adjust.
+	* MANIFEST: Ditto.
+	* match.h: Ditto.
+	* BUGS: Mention where to submit bugs.  Move old content...
+	* TODO: ...to here.  New file.
+
+2003-01-08  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+	Fix most warnings, and suppress the ones we can't fix for now.
+	* Make-lang.in: Suppress warnings about bad proto's in g95.h,
+	these warnings just clutter the screen and there's not much
+	we can do about them for now anyway.
+	* check.c, iresolve.c: Mark unused function parameters.
+	* dump-parse-tree.c (g95_show_array_spec): Punt on AS_UNKNOWN,
+	they should be resolved before they get here.
+	* error.c: Remove unused FILE *status_out.
+	* f95-lang.c (g95_init): Remove bogus cast.
+	* Many files: Make things 'const' where required.
+	* g95.h: Fix prototypes for all modified functions above.
+	(g95_options): Remove 'object' member.
+
+2003-01-07  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* Make-file.in: Cleanup bogus targets.  Add more comment.
+	* lang-options.h: New option '-w'.
+	* g95.h: add no_options field to struct g95_options.
+	* options.c (g95_init_options): Default no_warnings to off.
+	(g95_parse_arg): Recognise the '-w' switch and its alias,
+	'-fno-warnings'.
+	* error.c (g95_warning, g95_warning_now): Don't emit warning if
+	no_warning option is set.
+	* iresolve.c (g95_resolve_shape): Fix warning.
+
+2003-01-07  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* primary.c (g95_next_string_char): Rename next_string_char, and
+	make static.  Adjust callers accordingly.
+	* resolve.c (resolve_generic_f0): Return try, not match.  Adjust
+	callers accordingly.
+	* g95.h: Split out all g95_match* functions to...
+	* match.h: ...here. New file.
+	* array.c, decl.c, expr.c, format.c, interface.c, io.c, match.c,
+	matchexp.c, module.c, parse.c, primary.c: Inlcude match.h
+
+2003-01-07  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* symbol.c (g95_clear_new_implicit, g95_add_new_implicit_range,
+	g95_merge_new_implicit): New functions.
+	(g95_match_implicit_none, g95_match_implicit): Move from here...
+	* match.c (g95_match_implicit_none, g95_match_implicit): ... to here.
+	Modify to use the new functions in symbol.c.
+	* g95.h: Add and move prototypes.
+
+2003-01-06  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* bbt.c (insert): Use a typedef'ed compare_fn prototype for the
+	node compare function.
+	(g95_insert_bbt): Likewise.
+	(g95_insert_bbt_with_overlap): Likewise.
+	(g95_delete_bbt): Likewise.
+	(delete_treap): Likewise. Also fix a potential bug when calling it.
+	* module.c (compare_pointers): Change proto to compare_fn.
+	(compare_integers): Likewise.
+	(compare_true_names): Likewise.
+	(find_true_name): Adjust call to compare_true_names to match proto.
+	(require_atom, write_atom, mio_name): Fix 'const' warnings.
+	(init_pi_tree): Make compare a compare_fn instead of (int *).
+	* resolve.c (compare_cases): Change proto to compare_fn.
+	* symbol.c (g95_compare_symtree): Change proto to compare_fn, make
+	it static, and rename to compare_symtree.
+	(delete_symtree, g95_undo_symbols, g95_new_symtree): Use renamed
+	function.
+	* g95.h: Kill g95_compare_symtree prototype. Adjust prototypes
+	of g95_insert_bbt, g95_insert_bbt_with_overlap, and g95_delete_bbt.
+
+2003-01-06  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+	* Make-lang.in: Fix spaces/tabs issues from previous patch.
+	* patch.options: Blow away Paul's checkin mistake :-)
+	* io.c (terminate_io): Fix memory leak (Arnaud).
+
+2003-01-06  Steven Bosscher  <s.bosscher@student.tudelft.nl>
+
+	* Make-lang.in: Teach about building DVI, info manual.
+	* g95.texi: New file.
+
+2003-01-02  Paul Brook  <paul@nowt.org>
+
+	* trans-array.c (g95_reverse_ss): Make static and don't use.
+	(g95_conv_ss_descriptor): Don't use g95_loopinfo
+	(g95_conv_array_parameters): Modify for pointer assignments.
+	(g95_walk_subexpr): New function.
+	(g95_walk_expr*): Use it.
+	* trans-array.h (g95_reverse_ss): Remove prototype.
+	* trans-expr.c (g95_trans_pointer_assign): Implement.
+	(Many): Set se.want_pointer before calling g95_conv_array_parameter.
+	* trans-intrinsic.c: Sync with scalarizer changes.
+	* trans-io.c: Ditto.
+
+
+Copyright (C) 2003 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved.
diff --git a/gcc/fortran/ChangeLog-2004 b/gcc/fortran/ChangeLog-2004
new file mode 100644
index 000000000..d5d665406
--- /dev/null
+++ b/gcc/fortran/ChangeLog-2004
@@ -0,0 +1,2853 @@
+2004-12-29  Steven G. Kargl  <kargls@comcast.net>
+
+	* gfortran.h (gfc_case): fix typo in comment.
+
+2004-12-27  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_ishft): Change to
+	logical	shift.  Call fold.  Remove 0-bit shift shortcut.
+	(gfc_conv_intrinsic_ishftc): Convert first argument to at least
+	4 bytes bits.  Convert 2nd and 3rd argument to 4 bytes.  Convert
+	result if width(arg 1) < 4 bytes.  Call fold.
+
+	PR fortran/19032
+	* trans-intrinsic.c (gfc_conv_intrinsic_mod): Update comment
+	in front of function to match the standard.  Correct handling
+	of MODULO.
+
+2004-12-27  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	* trans-expr.c (gfc_conv_cst_int_power): Only check for
+	flag_unsafe_math_optimizations if we have a float type.
+
+2004-12-23  Steven G. Kargl  <kargls@comcast.net>
+
+	* gfortran.texi: Fix typo.
+
+2004-12-16  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-intrinsic.c (build_fixbound_expr): Clarify comment, fix
+	comment typo.
+
+2004-12-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/18993
+	* match.c (gfc_match_if): Don't explicitly skip optional whitespace.
+	(gfc_match_nullify): Make sure that ')' is in front of the end of
+	statement.
+
+	* scanner.c (skip_fixed_comments): Fix typo in comment preceding
+	function.
+
+2004-12-14  Richard Henderson  <rth@redhat.com>
+
+	* gfortran.h (gfc_expr.function.name): Make const.
+	(gfc_iresolve_init_1, gfc_iresolve_done_1): Remove.
+	(gfc_get_string): Update prototype.
+	* iresolve.c: Include tree.h.
+	(string_node, HASH_SIZE, string_head, hash): Remove.
+	(gfc_get_string): Use vsnprintf, get_identifier.
+	(free_strings, gfc_iresolve_init_1, gfc_iresolve_done_1): Remove.
+	* misc.c (gfc_init_1): Don't call gfc_iresolve_init_1.
+	(gfc_done_1): Don't call gfc_iresolve_done_1.
+	* module.c (mio_allocated_string): Take and return const char *,
+	instead of modifying char**.
+	(mio_expr): Update to match.
+	* resolve.c (pure_function): Constify name argument.
+	(resolve_function): Constify name.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Likewise.
+
+2004-12-12  Richard Henderson  <rth@redhat.com>
+
+	* iresolve.c (gfc_resolve_all, gfc_resolve_any, gfc_resolve_count,
+	gfc_resolve_cshift, gfc_resolve_dot_product, gfc_resolve_eoshift,
+	gfc_resolve_matmul, gfc_resolve_maxloc, gfc_resolve_maxval,
+	gfc_resolve_minloc, gfc_resolve_minval, gfc_resolve_pack,
+	gfc_resolve_product, gfc_resolve_reshape, gfc_resolve_shape,
+	gfc_resolve_spread, gfc_resolve_sum, gfc_resolve_transpose,
+	gfc_resolve_unpack: Use PREFIX.
+
+2004-12-12  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/18869
+	* match.c (gfc_match_common): Skip whitespace.
+
+2004-12-12  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/16581
+	* check.c (gfc_check_iand, gfc_check_ibclr, gfc_check_ibits,
+	gfc_check_ibset, gfc_check_ieor, gfc_check_ior): Remove default
+	integer kind check; Issue error for -std=f95 when needed.
+	* intrinsic.c (add_functions): Change ieor from GFC_STD_GNU to
+	GFC_STD_F95.
+	* iresolve.c (gfc_resolve_iand, gfc_resolve_ieor, gfc_resolve_ior):
+	Promote arguments to same kind.
+
+2004-12-12  Steven G. Kargl  <kargls@comcast.net>
+	Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/16222
+	* resolve.c (gfc_resolve_iterator_expr): New function.
+	(gfc_resolve_iterator): Use it.  Add real_ok argument.  Convert
+	start, end and stride to correct type.
+	(resolve_code): Pass extra argument.
+	* array.c (resolve_array_list): Pass extra argument.
+	* gfortran.h (gfc_resolve): Add prototype.
+	* trans-stmt.c (gfc_trans_do): Remove redundant type conversions.
+	Handle real type iterators.
+
+2004-12-11  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/17175
+	* iresolve.c (gfc_resolve_scale): Convert 'I' argument if not of
+	same kind as C's 'int'.
+	(gfc_resolve_set_exponent): Convert 'I' argument if not of kind 4.
+
+2004-12-08  Richard Henderson  <rth@redhat.com>
+
+	* intrinsic.c (gfc_convert_type_warn): Propagate the input shape
+	to the output expression.
+	* iresolve.c (gfc_resolve_cshift, gfc_resolve_eoshift): Suppress
+	warning conversion.
+	(gfc_resolve_reshape): Force convert SHAPE and ORDER parameters
+	to index kind.
+
+2004-12-08  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/18826
+	* resolve.c (resolve_code): Impose correct restrictions on
+	assigned variable.
+
+	* decl.c (gfc_match_end): Use locus of END when eos is an error.
+
+2004-12-02  Steven G. Kargl  <kargls@comcast.net>
+	Paul Brook  <paul@codesourcery.com>
+
+	* check.c (gfc_check_flush, gfc_check_fnum): New functions.
+	(gfc_check_fstat, gfc_check_fstat_sub): New functions.
+	(gfc_check_stat, gfc_check_stat_sub): New functions.
+	* gfortran.h (GFC_ISYM_FNUM,GFC_ISYM_FSTAT,GFC_ISYM_STAT): New symbols
+	* intrinsic.c (add_functions,add_subroutines): Add flush, fnum,
+	fstat, and stat to intrinsics symbol tables.
+	* intrinsic.h (gfc_check_flush, gfc_resolve_stat_sub): Add prototypes.
+	(gfc_resolve_fstat_sub, gfc_resolve_stat): Ditto.
+	* iresolve.c (gfc_resolve_fnum, gfc_resolve_fstat): New functions.
+	(gfc_resolve_stat, gfc_resolve_flush): New functions.
+	(gfc_resolve_stat_sub,gfc_resolve_fstat_sub): New functions
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Add new intrinsics.
+
+2004-12-02  Steven G. Kargl  <kargls@comcast.net>
+
+	* intrinsic.c: Fix and add comments, fix function declarations
+	(OPTIONAL,REQUIRED): New symbols
+	(add_functions,add_subroutines): Use symbols
+	(gmp.h): Remove unused include
+
+2004-11-25  Joseph S. Myers  <joseph@codesourcery.com>
+
+	* f95-lang.c, gfortranspec.c, trans-decl.c: Avoid ` as left quote
+	in diagnostics.
+
+2004-11-24  Steven Bosscher  <stevenb@suse.de>
+
+	* options.c (gfc_post_options): Don't clear flag_inline_functions.
+
+2004-11-20  Steven G. Kargl  <kargls@comcast.net>
+
+	* check.c (gfc_check_getcwd_sub): Fix seg fault.
+
+	* check.c (gfc_check_exit,gfc_check_umask,gfc_check_umask_sub,
+	gfc_check_unlink,gfc_check_unlink_sub): New functions
+	* gfortran.h (GFC_ISYM_UMASK,GFC_ISYM_UNLINK): New symbols
+	* intrinsic.c (add_functions,add_subroutines): Add umask, unlink,
+	exit to intrinsics symbol tables.
+	* intrinsic.h (gfc_check_umask,gfc_check_unlink,gfc_check_exit,
+	gfc_check_umask_sub,gfc_check_unlink_sub,gfc_resolve_umask,
+	gfc_resolve_unlink,gfc_resolve_exit,gfc_resolve_umask_sub,
+	gfc_resolve_unlink_sub): Add and sort prototypes.
+	* iresolve.c (gfc_resolve_umask,gfc_resolve_unlink,gfc_resolve_exit,
+	gfc_resolve_umask_sub,gfc_resolve_unlink_sub): New functions
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbols
+
+2004-11-16  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/13010
+	* trans-array.c (gfc_trans_allocate_temp_array): Use gfc_get_dtype.
+	(gfc_array_init_size, gfc_conv_expr_descriptor): Ditto.
+	* trans-types.c (gfc_get_dtype): Accept array type rather than element
+	type.
+	(gfc_get_nodesc_array_type): Don't set GFC_TYPE_ARRAY_DTYPE.
+	(gfc_get_array_type_bounds): Ditto.
+	(gfc_get_derived_type): Recurse into derived type pointers.
+	* trans-types.h (gfc_get_dtype): Add prototype.
+	* trans.h (GFC_TYPE_ARRAY_DTYPE): Add comment.
+
+2004-11-15  Paul Brook  <paul@codesourcery.com>
+
+	* trans-types.c (gfc_get_dtype): Remove obsolete TODO.
+
+2004-11-10  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/18375
+	* trans-expr.c (gfc_trans_subarray_assign): Free shape before ss.
+	* trans-io.c (transfer_array_component): Ditto.
+
+2004-11-10  Paul Brook  <paul@codesourcery.com>
+
+	* invoke.texi: Fix typo.
+
+2004-11-08  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* arith.c, array.c, decl.c, expr.c, f95-lang.c, gfortran.h,
+	gfortranspec.c, interface.c, intrinsic.c, iresolve.c, match.c,
+	module.c, parse.c, parse.h, primary.c, resolve.c, scanner.c,
+	trans-array.c, trans-array.h, trans-expr.c, trans-intrinsic.c,
+	trans-io.c, trans-stmt.c, trans.h: Fix comment formatting.
+
+2004-11-06  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/18023
+	* io.c (resolve_tag): Tighten up exception for assigned FORMAT.
+
+2004-11-06  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* gfortranspec.c: Replace GNU CC with GCC.
+
+2004-11-05  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortranspec.c (lang_specific_driver): Change year to 2004.
+
+2004-11-05  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/18111
+	*  trans-decl.c (create_function_arglist): Set DECL_ARTIFICIAL for
+	hidden parameters.
+
+2004-11-05  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15164
+	* trans-decl.c (gfc_finish_var_decl): Don't declare arguments to
+	module procedures as if they were module variables.
+
+2004-11-03  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/17535
+	PR fortran/17583
+	PR fortran/17713
+	* module.c (write_symbol1): Set module_name for dummy arguments.
+
+2004-11-02  Paul Brook  <paul@codesourcery.com>
+
+	* intrinsic.c (check_intrinsic_standard): Include error locus.
+	Remove VLA.
+	(gfc_intrinsic_func_interface, gfc_intrinsic_sub_interface): Pass
+	locus to check_intrinsic_standard.
+
+2004-10-31  Janne Blomqvist  <jblomqvi@cc.hut.fi>
+
+	PR fortran/17590
+	* gfortran.h: Change GFC_STD_* flags to more appropriate
+	ones. (struct gfc_intrinsic_isym): Add field for standard. (struct
+	gfc_option_t): Add field for warning about use of nonstandard
+	intrinsics.
+	* intrinsic.c (add_sym): Add parameter for standard version, check
+	this against current standard.
+	(add_sym_0): Pass standard parameter to add_sym.
+	(add_sym_1, add_sym_0s, add_sym_1s, add_sym_1m, add_sym_2): Ditto.
+	(add_sym_2s, add_sym_3, add_sym_3ml, add_sym_3red, add_sym_3s): Ditto.
+	(add_sym_4, add_sym_4s, add_sym_5, add_sym_5s): Ditto.
+	(make_generic): Add parameter for standard, check this
+	against currently selected standard.
+	(add_functions, add_subroutines): Add parameter to tell which
+	standard an intrinsic belongs to.
+	(check_intrinsic_standard): New function.
+	(gfc_intrinsic_func_interface): Add call to check_intrinsic_standard.
+	(gfc_intrinsic_sub_interface): Ditto.
+	* lang.opt: Add Wnonstd-intrinsics option.
+	* options.c (gfc_init_options): Change to use new GFC_STD_* flags,
+	init new warning.
+	(set_Wall): Add warning about nonstd intrinsics.
+	(gfc_handle_option): Change to use new GFC_STD_* flags,
+	handle new warning.
+	* invoke.texi: Update manual to include -Wnonstd-intrinsics.
+
+2004-10-30  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	* f95-lang.c (lang_tree_node): Add chain_next to be the TREE_CHAIN.
+
+2004-10-30  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* simplify.c (twos_complement): Calculate mask in GMP arithmetic.
+
+2004-10-30  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans.c (gfc_trans_code): Set global locus after recursing. Fix
+	comment typo.
+
+2004-10-30  Canqun Yang  <canqun@nudt.edu.cn>
+
+	* check.c (gfc_check_rand): Allow missing optional argument.
+	(gfc_check_irand): Ditto.
+	* intrinsic.c (add_functions): Set arg optional flag for {i,}rand.
+
+2004-10-28  Scott Robert Ladd  <scott.ladd@coyotegulch.com>
+
+	PR fortran/13490, PR fortran/17912
+	* gcc/fortran/gfortran.h: Added pedantic_min_int to gfc_integer_info
+	* gcc/fortran/gfortran.h: Added ARITH_ASYMMETRIC to arith
+	* gcc/fortran/arith.c: Added support for an "asymmetric integer"
+	warning when compiling with pedantic.
+	* gcc/fortran/arith.c: Set minimum integer values to reflect
+	realities of two's complement signed integers. Added
+	pedantic minimum.
+
+2004-10-17  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	* Make-lang.in (F95_ADDITIONAL_OBJS): Kill.
+	(f951): Do not depend on F95_ADDITIONAL_OBJS and don't
+	link it in.
+
+2004-10-14  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-decl.c (generate_local_decl): Simplify logic, fix comment
+	typo.
+	(gfc_generate_function_code): Fix formatting issue.
+
+2004-10-10  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* module.c: Fix formatting issues.
+
+2004-10-09  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* module.c (mio_interface_rest): Set where member of interface
+	while loading.
+
+2004-10-08  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	PR fortran/17901
+	* options.c (gfc_handle_option): Add break after handing the
+	J/M option.
+
+2004-10-08  Tobias Schlueter  <tobias.shclueter@physik.uni-muenchen.de>
+
+	* arith.c: Fix formatting issues.
+
+2004-10-07  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/17676
+	* resolve.c (resolve_operator): Use correct operator name in message.
+
+2004-10-07  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* primary.c (match_boz_constant): Allow kind parameter suffixes.
+	Move standard warning further to the front.
+
+2004-10-07  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* trans-stmt.c: Fix a comment typo.
+
+2004-10-07  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/17678
+	* trans-array.c (gfc_trans_deferred_array): Leave use associated
+	variables alone.
+
+2004-10-06  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/17568
+	* simplify.c (twos_complement): New function.
+	(gfc_simplify_ishft, gfc_simplify_ishftc): Revise.
+
+	* simplify.c (gfc_simplify_abs): Use mpfr_hypot for CABS.
+
+2004-10-06  Paul Brook  <paul@codesourcery.com>
+
+	* trans-stmt.c (gfc_trans_simple_do): New function.
+	(gfc_trans_do): Use it.  Evaluate iteration bounds before entering
+	loop.  Update comments.
+
+2004-10-04  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/17283
+	* iresolve.c (gfc_resolve_pack): Choose function depending if mask
+	is scalar.
+
+	PR fortran/17631
+	* intrinsic.c (add_sym_5): Remove.
+	(add_subroutines): Add resolution function for MVBITS.
+	* intrinsic.h (gfc_resolve_mvbits): Declare resolution function for
+	MVBITS
+	* iresolve.c (gfc_resolve_mvbits): New function.
+	(gfc_resolve_random_number): Remove empty line at end of function.
+
+	* trans-const.c (gfc_build_cstring_const): New function.
+	(gfc_init_cst): Use new function.
+	* trans-const.h (gfc_build_cstring_const): Add prototype.
+	* trans-io.c (set_string, set_error_locus): Use new function.
+	* trans-stmt.c (gfc_trans_goto): Use new function.
+
+	PR fortran/17708
+	* parse.c (accept_statement): Don't treat END DO like END IF and
+	END SELECT.
+	(parse_do_block): Generate possible END DO label inside END DO
+	block.
+
+	PR fortran/17776
+	* check.c (gfc_check_system_sub): New function.
+	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SYSTEM.
+	* intrinsic.c (add_functions): Add 'system'.
+	(add_subroutines): Add 'system'.
+	* intrinsic.h (gfc_check_etime_sub, gfc_check_getcwd_sub):
+	Move prototypes to other suborutines.
+	(gfc_check_system_sub, gfc_resolve_system, gfc_resolve_system_sub):
+	Add prototype.
+	(gfc_resolve_system_clock): Fix formatting of prototype.
+	* iresolve.c (gfc_resolve_system, gfc_resolve_system_sub): New
+	functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Deal with
+	GFC_ISYM_SYSTEM.
+
+2004-10-04  Erik Schnetter  <schnetter@aei.mpg.de>
+
+	* scanner.c (preprocessor_line): Accept preprocessor lines without
+	file names.  Check file names for closing quotes.  Handle escaped
+	quotes in file names.
+
+2004-10-04  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+	Paul Brook  <paul@codesourcery.com>
+
+	* trans-array.c (gfc_conv_expr_descriptor): Check for substriungs.
+	Use gfc_get_expr_charlen.
+	* trans-expr.c (gfc_get_expr_charlen): New function.
+	* trans.h (gfc_get_expr_charlen): Add prototype.
+
+2004-10-04  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* trans-intrinsic.c: Fix a comment typo.
+
+2004-10-03  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* simplify.c (range_check): Remove blank line at beginning of function.
+	(gfc_simplify_dint): Same at end of function.
+	(gfc_simplify_exponent, gfc_simplify_fraction): Simplify calculations.
+	(gfc_simplify_bound): Fix indentation.
+	(gfc_simplify_log10): Simplify calculation.
+	(gfc_simplify_min, gfc_simplify_max): Remove blank line at beginning
+	of function.
+	(gfc_simplify_nearest): Same at end of function.
+	(gfc_simplify_nint, gfc_simplify_idnint): Same at beginning of
+	function.
+	(gfc_simplify_rrspacing, gfc_simplify_set_exponent,
+	gfc_simplify_spacing): Simplify calulations.
+
+2004-10-03  Feng Wang  <fengwang@nudt.edu.cn>
+
+	* trans-intrinsic.c: Fix comments on spacing and rrspacing
+	(gfc_conv_intrinsic_rrspacing): Add fold on constant trees.
+
+2004-10-01  Jan Hubicka  <jh@suse.cz>
+
+	* f95-lang.c (gfc_expand_function): Update call of
+	tree_rest_of_compilation.
+	* trans-decl.c (gfc_generate_constructors): Likewise.
+
+2004-09-26  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-intrinsic.c: Comment fixes.
+
+2004-09-25  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* decl.c (add_init_expr_to_sym, variable_decl): Comment fixes.
+
+2004-09-24  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-types.c (gfc_return_by_reference): Remove superfluous
+	assertion.
+
+	* intrinsic.h (gfc_resolve_getcwd): Update prototype.
+	* iresolve.c (gfc_resolve_getcwd): Add second argument to function.
+
+	PR fortran/17615
+	* trans-expr.c (gfc_trans_arrayfunc_assign): Look at resolved
+	function to determine return type.
+
+2004-09-20  Jan Hubicka  <jh@suse.cz>
+
+	* trans-decl.c (build_entry_thunks): Finalize the function; do not lower
+	tree.
+	(gfc_generate_function_code): Likewise.
+
+2004-09-20  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15957
+	* simplify.c (gfc_simplify_reshape): Set shape of return value
+	correctly.
+
+2004-09-17  Jeffrey D. Oldham  <oldham@codesourcery.com>
+	    Zack Weinberg  <zack@codesourcery.com>
+
+	* f95-lang.c, trans-expr.c, trans.c: Update for new tree-class
+	enumeration constants.
+
+2004-09-17  Paul Brook  <paul@codesourcery.com>
+
+	* gfortran.h (struct gfc_linebuf): Don't use C99 empty arrays.
+	(gfc_linebuf_header_size): Define.
+	* scanner.c (load_file): Use it.
+
+2004-09-16  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* array.c, data.c, decl.c, dependency.c, error.c, f95-lang.c,
+	interface.c, intrinsic.c, io.c, misc.c, module.c, parse.h,
+	resolve.c, scanner.c, trans-array.c, trans-array.h,
+	trans-common.c, trans-const.h, trans-decl.c, trans-expr.c,
+	trans-intrinsic.c, trans-stmt.c, trans-types.c, trans.c,
+	trans.h: Fix comment typos.  Follow spelling conventions.
+
+2004-09-16  Victor Leikehman  <lei@il.ibm.com>
+
+	PR/15364
+	* trans-io.c (transfer_array_component): New function.
+	(transfer_expr): For array fields, call transfer_array_component.
+
+2004-09-16  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* gfortran.texi: Fix a typo.
+
+2004-09-15  Aaron W. LaFramboise  <aaronavay62@aaronwl.com>
+
+	* parse.c (eof_buf): Rename eof to eof_buf.
+	(unexpected_eof): Same.
+	(gfc_parse_file): Same.
+
+2004-09-15  Steven G. Kargl  <kargls@comcast.net>
+
+	* check.c (gfc_check_getcwd_sub): New function.
+	* gfortran.h (GFC_ISYM_GETCWD): New symbol.
+	* intrinsic.c (add_functions): Add function definition;
+	Use symbol.
+	* intrinsic.c (add_subroutines): Add subroutine definitions.
+	* intrinsic.h: Add prototypes.
+	* iresolve.c (gfc_resolve_getcwd, gfc_resolve_getcwd_sub):
+	New functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Use symbol.
+
+2004-09-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/16485
+	* module.c (write_symbol): Don't fill in module name here.
+	(write_symbol0): Fill in here instead.
+
+2004-09-14  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* data.c, decl.c, f95-lang.c, gfortran.h, match.c,
+	trans-array.c, trans-common.c, trans-expr.c,
+	trans-intrinsic.c, trans-stmt.c, trans-types.c, trans.h: Fix
+	comment typos.  Follow spelling conventions.
+
+2004-09-09  Paul Brook  <paul@codesourcery.com>
+
+	* scanner.c (get_file): Add ATTRIBUTE_UNUSED.
+
+2004-09-08  Paul Brook  <paul@codesourcery.com>
+
+	* array.c: Don't include assert.h.
+	* data.c: Don't include assert.h.  Replace assert and abort with
+	gcc_assert and gcc_unreachable.
+	* dependency.c: Ditto.
+	* f95-lang.c: Ditto.
+	* iresolve.c: Ditto.
+	* resolve.c: Ditto.
+	* simplify.c: Ditto.
+	* symbol.c: Ditto.
+	* trans-array.c: Ditto.
+	* trans-common.c: Ditto.
+	* trans-const.c: Ditto.
+	* trans-decl.c: Ditto.
+	* trans-expr.c: Ditto.
+	* trans-intrinsic.c: Ditto.
+	* trans-io.c: Ditto.
+	* trans-stmt.c: Ditto.
+	* trans-types.c: Ditto.
+	* trans.c: Ditto.
+
+2004-09-07  Per Bothner  <per@bothner.com>
+	Paul Brook  <paul@codesourcery.com>
+
+	* error.c (show_locus): Handle mapped locations.
+	* f95-lang.c (gfc_be_parse_file): Initialize mapped locations.
+	* gfortran.h: Include input.h.
+	(struct gfc_linebuf): Use source_location.
+	* scanner.c (get_file): Initialize linemap.
+	(preprocessor_line): Pass extra argument to get_file.
+	(load_file): Ditto.  Setup linemap.
+	(gfc_new_file): Handle mapped locations.
+	* trans-common.c (build_field, build_equiv_decl, build_common_decl):
+	Set decl source locations.
+	(gfc_trans_common): Set blank common block location.
+	* trans-decl.c (gfc_set_decl_location): New function.
+	(gfc_get_label_decl, gfc_get_symbol_decl): Use it.
+	(trans_function_start): Move call to gfc_set_backend_locus..
+	(build_function_decl): ... to here.
+	(build_entry_thunks): Set and restore the backend locus.
+	(gfc_generate_constructors): Remove excess arguments to
+	init_function_start.
+	(gfc_generate_block_data): Add comments.  Set the decl locus.
+	* trans-io.c (set_error_locus): Handle mapped locations.
+	* trans.c (gfc_get_backend_locus, gfc_get_backend_locus): Ditto.
+	(gfc_trans_code): Use SET_EXPR_LOCATION.
+	(gfc_generate_code): Override the location of the new symbol.
+	* trans.h (gfc_set_decl_location): Add prototype.
+
+2004-08-31  Paul Brook  <paul@codesourcery.com>
+
+	* trans-types.c (gfc_type_for_mode): Return NULL for unknown modes.
+
+2004-09-01  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15327
+	* trans-intrinsic.c (gfc_conv_intrinsic_merge): Do the right thing for
+	strings.
+
+2004-09-01  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/16400
+	PR fortran/16404
+	(port from g95)
+	* resolve.c (resolve_transfer): New function.
+	(resolve_code): Call resolve_transfer in case of EXEC_TRANSFER.
+
+2004-08-31  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/16579
+	* trans-types.c (gfc_init_types): Make gfc_character1_type_node an
+	unsigned char.
+
+2004-08-31  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* CONTRIB, NEWS, README, TODO: Remove obsolete files.
+
+2004-08-31  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/17244
+	* trans-types.c (gfc_return_by_reference): Remove TODO error,
+	add comment pointing out possible issue WRT compatibility with g77.
+
+2004-08-31  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-decl.c, trans-expr.c, trans-io.c, trans-types.c: Replace
+	all occurences of 'gfc_strlen_type_node' by
+	'gfc_charlen_type_node'.
+	* trans-types.h: Same. Also update comment accordingly.
+
+2004-08-31  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* primary.c: Update copyright boilerplate to say GCC.
+	* f95-lang.c: Change initial comment to say gfortran.
+
+2004-08-31  Paul Brook  <paul@codesourcery.com>
+
+	* trans-types.h: Add comments.
+	(intmax_type_node, string_type_node, const_string_type_node): Remove.
+
+2004-08-30  Richard Henderson  <rth@redhat.com>
+
+	* Make-lang.in (fortran/f95-lang.o): Update dependencies.
+	(fortran/trans-decl.o, fortran/trans-types.o): Likewise.
+	* gfortran.h (gfc_integer_info): Add c_char, c_short, c_int,
+	c_long, c_long_long.
+	(gfc_logical_info): Add c_bool.
+	(gfc_real_info): Add mode_precision, c_float, c_double, c_long_double.
+	* trans-array.c (gfc_array_allocate): Use TYPE_PRECISION
+	rather than gfc_int[48]_type_node for allocate choice.
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Cache
+	local copies of some kind type nodes.
+	(gfc_build_builtin_function_decls): Likewise.
+	* trans-expr.c (gfc_conv_power_op): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_index,
+	gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify,
+	gfc_conv_intrinsic_trim, gfc_conv_intrinsic_repeat): Likewise.
+	* trans-stmt.c (gfc_trans_pause, gfc_trans_stop,
+	gfc_trans_character_select, gfc_trans_allocate): Likewise.
+	* trans-io.c (gfc_pint4_type_node): Move into ...
+	(gfc_build_io_library_fndecls): ... here.  Cache local copies of
+	some kind type nodes.
+	* trans-types.c (gfc_type_nodes): Remove.
+	(gfc_character1_type_node, gfc_strlen_type_node): New.
+	(gfc_integer_types, gfc_logical_types): New.
+	(gfc_real_types, gfc_complex_types): New.
+	(gfc_init_kinds): Fill in real mode_precision.
+	(gfc_build_int_type, gfc_build_real_type): New.
+	(gfc_build_complex_type, gfc_build_logical_type): New.
+	(c_size_t_size): New.
+	(gfc_init_types): Loop over kinds.
+	(gfc_get_int_type, gfc_get_real_type): Use gfc_validate_kind.
+	(gfc_get_complex_type, gfc_get_logical_type): Likewise.
+	(gfc_get_character_type_len): Likewise.
+	(gfc_type_for_size): Loop over kinds; use a reduced set of
+	unsigned type nodes.
+	(gfc_type_for_mode): Loop over kinds.
+	(gfc_signed_or_unsigned_type): Use gfc_type_for_size.
+	(gfc_unsigned_type, gfc_signed_type): Use gfc_signed_or_unsigned_type.
+	* trans-types.h (F95_INT1_TYPE, F95_INT2_TYPE, F95_INT4_TYPE,
+	F95_INT8_TYPE, F95_INT16_TYPE, F95_REAL4_TYPE, F95_REAL8_TYPE,
+	F95_REAl16_TYPE, F95_COMPLEX4_TYPE, F95_COMPLEX8_TYPE,
+	F95_COMPLEX16_TYPE, F95_LOGICAL1_TYPE, F95_LOGICAL2_TYPE,
+	F95_LOGICAL4_TYPE, F95_LOGICAL8_TYPE, F95_LOGICAL16_TYPE,
+	F95_CHARACTER1_TYPE, NUM_F95_TYPES, gfc_type_nodes,
+	gfc_int1_type_node, gfc_int2_type_node, gfc_int4_type_node,
+	gfc_int8_type_node, gfc_int16_type_node, gfc_real4_type_node,
+	gfc_real8_type_node, gfc_real16_type_node, gfc_complex4_type_node,
+	gfc_complex8_type_node, gfc_complex16_type_node,
+	gfc_logical1_type_node, gfc_logical2_type_node,
+	gfc_logical4_type_node, gfc_logical8_type_node,
+	gfc_logical16_type_node, gfc_strlen_kind): Remove.
+	(gfc_character1_type_node): Turn in to a variable.
+	(gfc_strlen_type_node): Likewise.
+
+2004-08-30  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.h (gfc_namespace): Add new field is_block_data.
+	* parse.c (accept_statement): Remove special handling for BLOCK DATA.
+	(parse_block_data): Record BLOCK DATA name, set is_block_data field.
+	* trans.c (gfc_generate_code): Handle BLOCK DATA units.
+	* trans.h (gfc_generate_block_data): Add prototype.
+	* trans-decl.c (gfc_generate_block_data): New function.
+
+2004-08-29  Richard Henderson  <rth@redhat.com>
+
+	* trans-const.c (gfc_conv_mpz_to_tree): Use mpz_export.
+	* trans-types.c (gfc_init_kinds): Reject integer kinds larger
+	than two HOST_WIDE_INT.
+
+2004-08-29  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/13910
+	* decl.c (free_variable, free_value, gfc_free_data, var_list,
+	var_element, top_var_list, match_data_constant, top_val_list,
+	gfc_match_data): Move here from match.c.
+	(match_old_style_init): New function.
+	(variable_decl): Match old-style initialization.
+	* expr.c (gfc_get_variable_expr): New function.
+	* gfortran.h (gfc_get_variable_expr): Add prototype.
+	* gfortran.texi: Start documentation for supported extensions.
+	* match.c: Remove the functions moved to decl.c.
+	* match.h (gfc_match_data): Move prototype to under decl.c.
+	* symbol.c (gfc_find_sym_tree, gfc_find_symbol): Add/correct
+	comments.
+
+2004-08-29  Steven G. Kargl  <kargls@comcast.net>
+	Paul Brook  <paul@codesourcery.com>
+
+	* check.c (gfc_check_besn, gfc_check_g77_math1): New functions.
+	* f95-lang.c (DO_DEFINE_MATH_BUILTIN): Define.
+	(DEFINE_MATH_BUILTIN, DEFINE_MATH_BUILTIN_C): Use it.
+	(build_builtin_fntypes): New function.
+	(gfc_init_builtin_functions): Use it.
+	* gfortran.h (enum gfc_generic_isym_id): Add GFC_ISYM_{J,Y}{0,1,N}
+	and GFC_ISYM_ERF{,C}.
+	(gfc_c_int_kind): Declare.
+	* intrinsic.c (add_functions): Add [d]bes* and [d]erf*.
+	* intrinsic.h (gfc_check_besn, gfc_check_g77_math1, gfc_resolve_besn,
+	gfc_resolve_g77_math1): Add prototypes.
+	* resolve.c (gfc_resolve_besn, gfc_resolve_g77_math1): New functions.
+	* mathbuiltins.def: Add comment.  Change third argument.  Use
+	DEFINE_MATH_BUILTIN_C.  Add bessel and error functions.
+	* trans-intrinsic.c (BUILT_IN_FUNCTION): Define.
+	(DEFINE_MATH_BUILTIN, DEFINE_MATH_BUILTIN_C): Use it.
+	* trans-types.c (gfc_c_int_kind): Declare.
+	(gfc_init_kinds): Set it.
+
+2004-08-29  Steven G. Kargl  <kargls@comcast.net>
+	Paul Brook  <paul@codesourcery.com>
+
+	* gfortran.h (enum gfc_generic_isym_id): Add GFC_ISYM_GET?ID.
+	(gfc_check_f, gfc_simplify_f): Add f0.
+	* intrinsic.c (do_check): Call f0.  Flatten.
+	(add_sym_0): Fix prototype.  Set f0.
+	(add_functions): Add getgid, getgid and getuid.
+	(resolve_intrinsic): Remove obsolete comment.
+	(do_simplify): Call f0.
+	* intrinsic.h (gfc_resolve_getgid, gfc_resolve_getpid,
+	gfc_resolve_getuid): Add prototypes.
+	* iresolve.c (gfc_resolve_getgid, gfc_resolve_getpid,
+	gfc_resolve_getuid): New functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Handle
+	GFC_ISYM_GET?ID.
+
+2004-08-28  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* error.c (gfc_error_init_1): Remove blank line in front of
+	function body. Add missing blank.
+	(gfc_buffer_error, error_char, error_string): Remove blank line in
+	front of function body.
+	(show_locus): Add comma in comment.
+	(gfc_clear_warning, gfc_warning_check, gfc_clear_error,
+	gfc_push_error, gfc_pop_error): Remove blank line in front of
+	function body.
+	(gfc_get_errors): Typo fix in comment in front of function. Remove
+	blank line in front of function body.
+
+2004-08-27  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.h (gfc_default_*_kind): Remove prototypes, add extern
+	variable declaration of same name.
+	* arith.c, check.c, decl.c, dump_parse_tree.c, expr.c,
+	intrinsic.c, io.c, iresolve.c, match.c, options.c, primary.c,
+	resolve.c, simplify.c, symbol.c, trans-const.c, trans-io.c:
+	Replace all calls to gfc_default_*_kind with variable accesses.
+	* trans-types.c: Same as above.
+	(gfc_default_*_kind_1): Rename to gfc_default_*_kind, remove
+	static qualifier. Replace all occurences.
+	(gfc_default_*_kind): Remove functions.
+
+2004-08-26  Richard Henderson  <rth@redhat.com>
+
+	* arith.c: Include system.h, not real system headers.
+	(MPZ_NULL, MPF_NULL, DEF_GFC_INTEGER_KIND, DEF_GFC_LOGICAL_KIND,
+	DEF_GFC_REAL_KIND, GFC_SP_KIND, GFC_SP_PREC, GFC_SP_EMIN, GFC_SP_EMAX,
+	GFC_DP_KIND, GFC_DP_PREC, GFC_DP_EMIN, GFC_DP_EMAX, GFC_QP_KIND,
+	GFC_QP_PREC, GFC_QP_EMIN, GFC_QP_EMAX): Remove.
+	(gfc_integer_kinds, gfc_logical_kinds, gfc_real_kinds,
+	gfc_index_integer_kind, gfc_default_integer_kind,
+	gfc_default_real_kind,gfc_default_double_kind,
+	gfc_default_character_kind, gfc_default_logical_kind,
+	gfc_default_complex_kind, validate_integer, validate_real,
+	validate_logical, validate_character,
+	gfc_validate_kind): Move to trans-types.c.
+	(gfc_set_model_kind): Use gfc_validate_kind.
+	(gfc_set_model): Just copy the current precision to default.
+	(gfc_arith_init_1): Use mpfr precision 128 for integer setup.
+	* f95-lang.c (gfc_init_decl_processing): Invoke gfc_init_kinds.
+	* gfortran.h: Update file commentary.
+	* trans-types.c (MAX_INT_KINDS, MAX_REAL_KINDS): New.
+	(gfc_default_integer_kind_1, gfc_default_real_kind_1,
+	gfc_default_double_kind_1, gfc_default_character_kind_1,
+	gfc_default_logical_kind_1, gfc_default_complex_kind_1): New.
+	(gfc_init_kinds): New.
+	(gfc_init_types): Don't set gfc_index_integer_kind here.
+	* trans-types.h (gfc_init_kinds): Declare.
+	* doc/invoke.texi: Clarify DOUBLE PRECISION behaviour wrt -r8.
+
+2004-08-26  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* check.c (gfc_check_atan2): New function.
+	* intrinsic.c (add_functions): Use gfc_check_atan2 for ATAN2
+	* intrinsic.h (gfc_check_atan2): Add prototype.
+
+2004-08-25  Richard Henderson  <rth@redhat.com>
+
+	* arith.c (gfc_validate_kind): Add may_fail argument; abort if
+	false and we don't validate the kind.
+	(gfc_check_integer_range, gfc_check_real_range): Update to match.
+	* check.c (kind_check): Likewise.
+	* decl.c (gfc_match_old_kind_spec, gfc_match_kind_spec): Likewise.
+	(match_char_spec, match_logical_spec): Likewise.
+	* gfortran.h (gfc_validate_kind): Likewise.
+	* options.c (gfc_handle_option): Likewise.
+	* primary.c (match_integer_constant, match_real_constant,
+	match_string_constant, match_logical_constant,
+	match_const_complex_part): Likewise.
+	* simplify.c (get_kind, gfc_simplify_bit_size, gfc_simplify_digits,
+	gfc_simplify_epsilon, gfc_simplify_huge, gfc_simplify_ibclr,
+	gfc_simplify_ibset, gfc_simplify_ishft, gfc_simplify_ishftc,
+	gfc_simplify_maxexponent, gfc_simplify_minexponent,
+	gfc_simplify_nearest, gfc_simplify_not, gfc_simplify_precision,
+	gfc_simplify_radix, gfc_simplify_range, gfc_simplify_rrspacing,
+	gfc_simplify_scale, gfc_simplify_spacing, gfc_simplify_tan,
+	gfc_simplify_tiny): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_aint, gfc_conv_intrinsic_mod,
+	gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_minmaxval,
+	prepare_arg_info): Likewise.
+
+2004-08-25  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* expr.c (gfc_check_assign): Add comment. Add new warning.
+	* trans-expr.c (gfc_conv_function_call): Correctly dereference
+ 	result of pointer valued function when not in pointer assignment.
+
+2004-08-25  Paul Brook  <paul@codesourcery.com>
+
+	* config-lang.in: Remove dead commented line.
+	* module.c: Replace g95 with gfortran in comment.
+
+2004-08-25  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/17190
+	* arith.c (gfc_mpfr_to_mpz): Workaround mpfr bug.
+
+2004-08-25  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/17144
+	* trans-array.c (gfc_trans_allocate_temp_array): Remove
+	string_length argument.
+	(gfc_trans_array_ctor_element): New function.
+	(gfc_trans_array_constructor_subarray): Use it.
+	(gfc_trans_array_constructor_value): Ditto.  Handle constant
+	character arrays.
+	(get_array_ctor_var_strlen, get_array_ctor_strlen): New functions.
+	(gfc_trans_array_constructor): Use them.
+	(gfc_add_loop_ss_code): Update to new gfc_ss layout.
+	(gfc_conv_ss_descriptor): Remember section string length.
+	(gfc_conv_scalarized_array_ref): Ditto.  Remove dead code.
+	(gfc_conv_resolve_dependencies): Update to new gfc_ss layout.
+	(gfc_conv_expr_descriptor): Ditto.
+	(gfc_conv_loop_setup): Ditto.  Spelling fixes.
+	* trans-array.h (gfc_trans_allocate_temp_array): Update prototype.
+	* trans-const.c (gfc_conv_constant):  Update to new gfc_ss layout.
+	* trans-expr.c (gfc_conv_component_ref): Turn error into ICE.
+	(gfc_conv_variable): Set string_length from section.
+	(gfc_conv_function_call): Remove extra argument.
+	(gfc_conv_expr, gfc_conv_expr_reference): Update to new gfc_ss layout.
+	* trans-types.c (gfc_get_character_type_len): New function.
+	(gfc_get_character_type): Use it.
+	(gfc_get_dtype): Return zero for internal types.
+	* trans-types.h (gfc_get_character_type_len): Add prototype.
+	* trans.h (struct gfc_ss): Move string_length out of union.
+
+2004-08-25  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans.h (build2_v, build3_v): New macros.
+	(build_v): Remove.
+	* f95-lang.c (gfc_truthvalue_conversion): Use build2 instead of
+	build.
+	* trans-array.c (gfc_conv_descriptor_data,
+	gfc_conv_descriptor_offset, gfc_conv_descriptor_dimension,
+	gfc_conv_descriptor_stride, gfc_conv_descriptor_lbound,
+	gfc_conv_descriptor_ubound, gfc_trans_allocate_array_storage,
+	gfc_trans_allocate_temp_array,
+	gfc_trans_array_constructor_subarray,
+	gfc_trans_array_constructor_value, gfc_conv_array_index_ref,
+	gfc_trans_array_bound_check, gfc_conv_array_index_offset,
+	gfc_conv_scalarized_array_ref, gfc_conv_array_ref,
+	gfc_conv_array_ref, gfc_trans_preloop_setup,
+	gfc_trans_scalarized_loop_end, gfc_conv_ss_startstride,
+	gfc_conv_loop_setup, gfc_array_init_size,
+	gfc_conv_array_initializer, gfc_trans_array_bounds,
+	gfc_trans_auto_array_allocation, gfc_trans_dummy_array_bias,
+	gfc_conv_expr_descriptor, gfc_conv_array_parameter,
+	gfc_trans_deferred_array): Use buildN and buildN_v macros instead
+	of build and build_v as appropriate.
+	* trans-common.c (create_common): Same.
+	* trans-decl.c (gfc_trans_auto_character_variable,
+	gfc_trans_entry_master_switch, gfc_generate_function_code): Same.
+	* trans-expr.c (gfc_conv_expr_present, gfc_conv_substring,
+	gfc_conv_component_ref, gfc_conv_unary_op, gfc_conv_powi,
+	gfc_conv_cst_int_power, gfc_conv_string_tmp, gfc_conv_concat_op,
+	gfc_conv_expr_op, gfc_conv_function_call,
+	gfc_trans_structure_assign): Same.
+	* trans-intrinsic.c (build_fixbound_expr, build_round_expr,
+	gfc_conv_intrinsic_aint, gfc_conv_intrinsic_bound,
+	gfc_conv_intrinsic_cmplx, gfc_conv_intrinsic_mod,
+	gfc_conv_intrinsic_dim, gfc_conv_intrinsic_sign,
+	gfc_conv_intrinsic_dprod, gfc_conv_intrinsic_minmax,
+	gfc_conv_intrinsic_anyall, gfc_conv_intrinsic_count,
+	gfc_conv_intrinsic_arith, gfc_conv_intrinsic_minmaxloc,
+	gfc_conv_intrinsic_minmaxval, gfc_conv_intrinsic_btest,
+	gfc_conv_intrinsic_bitop, gfc_conv_intrinsic_singlebitop,
+	gfc_conv_intrinsic_ibits, gfc_conv_intrinsic_ishft,
+	gfc_conv_intrinsic_merge, gfc_conv_intrinsic_strcmp,
+	gfc_conv_allocated, gfc_conv_associated, prepare_arg_info,
+	gfc_conv_intrinsic_spacing, gfc_conv_intrinsic_rrspacing,
+	gfc_conv_intrinsic_trim, gfc_conv_intrinsic_repeat,
+	gfc_conv_intrinsic_iargc): Same.
+	* trans-io.c (set_parameter_value, set_parameter_ref, set_string,
+	set_flag, add_case, io_result, transfer_namelist_element,
+	transfer_expr): Same.
+	* trans-stmt.c (gfc_trans_goto, gfc_trans_return, gfc_trans_if_1,
+	gfc_trans_arithmetic_if, gfc_trans_do, gfc_trans_do_while,
+	gfc_trans_integer_select, gfc_trans_logical_select,
+	gfc_trans_character_select, gfc_trans_forall_loop,
+	gfc_trans_nested_forall_loop, gfc_do_allocate,
+	generate_loop_for_temp_to_lhs, generate_loop_for_rhs_to_temp,
+	compute_inner_temp_size, compute_overall_iter_number,
+	allocate_temp_for_forall_nest, gfc_trans_pointer_assign_need_temp,
+	gfc_trans_forall_1, gfc_evaluate_where_mask,
+	gfc_trans_where_assign, gfc_trans_allocate): Same.
+	* trans-types.c (gfc_get_dtype, gfc_get_array_type_bounds): Same.
+	* trans.c (gfc_add_modify_expr, gfc_finish_block,
+	gfc_build_array_ref, gfc_build_function_call,
+	gfc_trans_runtime_check): Same.
+
+2004-08-25  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-const.c (gfc_conv_mpz_to_tree): Change call to
+	build_int_cst to build_int_cst_wide in accordance to Nathan's
+	previous patch.
+
+2004-08-25  Nathan Sidwell  <nathan@codesourcery.com>
+
+	* trans-array.c (gfc_trans_array_constructor_value): Adjust
+	build_int_cst calls.
+	* trans-const.c (gfc_build_string_const, gfc_init_constants,
+	gfc_conv_mpz_to_tree, gfc_conv_constant_to_tree): Likewise.
+	* trans-decl.c (gfc_get_symbol_decl, build_entry_thunks,
+	gfc_trans_entry_master_switch): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_ibits,
+	gfc_conv_intrinsic_len, prepare_arg_info): Likewise.
+	* trans-io.c (add_case, set_error_locus,
+	transfer_namelist_element, transfer_expr): Likewise.
+	* trans-stmt.c (gfc_trans_label_assign, gfc_trans_pause,
+	gfc_trans_stop, gfc_trans_character_select): Likewise.
+	* trans-types.c (gfc_init_types, gfc_get_dtype): Likewise.
+	* trans.c (gfc_trans_runtime_check): Likewise.
+
+2004-08-24  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-decl.c, trans-types.c: Add and remove blank lines as
+	required.
+
+2004-08-24  Richard Henderson  <rth@redhat.com>
+
+	* trans-const.c (gfc_conv_mpz_to_tree): Fix 64-bit shift warning.
+
+2004-08-24  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* resolve.c (merge_argument_lists): Revert unintentionally
+	committed change.
+
+2004-08-24  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-decl.c (build_function_decl): Fix spelling in comment.
+	(build_entry_thunks): Remove code with no function.
+	(gfc_build_intrinsic_function_decls): Remove empty line.
+
+	* resolve.c (resolve_entries): Fix a bunch of comment typos.
+
+2004-08-24  Nathan Sidwell  <nathan@codesourcery.com>
+
+	* f95-lang.c (gfc_init_decl_processing): Adjust
+	build_common_tree_nodes call.
+
+2004-08-24  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-types.c: Spelling and formatting fixes.
+
+2004-08-23  Richard Henderson  <rth@redhat.com>
+
+	* trans-const.c (gfc_conv_mpz_to_tree): Use mpz_getlimbn instead
+	of going through an intermediate string.  Fix 32/64 int/long bug.
+
+2004-08-23  Eric Christopher  <echristo@redhat.com>
+
+	* trans-types.c (gfc_type_for_mode): Remove VECTOR_TYPE_SUPPORTED_P
+	usage. Use build_vector_type_for_mode for vector types.
+
+2004-08-22  Richard Henderson  <rth@redhat.com>
+
+	PR 13465
+	* data.c (find_con_by_offset): Search ordered list; handle
+	elements with repeat counts.
+	(gfc_assign_data_value_range): New.
+	* gfortran.h (struct gfc_data_value): Make repeat unsigned.
+	(gfc_assign_data_value_range): Declare.
+	* match.c (top_val_list): Extract repeat count into a temporary.
+	* resolve.c (values): Make left unsigned.
+	(next_data_value): Don't decrement left.
+	(check_data_variable): Use gfc_assign_data_value_range.
+
+2004-08-22  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-const.c, trans-decl.c, trans-expr.c: Spelling fixes.
+
+2004-08-22  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* check.c (gfc_check_reduction): Rename to ...
+	(check_reduction): ... this. Make static. Don't check type of
+	first argument.
+	(gfc_check_minval_maxval, gfc_check_prodcut_sum): New functions.
+	* intrinsic.c (add_functions): Change MAXVAL, MINVAL, PRODUCT and
+	SUM to use new check functions.
+	(check_specific): Change logic to call new functions.
+	* intrinsic.h (gfc_check_minval_maxval, gfc_check_product_sum):
+	Add prototypes.
+	(gfc_check_reduction): Remove prototype.
+
+2004-08-20  Paul Brook  <paul@codesourcery.com>
+	Canqun Yang  <canqun@nudt.edu.cn>
+
+	PR fortran/17077
+	* trans-array.c (gfc_conv_array_parameter): Pass correct pointer
+	for automatic arrays.
+	* trans-types.c (gfc_get_nodesc_array_type): Add comment.
+
+2004-08-19  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+	(Port from g95)
+
+	PR fortran/17074
+	* match.c (match_simple_forall, match_simple_where): Forward-declare.
+	(gfc_match_if): Order statement list alphabetically, add WHERE and
+	FORALL, remove double PAUSE.
+	(gfc_match_simple_where, match_forall_header,
+	gfc_match_simple_forall): New functions.
+	(gfc_match_forall): Use match_forall_header.
+
+2004-08-19  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/17091
+	* gfortran.h (gfc_access): Give ACCESS_UNKNOWN value 0.
+	* symbol.c (gfc_clear_attr): Use memset.
+
+2004-08-19  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/14976
+	PR fortran/16228
+	* data.c (assign_substring_data_value): Remove.
+	(create_character_intializer): New function.
+	(gfc_assign_data_value): Track the typespec for the current
+	subobject.  Use create_character_intializer.
+
+2004-08-19  Erik Schnetter  <schnetter@aei.mpg.de>
+
+	PR fortran/16946
+	* check.c (gfc_check_reduction): New function.
+	(gfc_check_minval_maxval): Removed.
+	(gfc_check_product): Removed.
+	(gfc_check_sum): Removed.
+	* intrinsic.h: Add/remove declarations for these.
+	* gfortran.h: Add field f3red to union gfc_check_f.
+	* intrinsic.c (add_sym_3red): New function.
+	(add_functions): Register maxval, minval, product, and sum intrinsics
+	through add_sym_3red.
+	(check_specific): Handle f3red union field.
+	* iresolve.c: Whitespace change.
+
+2004-08-18  Paul Brook  <paul@codesourcery.com>
+
+	* trans-types.c (gfc_sym_type): Use pointer types for optional args.
+
+2004-08-18  Victor Leikehman  <lei@il.ibm.com>
+
+	PR fortran/13278
+	* trans-io.c (transfer_namelist_element): New. Recursively handle
+	derived-type variables.  Pass string lengths.
+	(build_dt): Code moved to build_namelist, with some
+	changes and additions.
+	(gfc_build_io_library_fndecls): Declare the fifth
+	argument in st_set_nml_var_char -- string_length.
+
+2004-08-17  Paul Brook  <paul@codesourcery.com>
+	Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/13082
+	* decl.c (get_proc_name): Update mystery comment.
+	(gfc_match_entry): Check for errors earlier.  Add entry point to list.
+	* dump-parse-tree.c (gfc_show_code_node): Print EXEC_ENTRY nodes.
+	* gfortran.h (symbol_attribute): Add entry_master.  Document entry.
+	(struct gfc_entry_list): Define.
+	(gfc_get_entry_list): Define.
+	(struct gfc_namespace): Add refs and entries.
+	(enum gfc_exec_op): Add EXEC_ENTRY.
+	(struct gfc_code): Add ext.entry.
+	* module.c (ab_attribute, attr_bits): Remove AB_ENTRY.
+	(mio_symbol_attribute): Don't save/reture addr->entry.
+	(mio_namespace_ref): Refcount namespaces.
+	* parse.c (accept_statement): Handle ST_ENTRY.
+	(gfc_fixup_sibling_symbols): Mark symbol as referenced.
+	(parse_contained): Fixup sibling references to entry points
+	after parsing the procedure body.
+	* resolve.c (resolve_contained_fntype): New function.
+	(merge_argument_lists, resolve_entries): New functions.
+	(resolve_contained_functions): Use them.
+	(resolve_code): Handle EXEC_ENTRY.
+	(gfc_resolve): Call resolve_entries.
+	* st.c (gfc_free_statement): Handle EXEC_ENTRY.
+	* symbol.c (gfc_get_namespace): Refcount namespaces.
+	(gfc_free_namespace): Ditto.
+	* trans-array.c (gfc_trans_dummy_array_bias): Treat all args as
+	optional when multiple entry points are present.
+	* trans-decl.c (gfc_get_symbol_decl): Remove incorrect check.
+	(gfc_get_extern_function_decl): Add assertion.  Fix coment.
+	(create_function_arglist, trans_function_start, build_entry_thunks):
+	New functions.
+	(gfc_build_function_decl): Rename ...
+	(build_function_decl): ... to this.
+	(gfc_create_function_decl): New function.
+	(gfc_generate_contained_functions): Use it.
+	(gfc_trans_entry_master_switch): New function.
+	(gfc_generate_function_code): Use new functions.
+	* trans-stmt.c (gfc_trans_entry): New function.
+	* trans-stmt.h (gfc_trans_entry): Add prototype.
+	* trans-types.c (gfc_get_function_type): Add entry point argument.
+	* trans.c (gfc_trans_code): Handle EXEC_ENTRY.
+	(gfc_generate_module_code): Call gfc_create_function_decl.
+	* trans.h (gfc_build_function_decl): Remove.
+	(gfc_create_function_decl): Add prototype.
+
+2004-08-15  Andrew Pinski  <apinski@apple.com>
+
+	PR fortran/17030
+	* f95-lang.c (gfc_init_builtin_functions): Initialize the builtins
+	for cabs{,f} and copysign{,f}.
+	* trans-decl.c (gfor_fndecl_math_cabsf): Delete.
+	(gfor_fndecl_math_cabs): Delete.
+	(gfor_fndecl_math_sign4): Delete.
+	(gfor_fndecl_math_sign8): Delete.
+	(gfc_build_intrinsic_function_decls): Remove the
+	initializing of cabs{,f} and copysign{,f} functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_abs): Use the builtins
+	instead of the functions definitions.
+	(gfc_conv_intrinsic_sign): Likewise.
+	* trans.h (gfor_fndecl_math_cabsf): Delete.
+	(gfor_fndecl_math_cabs): Delete.
+	(gfor_fndecl_math_sign4): Delete.
+	(gfor_fndecl_math_sign8): Delete.
+
+2004-08-15  Nathan Sidwell  <nathan@codesourcery.com>
+
+	* trans-array.c (gfc_trans_array_constructor_value): Use
+	build_int_cst.
+	* trans-const.c (gfc_build_string_const,
+	gfc_init_constants, gfc_conv_mpz_to_tree,
+	gfc_conv_constant_to_tree): Likewise.
+	* trans-decl.c (gfc_get_symbol_decl): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_ibits,
+	gfc_conv_intrinsic_len, prepare_arg_info): Likewise.
+	* trans-io.c (add_case, set_error_locus, build_dt,
+	transfer_expr): Likewise.
+	* trans-stmt.c (gfc_trans_label_assign, gfc_trans_pause,
+	gfc_trans_stop, gfc_trans_character_select): Likewise.
+	* trans-types.c (gfc_init_types, gfc_get_dtype): Likewise.
+	* trans.c (gfc_trans_runtime_check): Likewise.
+
+2004-08-14  Paul Brook  <paul@codesourcery.com>
+
+	* trans-decl.c (gfc_build_function_decl): Remove dead code.
+
+2004-08-14  Paul Brook  <paul@codesourcery.com>
+
+	* trans-arry.c (gfc_trans_auto_array_allocation): Remove unused var.
+
+2004-08-13  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.h: Add comments.
+	* parse.c (parse_contained): Fix comment typo.
+	* resolve.c (was_declared): Ditto.
+	* symbol.c: Ditto.
+
+2004-08-11  Paul Brook  <paul@codeourcery.com>
+
+	PR fortran/16917
+	* intrinsic.c (add_functions): Add dfloat as an alias for dble.
+
+2004-08-10  Richard Henderson  <rth@redhat.com>
+
+	* f95-lang.c (gfc_init_builtin_functions): Remove
+	 __builtin_stack_alloc, add __builtin_alloca.
+	* trans-array.c (gfc_trans_auto_array_allocation): Use DECL_EXPR.
+	* trans-decl.c (gfc_trans_auto_character_variable): Likewise.
+
+2004-08-10  Paul Brook  <paul@codesourcery.com>
+
+	* trans-io.c (transfer_expr): Handle pointters.
+
+2004-08-10  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/16919
+	* trans-array.c (gfc_add_loop_ss_code): Handle GFC_SS_COMPONENT.
+	(gfc_conv_array_index_offset): Allow "temporary" with nonzero delta.
+	(gfc_trans_preloop_setup, gfc_trans_scalarized_loop_boundary):
+	Handle GFC_SS_COMPONENT.
+	(gfc_conv_ss_startstride): Ditto.  Set ss->shape.
+	(gfc_conv_loop_setup): Tweak commends. Remove dead code.
+	Use ss->shape.
+	(gfc_conv_array_initializer): Call specific initializer routines.
+	* trans-expr.c (gfc_trans_structure_assign): New function.
+	(gfc_trans_subarray_assign): New function.
+	(gfc_trans_subcomponent_assign): New fucntion
+	(gfc_conv_structure): Use them.
+	* trans.h (gfc_ss_type): Add GFC_SS_COMPONENT.
+	(gfc_ss): Add shape.
+
+2004-08-08  Victor Leikehman  <lei@il.ibm.com>
+
+	* simplify.c (gfc_simplify_shape): Bugfix.
+	* expr.c (gfc_copy_shape_excluding): New function.
+	* gfortran.h (gfc_get_shape): Bugfix.
+	(gfc_copy_shape_excluding): Added declaration.
+	* iresolve.c (gfc_resolve_all, gfc_resolve_any, gfc_resolve_count,
+	gfc_resolve_cshift, gfc_resolve_eoshift, gfc_resolve_lbound,
+	gfc_resolve_ubound, gfc_resolve_transpose): Added compile
+	time resolution of shape.
+
+2004-08-06  Janne Blomqvist  <jblomqvi@cc.hut.fi>
+
+	* intrinsic.c (add_subroutines): Add getenv and
+	get_environment_variable. (add_sym_5s): New function.
+	* intrinsic.h (gfc_resolve_get_environment_variable): Add
+	prototype.
+	* iresolve.c (gfc_resolve_get_environment_variable): New
+	function.
+
+2004-08-06  Feng Wang  <fengwang@nudt.edu.cn>
+
+	* f95-lang.c (gfc_init_builtin_functions): Fix the number of
+	__builtin_pow[f] arguments.
+
+2004-08-06  Steven G. Kargl  <kargls@comcast.net>
+
+	* arith.c: Add #define for model numbers.  Remove global GMP variables.
+	(natural_logarithm,common_logarithm,exponential,sine,
+	cosine,arctangent,hypercos,hypersine ): Remove.
+	(gfc_mpfr_to_mpz,gfc_set_model_kind,gfc_set_model): New functions.
+	(arctangent2,gfc_arith_init_1,gfc_arith_done_1
+	gfc_check_real_range, gfc_constant_result, gfc_range_check,
+	gfc_arith_uminus,gfc_arith_plus, gfc_arith_minus, gfc_arith_times,
+	gfc_arith_divide,complex_reciprocal,complex_pow_ui,
+	gfc_arith_power,gfc_compare_expr,compare_complex,gfc_convert_real,
+	gfc_convert_complex,gfc_int2real,gfc_int2complex,
+	gfc_real2int,gfc_real2real,gfc_real2complex,
+	gfc_complex2int,gfc_complex2real,gfc_complex2complex): Convert GMP
+	to MPFR, use new functions.
+	* arith.h: Remove extern global variables.
+	(natural_logarithm,common_logarithm,exponential, sine, cosine,
+	arctangent,hypercos,hypersine): Remove prototypes.
+	(arctangent2): Update prototype from GMP to MPFR.
+	(gfc_mpfr_to_mpz, gfc_set_model_kind,gfc_set_model): Add prototypes.
+	* dump-parse-tree.c (gfc_show_expr): Convert GMP to MPFR.
+	* expr.c (free_expr0,gfc_copy_expr): Convert GMP to MPFR.
+	* gfortran.h (GFC_REAL_BITS): Remove.
+	(arith): Add ARITH_NAN.
+	Include mpfr.h.  Define GFC_RND_MODE.
+	Rename GCC_GFORTRAN_H GFC_GFC_H.
+	(gfc_expr): Convert GMP to MPFR.
+	* module.c: Add arith.h, correct type in comment.
+	(mio_gmp_real): Convert GMP to MPFR.
+	(mio_expr):  Use gfc_set_model_kind().
+	* primary.c:  Update copyright date with 2004.
+	(match_real_constant,match_const_complex_part): Convert GMP to MPFR.
+	* simplify.c: Remove global GMP variables
+	(gfc_simplify_abs,gfc_simplify_acos,gfc_simplify_aimag,
+	gfc_simplify_aint,gfc_simplify_dint,gfc_simplify_anint,
+	gfc_simplify_dnint,gfc_simplify_asin,gfc_simplify_atan,
+	gfc_simplify_atan2,gfc_simplify_ceiling,simplify_cmplx,
+	gfc_simplify_conjg,gfc_simplify_cos,gfc_simplify_cosh,
+	gfc_simplify_dim,gfc_simplify_dprod,gfc_simplify_epsilon,
+	gfc_simplify_exp,gfc_simplify_exponent,gfc_simplify_floor,
+	gfc_simplify_fraction,gfc_simplify_huge,gfc_simplify_int,
+	gfc_simplify_ifix,gfc_simplify_idint,gfc_simplify_log,
+	gfc_simplify_log10,simplify_min_max,gfc_simplify_mod,
+	gfc_simplify_modulo,gfc_simplify_nearest,simplify_nint,
+	gfc_simplify_rrspacing,gfc_simplify_scale,
+	gfc_simplify_set_exponent,gfc_simplify_sign,gfc_simplify_sin,
+	gfc_simplify_sinh,gfc_simplify_spacing,gfc_simplify_sqrt,
+	gfc_simplify_tan,gfc_simplify_tanh,gfc_simplify_tiny,
+	gfc_simplify_init_1,gfc_simplify_done_1):  Convert GMP to MPFR.
+	Use new functions.
+	* trans-const.c (gfc_conv_mpfr_to_tree): Rename from
+	gfc_conv_mpf_to_tree.  Convert it to use MPFR
+	(gfc_conv_constant_to_tree): Use it.
+	* trans-const.h: Update prototype for gfc_conv_mpfr_to_tree().
+	* trans-intrinsic.c: Add arith.h, remove gmp.h
+	(gfc_conv_intrinsic_aint,gfc_conv_intrinsic_mod): Convert GMP to MPFR.
+
+2004-08-06  Victor Leikehman  <lei@il.ibm.com>
+	Paul Brook  <paul@codesourcery.com>
+
+	* trans-array.c (gfc_trans_allocate_array_storage,
+	gfc_trans_allocate_temp_array, gfc_add_loop_ss_code,
+	gfc_conv_loop_setup): For functions, if the shape of the result
+	is not known in compile-time, generate an empty array descriptor for
+	the result and let the callee to allocate the memory.
+	(gfc_trans_dummy_array_bias): Do nothing for pointers.
+	(gfc_conv_expr_descriptor): Use function return values directly.
+	* trans-expr.c (gfc_conv_function_call): Always add byref call
+	insn to pre chain.
+	(gfc_trans_pointer_assignment): Add comments.
+	(gfc_trans_arrayfunc_assign): Don't chain on expression.
+
+2004-08-01  Roger Sayle  <roger@eyesopen.com>
+
+	* options.c (gfc_init_options): Don't warn about the use GNU
+	extensions by default.
+	(gfc_post_options): Warn about GNU extensions with -pedantic.
+	(gfc_handle_option): Don't warn about GNU extensions with -std=gnu.
+
+2004-07-30  Richard Henderson  <rth@redhat.com>
+
+	* trans-expr.c (gfc_conv_expr_reference): Create a CONST_DECL
+	for TREE_CONSTANTs.
+
+2004-07-25  Richard Henderson  <rth@redhat.com>
+
+	* trans-decl.c (gfc_build_function_decl): Set DECL_ARTIFICIAL
+	and DECL_IGNORED_P on RESULT_DECL.
+	(gfc_generate_constructors): Likewise.
+
+2004-07-18  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/16465
+	* lang.opt (ffixed-line-length-none, ffixed-line-length-): New
+	options.
+	(ffixed-line-length-80, ffixed-line-length-132): Remove.
+	* options.c (gfc_handle_options): Deal with changed options.
+	* scanner.c (load_line): Change second arg to 'char **',
+	allocate if pointing to NULL. Keep track of buffer's length.
+	Adapt buffer size to overlong lines. Pad lines to full length
+	in fixed form.
+	(load_file): Adapt to new interface of load_line.
+
+2004-07-17  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* trans.h (builtin_function): Declare.
+
+2004-07-16  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/16404
+	(parts ported from g95)
+	* parse.h (gfc_state_data): New field do_variable.
+	(gfc_check_do_variable): Add prototype.
+	* parse.c (push_state): Initialize field 'do_variable'.
+	(gfc_check_do_variable): New function.
+	(parse_do_block): Remember do iterator variable.
+	(parse_file): Initialize field 'do_variable'.
+	* match.c (gfc_match_assignment, gfc_match_do,
+	gfc_match_allocate, gfc_match_nullify, gfc_match_deallocate):
+	Add previously missing checks.
+	(gfc_match_return): Reformat error message.
+	* io.c (match_out_tag): New function.
+	(match_open_element, match_close_element,
+	match_file_element, match_dt_element): Call match_out_tag
+	instead of match_vtag where appropriate.
+	(match_io_iterator, match_io_element): Add missing check.
+	(match_io): Reformat error message.
+	(match_inquire_element): Call match_out_tag where appropriate.
+
+	* parse.c (gfc_check_do_variable): Fix error locus.
+
+2004-07-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15129
+	* trans-decl.c (gfc_build_function_decl): Create a new chardecl
+	for every assumed length character dummy argument.
+
+	PR fortran/15140
+	* trans-decl.c (gfc_trans_deferred_vars): Remove bogus assertion.
+
+	PR fortran/13792
+	* simplify.c (gfc_simplify_bound): Copy the bound expression.
+
+2004-07-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+ 	PR fortran/15324
+	* trans-array.c gfc_trans_g77_array,
+	gfc_trans_dummy_array_bias): Don't call gfc_trans_string_init
+	for assumed length characters.
+	(gfc_conv_expr_descriptor): Set se->string_length if dealing
+	with a character expression.
+	(gfc_cvonv_array_parameter): Pass string length when passing
+	character array according to g77 conventions.
+
+2004-07-12  Paul Brook  <paul@codesourcery.com>
+
+	* expr.c (gfc_check_assign_symbol): Handle pointer assignments.
+	* trans-array.c (gfc_trans_auto_array_allocation): Remove
+	initialization code.
+	* trans-common.c (create_common): Use gfc_conv_initializer.
+	* trans-decl.c (gfc_get_symbol_decl): Use gfc_conv_initializer.
+	* trans-expr.c (gfc_conv_initializer): New function.
+	(gfc_conv_structure): Use it.
+	* trans.h (gfc_conv_initializer): Add prototype.
+
+2004-07-11  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/15986
+	* parse.c (gfc_fixup_sibling_symbols): Also look for untyped
+	variables.
+	(parse_contained): Mark contained symbols as referenced.
+
+2004-07-11  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/16455
+	* module.c (gfc_dump_module, gfc_use_module): Print locus
+	when opening of module file fails.
+
+	PR fortran/16404
+	* io.c (match_io): Flag 'WRITE(...), ...' as extension.
+
+	PR fortran/16404
+	* match.c (gfc_match_program): A program name is obligatory.
+	(gfc_match_return): RETURN in main program is an extension.
+	(gfc_match_block_data): A space is required before a block data
+	name.
+
+	PR fortran/16433
+	* primary.c (match_boz_constant): Call gfc_notify_std only if
+	we actually have a non-standard boz-literal-constant.
+
+	PR fortran/15754
+	* expr.c (gfc_check_assign): Print ranks if incompatible. Issue
+	warning if assigning NULL().
+
+2004-07-11  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* f95-lang.c (set_block): Remove.
+	(gfc_clear_binding_stack): New.
+	(LANG_HOOKS_CLEAR_BINDING_STACK): Define.
+	(struct binding_level): Remove block_created_by_back_end.
+	(clear_binding_level): Likewise.
+	(poplevel): Don't handle block_created_by_back_end.
+
+2004-07-10  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-decl.c (gfc_create_module_variable): Nothing to do if
+	symbol is in common, because we ...
+	(gfc_generate_module_vars): Call gfc_trans_common.
+
+2004-07-10  Paul Brook  <paul@codesourcery.com>
+
+	* trans-array.c (gfc_build_null_descriptor): New function.
+	(gfc_trans_static_array_pointer): Use it.
+	* trans-array.h (gfc_build_null_descriptor): Add prototype.
+	* trans-expr.c (gfc_conv_structure): Handle array pointers.
+
+2004-07-10  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/16336
+	* decl.c (gfc_match_save): Use-associated common block
+	doesn't collide.
+	* gfortran.h (gfc_common_head): Add new field 'name'.
+	Fix typo in comment after #endif.
+	* match.c (gfc_get_common): Add new argument from_common,
+	mangle name if flag is set, fill in new field in structure
+	gfc_common_head.
+	(match_common): Set new arg in call to gfc_get_common,
+	use-associated common block doesn't collide.
+	* match.h (gfc_get_common): Adapt prototype.
+	* module.c (load_commons): Set new arg in call to
+	gfc_get_common.
+	* symbol.c (free_common_tree): New function.
+	(gfc_free_namespace): Call new function.
+	* trans-common.c (several functions): Remove argument
+	'name', use name from gfc_common_head instead.
+
+2004-07-10  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* expr.c (gfc_check_pointer_assign): Verify that rank of the LHS
+	and RHS match. Return early if the RHS is NULL().
+
+	PR fortran/16336
+	* match.c (match_common): Fix error reporting for used common.
+
+	PR fortran/15969
+	* trans-expr.c (gfc_conv_structure): Handle initialization
+	of scalar pointer components.
+
+	* parse.c (decode_statement): Fix matching of BLOCK DATA.
+
+	* trans-decl.c (generate_local_decl): Remove workaround obsoleted
+	by fix for PR 15481.
+
+2004-07-10  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-common.c: Fix whitespace issues, make variable names
+	more readable.
+	(create_common): Additionally, make loop logic more obvious.
+
+2004-07-10  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+	Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/13415
+	* trans-common.c (calculate_length): Remove ...
+	(get_segment_info): Merge into here.  Save field type.
+	(build_field): Use saved type.
+	(create_common, new_condition, new_segment, finish_equivalences):
+	Use new get_segment_info.
+	* trans-types.c: Update comment.
+
+2004-07-09  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/14077
+	* moduele.c (mio_symbol): Don't I/O initial values unless
+	symbol is a parameter.
+
+2004-07-09  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/13201
+	* resolve.c (resolve_symbol): Verify that the shape of a
+	parameter array is not only explicit, but also constant.
+	* array.c (gfc_is_compile_time_shape): New function.
+	* gfortran.h (gfc_is_compile_time_shape): Add prototype.
+
+2004-07-09  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15481
+	PR fortran/13372
+	PR fortran/13575
+	PR fortran/15978
+	* module.c (write_symbol, write_symtree): Remove workaround.
+	* primary.c (match_actual_arglist): Enhance comment.
+	(gfc_match_rvalue): Handle function call with first argument
+	a keyword argument correctly.
+	* resolve.c (resolve_symbol): Change call to
+	gfc_set_default_type to issue error if no implicit type
+	can be found.
+	* trans-decl.c (gfc_create_module_variable): Remove workaround.
+
+2004-07-08  Paul Brook  <paul@codesourcery.com>
+
+	* intrinsic.c (add_sym_4s): New function.
+	(add_subroutines): Change gfc_add_sym_? to gfc_add_sym_?s.
+
+2004-07-04  Janne Blomqvist  <jblomqvi@cc.hut.fi>
+	Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/15280
+	PR fortran/15665
+	* gfortran.h (enum gfc_generic_isym_id): Add GFC_ISYM_IARGC and
+	GFC_ISYM_COMMAND_ARGUMENT_COUNT.
+	* intrinsic.c (add_functions):  Identify iargc.  Add
+	command_argument_count.
+	(add_subroutines): Resolve getarg.  Add get_command and
+	get_command_argument.
+	* intrinsic.h (gfc_resolve_getarg, gfc_resolve_get_command,
+	gfc_resolve_get_command_argument): Add prototypes.
+	* iresolve.c (gfc_resolve_getarg, gfc_resolve_get_command,
+	gfc_resolve_get_command_argument): New functions.
+	* trans-decl.c (gfor_fndecl_iargc): New variable.
+	(gfc_build_intrinsic_function_decls): Set it.
+	* trans-intrinsic.c (gfc_conv_intrinsic_iargc): New function.
+	(gfc_conv_intrinsic_function): Use it.
+	* trans.h (gfor_fndecl_iargc): Declare.
+
+2004-07-04  Matthias Klose  <doko@debian.org>
+
+	* Make-lang.in: Generate and install gfortran man page.
+	* invoke.texi: Remove extra '@c man end'.
+
+2004-07-04  Richard Henderson  <rth@redhat.com>
+
+	* f95-lang.c (gfc_mark_addressable): Don't put_var_into_stack.
+
+2004-07-04  Paul Brook  <paul@codesourcery.com>
+
+	* decl.c (gfc_match_implicit_range): Don't use typespec.
+	(gfc_match_implicit): Handle character selectors.
+	* gfortran.h (gfc_set_implicit): Remove prototype.
+	(gfc_add_new_implicit_range, gfc_merge_new_implicit): Update.
+	* parse.c (accept_statement): Don't call gfc_set_implicit.
+	* symbol.c (new_ts): Remove.
+	(gfc_set_implicit_none): Use same loop bounds as other functions.
+	(gfc_set_implicit): Remove.
+	(gfc_clear_new_implicit, gfc_add_new_implicit_range): Only set flags.
+	(gfc_merge_new_implicit): Combine with gfc_set_implicit.
+
+2004-06-30  Richard Henderson  <rth@redhat.com>
+
+	* match.c (var_element): Remove unused variable.
+
+	* trans-decl.c (gfc_generate_function_code): Don't set
+	x_whole_function_mode_p.
+	(gfc_generate_constructors): Likewise.
+
+2004-06-30  Richard Henderson  <rth@redhat.com>
+
+	* trans-decl.c (gfc_generate_function_code): Don't set
+	immediate_size_expand.
+	(gfc_generate_constructors): Likewise.
+
+2004-06-30  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/16161
+	* decl.c (gfc_match_type_spec): Rename second argument to
+	'implicit_flag', reverse meaning. Don't match_char_spec if
+	'implicit_flag' is set. Rename to ...
+	(match_type_spec): ... this.
+	(gfc_match_implicit_none, match_implicit_range): Move here
+	from match.c.
+	(gfc_match_implicit): Move here from match.c, try to
+	match_char_len if match_implicit_range doesn't succeed for
+	CHARACTER implicits. Call renamed fucntion match_type_spec.
+	(gfc_match_data_decl, match_prefix): Call renamed function
+	match_type_spec.
+	* match.c (gfc_match_implicit_none, match_implicit_range,
+	gfc_match_implicit): Move to decl.c.
+	* match.h (gfc_match_implicit_none, gfc_match_implicit):
+	Move protoypes to section 'decl.c'.
+	(gfc_match_type_spec): Remove prototype.
+
+2004-06-29  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* decl.c, interface.c, symbol.c, trans-common.c: Add 2004 to
+	copyright years.
+
+2004-06-29  Steven Bosscher  <stevenb@suse.de>
+
+	Make sure types in assignments are compatible.  Mostly mechanical.
+	* trans-const.h (gfc_index_one_node): New define.
+	* trans-array.c (gfc_trans_allocate_array_storage,
+	gfc_trans_allocate_temp_array, gfc_trans_array_constructor_subarray,
+	gfc_trans_array_constructor_value, gfc_trans_array_constructor,
+	gfc_conv_array_ubound, gfc_conv_array_ref,
+	gfc_trans_scalarized_loop_end, gfc_conv_section_startstride,
+	gfc_conv_ss_startstride, gfc_conv_loop_setup, gfc_array_init_size,
+	gfc_trans_array_bounds, gfc_trans_dummy_array_bias,
+	gfc_conv_expr_descriptor, gfc_trans_deferred_array): Use the correct
+	types in assignments, conversions and conditionals for expressions.
+	* trans-expr.c (gfc_conv_expr_present, gfc_conv_substring,
+	gfc_conv_unary_op, gfc_conv_cst_int_power, gfc_conv_string_tmp,
+	gfc_conv_function_call, gfc_trans_pointer_assignment,
+	gfc_trans_scalar_assign): Likewise.
+	* trans-intrinsic.c (build_fixbound_expr, gfc_conv_intrinsic_bound,
+	gfc_conv_intrinsic_anyall, gfc_conv_intrinsic_count,
+	gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_btest,
+	gfc_conv_intrinsic_singlebitop, gfc_conv_intrinsic_ishft,
+	gfc_conv_intrinsic_ishftc, gfc_conv_intrinsic_strcmp,
+	gfc_conv_allocated, gfc_conv_associated,
+	gfc_conv_intrinsic_rrspacing, gfc_conv_intrinsic_trim): Likewise.
+	* trans-io.c (set_string): Likewise.
+	* trans-stmt.c (gfc_trans_do, gfc_trans_forall_loop,
+	gfc_do_allocate, generate_loop_for_temp_to_lhs,
+	generate_loop_for_rhs_to_temp, compute_inner_temp_size,
+	compute_overall_iter_number, gfc_trans_assign_need_temp,
+	gfc_trans_pointer_assign_need_temp, gfc_trans_forall_1,
+	gfc_evaluate_where_mask, gfc_trans_where_assign,
+	gfc_trans_where_2): Likewise.
+	* trans-types.c (gfc_get_character_type, gfc_build_array_type,
+	gfc_get_nodesc_array_type, gfc_get_array_type_bounds): Likewise.
+
+	* trans.c (gfc_add_modify_expr): Add sanity check that types
+	for the lhs and rhs are the same for scalar assignments.
+
+2004-06-29  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* dump-parse-tree.c (show_common): New function.
+	(gfc_show_namespace): Show commons.
+
+2004-06-29  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+	Andrew Vaught  <andyv@firstinter.net>
+
+	PR fortran/13249
+	PR fortran/15481
+	* decl.c (gfc_match_save): Adapt to new common structures,
+	don't allow saving USE-associated common.
+	* dump-parse-tree (gfc_show_attr): (saved_)common are not
+	symbol attributes any longer.
+	(gfc_show_symbol): Don't show old-style commons any longer.
+	(gfc_show_namespace): Adapt call to gfc_traverse_symtree to new
+	interface.
+	* gfortran.h (symbol_attribute): Remove common and saved_common
+	attributes.
+	(gfc_symbol): Remove common_head element.
+	(gfc_common_head): New struct.
+	(gfc_get_common_head): New macro.
+	(gfc_symtree): Add field 'common' to union.
+	(gfc_namespace): Add field 'common_root'; change type of field
+	'blank_common' to blank_common.
+	(gfc_add_data): New prototype.
+	(gfc_traverse_symtree): Expect a symtree as first argument
+	instead of namespace.
+	* match.c (gfc_get_common): New function.
+	(match_common_name): Change to take char * as argument, adapt,
+	fix bug with empty name.
+	(gfc_match_common): Adapt to new data structures. Disallow
+	redeclaration of USE-associated COMMON-block. Fix bug with
+	empty common.
+	(var_element): Adapt to new common structures.
+	* match.h (gfc_get_common): Declare.
+	* module.c: Add 2004 to copyright years, add commons to module
+	file layout description.
+	(ab_attribute, attr_bits, mio_symbol_attributes): Remove code
+	for removed attributes.
+	(mio_symbol): Adapt to new way of storing common relations.
+	(load_commons): New function.
+	(read_module): Skip common list on first pass, load_commons at
+	second.
+	(write_commons): New function.
+	(write_module): Call write_commons().
+	* symbol.c (gfc_add_saved_comon, gfc_add_common): Remove
+	functions related to removed attributes.
+	(gfc_add_data): New function.
+	(gfc_clear_attr): Don't set removed attributes.
+	(gfc_copy_attr): Don't copy removed attributes.
+	(traverse_symtree): Remove.
+	(gfc_traverse_symtree): Don't traverse symbol
+	tree of the passed namespace, but require a symtree to be passed
+	instead. Unify with traverse_symtree.
+	(gfc_traverse_ns): Call gfc_traverse_symtree according to new
+	interface.
+	(save_symbol): Remove setting of removed attribute.
+	* trans-common.c (gfc_sym_mangled_common_id): Change to
+	take 'char *' argument instead of 'gfc_symbol'.
+	(build_common_decl, new_segment, translate_common): Adapt to new
+	data structures, add new
+	argument name.
+	(create_common): Adapt to new data structures, add new
+	argument name. Fix typo in intialization of derived types.
+	(finish_equivalences): Add second argument in call to
+	create_common.
+	(named_common): take 'gfc_symtree' instead of 'gfc_symbol'.
+	(gfc_trans_common): Adapt to new data structures.
+	* trans-decl.c (gfc_create_module_variables): Remove test for
+	removed attribute.
+
+2004-06-29  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* io.c: Add 2004 to copyright years.
+
+2004-06-29  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+	Andrew Vaught  <andyv@firstinter.net>
+
+	* gfortran.h (gfc_gsymbol): New typedef.
+	(gfc_gsym_root): New variable.
+	(gfc_get_gsymbol, gfc_find_gsym): New prototypes.
+	* parse.c (global_used): New function.
+	(parse_block_data): Check for double empty BLOCK DATA,
+	use global symbol table.
+	(parse_module): Use global symbol table.
+	(add_global_procedure, add_global_program): New functions.
+	(gfc_parse_file): Use global symbol table.
+	* symbol.c (gfc_gsym_root): New variable.
+	(gfc_find_gsym, gsym_compare, gfc_get_gsymbol): New
+	functions.
+
+2004-06-29  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* module.c (mio_gmp_real): Correct writing of negative numbers.
+
+2004-06-29  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15963
+	* expr.c (check_intrinsic_op): Allow comparison of characters.
+	Make logic easier.
+
+2004-06-26  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+	Andrew Vaught  <andyv@firstinter.net>
+
+	* decl.c (contained_procedure): New function.
+	(match_end): Verify correctness of END STATEMENT in
+	all cases.
+
+2004-06-26  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+	Andrew Vaught  <andyv@firstinter.net>
+
+	PR fortran/15190
+	* decl.c (gfc_match_type_spec), io.c (match_io), parse.c
+	(decode_statement): Enforce required space in free-form.
+
+2004-06-22  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
+
+	* f95-lang.c (LANG_HOOKS_GIMPLE_BEFORE_INLINING): Deleted.
+	* trans-array.c (gfc_conv_descriptor_data): Add operand
+	for COMPONENT_REF.
+	(gfc_conv_descriptor_offset, gfc_conv_descriptor_dtype): Likewise.
+	(gfc_conv_descriptor_dimension, gfc_conv_descriptor_stride): Likewise.
+	(gfc_conv_descriptor_lbound, gfc_conv_descriptor_ubound): Likewise.
+	* trans-common.c (create_common): Likewise.
+	* trans-expr.c (gfc_conv_component_ref): Likewise.
+	* trans-io.c (set_parameter_value): Likewise.
+	(set_parameter_ref, set_string, set_flag, io_result): Likewise.
+	(transfer_expr): Likewise.
+	* trans-decl.c (gfc_trans_auto_character_variable):
+	Set up to get DECL_SIZE and DECL_SIZE_UNIT gimplified.
+	(gfc_gimplify_function): New function.
+	(gfc_generate_function-code): Properly handle nested functions.
+	* trans.c (gfc_build_array_ref): Add two new operands for ARRAY_REF.
+
+2004-06-22  Janne Blomqvist  <jblomqvi@cc.hut.fi>
+
+	PR fortran/15750
+	* io.c (gfc_match_inquire): Bugfix for iolength related stuff.
+	(gfc_resolve_inquire): Resolve the iolength tag.  Return
+	SUCCESS at end of function if no failure has occured.
+	* resolve.c (resolve_code): Resolve if iolength is encountered.
+	* trans-io.c: (ioparm_iolength, iocall_iolength,
+	iocall_iolength_done): New variables.
+	(last_dt): Add IOLENGTH.
+	(gfc_build_io_library_fndecls ): Set iolength related variables.
+	(gfc_trans_iolength): Implement.
+	(gfc_trans_dt_end): Treat iolength as a third form of data transfer.
+
+2004-06-21  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de
+
+	PR fortran/15511
+	* scanner.c (load_line): Don't truncate preprocessor lines.
+	Reformat error message.
+	(preprocessor_line): Issue warning in case of malformed
+	preprocessor line.
+
+2004-06-21  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* resolve.c (resolve_symbol): Add comment in function body.
+	(check_data_variable): Change type of mark to ar_type, adapt code
+	accordingly.
+
+2004-06-21  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* array.c (gfc_insert_constructor): Avoid redundant call to
+	mpz_comp. Add 2004 to copyright years.
+
+2004-06-21  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* trans.h (stmtblock_t): Change has_scope to unsigned int.
+
+2004-06-20  Steven G. Kargl  <kargls@comcast.net>
+
+	* arith.c (gfc_range_check): correct complex underflow.
+
+2004-06-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15962
+	* match.c (match_case_selector): Call gfc_match_init_expr
+	instead of gfc_match_expr.
+	* resolve.c (validate_case_label_expr): No need to check for
+	constant, since it wouldn't have been matched with the fix to
+	match.c.
+
+2004-06-14  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15211
+	* trans-intrinsic.c (gfc_conv_intrinsic_len): Deal with arrays
+	of strings.
+
+2004-06-14  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15510
+	* trans-deecl.c (generate_local_decl): Do not issue warning for
+	unused variables if they're use associated.
+
+2004-06-14  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+	Andrew Vaught  <andyv@firstinter.net>
+
+	PR fortran/14928
+	* gfortran.h (gfc_check_f): Add new field f3ml.
+	* check.c (gfc_check_minloc_maxloc): Take argument list instead
+	of individual arguments, reorder if necessary.
+	* intrinsic.h (gfc_check_minloc_maxloc): ... adapt prototype.
+	* intrinsic.c (add_sym_3ml): New function.
+	(add_functions): Change to add_sym_3ml for MINLOC, MAXLOC.
+	(check_specific): Catch special case MINLOC, MAXLOC.
+
+2004-06-14  Paul Brook  <paul@codesourcery.com>
+
+	* intrinsic.c (add_sym_2s): Use correct function types.
+
+2004-06-12  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* Make-lang.in (F95_OBJS, F95_PARSER_OBJS): Alphabetize.  Move data.c
+	* data.c (gfc_get_section_index):  Remove dependency on trans.h.
+
+2004-06-12  Steven G. Kargl  <kargls@comcast.net>
+
+	* check.c (gfc_check_second_sub, gfc_check_irand, gfc_check_rand
+	gfc_check_srand, gfc_check_etime, gfc_check_etime_sub): New functions.
+	* gfortran.h (gfc_generic_isym_id): New symbols GFC_ISYM_ETIME,
+	GFC_ISYM_IRAND, GFC_ISYM_RAND, GFC_ISYM_SECOND.
+	* trans-intrinsic.c:  Use symbols.
+	* intrinsic.c (add_sym_2s): New function.
+	* intrinsic.c: Add etime, dtime, irand, rand, second, srand.
+	* intrinsic.h: Function prototypes.
+	* iresolve.c (gfc_resolve_etime_sub, gfc_resolve_second_sub
+	gfc_resolve_srand):  New functions.
+
+2004-06-12  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/14957
+	* decl.c (gfc_match_end): Require END {SUBROUTINE|FUNCTION} for
+	contained procedure.
+
+2004-06-12  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/12841
+	* interface.c (compare_parameter, compare_actual_formal): Don't
+	check types and array shapes for NULL()
+	* trans-expr.c (conv_function_call): No double indirection for
+	NULL()
+
+2004-06-09  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* trans-expr.c (gfc_conv_cst_int_power): Compute
+	x**(-n) by converting it to (1/x)**n instead of
+	1/x**n.
+
+2004-06-09  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/13372
+	* module.c (write_symbol, write_symtree): Don't write symbols
+	wrongly added to namespace.
+	* trans-decl.c (gfc_create_module_variable): Don't create a
+	backend decl for a symbol incorrectly added to namespace.
+
+2004-06-09  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/13201
+	* resolve.c (resolve_symbol): Verify that parameter array has an
+	explicit shape. Fix typos and coding style issues in surrounding
+	lines.
+
+2004-06-05  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15478
+	* gfortran.texi: The documentation doesn't contain infomration on
+	how to report bugs, and shouldn't, so remove the line which
+	says it does.
+
+2004-06-05  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* intrinsic.c (sort_actual): Keep track of type of missing
+	arguments. (Missing from previous commit.)
+
+2004-06-03  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.h (gfc_actual_arglist): New field missing_arg_type.
+	* interface.c (compare_actual_formal): Keep type of omitted
+	optional arguments.
+	* trans-expr.c (gfc_conv_function_call): Add string length
+	argument for omitted string argument.
+
+2004-06-03  Paul Brook  <paul@codesourcery.com>
+
+	* trans.c (gfc_finish_block, gfc_add_expr_to_block): Build statement
+	lists instead of compound expr chains.
+	(gfc_trans_code): Annotate statement lists.
+
+2004-06-03  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-array.c: Fix spelling in comments.
+
+2004-06-02  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15557
+	* data.c (assign_substring_data_value): New function.
+	(gfc_assign_data_value): Call the new function if we're dealing
+	with a substring LHS.
+
+2004-06-01  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15477
+	* gfortran.h (GFC_VERSION): Remove.
+	* gfortran.texi (version-gfortran): Remove, replace by version-GCC
+	where used.
+
+2004-05-31  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-types.c: Fix spelling & layout in comments.
+
+2004-05-30  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/14067
+	* trans-const.c (gfc_conv_string_init): Allow variable string
+	length lower than initialization string length.
+
+2004-05-30  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/15620
+	* trans-decl.c (gfc_shadow_sym, gfc_restore_sym): New functions.
+	* trans-expr.c (gfc_trans_string_copy): New function.
+	(gfc_conv_statement_function): Use them.  Create temp vars.  Enforce
+	character lengths.
+	(gfc_conv_string_parameter): Use gfc_trans_string_copy.
+	* trans-stmt.c (gfc_trans_forall_1): Use gfc_{shadow,restore}_sym.
+	* trans.h (struct gfc_saved_var): Define.
+	(gfc_shadow_sym, gfc_restore_sym): Add prototypes.
+
+2004-05-30  Steven G. Kargl  <kargls@comcast.net>
+
+	* iresolve.c (gfc_resolve_random_number): Clean up conditional.
+
+2004-05-29  Steven G. Kargl  <kargls@comcast.net>
+
+	* simplify.c (gfc_simplify_log): Remove useless line of code.
+
+2004-05-29  Paul Brook  <paul@codesourcery.com>
+
+	* trans-common.c (find_equivalence): Find multiple rules.
+
+2004-05-27  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.h (gfc_current_locus, gfc_set_locus): Remove.
+	(gfc_current_locus): Declare new global variable.
+	* scanner.c (gfc_current_locus, gfc_set_locus): Remove.
+	(gfc_current_locus1): Rename ...
+	(gfc_current_locus): ... to this.
+	(gfc_at_eof, gfc_at_bol, gfc_at_eol, gfc_advance_line, next_char,
+	skip_fixed_comments, skip_free_comments, gfc_next_char_literal,
+	gfc_peek_char, gfc_gobble_whitespace, gfc_new_file): Use
+	gfc_current_locus instead of gfc_current_locus1, gfc_set_locus()
+	and gfc_current_locus(), respectively.
+	* array.c (match_subscript, gfc_match_array_ref, match_array_list,
+	match_array_cons_element, gfc_match_array_constructor):
+	Read/modify gfc_current_locus instead of calling gfc_set_locus()
+	and gfc_current_locus().
+	* decl.c (gfc_match_null, variable_decl, gfc_match_kind_spec,
+	match_attr_spec, gfc_match_function_decl, gfc_match_end,
+	attr_decl1, gfc_match_save): Likewise.
+	* error.c (error_print, gfc_internal_error): Likewise.
+	* expr.c (gfc_int_expr, gfc_default_logical_kind): Likewise.
+	* interface.c (gfc_add_interface): Likewise.
+	* io.c (gfc_match_format, match_dt_format, match_dt_element,
+	match_io_iterator, match_io): Likewise.
+	* match.c (gfc_match_space, gfc_match_eos,
+	gfc_match_small_literal_int, gfc_match_st_label,
+	gfc_match_strings, gfc_match_name, gfc_match_iterator,
+	gfc_match_char, gfc_match, gfc_match_assignment,
+	gfc_match_pointer_assignment, gfc_match_if, gfc_match_do,
+	gfc_match_nullify, gfc_match_call, match_implicit_range,
+	gfc_match_implicit, gfc_match_data, match_case_selector,
+	gfc_match_case, match_forall_iterator): Likewise.
+	* matchexp.c (gfc_match_defined_op_name, next_operator,
+	match_level_1, match_mult_operand, match_ext_mult_operand,
+	match_add_operand, match_ext_add_operand, match_level_2,
+	match_level_3, match_level_4, match_and_operand, match_or_operand,
+	match_equiv_operand, match_level_5, gfc_match_expr): Likewise.
+	* module.c (gfc_match_use, mio_array_ref, mio_expr): Likewise.
+	* parse.c (match_word, decode_statement, next_free, next_fixed,
+	add_statement, verify_st_order, parse_if_block, gfc_parse_file):
+	Likewise.
+	* primary.c (match_digits, match_integer_constant,
+	match_boz_constant, match_real_constant, match_substring,
+	next_string_char, match_charkind_name, match_string_constant,
+	match_logical_constant, match_const_complex_part,
+	match_complex_constant, match_actual_arg, match_keyword_arg,
+	gfc_match_actual_arglist, gfc_match_structure_constructor,
+	gfc_match_rvalue, gfc_match_variable): Likewise.
+	* st.c (gfc_get_code): Likewise.
+	* symbol.c (check_conflict, check_used, check_done,
+	duplicate_attr, add_flavor, gfc_add_procedure, gfc_add_intent,
+	gfc_add_access, gfc_add_explicit_interface, gfc_add_type,
+	gfc_add_component, gfc_reference_st_label, gfc_new_symbol): Likewise.
+
+2004-05-26  Roger Sayle  <roger@eyesopen.com>
+
+	* io.c (format_asterisk): Silence compiler warnings by correcting
+	the number of elements of a "locus" initializer.
+
+2004-05-25  Roger Sayle  <roger@eyesopen.com>
+
+	PR fortran/13912
+	* matchexp.c: Allow unary operators after arithmetic operators
+	as a GNU extension.
+	(match_ext_mult_operand, match_ext_add_operand): New functions.
+	(match_mult_operand): Tweak to call match_ext_mult_operand.
+	(match_add_operand): Tweak to call match_ext_mult_operand.
+	(match_level_2): Rearrange to call match_ext_add_operand.
+
+2004-05-25  Paul Brook  <paul@codesourcery.com>
+
+	* expr.c (check_inquiry): Remove bogus tests.
+
+2004-05-23  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/13773
+	* expr.c (restricted_args): Remove redundant checks/argument.
+	(external_spec_function): Update to match.
+	(restricted_intrinsic): Rewrite.
+
+2004-05-23  Paul Brook  <paul@codesourcery.com>
+	Victor Leikehman  <lei@haifasphere.co.il>
+
+	* gfortran.h (struct gfc_symbol): Add equiv_built.
+	* trans-common.c: Change int to HOST_WIDE_INT.  Capitalize error
+	messages.
+	(current_length): Remove.
+	(add_segments): New function.
+	(build_equiv_decl): Create initialized common blocks.
+	(build_common_decl): Always add decl to bindings.
+	(create_common): Create initializers.
+	(find_segment_info): Reformat to match coding conventions.
+	(new_condition): Use add_segments.
+	(add_condition, find_equivalence, add_equivalences): Move iteration
+	inside functions.  Only process each segment once.
+	(new_segment, finish_equivalences, translate_common): Simplify.
+
+2004-05-23  Steven G. Kargl  <kargls@comcast.net>
+
+	* check.c (gfc_check_random_seed): Issue for too many arguments.
+
+2004-05-22  Steven G. Kargl  <kargls@comcast.net>
+
+	* intrinsic.c (add_subroutines): Use add_sym_3s for random_seed.
+
+2004-05-22  Paul Brook  <paul@codesourcery.com>
+
+	* dump-parse-tree.c (gfc_show_equiv): New function.
+	(gfc_show_namespace): Use it.
+
+2004-05-22  Victor Leikehman  <lei@haifasphere.co.il>
+
+	PR fortran/13249
+	* symbol.c (gfc_add_common): Disable checks to work around other more
+	fundamental inadequacies.
+
+2004-05-22  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-decl.c (gfc_get_extern_function_decl): Set DECL_IS_PURE
+	only for functions.
+	(gfc_build_function_decl): Likewise.
+
+2004-05-22  Steven G. Kargl  <kargls@comcast.net>
+
+	* check.c (gfc_check_system_clock): New function.
+	* intrinsic.c (add_sym_3s): New function.
+	(add_subroutines): Use it.
+	* intrinsic.h (gfc_check_system_clock, gfc_resolve_system_clock):
+	Add prototypes.
+	* iresolve.c (gfc_resolve_system_clock): New function.
+
+2004-05-22  Steven G. Kargl  <kargls@comcast.net>
+
+	* invoke.texi: Document -Wunderflow and spell check.
+	* lang.opt: Add Wunderflow.
+	* gfortran.h (gfc_option_t): Add warn_underflow option.
+	* options.c (gfc_init_options, set_Wall): Use it.
+	* primary.c (match_real_constant): Explicitly handle UNDERFLOW.
+	* arith.c (gfc_arith_uminus, gfc_arith_plus, gfc_arith_minus,
+	gfc_arith_times, gfc_arith_divide, gfc_arith_power, gfc_real2real,
+	gfc_real2complex, gfc_complex2real, gfc_complex2complex): Ditto.
+	* arith.c (common_logarithm): Fix typo in comment.
+
+2004-05-21  Roger Sayle  <roger@eyesopen.com>
+
+	* io.c (check_format): As a GNU extension, allow the comma after a
+	string literal to be optional in a format.  Use gfc_notify_std to
+	issue an error/warning as appropriate.
+
+2004-05-21  Roger Sayle  <roger@eyesopen.com>
+
+	* io.c (check_format): Use gfc_notify_std to determine whether to
+	issue an error/warning for omitting the digits from the X format.
+
+2004-05-20  Roger Sayle  <roger@eyesopen.com>
+
+	* io.c (check_format): Allow the number before the X format to
+	be optional when not -pedantic.
+
+2004-05-18  Feng Wang  <fengwang@nudt.edu.cn>
+	Paul Brook  <paul@codesourcery.com>
+
+	* f95-lang.c (gfc_init_builtin_functions): Use vold_list_node.
+	Create decls for __builtin_pow{,f}.
+	* gfortran.h (PREFIX_LEN): Define.
+	* trans-decl.c (gfor_fndecl_math_powi): Add.
+	(gfor_fndecl_math_powf, gfor_fndecl_math_pow): Remove.
+	(gfc_build_intrinsic_function_decls): Create decls for powi.
+	* trans-expr.c (powi_table): Add.
+	(gfc_conv_integer_power): Remove.
+	(gfc_conv_powi): New function.
+	(gfc_conv_cst_int_power): New function.
+	(gfc_conv_power_op): Use new powi routines.
+	* trans.h (struct gfc_powdecl_list): Add.
+	(gfor_fndecl_math_powi): Add.
+	(gfor_fndecl_math_powf, gfor_fndecl_math_pow): Remove.
+
+2004-05-18  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans.c, trans-decl.c: Fix comment typos.
+
+2004-05-18  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-const.c (gfc_conv_mpf_to_tree): Fix typo.
+
+2004-05-18  Steve Kargl  <kargls@comcast.net>
+
+	* arith.c (gfc_int2complex): Fix incorrect range checking.
+
+2004-05-18  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/13930
+	* decl.c (add_init_expr_to_sym): Remove incorrect check.
+	(default_initializer): Move to expr.c.
+	(variable_decl): Don't assign default initializer to variables.
+	* expr.c (gfc_default_initializer): Move to here.
+	* gfortran.h (gfc_default_initializer): Add prototype.
+	* resolve.c (resolve_symbol): Check for illegal initializers.
+	Assign default initializer.
+
+2004-05-17  Steve Kargl  <kargls@comcast.net>
+
+	* arith.c (gfc_arith_power): Complex number raised to 0 power is 1.
+
+2004-05-17  Steve Kargl  <kargls@comcast.net>
+
+	* arith.c (gfc_real2complex): Range checking wrong part of complex
+	number.
+
+2004-05-16  Paul Brook  <paul@codesourcery.com>
+
+	* options.c (gfc_handle_module_path_options): Fix buffer overrun.
+
+2004-05-16  Paul Brook  <paul@codesourcery.com>
+
+	* arith.c (gfc_range_check): Fix logic error.
+
+2004-05-16  Steve Kargl  <sgk@troutmask.apl.washington.edu>
+
+	* arith.c: Fix comment typos.
+
+2004-05-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/13742
+	* decl.c (add_init_expr_to_sym): Verify that COMMON variable is
+	not initialized in a disallowed fashion.
+	* match.c (gfc_match_common): Likewise.
+	(var_element): Verify that variable is not in the blank COMMON,
+	if it is in a common.
+
+2004-05-15  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* Make-lang.in (f95.generated-manpages): Remove.
+	(f95.srcextra): New.
+	(f95.info, fortran/gfortran.info, fortran/gfortran.dvi,
+	f95.maintainer-clean): Generate info and dvi files in objdir/doc.
+	(f95.dvi): Remove.
+	(dvi): New.
+	(f95.install-info): Remove.
+	(install-info): New.
+
+2004-05-15  Victor Leikehman  <lei@haifasphere.co.il>
+
+	* decl.c (add_init_expr_to_sym): Check for variable size arrays.
+
+2004-05-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* primary.c (match_boz_constant): Use gfc_notify_std() for
+	issuing a warning or an error.
+
+2004-05-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/13826
+	* primary.c (match_structure_constructor): Rename ...
+	(gfc_match_structure_constructor): ... to this. Make non-static.
+	(gfc_match_rvalue): Call renamed function.
+	* match.h (gfc_match_structure_constructor): Declare.
+	* match.c (gfc_match_data_constant): Handle structure
+	constructor.
+
+2004-05-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/13702
+	(Port from g95)
+	* gfortran.h (gfc_linebuf): New typedef.
+	(linebuf): Remove.
+	(gfc_file): Revamped, use new gfc_linebuf.
+	(locus): Revamped, use new types.
+	(gfc_current_file): Remove.
+	(gfc_current_form, gfc_source_file): New global variables.
+	* match.c (gfc_match_space, gfc_match_strings): Use
+	gfc_current_form to find source form.
+	* module.c (gfc_dump_module): Use gfc_source_file when printing
+	module header.
+	* error.c (show_locus, show_loci) Use new data structures to print
+	locus.
+	* scanner.c (first_file, first_duplicated_file, gfc_current_file):
+	Remove.
+	(file_head, current_file, gfc_current_form, line_head, line_tail,
+	gfc_current_locus1, gfc_source_file): New global variables.
+	(gfc_scanner_init1): Set new global variables.
+	(gfc_scanner_done1): Free new data structures.
+	(gfc_current_locus): Return pointer to gfc_current_locus1.
+	(gfc_set_locus): Set gfc_current_locus1.
+	(gfc_at_eof): Set new variables.
+	(gfc_at_bol, gfc_at_eol, gfc_advance_line, gfc_next_char): Adapt
+	to new locus structure.
+	(gfc_check_include): Remove.
+	(skip_free_comments, skip_fixed_comments): Use gfc_current_locus1.
+	(gfc_skip_comments): Use gfc_current_form, find locus with
+	gfc_current_locus1.
+	(gfc_next_char): Use gfc_current_form.
+	(gfc_peek_char, gfc_gobble_whitespace): Use gfc_current_locus1.
+	(load_line): Use gfc_current_form. Recognize ^Z as EOF. Fix
+	comment formatting.
+	(get_file): New function.
+	(preprocessor_line, include_line): New functions.
+	(load_file): Move down, rewrite to match new data structures.
+	(gfc_new_file): Rewrite to match new data structures.
+	* parse.c (next_statement): Remove code which is now useless. Use
+	gfc_source_form and gfc_source_file where appropriate.
+	* trans-decl.c (gfc_get_label_decl): adapt to new data structures
+	when determining locus of frontend code.
+	* trans-io.c (set_error_locus): Same.
+	* trans.c (gfc_get_backend_locus, gfc_set_backend_locus): Likewise.
+	* lang-specs.h (@f77-cpp-input, @f95-cpp-input): Remove '-P' from
+	preprocessor flags.
+	(all): Add missing initializers.
+
+2004-05-15  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* Make-lang.in (trans-common.o): Remove redundant dependency.
+	(data.c): Replace object file name ...
+	(data.o): ... by the correct one.
+
+2004-05-14  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* dump-parse-tree.c (gfc_show_array_ref): Print colon only
+	for ranges when dumping array references.
+
+2004-05-14  Victor Leikehman  <lei@haifasphere.co.il>
+
+	* decl.c (variable_decl): Always apply default initializer.
+
+2004-05-08  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15206
+	* trans-intrinsic.c (gfc_conv_intrinsic_rrspacing): Fixed to
+	handle zero correctly.
+
+2004-05-14  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* match.c (gfc_match): Eliminate dead code.
+
+2004-05-14  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* parse.c (gfc_statement_next_fixed): (Change from Andy's tree)
+	Detect bad continuation line in fixed form sources.
+
+2004-05-14  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15205
+	* iresolve.c (gfc_resolve_nearest): Add new function.
+	* intrinsic.h: ... declare it here.
+	* intrinsic.c (add_functions): ... add it as resolving function
+	for NEAREST.
+
+2004-05-14  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/14066
+	* match.c (gfc_match_do): Allow infinite loops with
+	label-do-stmt. Do not enforce space after comma.
+
+2004-05-14  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/15051
+	* parse.c (parse_interface): Allow empty INTERFACE, remove
+	seen_body.
+
+2004-05-14  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* Make-lang.in, arith.c, arith.h, array.c, bbt.c, check.c,
+	decl.c, dependency.c, dependency.h, dump-parse-tree.c, error.c,
+	expr.c, f95-lang.c, gfortran.h, interface.c, intrinsic.c,
+	intrinsic.h, io.c, iresolve.c, lang-specs.h, match.c, match.h,
+	matchexp.c, misc.c, module.c, options.c, parse.c, parse.h,
+	primary.c, resolve.c, scanner.c, simplify.c, st.c, symbol.c,
+	trans-array.c, trans-array.h, trans-common.c, trans-const.c,
+	trans-const.h, trans-decl.c, trans-expr.c, trans-intrinsic.c,
+	trans-io.c, trans-stmt.c, trans-stmt.h, trans-types.c,
+	trans-types.h, trans.c, trans.h: Update copyright years and
+	boilerplate.
+	* data.c: Likewise, also removed two whitespace-only lines.
+	* gfortranspec.c, lang.opt: Update copyright years.
+
+2004-05-14  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/14568
+	* trans-decl.c (generate_local_decl): Don't warn for unused
+	variables which are in common blocks.
+
+2004-05-13  Diego Novillo  <dnovillo@redhat.com>
+
+	* Make-lang.in, f95-lang.c, trans-array.c, trans-decl.c,
+	trans-expr.c, trans-intrinsic.c, trans-io.c, trans-stmt.c,
+	trans.c: Rename tree-simple.[ch] to tree-gimple.[ch].
+
+2004-05-13  Victor Leikehman  <lei@haifasphere.co.il>
+
+	PR fortran/15314
+	* trans-expr.c (gfc_conv_structure): Use field type, not expr type.
+
+2004-05-13  Joseph S. Myers  <jsm@polyomino.org.uk>
+
+	* gfortran.texi: Use @table @emph instead of @itemize @emph.
+	Remove "set DEVELOPMENT".
+	(Compiling GFORTRAN): Remove.
+
+2004-05-09  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* array.c (match_subscript, match_array_ref): Add comments
+	explaining argument 'init'.
+	* decl.c, f95-lang.c, match.c, resolve.c, trans-array.c,
+	trans-expr.c, trans.c: Fix some typos in comments.
+	* dump-parse-tree.c (gfc_show_expr): Remove wrong comment.
+	* primary.c (match_digits, match_integer_constant): Add comment
+	explaining signflag.
+
+2004-05-01  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/13940
+	* primary.c: Include system.h and flags.h, needed for pedantic.
+	(match_boz_constant): Allow "x" for hexadecimal constants, warn if
+	pedantic is set.
+
+2004-05-01  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/13940
+	* match.c (match_data_constant): Handle case where
+	gfc_find_symbol	sets sym to NULL
+
+2004-04-28  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* Make-lang.in (f95-lang.o, trans-intrinsic.o): Add missing
+	dependency on mathbuiltins.def
+
+2004-04-24  Victor Leikehman  <lei@il.ibm.com>
+
+	* trans-io.c (transfer_expr): Implemented recursive printing
+	of derived types.
+
+2004-04-24  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	* gfortranspec.c: Do not include multilib.h.
+
+2004-04-24  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-intrinsic.c: Fix comment, this is not trans-expr.c. Add
+	2004 to copyright years.
+	* trans-expr.c, trans-decl.c: Comment update, we now generate
+	GENERIC, not SIMPLE. Add 2004 to copyright years.
+
+2004-04-24  Paul Brook  <paul@codesourcery.com>
+
+	* Make-lang.in (gfortranspec.o): Add dependency on $(TM_H).
+
+2004-04-24  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR 14817
+	* arith.c (gfc_arith_divide): Fix complex divide.
+
+2004-04-23  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	* gfortranspec.c: Include the target headers.
+
+2004-04-18  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/14921
+	PR fortran/14540
+	* arith.c (arctangent2): New function.
+	* arith.h (arctangent2): Add function prototype.
+	* simplify.c (gfc_simplify_atan2): Use it.
+	(gfc_simplify_log): Use it.
+
+2004-04-12  Diego Novillo  <dnovillo@redhat.com>
+
+	* fortran/f95-lang.c (gfc_expand_stmt): Remove.
+	(LANG_HOOKS_RTL_EXPAND_STMT): Remove.
+
+2004-04-11  Bud Davis  <bdavis9659@comcast.net>
+
+	PR fortran/14872
+	* trans-io.c (build_dt): Change REC to value.
+
+2004-04-11  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR 14394
+	* trans-const.c (gfc_conv_mpf_to_tree): Loosen the maximum digits of
+	the real value when converting mpf to string.
+
+2004-04-11  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR 14395
+	* trans-intrinsic.c (gfc_conv_intrinsic_cmplx): Fix the imag part of
+	the result.
+
+2004-04-11  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/14377
+	* simplify.c (simplify_min_max): Convert the type of the result.
+
+2004-04-11  Paul Brook  <paul@codesourcery.com>
+
+	* gfortran.texi: Use full target triplet.
+
+2004-04-11  Paul Brook  <paul@codesourcery.com>
+
+	* Make-lang.in (GFORTRAN_TEXI): Set it.
+	(fortran/dfortran.dvi): Use it.  Add fortran to include paths.
+	(fortran/gfortran.info): Ditto.
+	* gfortran.texi: Major update.
+	* invoke.texi: New file.
+
+2004-04-10  Paul Brook  <paul@codesourcery.com>
+
+	* trans-array.c (gfc_trans_allocate_temp_array,
+	gfc_conv_tmp_array_ref): Don't use GFC_DECL_STRING.
+	* trans-decl.c (gfc_build_dummy_array_decl,
+	gfc_get_symbol_decl, gfc_build_function_decl,
+	gfc_create_module_variable): Ditto.
+	* trans-expr.c (gfc_conv_variable): Ditto.
+	* trans-intrinsic.c (gfc_conv_intrinsic_len): Ditto.
+	* trans.h (GFC_DECL_STRING): Remove.
+	(GFC_DECL_PACKED_ARRAY, GFC_DECL_PARTIAL_PACKED_ARRAY,
+	GFC_DECL_ASSIGN): Renumber flags.
+
+2004-04-05  Paul Brook  <paul@codesourcery.com>
+
+	PR 13252
+	PR 14081
+	* f95-lang.c (gfc_init_builtin_functions): Add stack_alloc, stack_save
+	and stack_restore.
+	* gfortran.h (struct gfc_charlen): Add backend_decl.
+	* trans-array.c (gfc_trans_allocate_temp_array,
+	gfc_conv_temp_array_ref, gfc_conv_resolve_dependencies,
+	(gfc_conv_loop_setup, gfc_array_allocate, gfc_conv_array_init_size):
+	Remove old, broken string handling.
+	(gfc_trans_auto_array_allocation, gfc_trans_g77_array,
+	gfc_trans_dummy_array_bias, gfc_conv_expr_descriptor,
+	gfc_trans_deferred_array): Handle character arrays.
+	* trans-const.c (gfc_conv_const_charlen): New function.
+	* trans-const.h (gfc_conv_const_charlen): Add prototype.
+	* trans-decl.c (gfc_finish_var_decl): Don't mark automatic variables
+	as static.
+	(gfc_build_dummy_array_decl): Handle arrays with unknown element size.
+	(gfc_create_string_length): New function.
+	(gfc_get_symbol_decl): Create lengths for character variables.
+	(gfc_get_fake_result_decl): Ditto.
+	(gfc_build_function_decl): Only set length for assumed length
+	character arguments.
+	(gfc_trans_dummy_character): New function.
+	(gfc_trans_auto_character_variable): Rewrite.
+	(gfc_trans_deferred_vars): Handle more types of character variable.
+	(gfc_create_module_variable): String lengths have moved.
+	(gfc_generate_function_code): Initialize deferred var chain earlier.
+	* trans-expr.c (gfc_conv_init_string_length): Rename ...
+	(gfc_trans_init_string_length):  ... to this.
+	(gfc_conv_component_ref, gfc_conv_variable, gfc_conv_concat_op,
+	gfc_conv_function_call): Update to new format for character variables.
+	(gfc_conv_string_length): Remove.
+	(gfc_conv_string_parameter): Update assertion.
+	* trans-intrinsic.c (gfc_conv_intrinsic_len): Use new location.
+	* trans-io.c (set_string): Use new macro names.
+	* trans-stmt.c (gfc_trans_label_assign. gfc_trans_goto): Ditto.
+	* trans-types.c (gfc_get_character_type): Use existing length expr.
+	(gfc_is_nodesc_array): Make public.
+	(gfc_get_dtype_cst): Rename ...
+	(gfc_get_dtype): ... to this.  Handle unknown size arrays.
+	(gfc_get_nodesc_array_type): Use new name.
+	(gfc_sym_type): New character variable code.
+	(gfc_get_derived_type): Ditto.
+	(gfc_get_function_type): Evaluate character variable lengths.
+	* trans-types.h (gfc_strlen_kind): Define.
+	(gfc_is_nodesc_array): Add prototype.
+	* trans.h: Update prototypes.
+	(struct lang_type): Update comments.
+	(GFC_DECL_STRING_LEN): New name for GFC_DECL_STRING_LENGTH.
+	(GFC_KNOWN_SIZE_STRING_TYPE): Remove.
+
+2004-04-04  Paul Brook  <paul@codesourcery.com>
+
+	* gfortran.h (struct gfc_option_t): Remove flag_g77_calls.
+	* options.c (gfc_init.options, gfc_handle_option): Ditto.
+	* trans-expr.c (gfc_conv_function_call): Ditto.
+	* trans-types.c (gfc_is_nodesc_array): Ditto
+	* lang.opt (fg77-calls): Remove.
+
+2004-04-04  Paul Brook  <paul@codesourcery.com>
+
+	* trans-array.c (OFFSET_FIELD): Rename from BASE_FIELD.
+	(gfc_conv_descriptor_base): Rename ...
+	(gfc_conv_descriptor_offset): ... to this.
+	(gfc_trans_allocate_array_storage): Set offset to zero.
+	(gfc_conv_array_base): Rename ...
+	(gfc_conv_array_offset): ... to this.
+	(gfc_conv_array_index_ref): Add offset parameter.
+	(gfc_conv_array_ref): Include offset.
+	(gfc_trans_preloop_setup): Use existing offset.
+	(gfc_trans_allocate_temp_array,  gfc_array_allocate,
+	gfc_trans_auto_array_allocation, gfc_trans_g77_array,
+	gfc_trans_dummy_array_bias, gfc_conv_expr_descriptor,
+	gfc_conf_ss_descriptor): Set offset.
+	* trans-array.h: Rename prototypes.
+	* trans-const.h (gfc_index_zero_node): Define.
+	* trans-decl.c (gfc_build_qualified_array): Change base to offset.
+	* trans-types.c (gfc_get_array_type_bounds): Ditto.
+	(gfc_get_nodesc_array_type): Calculate offset before upper bound.
+
+2004-03-25  Diego Novillo  <dnovillo@redhat.com>
+
+	* convert.c (convert): Don't handle WITH_RECORD_EXPR.
+
+2004-03-24  Bud Davis  <bdavis9659@comcast.net>
+
+	PR 14055
+	* arith.c (gfc_convert_integer,gfc_convert_real):  Removed leading '+'
+	before conversion by gmp library call.
+
+2004-03-24  Bud Davis  <bdavis9659@comcast.net>
+
+	PR 12921
+	* trans-io.c (gfc_trans_open): Change RECL= to a value parameter.
+
+2004-02-24  Richard Henderson  <rth@redhat.com>
+
+	* trans-array.c (gfc_trans_dummy_array_bias): Fix typo.
+
+2004-02-19  Loren J. Rittle  <ljrittle@acm.org>
+
+	* Make-lang.in ($(srcdir)/fortran/gfortran.info): Move...
+	(fortran/gfortran.info): ... to here.
+	(f95.srcinfo): New.
+
+2004-02-16  Richard Henderson  <rth@redhat.com>
+
+	* Make-lang.in (f95-lang.o, trans-decl.o): Depend on cgraph.h.
+	* f95-lang.c (LANG_HOOKS_EXPAND_DECL): Remove.
+	(LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION): New.
+	(gfc_expand_function): Rename from expand_function_body, make static,
+	don't do anything except invoke tree_rest_of_compilation.
+	(gfc_be_parse_file): Invoke cgraph.
+	(gfc_expand_decl): Remove.
+	(gfc_init_builtin_functions): Add __builtin_init_trampoline and
+	__builtin_adjust_trampoline.
+	* trans-decl.c (gfc_get_extern_function_decl): Don't set DECL_CONTEXT.
+	(gfc_finalize): New.
+	(gfc_generate_function_code): Use it.  Lower nested functions.
+	* trans-expr.c (gfc_conv_function_call): Add static chain operand
+	to call_expr.
+	* trans.c (gfc_build_function_call): Likewise.
+	* trans.h (expand_function_body): Remove.
+
+2004-02-15  Victor Leikehman  <lei@il.ibm.com>
+
+	PR gfortran/13433
+	* trans-decl.c (gfc_build_function_decl) For functions
+	returning CHARACTER pass an extra length argument,
+	following g77 calling conventions.
+	* trans-types.c (gfc_get_function_type) Ditto.
+	* trans-expr.c (gfc_conv_function_call) Ditto.
+
+2004-02-14  Paul Brook  <paul@codesourcery.com>
+
+	* f95-lang.c (gfc_init_builtin_functions): Build chain properly.
+
+2004-02-12  Paul Brook  <paul@nowt.org>
+
+	* BUGS: Remove.
+
+2004-02-08  Steve Kargl  <sgk@troutmask.apl.washington.edu>
+
+	* gfortran.texi: Fix typos.
+
+2004-02-07  Bud Davis  <bdavis9659@comcast.net>
+
+	PR gfortran/13909
+	* intrinsic.c (add_conversions) Use logical conversion instead
+	of real.
+	* trans-types.c (gfc_get_logical_type) implemented logical*1
+	and logical*2.
+
+2004-01-17  Paul Brook  <paul@codesourcery.com>
+
+	* lang-specs.h: Remove %<fixed-form.
+
+2004-01-15  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* lang-specs.h: Enable preprocessing of source files
+	ending in .F, .fpp, .FPP, .F90 and .F95.
+
+2004-01-13  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR fortran/12912
+	* lang-specs.h: Enable compilation of files ending
+	in .f, .for and .FOR.
+
+2004-01-11  Paul Brook  <paul@codesourcery.com>
+
+	* trans-stmt.c (gfc_trans_if_1): New function.
+	(gfc_trans_if): Use it.
+
+2004-01-11  Erik Schnetter  <schnetter@uni-tuebingen.de>
+
+	* gfortran.h (GFC_MAX_SYMBOL_LEN): Increase.
+	(gfc_option_t): Add max_identifier_length.
+	* lang.opt: Add fmax-identifier-length.
+	* match.c (parse_name): Use limit.
+	* options.c (gfc_init_options): Set max_identifier_length.
+	(gfc_handle_option): Ditto.
+
+2004-01-11  Feng Wang  <fengwang@nudt.edu.cn>
+
+	* intrinsic.c (add_functions): Add resolve function to dcmplx.
+	* intrinsic.h (gfc_resolve_dcmplx): Add prototype.
+	* iresolve.c (gfc_resolve_dcmplx): New function.
+
+2004-01-10  Paul Brook  <paul@codesourcery.com>
+
+	* trans-decl.c (gfc_get_symbol_decl): Don't set subroutine attr.
+	* trans-types.c (gfc_sym_type): Handle external dummy procedures.
+	(gfc_return_by_reference): Correct condition.
+	(gfc_get_function_type): Ditto.
+
+2004-01-10  Paul Brook  <paul@codesourcery.com>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmax): Convert mismatched
+	types.
+
+2004-01-10  Huang Chun  <chunhuang73@hotmail.com>
+
+	* iresolve.c: Use correct kind.
+
+2004-01-10  Huang Chun  <chunhuang73@hotmail.com>
+
+	PR fortran/13467
+	* trans-decl.c (gfc_create_module_variable):  Output array valued
+	parameters.
+
+2004-01-10  Paul Brook  <paul@codesourcery.com>
+
+	* resolve.c (resolve_branch): Get error message right way round.
+
+2004-01-10  Canqun Yang  <canqun@nudt.edu.cn>
+
+	* trans-array (gfc_conv_loop_setup): Adjust comment to track
+	reality.
+	(gfc_array_allocate): Don't count size of element twice.
+
+2004-01-04  Paul Brook  <paul@codesourcery.com>
+
+	* lang.opt (i8, r8, std=*): Remove RejectNegative.
+
+2004-01-04  Paul Brook  <paul@codesourcery.com>
+
+	* error.c (gfc_notify_std): New function.
+	* gfortran.h (gfc_notify_std): Declare.
+	(GFC_STD_*): Define.
+	(gfc_option_t): Add warn_std and allow_std.
+	* intrinsic.c (gfc_init_expr_extensions): Fix logic.
+	(gfc_intrinsic_func_interface): Use gfc_notify_std.
+	* check.c (check_rest): Use gfc_notify_std.
+	* match.c (gfc_match_pause): Ditto.
+	(gfc_match_assign): Ditto.
+	(gfc_match_goto): Ditto.
+	* resolve.c (resolve_branch): Ditto.
+	* lang.opt: Add std=<foo> and w.
+	* options.c (gfc_init_options): Set allow_std and warn_std.
+	(gfc_handle_option): Handle OPT_std_* and OPT_w.
+
+2004-01-01  Paul Brook  <paul@codesourcery.com>
+
+	* array.c (gfc_append_constructor): Take constructor, not expression.
+	* data.c (struct gfc_expr_stack): Remove.
+	(expr_stack): Remove.
+	(find_con_by_offset): Rename from find_expr_in_con.
+	(find_con_by_component): Rename from find_component_in_con.
+	(gfc_get_expr_stack): Remove.
+	(gfc_assign_data_value): Rewrite.
+	(gfc_expr_push): Remove.
+	(gfc_expr_pop): Remove.
+	(gfc_advance_section): Rename from
+	gfc_modify_index_and_calculate_offset.  Handle unbounded sections.
+	(gfc_get_section_index): Handle unbounded sections.
+	* gfortran.h: Update prototypes.
+	* resolve.c (check_data_variable): Array section maight not be the
+	last ref.
+
+2004-01-01  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/13432
+	* resolve.c (resolve_symbol): Allow assumed length function results.
+
+2004-01-01  Steve Kargl  <sgk@troutmask.apl.washington.edu>
+
+	* match.c (gfc_match_pause): Fix spelling.
+
+2004-01-01  Steven Bosscher  <stevenb@suse.de>
+
+	PR fortran/13251
+	* trans-expr.c (gfc_conv_variable): Take the type kind of a substring
+	reference from the expression.
+
+
+Copyright (C) 2004 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved.
diff --git a/gcc/fortran/ChangeLog-2005 b/gcc/fortran/ChangeLog-2005
new file mode 100644
index 000000000..d9fa6a587
--- /dev/null
+++ b/gcc/fortran/ChangeLog-2005
@@ -0,0 +1,3730 @@
+2005-12-30  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/22607
+	* trans-decl.c(gfc_get_extern_function_decl): Don't set
+	DECL_IS_PURE (fndecl) = 1 for return-by-reference
+	functions.
+
+	fortran/PR 25396
+	* interface.c (gfc_extend_expr): Initialize
+	e->value.function.name to NULL.
+
+2005-12-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25532
+	* trans-types.c (copy_dt_decls_ifequal): Copy declarations for
+	components of derived type components by recursing into
+	gfc_get_derived_type.
+
+2005-12-28  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	PR fortran/25587
+	* trans-io.c (gfc_build_st_parameter): Correct off by one error.
+
+2005-12-28  Rafael Ávila de Espíndola  <rafael.espindola@gmail.com>
+
+	* Make-lang.in: Remove distdir from comment.
+
+2005-12-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25029
+	PR fortran/21256
+	* resolve.c (check_assumed_size_reference, resolve_assumed_size_actual):
+	Remove because of regressions caused by patch.
+	(resolve_function, resolve_call, resolve_variable): Remove assumed size
+	checks because of regressionscaused by patch.
+
+2005-12-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25029
+	PR fortran/21256
+	*resolve.c(resolve_function): Remove assumed size checking for SIZE
+	and UBOUND and rely on their built-in checking.
+
+2005-12-22  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/18990
+	* gfortran.h (gfc_charlen): Add resolved field.
+	* expr.c (gfc_specification_expr): Accept NULL argument.
+	* resolve.c (gfc_resolve_charlen, gfc_resolve_derived): New.
+	(gfc_resolve_symbol): Resolve derived type definitions.  Use
+	resolve_charlen to resolve character lengths.
+
+2005-12-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/20889
+	*resolve.c(resolve_structure_cons): Do not attempt to convert
+	the type of mismatched pointer type components, except when
+	the constructor component is BT_UNKNOWN; emit error instead.
+
+	PR fortran/25029
+	PR fortran/21256
+	*resolve.c(check_assumed_size_reference): New function to check for upper
+	bound in assumed size array references.
+	(resolve_assumed_size_actual): New function to do a very restricted scan
+	of actual argument expressions of those procedures for which incomplete
+	assumed size array references are not allowed.
+	(resolve_function, resolve_call): Switch off assumed size checking of
+	actual arguments, except for elemental procedures and array valued
+	intrinsics; excepting LBOUND.
+	(resolve_variable): Call check_assumed_size_reference.
+
+	PR fortran/19362
+	PR fortran/20244
+	PR fortran/20864
+	PR fortran/25391
+	*interface.c(gfc_compare_types): Broken into two.
+	(gfc_compare_derived_types): Second half of gfc_compare_types with
+	corrections for a missing check that module name is non-NULL and
+	a check for private components.
+	*symbol.c(gfc_free_dt_list): New function.
+	(gfc_free_namespace): Call gfc_free_dt_list.
+	*resolve.c(resolve_symbol): Build the list of derived types in the
+	symbols namespace.
+	*gfortran.h: Define the structure type gfc_dt_list.  Add a new field,
+	derived_types to gfc_namespace.  Provide a prototye for the new
+	function gfc_compare_derived_types.
+	*trans_types.c(gfc_get_derived_type): Test for the derived type being
+	available in the host namespace. In this case, the host backend
+	declaration is used for the structure and its components.  If an
+	unbuilt, equal structure that is not use associated is found in the
+	host namespace, build it there and then.  On exit,traverse the
+	namespace of the derived type to see if there are equal but unbuilt.
+	If so, copy the structure and its component declarations.
+	(copy_dt_decls_ifequal): New functions to copy declarations to other
+	equal structure types.
+
+	PR fortran/20862
+	* io.c (gfc_match_format): Make the appearance of a format statement
+	in a module specification block an error.
+
+	PR fortran/23152
+	* match.c (gfc_match_namelist): Set assumed shape arrays in
+	namelists as std=GFC_STD_GNU and assumed size arrays as an
+	unconditional error.
+
+	PR fortran/25069
+	* match.c (gfc_match_namelist): Set the respecification of a USE
+	associated namelist group as std=GFC_STD_GNU.  Permit the concatenation
+	on no error.
+
+	PR fortran/25053
+	PR fortran/25063
+	PR fortran/25064
+	PR fortran/25066
+	PR fortran/25067
+	PR fortran/25068
+	PR fortran/25307
+	* io.c (resolve_tag): Change std on IOSTAT != default integer to
+	GFC_STD_GNU and change message accordingly.  Add same error for
+	SIZE.
+	(match_dt_element, gfortran.h): Add field err_where to gfc_dt and
+	set it when tags are being matched.
+	(gfc_resolve_dt): Remove tests that can be done before resolution
+	and add some of the new ones here.
+	(check_io_constraints): New function that checks for most of the
+	data transfer constraints. Some of these were previously done in
+	match_io, from where this function is called, and some were done
+	in gfc_resolve_dt.
+	(match_io): Remove most of the tests of constraints and add the
+	call to check_io_constraints.
+
+2005-12-21  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/25423
+	* parse.c (parse_where_block): break instead of "fall
+	through" after parsing nested WHERE construct.
+
+2005-12-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25018
+	*expr.c(check_inquiry): Return FAILURE if there is no symtree to
+	provide a name. Error/warning for assumed character length argument
+	to LEN for an initialization expression, using GFC_GNU_STD. Add an
+	argument to flag that the expression is not restricted.
+	(check_init_expr): Improve the message for a failing variable.
+	(gfc_match_init_expr): Call check_enquiry again to make sure that
+	unsimplified expressions are not causing unnecessary errors.
+
+2005-12-17  Steven G. Kargl  <kargls@comcast.net>
+	    Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/25458
+	* simplify.c (gfc_simplify_ibset, gfc_simplify_not): Add call to
+	twos_complement.
+
+2005-12-17  Steven G. Kargl  <kargls@comcast.net>
+
+	* decl.c (gfc_match_old_kind_spec,match_type_spec): Use gfc_std_notify
+	to report nonstandard intrinsic type declarations.
+
+2005-12-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/24268
+	* io.c (format_lex): Allow whitespace within text of format specifier.
+
+2005-12-16  Steven G. Kargl <kargls@comcast.net>
+ 
+	PR fortran/25106
+	PR fortran/25055
+	* match.c (gfc_match_small_literal_int): Add cnt argument;
+	(gfc_match_st_label,gfc_match_stopcode): Account for cnt argument.
+	* match.h (gfc_match_small_literal_int): Update prototype.
+	* decl.c (match_char_length,gfc_match_old_kind_spec): Account for cnt.
+	* parse.c (next_free): Ditto.
+	* primary.c (match_kind_param): Ditto.
+
+2005-12-16  Richard Guenther  <rguenther@suse.de>
+
+	* trans.h (tree): Remove declaration of gfc_build_function_call.
+	* trans.c (gfc_build_function_call): Remove.
+	(gfc_build_array_ref): Use build_function_call_expr.
+	(gfc_trans_runtime_check): Likewise.
+	* trans-array.c (gfc_trans_allocate_array_storage): Likewise.
+	(gfc_grow_array): Likewise.
+	(gfc_trans_array_ctor_element): Likewise.
+	(gfc_trans_array_constructor_value): Likewise.
+	(gfc_array_allocate): Likewise.
+	(gfc_array_deallocate): Likewise.
+	(gfc_trans_auto_array_allocation): Likewise.
+	(gfc_trans_dummy_array_bias): Likewise.
+	(gfc_conv_array_parameter): Likewise.
+	* trans-expr.c (gfc_conv_power_op): Likewise.
+	(gfc_conv_string_tmp): Likewise.
+	(gfc_conv_concat_op): Likewise.
+	(gfc_conv_expr_op): Likewise.
+	(gfc_trans_string_copy): Likewise.
+	* trans-decl.c (build_entry_thunks): Likewise.
+	(gfc_generate_function_code): Likewise.
+	(gfc_generate_constructors): Likewise.
+	* trans-io.c (gfc_trans_open): Likewise.
+	(gfc_trans_close): Likewise.
+	(build_filepos): Likewise.
+	(gfc_trans_inquire): Likewise.
+	(transfer_namelist_element): Likewise.
+	(build_dt): Likewise.
+	(gfc_trans_dt_end): Likewise.
+	(transfer_expr): Likewise.
+	(transfer_array_desc): Likewise.
+	* trans-stmt.c (gfc_trans_pause): Likewise.
+	(gfc_trans_stop): Likewise.
+	(gfc_trans_character_select): Likewise.
+	(gfc_do_allocate): Likewise.
+	(gfc_trans_assign_need_temp): Likewise.
+	(gfc_trans_pointer_assign_need_temp): Likewise.
+	(gfc_trans_forall_1): Likewise.
+	(gfc_trans_where): Likewise.
+	(gfc_trans_allocate): Likewise.
+	(gfc_trans_deallocate): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_aint): Likewise.
+	(gfc_conv_intrinsic_lib_function): Likewise.
+	(gfc_conv_intrinsic_exponent): Likewise.
+	(gfc_conv_intrinsic_abs): Likewise.
+	(gfc_conv_intrinsic_sign): Likewise.
+	(gfc_conv_intrinsic_ctime): Likewise.
+	(gfc_conv_intrinsic_fdate): Likewise.
+	(gfc_conv_intrinsic_ttynam): Likewise.
+	(gfc_conv_intrinsic_ishftc): Likewise.
+	(gfc_conv_intrinsic_len_trim): Likewise.
+	(gfc_conv_intrinsic_index): Likewise.
+	(gfc_conv_intrinsic_size): Likewise.
+	(gfc_conv_intrinsic_strcmp): Likewise.
+	(gfc_conv_intrinsic_adjust): Likewise.
+	(gfc_conv_associated): Likewise.
+	(gfc_conv_intrinsic_scan): Likewise.
+	(gfc_conv_intrinsic_verify): Likewise.
+	(call_builtin_clz): Likewise.
+	(gfc_conv_intrinsic_si_kind): Likewise.
+	(gfc_conv_intrinsic_sr_kind): Likewise.
+	(gfc_conv_intrinsic_trim): Likewise.
+	(gfc_conv_intrinsic_repeat): Likewise.
+	(gfc_conv_intrinsic_iargc): Likewise.
+
+2005-12-16  Richard Guenther  <rguenther@suse.de>
+
+	* trans.h (gfc_build_indirect_ref): Remove declaration.
+	* trans.c (gfc_build_indirect_ref): Remove.
+	* trans-array.c (gfc_trans_array_ctor_element): Use
+	build_fold_indirect_ref instead of gfc_build_indirect_ref.
+	(gfc_trans_array_constructor_value): Likewise.
+	(gfc_conv_array_index_offset): Likewise.
+	(gfc_conv_scalarized_array_ref): Likewise.
+	(gfc_conv_array_ref): Likewise.
+	(gfc_trans_dummy_array_bias): Likewise.
+	(gfc_conv_expr_descriptor): Likewise.
+	(gfc_conv_array_parameter): Likewise.
+	* trans-decl.c (gfc_finish_cray_pointee): Likewise.
+	(gfc_get_symbol_decl): Likewise.
+	* trans-expr.c (gfc_conv_substring): Likewise.
+	(gfc_conv_component_ref): Likewise.
+	(gfc_conv_variable): Likewise.
+	(gfc_add_interface_mapping): Likewise.
+	(gfc_conv_function_call): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_ichar): Likewise.
+	(gfc_conv_intrinsic_transfer): Likewise.
+	* trans-io.c (nml_get_addr_expr): Likewise.
+	(transfer_namelist_element): Likewise.
+	(transfer_expr): Likewise.
+	* trans-stmt.c (gfc_trans_nested_forall_loop): Likewise.
+	(allocate_temp_for_forall_nest_1): Likewise.
+	(gfc_trans_forall_1): Likewise.
+
+2005-12-16  Richard Guenther  <rguenther@suse.de>
+
+	* trans-array.c (gfc_conv_descriptor_data_addr): Use
+	build_fold_addr_expr where appropriate.
+	(gfc_trans_allocate_array_storage): Likewise.
+	(gfc_trans_array_constructor_value): Likewise.
+	(gfc_conv_array_data): Likewise.
+	(gfc_conv_expr_descriptor): Likewise.
+	(gfc_conv_array_parameter): Likewise.
+	* trans-expr.c (gfc_conv_variable): Likewise.
+	(gfc_conv_function_val): Likewise.
+	(gfc_conv_function_call): Likewise.
+	(gfc_conv_expr_reference): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_ctime): Likewise.
+	(gfc_conv_intrinsic_fdate): Likewise.
+	(gfc_conv_intrinsic_ttynam): Likewise.
+	(gfc_conv_intrinsic_si_kind): Likewise.
+	(gfc_conv_intrinsic_trim): Likewise.
+	* trans-io.c (set_parameter_ref): Likewise.
+	(gfc_convert_array_to_string): Likewise.
+	(gfc_trans_open): Likewise.
+	(gfc_trans_close): Likewise.
+	(build_filepos): Likewise.
+	(gfc_trans_inquire): Likewise.
+	(nml_get_addr_expr): Likewise.
+	(transfer_namelist_element): Likewise.
+	(build_dt): Likewise.
+	(gfc_trans_dt_end): Likewise.
+	(transfer_array_component): Likewise.
+	(transfer_expr): Likewise.
+	(transfer_array_desc): Likewise.
+	(gfc_trans_transfer): Likewise.
+	* trans-stmt.c (gfc_trans_allocate): Likewise.
+	(gfc_trans_deallocate): Likewise.
+
+2005-12-16  Kazu Hirata  <kazu@codesourcery.com>
+
+	* dependency.c, resolve.c, trans-array.c: Fix comment typos.
+	* gfortran.texi: Fix typos.
+
+2005-12-14  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/18197
+	* resolve.c (resolve_formal_arglist): Remove code to set
+	the type of a function symbol from it's result symbol.
+
+2005-12-13  Richard Guenther  <rguenther@suse.de>
+
+	* trans-expr.c (gfc_conv_substring): Use fold_build2 and
+	build_int_cst.
+
+2005-12-13  Richard Sandiford  <richard@codesourcery.com>
+
+	* Make-lang.in (fortran/trans-resolve.o): Depend on
+	fortran/dependency.h.
+	* gfortran.h (gfc_expr): Add an "inline_noncopying_intrinsic" flag.
+	* dependency.h (gfc_get_noncopying_intrinsic_argument): Declare.
+	(gfc_check_fncall_dependency): Change prototype.
+	* dependency.c (gfc_get_noncopying_intrinsic_argument): New function.
+	(gfc_check_argument_var_dependency): New function, split from
+	gfc_check_fncall_dependency.
+	(gfc_check_argument_dependency): New function.
+	(gfc_check_fncall_dependency): Replace the expression parameter with
+	separate symbol and argument list parameters.  Generalize the function
+	to handle dependencies for any type of expression, not just variables.
+	Accept a further argument giving the intent of the expression being
+	tested.  Ignore	intent(in) arguments if that expression is also
+	intent(in).
+	* resolve.c: Include dependency.h.
+	(find_noncopying_intrinsics): New function.
+	(resolve_function, resolve_call): Call it on success.
+	* trans-array.h (gfc_conv_array_transpose): Declare.
+	(gfc_check_fncall_dependency): Remove prototype.
+	* trans-array.c (gfc_conv_array_transpose): New function.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Don't use the
+	libcall handling if the expression is to be evaluated inline.
+	Add a case for handling inline transpose()s.
+	* trans-expr.c (gfc_trans_arrayfunc_assign): Adjust for the new
+	interface provided by gfc_check_fncall_dependency.
+
+2005-12-12  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/25078
+	* match.c (gfc_match_equivalence):  Count number of objects.
+
+2005-12-11  Aldy Hernandez  <aldyh@redhat.com>
+
+        * lang.opt: Add RejectNegative to ffixed-form and ffree-form.
+
+2005-12-10  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/25068
+	* io.c (resolve_tag): Add correct diagnostic for F2003 feature.
+
+2005-12-10  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/23815
+	* io.c (top level):  Add convert to io_tag.
+	(resolve_tag):  convert is GFC_STD_GNU.
+	(match_open_element):  Add convert.
+	(gfc_free_open):  Likewise.
+	(gfc_resolve_open):  Likewise.
+	(gfc_free_inquire):  Likewise.
+	(match_inquire_element):  Likewise.
+	* dump-parse-tree.c (gfc_show_code_node):  Add
+	convet for open and inquire.
+	gfortran.h: Add convert to gfc_open and gfc_inquire.
+	* trans-io.c (gfc_trans_open):  Add convert.
+	(gfc_trans_inquire):  Likewise.
+	* ioparm.def:  Add convert to open and inquire.
+	* gfortran.texi:  Document CONVERT.
+
+2005-12-09  Roger Sayle  <roger@eyesopen.com>
+
+	PR fortran/22527
+	* f95-lang.c (gfc_truthvalue_conversion): Use a zero of the correct
+	integer type when building an inequality.
+
+2005-12-09  Richard Guenther  <rguenther@suse.de>
+
+	* f95-lang.c (build_builtin_fntypes): Use correct
+	return types, as indicated by comments.
+
+2005-12-08  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/25292
+	* check.c (gfc_check_associated): Allow function results
+	as actual arguments to ASSOCIATED.  Moved a misplaced
+	comment.
+
+2005-12-07  Rafael Ávila de Espíndola  <rafael.espindola@gmail.com>
+
+	* Make-lang.in (fortran.all.build, fortran.install-normal): Remove.
+
+2005-12-07  Rafael Ávila de Espíndola  <rafael.espindola@gmail.com>
+
+	* Make-lang.in: Remove all dependencies on s-gtype, except for
+	gt-fortran-trans.h.
+
+2005-12-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/25106
+	* parse.c (next_free): Use new prototype for gfc_match_st_label.
+	Correctly emit hard error if a label is zero.
+	* match.c (gfc_match_st_label): Never allow zero as a valid
+	label.
+	(gfc_match, gfc_match_do, gfc_match_goto): Use new prototype for
+	gfc_match_st_label.
+	* primary.c (): Use new prototype for gfc_match_st_label.
+	* io.c (): Likewise.
+	* match.h: Likewise.
+
+2005-12-02  Richard Guenther  <rguenther@suse.de>
+
+	* trans.h (build1_v): Use build1, not build to build the
+	void typed tree.
+
+2005-12-01  Erik Schnetter  <schnetter@aei.mpg.de>
+
+	* decl.c (gfc_match_old_kind_spec):  Improve handling of old style
+	COMPLEX*N
+
+2005-12-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24789
+	* trans-decl.c (gfc_get_symbol_decl):  Move the expression for
+	unit size of automatic character length, dummy pointer array
+	elements down a few lines from the version that fixed PR15809.
+
+2005-11-30  Bernhard Fischer <rep.nop@aon.at>
+
+	PR fortran/21302
+	* lang.opt: New options -ffree-line-length- and -ffree-line-length-none.
+	* gfortran.h: Add free_line_length and add description of
+	free_line_length and fixed_line_length.
+	* options.c (gfc_init_options, gfc_handle_option): Initialize
+	and set free_line_length and fixed_line_length.
+	* scanner.c (load_line): Set free_line_length to 132 and
+	fixed_line_length to 72 or user requested values.
+	* scanner.c: Typo in comment.
+	* invoke.texi: Document -ffree-line-length- and
+	-ffree-line-length-none
+
+2005-11-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/15809
+	* trans-decl.c (gfc_get_symbol_decl):  In the case of automatic
+	character length, dummy pointer arrays, build an expression for
+	unit size of the array elements, to be picked up and used in the
+	descriptor dtype.
+	* trans-io.c (gfc_trans_transfer):  Modify the detection of
+	components of derived type arrays to use the gfc_expr references
+	instead of the array descriptor dtype.  This allows the latter
+	to contain expressions.
+
+2005-11-30  Erik Edelmann  <erik.edelmann@iki.fi>
+
+	PR fortran/15809
+	* trans-array.c (gfc_trans_deferred_array):  Allow PARM_DECLs past
+	in addition to VAR_DECLs.
+
+2005-11-29  Jakub Jelinek  <jakub@redhat.com>
+
+	* io.c (gfc_resolve_open): RESOLVE_TAG access field as well.
+
+2005-11-27 Bernhard Fischer <rep.nop@aon.at>
+
+	* gfortran.h: remove superfluous whitespace and use GNU
+	comment-style for the documentation of backend_decl.
+
+2005-11-27  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/24917
+	* primary.c (match_boz_constant):  Implement postfix BOZ constants;
+	(match_string_constant): Peek for b, o, z, and x
+
+2005-11-27  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/23912
+	* iresolve.c (gfc_resolve_dim, gfc_resolve_mod,
+	gfc_resolve_modulo): When arguments have different kinds, fold
+	the lower one to the largest kind.
+	* check.c (gfc_check_a_p): Arguments of different kinds is not
+	a hard error, but an extension.
+	* simplify.c (gfc_simplify_dim, gfc_simplify_mod,
+	gfc_simplify_modulo): When arguments have different kinds, fold
+	the lower one to the largest kind.
+
+2005-11-21  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/14943
+	PR fortran/21647
+	* Make-lang.in (fortran/trans-io.o): Depend on fortran/ioparm.def.
+	* dump-parse-tree.c (gfc_show_code_node): Dump c->block for
+	EXEC_{READ,WRITE,IOLENGTH} nodes.
+	* io.c (terminate_io, match_io, gfc_match_inquire): Put data
+	transfer commands into EXEC_{READ,WRITE,IOLENGTH}'s code->block.
+	* resolve.c (resolve_blocks): Handle EXEC_{READ,WRITE,IOLENGTH}.
+	* trans-io.c (ioparm_unit, ioparm_err, ioparm_end, ioparm_eor,
+	ioparm_list_format, ioparm_library_return, ioparm_iostat,
+	ioparm_exist, ioparm_opened, ioparm_number, ioparm_named,
+	ioparm_rec, ioparm_nextrec, ioparm_size, ioparm_recl_in,
+	ioparm_recl_out, ioparm_iolength, ioparm_file, ioparm_file_len,
+	ioparm_status, ioparm_status_len, ioparm_access, ioparm_access_len,
+	ioparm_form, ioparm_form_len, ioparm_blank, ioparm_blank_len,
+	ioparm_position, ioparm_position_len, ioparm_action,
+	ioparm_action_len, ioparm_delim, ioparm_delim_len, ioparm_pad,
+	ioparm_pad_len, ioparm_format, ioparm_format_len, ioparm_advance,
+	ioparm_advance_len, ioparm_name, ioparm_name_len,
+	ioparm_internal_unit, ioparm_internal_unit_len,
+	ioparm_internal_unit_desc, ioparm_sequential, ioparm_sequential_len,
+	ioparm_direct, ioparm_direct_len, ioparm_formatted,
+	ioparm_formatted_len, ioparm_unformatted, ioparm_unformatted_len,
+	ioparm_read, ioparm_read_len, ioparm_write, ioparm_write_len,
+	ioparm_readwrite, ioparm_readwrite_len, ioparm_namelist_name,
+	ioparm_namelist_name_len, ioparm_namelist_read_mode, ioparm_iomsg,
+	ioparm_iomsg_len, ioparm_var): Remove.
+	(enum ioparam_type, enum iofield_type, enum iofield,
+	enum iocall): New enums.
+	(gfc_st_parameter_field, gfc_st_parameter): New typedefs.
+	(st_parameter, st_parameter_field, iocall): New variables.
+	(ADD_FIELD, ADD_STRING): Remove.
+	(dt_parm, dt_post_end_block): New variables.
+	(gfc_build_st_parameter): New function.
+	(gfc_build_io_library_fndecls): Use it.  Initialize iocall
+	array rather than ioparm_*, add extra first arguments to
+	the function types.
+	(set_parameter_const): New function.
+	(set_parameter_value): Add type argument, return a bitmask.
+	Changed to set a field in automatic structure variable rather
+	than set a field in a global _gfortran_ioparm variable.
+	(set_parameter_ref): Likewise.  If requested var has different
+	size than what field should point to, call with a temporary and
+	then copy into the user variable.  Add postblock argument.
+	(set_string): Remove var_len argument, add type argument, return
+	a bitmask.  Changed to set fields in automatic structure variable
+	rather than set a field in a global _gfortran_ioparm variable.
+	(set_internal_unit): Remove iunit, iunit_len, iunit_desc arguments,
+	add var argument.  Return a bitmask.  Changed to set fields in
+	automatic structure variable rather than set a field in a global
+	_gfortran_ioparm variable.
+	(set_flag): Removed.
+	(io_result): Add var argument.  Changed to read common.flags field
+	from automatic structure variable and bitwise AND it with 3.
+	(set_error_locus): Add var argument.  Changed to set fields in
+	automatic structure variable rather than set a field in a global
+	_gfortran_{filename,line} variables.
+	(gfc_trans_open): Use gfc_start_block rather than gfc_init_block.
+	Create a temporary st_parameter_* structure.  Adjust callers of
+	all above mentioned functions.  Pass address of the temporary
+	variable as first argument to the generated function call.
+	Use iocall array rather than ioparm_* separate variables.
+	(gfc_trans_close, build_filepos, gfc_trans_inquire): Likewise.
+	(build_dt): Likewise.  Change first argument to tree from tree *.
+	Don't dereference code->ext.dt if last_dt == INQUIRE.  Emit
+	IOLENGTH argument setup here.  Set dt_parm/dt_post_end_block
+	variables and gfc_trans_code the nested data transfer commands
+	in code->block.
+	(gfc_trans_iolength): Just set last_dt and call build_dt immediately.
+	(transfer_namelist_element): Pass address of dt_parm variable
+	to generated functions.  Use iocall array rather than ioparm_*
+	separate variables.
+	(gfc_trans_backspace, gfc_trans_endfile, gfc_trans_rewind,
+	gfc_trans_flush, gfc_trans_read, gfc_trans_write): Use iocall array
+	rather than ioparm_* separate variables.
+	(gfc_trans_dt_end): Likewise.  Pass address of dt_parm variable
+	as first argument to generated function.  Adjust io_result caller.
+	Prepend dt_post_end_block before io_result code.
+	(transfer_expr): Use iocall array rather than ioparm_* separate
+	variables.  Pass address of dt_parm variables as first argument
+	to generated functions.
+	* ioparm.def: New file.
+
+2005-11-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24223
+	* resolve.c (resolve_contained_fntype) Error if an internal
+	function is assumed character length.
+
+	PR fortran/24705
+	* trans-decl.c (gfc_create_module_variable) Skip ICE in
+	when backend decl has been built and the symbol is marked
+	as being in an equivalence statement.
+
+2005-11-20  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* invoke.texi: Remove superfluous @item.
+
+2005-11-19  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/24862
+	* trans-io.c (gfc_trans_transfer): Handle arrays of derived type.
+
+2005-11-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/20811
+	* scanner.c (gfc_open_included_file): Add an extra include_cwd
+	argument. Only include files in the current working directory if
+	its value is true.
+	* gfortran.h: Change prototype for gfc_open_included_file.
+	(load_file): Don't search for include files in the current working
+	directory.
+	* options.c (gfc_post_options): Add the directory of the source file
+	to the list of paths for included files.
+	* module.c (gfc_use_module): Look for module files in the current
+	directory.
+
+2005-11-16  Alan Modra  <amodra@bigpond.net.au>
+
+	PR fortran/24096
+	* trans-types.c (gfc_init_kinds): Use one less for max_exponent
+	of IBM extended double format.
+
+2005-11-13  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
+	FPUTC, FPUT, AND, XOR and OR intrinsic functions.
+	(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
+	subroutines.
+	* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
+	GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
+	GFC_ISYM_OR, GFC_ISYM_XOR.
+	* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
+	gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
+	gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
+	gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
+	gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
+	New functions.
+	* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
+	gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
+	gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
+	* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
+	gfc_simplify_xor): New functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
+	GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
+	GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
+	GFC_ISYM_XOR.
+	* intrinsic.h: Add prototypes for all functions added to iresolve.c,
+	simplify.c and check.c.
+
+2005-11-10  Paul Thomas  <pault@gcc.gnu.org>
+	    Steven G. Kargl <kargls@comcast.net>
+
+	PR fortran/15976
+	* resolve.c (resolve_symbol): Disallow automatic arrays in module scope.
+
+2005-11-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24655
+	PR fortran/24755
+	* match.c (recursive_stmt_fcn): Add checks that symtree exists
+	for the expression to weed out inline intrinsic functions and
+	parameters.
+
+	PR fortran/24409
+	* module.c (mio_symtree_ref): Correct the patch of 0923 so that
+	a symbol is not substituted for by a the symbol for the module
+	itself and to prevent the promotion of a formal argument.
+
+2005-11-10  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/24643
+	* primary.c (match_varspec): Check for implicitly typed CHARACTER
+	variables before matching substrings.
+
+2005-11-09  Steven G. Kargl  <kargls@comcast.net>
+
+	* trans-intrinsic.c: Typo in comment.
+
+2005-11-09  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/22607
+	* trans-decl.c(build_function_decl): Don't set
+	DECL_IS_PURE (fndecl) = 1 for return-by-reference
+	functions.
+
+2005-11-08  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* dump-parse-tree.c: Fix comment typo, add a few blank lines.
+
+2005-11-07  Steven G. Kargl  <kargls@comcast.net>
+
+	* error.c: Use flag_fatal_error.
+	* invoke.texi:  Remove -Werror from list of options.
+
+2005-11-06  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24534
+	* resolve.c (resolve_symbol): Exclude case of PRIVATE declared
+	within derived type from error associated with PRIVATE type
+	components within derived type.
+
+	PR fortran/20838
+	PR fortran/20840
+	* gfortran.h: Add prototype for gfc_has_vector_index.
+	* io.c (gfc_resolve_dt): Error if internal unit has a vector index.
+	* expr.c (gfc_has_vector_index): New function to check if any of
+	the array references of an expression have vector inidices.
+	(gfc_check_pointer_assign): Error if internal unit has a vector index.
+
+	PR fortran/17737
+	* data.c (gfc_assign_data_value): Remove gcc_assert that caused the ICE
+	and replace by a standard dependent warning/error if overwriting an
+	existing initialization.
+	* decl.c (gfc_data_variable): Remove old error for already initialized
+	variable and the unused error check for common block variables.  Add
+	error for hots associated variable and standard dependent error for
+	common block variables, outside of blockdata.
+	* symbol.c (check_conflict): Add constraints for DATA statement.
+
+2005-11-06  Janne Blomqvist <jb@gcc.gnu.org>
+
+	PR fortran/24174
+	PR fortran/24305
+	* fortran/trans-io.c (gfc_build_io_library_fndecls): Add kind
+	argument to transfer_array.
+	(transfer_array_desc): Add kind argument.
+
+2005-11-06  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsic.c (add_functions): Add ctime and fdate intrinsics.
+	(add_subroutines): Likewise.
+	* intrinsic.h: Prototypes for gfc_check_ctime,
+	gfc_check_ctime_sub, gfc_check_fdate_sub, gfc_resolve_ctime,
+	gfc_resolve_fdate, gfc_resolve_ctime_sub, gfc_resolve_fdate_sub.
+	* gfortran.h: Add GFC_ISYM_CTIME and GFC_ISYM_FDATE.
+	* iresolve.c (gfc_resolve_ctime, gfc_resolve_fdate,
+	gfc_resolve_ctime_sub, gfc_resolve_fdate_sub): New functions.
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Add
+	gfor_fndecl_fdate and gfor_fndecl_ctime.
+	* check.c (gfc_check_ctime, gfc_check_ctime_sub,
+	gfc_check_fdate_sub): New functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_ctime,
+	gfc_conv_intrinsic_fdate): New functions.
+	(gfc_conv_intrinsic_function): Add cases for GFC_ISYM_CTIME
+	and GFC_ISYM_FDATE.
+	* intrinsic.texi: Documentation for the new CTIME and FDATE
+	intrinsics.
+	* trans.h: Declarations for gfor_fndecl_ctime and gfor_fndecl_fdate.
+
+2005-11-05  Kazu Hirata  <kazu@codesourcery.com>
+
+	* decl.c, trans-decl.c: Fix comment typos.
+	* gfortran.texi: Fix a typo.
+
+2005-11-05  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsic.c (add_functions): Add function version of TTYNAM.
+	* intrinsic.h: Add prototypes for gfc_check_ttynam and
+	gfc_resolve_ttynam.
+	* gfortran.h: Add case for GFC_ISYM_TTYNAM.
+	* iresolve.c (gfc_resolve_ttynam): New function.
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Add a tree
+	for function call to library ttynam.
+	* check.c (gfc_check_ttynam): New function.
+	* trans-intrinsic.c (gfc_conv_intrinsic_ttynam): New function.
+	(): Call gfc_conv_intrinsic_ttynam.
+	* trans.h: Add prototype for gfor_fndecl_ttynam.
+
+2005-11-04  Steven G. Kargl <kargls@comcast.net>
+
+	PR fortran/24636
+	* match.c (gfc_match_stopcode):  Set stop_code = -1.
+
+2005-11-04  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/18452
+	* lang-specs.h: Pass -lang-fortran to the preprocessor.
+
+2005-11-02  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	PR fortran/18157
+	* trans-array.c (gfc_conv_resolve_dependencies): Use the correct
+	type for the temporary array.
+	* trans-expr.c (gfc_trans_assignment): Pass lss
+	instead of lss_section
+	to gfc_conv_resolve_dependencies to get the
+	correct type.
+
+2005-11-02  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* decl.c (gfc_match_entry): Function entries don't need an argument
+	list if there's no RESULT clause.
+
+2005-11-01  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/24008
+	* decl.c (gfc_match_entry): Function entries need an argument list.
+
+2005-11-01  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR 24245
+	* trans.c (gfc_generate_code): Move code to create a main
+	program symbol from here ...
+	* parse.c (main_program_symbol): ... to this new
+	function, setting the locus from gfc_current_locus
+	instead of ns->code->loc.
+	(gfc_parse_file):  Call main_program_symbol for main programs.
+
+2005-11-01  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/24404
+	* resolve.c (resolve_symbol): Output symbol names in more error
+	messages, clarify error message.
+
+2005-11-01  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* dump-parse-tree.c (show_symtree): Revert change unintentionally
+	committed in r106246.
+
+2005-11-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/21565
+	* symbol.c (check_conflict): An object cannot be in a namelist and in
+	block data.
+
+	PR fortran/18737
+	* resolve.c (resolve_symbol): Set the error flag to
+	gfc_set_default_type, in the case of an external symbol, so that
+	an error message is emitted if IMPLICIT NONE is set.
+
+	PR fortran/14994
+	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SECNDS to enum.
+	* check.c (gfc_check_secnds): New function.
+	* intrinsic.c (add_functions): Add call to secnds.
+	* iresolve.c (gfc_resolve_secnds): New function.
+	* trans-intrinsic (gfc_conv_intrinsic_function): Add call to
+	secnds via case GFC_ISYM_SECNDS.
+	* intrinsic.texi: Add documentation for secnds.
+
+2005-10-31  Andreas Schwab  <schwab@suse.de>
+
+	* Make-lang.in (GFORTRAN_TARGET_INSTALL_NAME): Define.
+	(GFORTRAN_CROSS_NAME): Remove.
+	(fortran.install-common): Correctly install a cross compiler.
+	(fortran.uninstall): Use GFORTRAN_TARGET_INSTALL_NAME instead of
+	GFORTRAN_CROSS_NAME.
+
+2005-10-30  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	* gfortran.texi: Update contributors.
+
+2005-10-30  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/18883
+	* trans-decl.c (gfc_finish_var_decl): Add decl to the
+	current function, rather than the parent.  Make
+	assertion accept fake result variables.
+	* trans-expr.c (gfc_conv_variable): If the character
+	length of an ENTRY isn't set, get the length from
+	the master function instead.
+
+2005-10-30  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	* gfortran.texi:  Remove reservations about I/O usability.  Document
+	that array intrinsics mostly work.
+
+2005-10-30  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.texi: Move license stuff to back.  Add information
+	on ENUM and ENUMERATOR.
+	* invoke.texi: Document -fshort-enums.
+
+2005-10-30  Gaurav Gautam  <gauravga@noida.hcltech.com>
+	    Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* arith.c (gfc_enum_initializer): New function.
+	(gfc_check_integer_range): Made extern.
+	* decl.c (enumerator_history): New typedef.
+	(last_initializer, enum_history, max_enum): New variables.
+	(create_enum_history, gfc_free_enum_history): New functions.
+	(add_init_expr_to_sym): Call create_enum_history if parsing ENUM.
+	(variable_decl): Modified to parse enumerator definition.
+	(match_attr_spec): Add PARAMETER attribute to ENUMERATORs.
+	(gfc_match_data_decl): Issues error, if match_type_spec do not
+	return desired return values.
+	(set_enum_kind, gfc_match_enum, gfc_match_enumerator_def): New
+	functions.
+	(gfc_match_end): Deal with END ENUM.
+	* gfortran.h (gfc_statement): ST_ENUM, ST_ENUMERATOR, ST_END_ENUM
+	added.
+	(symbol_attribute): Bit field for enumerator added.
+	(gfc_options): Add fshort_enums.
+	(gfc_enum_initializer, gfc_check_integer_range): Add prototypes.
+	* options.c: Include target.h
+	(gfc_init_options): Initialize fshort_enums.
+	(gfc_handle_option): Deal with fshort_enums.
+	* parse.c (decode_statement): Match ENUM and ENUMERATOR statement.
+	(gfc_ascii_statement): Deal with the enumerator statements.
+	(parse_enum): New function to parse enum construct.
+	(parse_spec): Added case ST_ENUM.
+	* parse.h (gfc_compile_state): COMP_ENUM added.
+	(gfc_match_enum, gfc_match_enumerator_def, gfc_free_enum_history):
+	Prototype added.
+	* symbol.c (gfc_copy_attr): Copy enumeration attribute.
+	* lang.opt (fshort-enums): Option added.
+
+2005-10-30  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* check.c (gfc_check_malloc, gfc_check_free): New functions.
+	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_MALLOC.
+	* intrinsic.c (add_functions): Add symbols for MALLOC function.
+	(add_subroutines): Add symbol for FREE subroutine.
+	* intrinsic.h: Prototypes for gfc_check_malloc, gfc_check_free,
+	gfc_resolve_malloc and gfc_resolve_free.
+	* intrinsic.texi: Add doc for FREE and MALLOC intrinsics.
+	* iresolve.c (gfc_resolve_malloc, gfc_resolve_free): New
+	functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Add case for
+	GFC_ISYM_MALLOC.
+
+2005-10-30  Steven Bosscher  <stevenb@suse.de>
+
+	* gfortran.texi: Update contributors.
+
+2005-10-29  Steven Bosscher  <stevenb@suse.de>
+
+	* interface.c: Fix previous checkin (an incomplete patch
+	was commited for me).
+
+2005-10-29  Joseph S. Myers  <joseph@codesourcery.com>
+
+	* intrinsic.texi: Remove empty @cindex line.
+
+2005-10-28  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* check.c (gfc_check_alarm_sub, gfc_check_signal,
+	gfc_check_signal_sub): New functions.
+	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIGNAL.
+	* intrinsic.c (add_functions): Add signal intrinsic.
+	(add_subroutines): Add signal and alarm intrinsics.
+	* intrinsic.texi: Document the new intrinsics.
+	* iresolve.c (gfc_resolve_signal, gfc_resolve_alarm_sub,
+	gfc_resolve_signal_sub): New functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Add case
+	for GFC_ISYM_SIGNAL.
+	* intrinsic.h: Add prototypes for gfc_check_alarm_sub,
+	gfc_check_signal, gfc_check_signal_sub, gfc_resolve_signal,
+	gfc_resolve_alarm_sub, gfc_resolve_signal_sub.
+
+2005-10-28  Steven Bosscher  <stevenb@suse.de>
+
+	PR fortran/24545
+	* interface.c (gfc_match_end_interface): Fix typo in 
+	INTERFACE_USER_OP case.
+
+2005-10-26  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/15586
+	* resolve.c (resolve_symbol): Remove the use of whynot, so that
+	error messages are not built from pieces.
+
+2005-10-26  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24158
+	* decl.c (gfc_match_data_decl): Correct broken bit of code
+	that prevents undefined derived types from being used as
+	components of another derived type.
+	* resolve.c (resolve_symbol): Add backstop error when derived
+	type variables arrive here with a type that has no components.
+
+2005-10-25  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans.h (gfc_conv_cray_pointee): Remove.
+	* trans-expr.c (gfc_conv_variable): Revert 2005-10-24 change.
+	* trans-array.c (gfc_conv_array_parameter): Likewise.
+	* trans-decl.c (gfc_conv_cray_pointee): Remove.
+	(gfc_finish_cray_pointee): New function.
+	(gfc_finish_var_decl): Use it.  Don't return early for Cray
+	pointees.
+	(gfc_create_module_variable): Revert 2005-10-24 change.
+	* decl.c (cray_pointer_decl): Update comment.
+	* gfortran.texi: Don't mention Cray pointees aren't visible in the
+	debugger.
+
+	* symbol.c (check_conflict): Add conflict between cray_pointee
+	and in_common resp. in_equivalence.
+	* resolve.c (resolve_equivalence): Revert 2005-10-24 change.
+
+	* module.c (ab_attribute): Add AB_CRAY_POINTER and AB_CRAY_POINTEE.
+	(attr_bits): Likewise.
+	(mio_symbol_attribute): Save and restore cray_pointe{r,e} attributes.
+	(mio_symbol): For cray_pointee write/read cp_pointer reference.
+
+2005-10-25  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/22290
+	* trans-decl.c (gfc_add_assign_aux_vars): New function. Add two
+	auxiliary variables.
+	(gfc_get_symbol_decl): Use it when a variable, including dummy
+	argument, is assigned a label.
+	(gfc_trans_assign_aux_var): New function. Set initial value of
+	the auxiliary variable explicitly.
+	(gfc_trans_deferred_vars): Use it.
+	* trans-stmt.c (gfc_conv_label_variable): Handle dummy argument.
+
+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): Initialized.
+	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.
+
+2005-10-24  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/15586
+	* arith.c (gfc_arith_error): Change message to include locus.
+	(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
+	gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
+	the new gfc_arith_error.
+	(arith_error): Rewrite full error messages instead of building
+	them from pieces.
+	* check.c (must_be): Removed.
+	(type_check, numeric_check, int_or_real_check, real_or_complex_check,
+	kind_check, double_check, logical_array_check, array_check,
+	scalar_check, same_type_check, rank_check, kind_value_check,
+	variable_check, gfc_check_allocated, gfc_check_associated,
+	gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
+	gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
+	gfc_check_pack, gfc_check_precision, gfc_check_present,
+	gfc_check_spread): Rewrite full error messages instead of
+	building them from pieces.
+	* decl.c (gfc_match_entry): Rewrite full error messages instead
+	of building them from pieces.
+	* parse.c (gfc_state_name): Remove.
+	* parse.h: Remove prototype for gfc_state_name.
+
+2005-10-23  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	PR fortran/23635
+	* check.c (gfc_check_ichar_iachar): Move the code around so
+	that the check on the length is after check for
+	references.
+
+2005-10-23  Asher Langton  <langton2@llnl.gov>
+
+	* decl.c (match_type_spec): Add a BYTE type as an extension.
+
+2005-10-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/18022
+	* trans-expr.c (gfc_trans_arrayfunc_assign): Return NULL
+	if there is a component ref during an array ref to force
+	use of temporary in assignment.
+
+	PR fortran/24311
+	PR fortran/24384
+	* fortran/iresolve.c (check_charlen_present): New function to
+	add a charlen to the typespec, in the case of constant
+	expressions.
+	(gfc_resolve_merge, gfc_resolve_spread): Call.the above.
+	(gfc_resolve_spread): Make calls to library functions that
+	handle the case of the spread intrinsic with a scalar source.
+
+2005-10-22  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/24426
+	* decl.c (variable_decl): Don't assign default initializers to
+	pointers.
+
+2005-10-21  Jakub Jelinek  <jakub@redhat.com>
+
+	* interface.c (compare_actual_formal): Issue error when attempting
+	to pass an assumed-size array as assumed-shape array argument.
+
+2005-10-20  Erik Edelmann  <erik.edelmann@iki.fi>
+
+	PR fortran/21625
+	* resolve.c (expr_to_initialize): New function.
+	(resolve_allocate_expr): Take current statement as new
+	argument. Add default initializers to variables of
+	derived types, if they need it.
+	(resolve_code): Provide current statement as argument to
+	resolve_allocate_expr().
+
+2005-10-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24440
+	* resolve.c (resolve_symbol): Correct error in check for
+	assumed size array with default initializer by testing
+	for arrayspec before dereferencing it.
+
+2005-10-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/23446
+	* gfortran.h: Primitive for gfc_is_formal_arg.
+	* resolve.c(gfc_is_formal_arg): New function to signal across
+	several function calls that formal argument lists are being
+	processed.
+	(resolve_formal_arglist): Set/reset the flag for gfc_is_formal_arg.
+	*expr.c(check_restricted): Add check, via gfc_is_formal_arg, if
+	symbol is part of an formal argument declaration.
+
+	PR fortran/21459
+	* decl.c (add_init_expr_to_sym): Make a new character
+	length for each variable, when the expression is NULL
+	and link to cl_list.
+
+	PR fortran/20866
+	* match.c (recursive_stmt_fcn): New function that tests if
+	a statement function resurses through itself or other other
+	statement functions.
+	(gfc_match_st_function): Call recursive_stmt_fcn to check
+	if this is recursive and to raise error if so.
+
+	PR fortran/20849
+	PR fortran/20853
+	* resolve.c (resolve_symbol): Errors for assumed size arrays
+	with default initializer and for external objects with an
+	initializer.
+
+	PR fortran/20837
+	* decl.c (match_attr_spec): Prevent PUBLIC from being used
+	outside a module.
+
+2005-10-16  Erik Edelmann  <erik.edelmann@iki.fi>
+
+	PR 22273
+	* expr.c (check_inquiry): Add "len" to inquiry_function.
+
+2005-10-14  Jakub Jelinek  <jakub@redhat.com>
+
+	* primary.c (match_boz_constant): Add missing break after gfc_error.
+
+2005-10-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24092
+	* trans-types.c (gfc_get_derived_type): Insert code to obtain backend
+	declaration for derived types, building if necessary.  Return the
+	derived type if the fields have been built by this process.  Otherwise,
+	continue as before but using the already obtained backend_decls for the
+	derived type components.  Change the gcc_assert to act on the field.
+
+2005-10-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/18082
+	* decl.c (variable_decl): Make a new copy of the character
+	length for each variable, when the expression is not a
+	constant.
+
+2005-10-12  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* gfortran.h: Add bitmasks for different FPE traps. Add fpe
+	member to options_t.
+	* invoke.texi: Document the new -ffpe-trap option.
+	* lang.opt: Add -ffpe-trap option.
+	* options.c (gfc_init_options): Initialize the FPE option.
+	(gfc_handle_fpe_trap_option): New function to parse the argument
+	of the -ffpe-trap option.
+	(gfc_handle_option): Add case for -ffpe-trap.
+	* trans-decl.c: Declare a tree for the set_fpe library function.
+	(gfc_build_builtin_function_decls): Build this tree.
+	(gfc_generate_function_code): Generate a call to set_fpe at
+	the beginning of the main program.
+	* trans.h: New tree for the set_fpe library function.
+
+2005-10-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/20847
+	PR fortran/20856
+	* symbol.c (check_conflict): Prevent common variables and
+	function results from having the SAVE attribute,as required
+	by the standard.
+
+2005-10-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24207
+	* resolve.c (resolve_symbol): Exclude use and host associated
+	symbols from the test for private objects in a public namelist.
+
+2005-10-12  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-common.c (build_field): Fix comment typo.
+	(create_common): Set backend_decl of COMMON or EQUIVALENCEd
+	variables to a VAR_DECL with the COMPONENT_REF in
+	DECL_HAS_VALUE_EXPR rather than COMPONENT_REF directly.
+	* f95-lang.c (gfc_expand_function): Emit debug info for
+	EQUIVALENCEd variables if the equiv union is going to be output.
+
+2005-10-11  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/20786
+	* iresolve.c (gfc_resolve_aint, gfc_resolve_anint): Type conversion
+	of the argument.
+
+2005-10-11  Jakub Jelinek  <jakub@redhat.com>
+
+	* f95-lang.c (gfc_init_decl_processing): Initialize
+	void_list_node.
+
+2005-10-07  Erik Edelmann  <erik.edelmann@iki.fi>
+
+	PR 18568
+	* resolve.c (find_array_spec): Search through the list of
+	components in the symbol of the type instead of the symbol of the
+	variable.
+
+2005-10-05  Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/24176
+	* parse.c (gfc_parse_file): Exit early for empty files.
+
+2005-10-03  Steve Ellcey  <sje@cup.hp.com>
+
+	* fortran/trans-types.c (gfc_init_kinds): Only pass float, double,
+	and long double floating point types through to Fortran compiler.
+
+2005-10-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/20120
+	* f95-lang.c (DO_DEFINE_MATH_BUILTIN): Add support for long
+	double builtin function.
+	(gfc_init_builtin_functions): Add mfunc_longdouble,
+	mfunc_clongdouble and func_clongdouble_longdouble trees. Build
+	them for round, trunc, cabs, copysign and pow functions.
+	* iresolve.c (gfc_resolve_reshape, gfc_resolve_transpose): Add
+	case for kind 10 and 16.
+	* trans-decl.c: Add trees for cpowl10, cpowl16, ishftc16,
+	exponent10 and exponent16.
+	(gfc_build_intrinsic_function_decls): Build nodes for int16,
+	real10, real16, complex10 and complex16 types. Build all possible
+	combinations for function _gfortran_pow_?n_?n. Build function
+	calls cpowl10, cpowl16, ishftc16, exponent10 and exponent16.
+	* trans-expr.c (gfc_conv_power_op): Add case for integer(16),
+	real(10) and real(16).
+	* trans-intrinsic.c: Add suppport for long double builtin
+	functions in BUILT_IN_FUNCTION, LIBM_FUNCTION and LIBF_FUNCTION
+	macros.
+	(gfc_conv_intrinsic_aint): Add case for integer(16), real(10) and
+	real(16) kinds.
+	(gfc_build_intrinsic_lib_fndecls): Add support for real10_decl
+	and real16_decl in library functions.
+	(gfc_get_intrinsic_lib_fndecl): Add cases for real and complex
+	kinds 10 and 16.
+	(gfc_conv_intrinsic_exponent): Add cases for real(10) and real(16)
+	kinds.
+	(gfc_conv_intrinsic_sign): Likewise.
+	(gfc_conv_intrinsic_ishftc): Add case for integer(16) kind.
+	* trans-types.c (gfc_get_int_type, gfc_get_real_type,
+	gfc_get_complex_type, gfc_get_logical_type): Doesn't error out in
+	the case of kinds not available.
+	* trans.h: Declare trees for cpowl10, cpowl16, ishftc16,
+	exponent10 and exponent16.
+
+2005-10-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/16404
+	PR fortran/20835
+	PR fortran/20890
+	PR fortran/20899
+	PR fortran/20900
+	PR fortran/20901
+	PR fortran/20902
+	* gfortran.h: Prototype for gfc_add_in_equivalence.
+	* match.c (gfc_match_equivalence): Make a structure component
+	an explicit,rather than a syntax, error in an equivalence
+	group.  Call gfc_add_in_equivalence to add the constraints
+	imposed in check_conflict.
+	* resolve.c (resolve_symbol): Add constraints: No public
+	structures with private-type components and no public
+	procedures with private-type dummy arguments.
+	(resolve_equivalence_derived): Add constraint that prevents
+	a structure equivalence member from having a default
+	initializer.
+	(sequence_type): New static function to determine whether an
+	object is default numeric, default character, non-default
+	or mixed sequence. Add corresponding enum typespec.
+	(resolve_equivalence): Add constraints to equivalence groups
+	or their members: No more than one initialized member and
+	that different types are not equivalenced for std=f95.  All
+	the simple constraints have been moved to check_conflict.
+	* symbol.c (check_conflict): Simple equivalence constraints
+	added, including those removed from resolve_symbol.
+	(gfc_add_in_equivalence): New function to interface calls
+	match_equivalence to check_conflict.
+
+2005-09-27  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/18518
+	* trans-common.c (build_equiv_decl): Add IS_SAVED argument.
+	If it is true, set TREE_STATIC on the decl.
+	(create_common): If any symbol in equivalence has SAVE attribute,
+	pass true as last argument to build_equiv_decl.
+
+2005-09-24  Janne Blomqvist  <jblomqvi@cc.hut.fi>
+
+	* trans-io.c (gfc_build_io_library_fndecls): Add entry
+	iocall_x_array for transfer_array.
+	(transfer_array_desc): New function.
+	(gfc_trans_transfer): Add code to call transfer_array_desc.
+
+2005-09-26  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/23677
+	* symbol.c (gfc_is_var_automatic): Return true if character length
+	is non-constant rather than constant.
+	* resolve.c (gfc_resolve): Don't handle !gfc_option.flag_automatic
+	here.
+	* options.c (gfc_post_options): Set gfc_option.flag_max_stack_var_size
+	to 0 for -fno-automatic.
+
+2005-09-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/16861
+	* module.c (mio_component_ref): Return if the symbol is NULL
+	and wait for another iteration during module reads.
+	(mio_symtree_ref): Suppress the writing of contained symbols,
+	when a symbol is available in the main namespace.
+	(read_module): Restrict scope of special treatment of contained
+	symbols to variables only and suppress redundant call to
+	find_true_name.
+
+2005-09-22  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/24005
+	* interface.c (check_interface1): Fix NULL dereference.
+
+2005-09-22  Erik Edelmann  <erik.edelmann@iki.fi>
+
+	PR fortran/23843
+	* resolve.c (derived_inaccessible): New function.
+	(resolve_transfer): Use it to check for private
+	components.
+
+2005-09-22  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/23516
+	* intrinsic.c (add_function): Add IMAG, IMAGPART, and REALPART
+	intrinsics.
+	* intrinsic.h: Prototypes for gfc_simplify_realpart and
+	gfc_resolve_realpart.
+	* intrinsic.texi: Document intrinsic procedures.
+	* simplify.c (gfc_simplify_realpart): New function.
+	* irseolve.c (gfc_resolve_realpart): New function.
+
+2005-09-21  Erik Edelmann  <erik.edelmann@iki.fi>
+
+	PR fortran/19929
+	* trans-stmt.c (gfc_trans_deallocate): Check if the
+	object to be deallocated is an array by looking at
+	expr->rank instead of expr->symtree->n.sym->attr.dimension.
+
+2005-09-20  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/23420
+	* io.c (resolve_tag): Don't allow non-CHARACTER constants as formats.
+	(match_io): Fix usage of gfc_find_symbol.
+
+2005-09-20  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/23663
+	* primary.c (match_actual_arg): Handle ENTRY the same way
+	as FUNCTION.
+
+2005-09-18  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* Make-lang.in: Make check-fortran alias for check-gfortran.
+
+2005-09-18  Andreas Jaeger  <aj@suse.de>
+
+	* module.c (read_module): Add missed line from last patch.
+
+2005-09-18  Erik Edelmann  <erik.edelmann@iki.fi>
+
+	PR fortran/15975
+	* resolve.c (resolve_symbol): Don't assign default
+	initializer to pointers.
+
+2005-09-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/16861
+	* module.c (read_module): Give symbols from module procedures
+	different true_name entries to those from the module proper.
+
+2005-09-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/15586
+	* arith.c (gfc_arith_error): Add translation support for error
+	messages.
+	* array.c (gfc_match_array_ref): Likewise.
+	(gfc_match_array_spec): Likewise.
+	* check.c (must_be): Add msgid convention to third argument.
+	(same_type_check): Add translation support for error message.
+	(rank_check): Likewise.
+	(kind_value_check): Likewise.
+	(gfc_check_associated): Correct typo.
+	(gfc_check_reshape): Add translation support for error message.
+	(gfc_check_spread): Likewise.
+	* error.c (error_printf): Add nocmsgid convention to argument.
+	(gfc_warning, gfc_notify_std, gfc_warning_now, gfc_warning_check)
+	(gfc_error, gfc_error_now): Likewise.
+	(gfc_status): Add cmsgid convention to argument.
+	* expr.c (gfc_extract_int): Add translation support for error
+	messages.
+	(gfc_check_conformance): Add msgid convention to argument.
+	(gfc_check_pointer_assign): Correct tabbing.
+	* gfortran.h: Include intl.h header. Remove prototype for gfc_article.
+	* gfortranspec.c: Include intl.h header.
+	(lang_specific_driver): Add translation support for --version.
+	* io.c (check_format): Add translation support for error message.
+	(format_item_1): Likewise.
+	(data_desc): Likewise.
+	* matchexp.c: Likewise.
+	* misc.c (gfc_article): Remove function.
+	* module.c (bad_module): Use msgid convention. Add translation support
+	for error messages.
+	(require_atom): Add translation support for error messages.
+	* parse.c (gfc_ascii_statement): Likewise.
+	(gfc_state_name): Likewise.
+	* primary.c (match_boz_constant): Reorganise error messages for
+	translations.
+	* resolve.c (resolve_entries): Likewise.
+	(resolve_operator): Add translation support for error messages.
+	(gfc_resolve_expr): Use msgid convention. Reorganise error messages
+	for translations.
+	(resolve_symbol): Add translation support for error messages.
+	* symbol.c (gfc_add_procedure): Remove use of gfc_article function.
+	* trans-const.c (gfc_build_string_const): Use msgid convention.
+
+2005-09-16  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/23906
+	* dependency.c (transform_sections): Divide by correct value.
+	Elaborate comment.
+
+2005-09-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/21875 Internal Unit Array I/O, NIST
+	* fortran/trans-io.c (gfc_build_io_library_fndecls): Add field for
+	array descriptor to IOPARM structure.
+	* fortran/trans-io.c (set_internal_unit): New function to generate code
+	to store the character (array) and the character length for an internal
+	unit.
+	* fortran/trans-io (build_dt): Use the new function set_internal_unit.
+
+2005-09-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/19358
+	* trans-array.c (gfc_trans_dummy_array_bias): correct the typo
+	which uses dim[i].upper for lbound, rather than dim[i].lower.
+
+2005-09-13  Erik Edelmann  <erik.edelmann@iki.fi>
+
+	PR fortran/17740
+	* trans-expr.c (gfc_trans_arrayfunc_assign): Check value
+	of attr.elemental for specific function instead of generic name.
+
+2005-09-13  Richard Sandiford  <richard@codesourcery.com>
+
+	PR fortran/18899
+	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Move initialization
+	of argse.  Remove now-redundant want_pointer assignment.
+	* trans-array.c (gfc_conv_expr_descriptor): When not assigning to
+	a pointer, keep the original bounds of a full array reference.
+
+2005-09-13  Richard Sandiford  <richard@codesourcery.com>
+
+	PR target/19269
+	* iresolve.c (gfc_resolve_cshift, gfc_resolve_eoshift)
+	(gfc_resolve_pack, gfc_resolve_reshape, gfc_resolve_spread)
+	(gfc_resolve_transpose, gfc_resolve_unpack): Add "_char" to the name
+	for character-based operations.
+	(gfc_resolve_pack): Remove ATTRIBUTE_UNUSED from array argument.
+	(gfc_resolve_unpack): Copy the whole typespec from the vector.
+	* trans-array.c (gfc_conv_expr_descriptor): In the EXPR_FUNCTION
+	case, get the string length from the scalarization state.
+
+2005-09-14  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* Make-lang.in: Change targets prefixes from f95 to fortran.
+	* config-lang.in: Change language name to "fortran".
+	* lang.opt: Change language name to "fortran".
+	* options.c: Change CL_F95 to CL_Fortran.
+
+2005-09-09  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	gfortran.texi:  Document IOSTAT= specifier.
+
+2005-09-09  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	* gfortran.h:  Add iomsg to gfc_open, gfc_close, gfc_filepos,
+	gfc_inquire and gfc_dt.
+	* dump-parse-tree.c (gfc_show_code_node):  Add iomsg
+	for open, close, file positioning, inquire and namelist.
+	* io.c (io_tag):  Add tag_iomsg.
+	(resolve_tag): Add standards warning for iomsg.
+	(match_open_element):  Add iomsg.
+	(gfc_free_open):  Add iomsg.
+	(gfc_resolve_open):  Add iomsg.
+	(gfc_free_close):  Add iomsg.
+	(match_close_element):  Add iomsg.
+	(gfc_resolve_close):  Add iomsg.
+	(gfc_free_filepos):  Add iomsg.
+	(match_file_element):  Add iomsg.
+	(gfc_resolve_filepos):  Add iostat and iomsg.
+	(match-dt_element):  Add iomsg.
+	(gfc_free_dt):  Add iomsg.
+	(gfc_resolve_dt):  Add iomsg.
+	(gfc_free_inquire):  Add iomsg.
+	(match_inquire_element):  Add iomsg.
+	(gfc_resolve_inquire):  Add iomsg.
+	* trans_io.c:  Add ioparm_iomsg and ioparm_iomsg_len.
+	(gfc_build_io_library_fndecls):  Add iomsg as last field.
+	(gfc_trans_open):  Add iomsg.
+	(gfc_trans_close):  Add iomsg.
+	(build_fileos):  Call set_string for iomsg.
+	(gfc_trans_inquire):  Add iomsg.
+	(build_dt):  Add iomsg.
+
+2005-09-09  Richard Sandiford  <richard@codesourcery.com>
+
+	* match.h (gfc_match_equiv_variable): Declare.
+
+2005-09-09  Richard Sandiford  <richard@codesourcery.com>
+
+	PR fortran/19239
+	* Makefile.in (fortran/trans-expr.o): Depend on dependency.h.
+	* dependency.h (gfc_ref_needs_temporary_p): Declare.
+	* dependency.c (gfc_ref_needs_temporary_p): New function.
+	(gfc_check_fncall_dependency): Use it instead of inlined check.
+	By so doing, take advantage of the fact that character substrings
+	within an array reference also need a temporary.
+	* trans.h (GFC_SS_VECTOR): Adjust comment.
+	* trans-array.c (gfc_free_ss): Remove GFC_SS_VECTOR case.
+	(gfc_set_vector_loop_bounds): New function.
+	(gfc_add_loop_ss_code): Call it after evaluating the subscripts of
+	a GFC_SS_SECTION.  Deal with the GFC_SS_VECTOR case by evaluating
+	the vector expression and caching its descriptor for use within
+	the loop.
+	(gfc_conv_array_index_ref, gfc_conv_vector_array_index): Delete.
+	(gfc_conv_array_index_offset): Handle scalar, vector and range
+	dimensions as separate cases of a switch statement.  In the vector
+	case, use the loop variable to calculate a vector index and use the
+	referenced element as the dimension's index.  Perform bounds checking
+	on this final index.
+	(gfc_conv_section_upper_bound): Return null for vector indexes.
+	(gfc_conv_section_startstride): Give vector indexes a start value
+	of 0 and a stride of 1.
+	(gfc_conv_ss_startstride): Adjust for new GFC_SS_VECTOR representation.
+	(gfc_conv_expr_descriptor): Expand comments.  Generalize the
+	handling of the !want_pointer && !direct_byref case.  Use
+	gfc_ref_needs_temporary_p to decide whether the variable case
+	needs a temporary.
+	(gfc_walk_variable_expr): Handle DIMEN_VECTOR by creating a
+	GFC_SS_VECTOR index.
+	* trans-expr.c: Include dependency.h.
+	(gfc_trans_arrayfunc_assign): Fail if the target needs a temporary.
+
+2005-09-09  Richard Sandiford  <richard@codesourcery.com>
+
+	PR fortran/21104
+	* trans.h (gfc_interface_sym_mapping, gfc_interface_mapping): Moved
+	from trans-expr.c.
+	(gfc_init_interface_mapping, gfc_free_interface_mapping)
+	(gfc_add_interface_mapping, gfc_finish_interface_mapping)
+	(gfc_apply_interface_mapping): Declare.
+	* trans-array.h (gfc_set_loop_bounds_from_array_spec): Declare.
+	(gfc_trans_allocate_temp_array): Add pre and post block arguments.
+	* trans-array.c (gfc_set_loop_bounds_from_array_spec): New function.
+	(gfc_trans_allocate_array_storage): Replace loop argument with
+	separate pre and post blocks.
+	(gfc_trans_allocate_temp_array): Add pre and post block arguments.
+	Update call to gfc_trans_allocate_array_storage.
+	(gfc_trans_array_constructor, gfc_conv_loop_setup): Adjust for new
+	interface to gfc_trans_allocate_temp_array.
+	* trans-expr.c (gfc_interface_sym_mapping, gfc_interface_mapping):
+	Moved to trans.h.
+	(gfc_init_interface_mapping, gfc_free_interface_mapping)
+	(gfc_add_interface_mapping, gfc_finish_interface_mapping)
+	(gfc_apply_interface_mapping): Make extern.
+	(gfc_conv_function_call): Build an interface mapping for array
+	return values too.  Call gfc_set_loop_bounds_from_array_spec.
+	Adjust call to gfc_trans_allocate_temp_array so that code is
+	added to SE rather than LOOP.
+
+2005-09-09  Richard Sandiford  <richard@codesourcery.com>
+
+	PR fortran/12840
+	* trans.h (gfor_fndecl_internal_realloc): Declare.
+	(gfor_fndecl_internal_realloc64): Declare.
+	* trans-decl.c (gfor_fndecl_internal_realloc): New variable.
+	(gfor_fndecl_internal_realloc64): New variable.
+	(gfc_build_builtin_function_decls): Initialize them.
+	* trans-array.h (gfc_trans_allocate_temp_array): Add a fourth argument.
+	* trans-array.c (gfc_trans_allocate_array_storage): Add an argument
+	to say whether the array can grow later.  Don't allocate the array
+	on the stack if so.  Don't call malloc for zero-sized arrays.
+	(gfc_trans_allocate_temp_array): Add a similar argument here.
+	Pass it along to gfc_trans_allocate_array_storage.
+	(gfc_get_iteration_count, gfc_grow_array): New functions.
+	(gfc_iterator_has_dynamic_bounds): New function.
+	(gfc_get_array_constructor_element_size): New function.
+	(gfc_get_array_constructor_size): New function.
+	(gfc_trans_array_ctor_element): Replace pointer argument with
+	a descriptor tree.
+	(gfc_trans_array_constructor_subarray): Likewise.  Take an extra
+	argument to say whether the variable-sized part of the constructor
+	must be allocated using realloc.  Grow the array when this
+	argument is true.
+	(gfc_trans_array_constructor_value): Likewise.
+	(gfc_get_array_cons_size): Delete.
+	(gfc_trans_array_constructor): If the loop bound has not been set,
+	split the allocation into a static part and a dynamic part.  Set
+	loop->to to the bounds for static part before allocating the
+	temporary.  Adjust call to gfc_trans_array_constructor_value.
+	(gfc_conv_loop_setup): Allow any constructor to determine the
+	loop bounds.  Check whether the constructor has a dynamic size
+	and prefer to use something else if so.  Expect the loop bound
+	to be set later.  Adjust call to gfc_trans_allocate_temp_array.
+	* trans-expr.c (gfc_conv_function_call): Adjust another call here.
+
+2005-09-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/18878
+	* module.c (find_use_name_n): Based on original
+	find_use_name. Either counts number of use names for a
+	given real name or returns use name n.
+	(find_use_name, number_use_names): Interfaces to the
+	function find_use_name_n.
+	(read_module): Add the logic and calls to these functions,
+	so that mutiple reuses of the same real name are loaded.
+
+2005-09-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/22304
+	PR fortran/23270
+	PR fortran/18870
+	PR fortran/16511
+	PR fortran/17917
+	* gfortran.h: Move definition of BLANK_COMMON_NAME from trans-
+	common.c so that it is accessible to module.c. Add common_head
+	field to gfc_symbol structure. Add field for the equivalence
+	name AND new attr field, in_equivalence.
+	* match.c (gfc_match_common, gfc_match_equivalence): In loops
+	that flag common block equivalences, emit an error if the
+	common blocks are different, using sym->common_head as the
+	common block identifier. Ensure that symbols that are equivalence
+	associated with a common block are marked as being in_common.
+	* module.c (write_blank_common): New.
+	(write_common): Use unmangled common block name.
+	(load_equiv): New function ported from g95.
+	(read_module): Call load_equiv.
+	(write_equiv): New function ported from g95. Correct
+	string referencing for gfc functions. Give module
+	equivalences a unique name.
+	(write_module): Call write_equiv and write_blank_common.
+	* primary.c (match_variable) Old gfc_match_variable, made
+	static and third argument provided to indicate if parent
+	namespace to be visited or not.
+	(gfc_match_variable) New. Interface to match_variable.
+	(gfc_match_equiv_variable) New. Interface to match_variable.
+	* trans-common.c (finish_equivalences): Provide the call
+	to create_common with a gfc_common_header so that
+	module equivalences are made external, rather than local.
+	(find_equivalences): Ensure that all members in common block
+	equivalences are marked as used. This prevents the subsequent
+	call to this function from making local unions.
+	* trans-decl.c (gfc_generate_function_code): Move the call to
+	gfc_generate_contained_functions to after the call to
+	gfc_trans_common so the use-associated, contained common
+	blocks produce the correct references.
+	(gfc_create_module_variable): Return for equivalenced symbols
+	with existing backend declaration.
+
+2005-09-08  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/23765
+	* match.c (gfc_match_common): Remove unnecessary / wrong special
+	cases for end-of-statement.
+
+2005-09-08  Janne Blomqvist  <jblomqvi@cc.hut.fi>
+
+	* gfortran.texi: Add section about implemented F2003 features.
+
+2005-09-08  Richard Sandiford  <richard@codesourcery.com>
+
+	PR fortran/15326
+	* trans-array.c (gfc_add_loop_ss_code): Set ss->string_length in
+	the GFC_SS_FUNCTION case too.
+	* trans-expr.c (gfc_conv_function_val): Allow symbols to be bound
+	to function pointers as well as function decls.
+	(gfc_interface_sym_mapping, gfc_interface_mapping): New structures.
+	(gfc_init_interface_mapping, gfc_free_interface_mapping)
+	(gfc_get_interface_mapping_charlen, gfc_get_interface_mapping_array)
+	(gfc_set_interface_mapping_bounds, gfc_add_interface_mapping)
+	(gfc_finish_interface_mapping, gfc_apply_interface_mapping_to_cons)
+	(gfc_apply_interface_mapping_to_ref)
+	(gfc_apply_interface_mapping_to_expr)
+	(gfc_apply_interface_mapping): New functions.
+	(gfc_conv_function_call): Evaluate the arguments before working
+	out where the result should go.  Make the null pointer case provide
+	the string length in parmse.string_length.  Cope with non-constant
+	string lengths, using the above functions to evaluate such lengths.
+	Use a temporary typespec; don't assign to sym->cl->backend_decl.
+	Don't assign to se->string_length when returning a cached array
+	descriptor.
+
+2005-09-08  Richard Sandiford  <richard@codesourcery.com>
+
+	PR fortran/19928
+	* trans-array.c (gfc_conv_array_ref): Call gfc_advance_se_ss_chain
+	after handling scalarized references.  Make "indexse" inherit from
+	"se" when handling AR_ELEMENTs.
+	(gfc_walk_variable_expr): Add GFC_SS_SCALAR entries for each
+	substring or scalar reference that follows an array section.
+	* trans-expr.c (gfc_conv_variable): When called from within a
+	scalarization loop, start out with "ref" pointing to the scalarized
+	part of the reference.  Don't call gfc_advance_se_ss_chain here.
+
+2005-09-07  Richard Sandiford  <richard@codesourcery.com>
+
+	PR fortran/23373
+	* trans-expr.c (gfc_trans_pointer_assignment): Assign to a temporary
+	descriptor if the rhs is not a null pointer or variable.
+
+2005-09-07  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/20848
+	* symbol.c(check_conflict):  Add conflict for parameter/save,
+
+2005-09-06  Richard Sandiford  <richard@codesourcery.com>
+
+	PR fortran/19269
+	* simplify.c (gfc_simplify_transpose): Set the result's typespec from
+	the source, not the first element of the return value.
+
+2005-09-04  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/23661
+	* io.c (match_io): Correctly backup if PRINT followed by
+	symbol which is not a namelist.  Force blank between PRINT
+	and namelist in free form.
+
+2005-08-31  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/20592
+	* gfortran.h (gfc_option_t): Add flag_automatic.
+	* invoke.texi: Document the -fno-automatic option.
+	* lang.opt: Add a -fautomatic option.
+	* options.c (gfc_init_options): Default for -fautomatic is on.
+	(gfc_handle_option): Add handling of -fautomatic option.
+	* resolve.c (gfc_resolve): When -fno-automatic is used, mark
+	needed variables as SAVE.
+
+2005-08-27  Erik Edelmann  <erik.edelmann@iki.fi>
+
+	* trans-array.c (gfc_trans_deferred_array): Fix comments.
+
+2005-08-27  Erik Schnetter  <schnetter@aei.mpg.de>
+
+	* primary.c (match_charkind_name): Fix typo in comment leading to
+	function.
+
+2005-08-25  Erik Edelmann  <eedelman@acclab.helsinki.fi>
+
+	PR fortran/20363
+	* symbol.c (find_special): Remove.
+	(build_sym, add_init_expr, attr_decl1): Remove calls to
+	find_special in favor of calls to gfc_get_symbol.
+
+2005-08-24  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/17758
+	* gfortran.h (symbol_attribute):  Add noreturn to the structure.
+	(gfc_intrinsic_sym):  Add noreturn to the structure.
+	* intrinsic.c (make_noreturn):  New function.
+	(add_subroutines):  Mark subroutines abort and exit as noreturn.
+	(gfc_intrinsic_sub_interface):  Copy noreturn attribute from
+	isym to the resolved symbol.
+	* trans-decl.c (gfc_get_extern_function_decl): Set function
+	as VOLATILE (== noreturn) if the noreturn attribute is set.
+
+2005-08-21  Steven G. Kargl  <kargls@comcast.net>
+
+	* decl.c: Typo in comment.
+
+2005-08-21  Steven G. Kargl  <kargls@comcast.net>
+
+	* array.c: Bump GFC_MAX_AC_EXPAND from 100 to 65535.
+
+2005-08-21  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.h (gfc_option_t): Remove source field.  Add
+	flag_d_lines field.
+	(gfc_new_file): Remove arguments in prototype.
+	(gfc_source_file): Make 'const char *'.
+	* f95-lang.c (gfc_init): Use gfc_source_file instead of
+	gfc_option.source.  Call gfc_new_file without arguments.
+	* invoke.texi: Document new options '-fd-lines-as-code' and
+	'-fd-lines-as-comment'.
+	* lang.opt: Add new options.  Alphabetize.
+	* options.c (gfc_init_options): Initialize gfc_source_file instead
+	of gfc_option.source.  Initialize gfc_option.flag_d_lines.
+	(form_from_filename): Move here from scanner.c.  Make
+	'filename' argument 'const'.
+	(gfc_post_options): Set gfc_source_file.  Determine source form.
+	Warn if 'd-lines*' are used in free form.
+	* scanner.c (gfc_source_file): Constify.
+	(skip_fixed_comments): Deal with d-lines.
+	(get_file): Constify argument 'name'.
+	(load_file): Constify argument 'filename'.
+	(form_from_filename): Moved to options.c.
+	(gfc_new_file): Remove arguments.  Don't initialize
+	gfc_source_file, don't determine source form.
+	* trans-const.c (gfc_init_constants): Use gfc_source_file instead
+	of gfc_option.source.
+
+2005-08-19  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/23065
+	* gfortran.h: Remove PATH_MAX definition.
+	* module.c (write_module, gfc_dump_module): Use alloca to allocate
+	buffers.
+	* scanner.c (gfc_release_include_path, form_from_filename): Ditto.
+
+2005-08-16  Huang Chun  <chunhuang73@hotmail.com>
+
+	* trans-expr.c (gfc_conv_power_op): Evaluate the expression before
+	expand.
+
+2005-08-14  Asher Langton  <langton2@llnl.gov>
+
+	* parse.c (match): Enclose macro in do...while(0) and braces.
+
+2005-08-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/21432.
+	* gfortran.texi: Document PRINT namelist.
+
+2005-08-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/21432.
+	* io.c (match_io): Add code to implement PRINT namelist.
+
+2005-08-14  Canqun Yang  <canqun@nudt.edu.cn>
+
+	* trans-stmt.c (gfc_trans_arithmetic_if): Optimized in case of equal
+	labels.
+
+2005-08-11  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+	    Steven Bosscher  <stevenb@suse.de>
+
+	PR libfortran/20006
+	* gfortran.h: Add is_main_program member to symbol_attribute.
+	* trans-decl: Add a gfor_fndecl_set_std tree.
+	(gfc_build_builtin_function_decls): Create it.
+	(gfc_generate_function_code): Add this call at the beginning of
+	the main program.
+	* trans.c (gfc_generate_code): Move main_program and attr.
+	* trans.h: Add declaration for gfor_fndecl_set_std.
+
+2005-08-10  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR libfortran/22143
+	gfortran.h:  Declare new function gfc_resolve_dim_arg.
+	resolve.c:  New function gfc_resolve_dim_arg.
+	iresolve.c (gfc_resolve_all):  Use gfc_resolve_dim_arg.
+	(gfc_resolve_any):  Likewise.
+	(gfc_resolve_count):  Likewise.
+	(gfc_resolve_cshift):  Likewise.  If the kind of shift is less
+	gfc_default_integer_kind, convert it to default integer type.
+	(gfc_resolve_eoshift):  Likewise.
+	(gfc_resolve_maxloc):  Use gfc_resolve_dim_arg.
+	(gfc_resolve_maxval):  Likewise.
+	(gfc_resolve_minloc):  Likewise.
+	(gfc_resolve_minval):  Likewise.
+	(gfc_resolve_product):  Likewise.
+	(gfc_resolve_spread):  Likewise.
+	(gfc_resolve_sum):  Likewise.
+
+2005-08-09  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* check.c (gfc_check_ttynam_sub, gfc_check_isatty): Add check
+	functions for new intrinsics TTYNAM and ISATTY.
+	* intrinsic.c (add_functions, add_subroutines): Add new
+	intrinsics.
+	* intrinsic.h: Add prototypes for new check and resolve
+	functions.
+	* iresolve.c (gfc_resolve_isatty, gfc_resolve_ttynam_sub): New
+	resolve functions for intrinsics TTYNAM and ISATTY.
+	* gfortran.h (gfc_generic_isym_id): Add symbol for ISATTY.
+	* trans-intrinsic.c: Add case for GFC_ISYM_ISATTY.
+
+2005-08-09  Jakub Jelinek  <jakub@redhat.com>
+
+	* scanner.c (preprocessor_line): Don't write beyond the end of flag
+	buffer.
+
+2005-08-07   Janne Blomqvist  <jblomqvi@cc.hut.fi>
+
+	PR fortran/22390
+	* dump-parse-tree.c (gfc_show_code_node): Add case for FLUSH.
+	* gfortran.h: Add enums for FLUSH.
+	* io.c (gfc_free_filepos,match_file_element,match_filepos): Modify
+	comment appropriately.  (gfc_match_flush): New function.
+	* match.c (gfc_match_if): Add match for flush.
+	* match.h: Add prototype.
+	* parse.c (decode_statement): Add flush to 'f' case.
+	(next_statement): Add case for flush. (gfc_ascii_statement): Likewise.
+	* resolve.c (resolve_code): Add flush case.
+	* st.c (gfc_free_statement): Add flush case.
+	* trans-io.c: Add prototype for flush.
+	(gfc_build_io_library_fndecls): Build fndecl for flush.
+	(gfc_trans_flush): New function.
+	* trans-stmt.h: Add prototype.
+	* trans.c (gfc_trans_code): Add case for flush.
+
+2005-08-06  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* primary.c (match_hollerith_constant): Fix typo.
+
+2005-08-06  Kazu Hirata  <kazu@codesourcery.com>
+
+	* decl.c, dump-parse-tree.c, gfortran.texi, intrinsic.texi,
+	invoke.texi, resolve.c, trans-array.c, trans-array.h,
+	trans-common.c, trans-expr.c, trans-io.c, trans.h: Fix
+	comment/doc typos.  Follow spelling conventions.
+
+2005-08-06  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/18833
+	PR fortran/20850
+	* primary.c (match_varspec): If equiv_flag, don't look at sym's
+	attributes, call gfc_match_array_ref up to twice and don't do any
+	substring or component processing.
+	* resolve.c (resolve_equivalence): Transform REF_ARRAY into
+	REF_SUBSTRING or nothing if needed.  Check that substrings
+	don't have zero length.
+
+2005-08-05  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	* trans-expr.c  (gfc_build_builtin_function_decls):  Mark
+	stop_numeric and stop_string as non-returning.
+
+2005-08-04  Paul Brook  <paul@codesourcery.com>
+
+	* trans-expr.c (gfc_conv_expr, gfc_conv_expr_type): Update comments.
+	(gfc_conv_expr_lhs): Fix assertion.
+	(gfc_conv_expr_val): Merge post block.  Set se.expr to new value.
+
+2005-08-02  David Edelsohn  <edelsohn@gnu.org>
+
+	PR fortran/22491
+	* expr.c (simplify_parameter_variable): Do not copy the subobject
+	references if the expression value is a constant.
+
+	* expr.c (gfc_simplify_expr): Evaluate constant substrings.
+
+2005-07-31  Jerry DeLisle  <jvdelisle@verizon.net>
+
+	* intrinsic.texi: Add documentation for exponent, floor, and fnum and
+	fix description of ceiling in index.
+
+2005-07-31  Steven Bosscher  <stevenb@suse.de>
+
+	* trans-decl.c (gfc_build_builtin_function_decls): Give the internal
+	malloc functions the 'malloc' attribute.  Give runtime_error the
+	'noreturn' attribute.
+
+2005-07-31  Steven Bosscher  <stevenb@suse.de>
+
+	* trans-stmt.c (gfc_trans_goto): Jump to the known label instead
+	of the assigned goto variable.
+
+2005-07-29  Steven Bosscher  <stevenb@suse.de>
+
+	* trans-types.h (gfc_array_range_type): Add missing GTY decl for this.
+
+2005-07-28  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	* fortran/f95-lang.c (language_function): Remove
+	named_labels, shadowed_labels, returns_value, returns_abnormally,
+	warn_about_return_type, and extern_inline fields.
+	(named_labels): Remove variable.
+	(gfc_init_decl_processing): Remove setting of named_labels.
+
+2005-07-27  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
+
+	PR fortran/22503
+	* resolve.c (resolve_operator): Improve diagnostic for comparison
+	of logicals with invalid operator.
+
+2005-07-25  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/20063
+	* data.c (gfc_assign_data_value_range): Call
+	create_character_initializer if last_ts is a character type.
+
+2005-07-22  Manfred Hollstein  <mh@suse.com>
+
+	* match.c (gfc_match_symbol): Fix uninitialised warnings.
+	* matchexp.c (gfc_match_expr): Likewise.
+
+2005-07-20  Giovanni Bajo  <giovannibajo@libero.it>
+
+	Make CONSTRUCTOR use VEC to store initializers.
+	* trans-array.c (gfc_build_null_descriptor,
+	gfc_trans_array_constructor_value, gfc_conv_array_initializer):
+	Update to cope with VEC in CONSTRUCTOR_ELTS.
+	* trans-common.c (create_common): Likewise.
+	* trans-expr.c (gfc_conv_structure): Likewise.
+	* trans-stmt.c (gfc_trans_character_select): Use
+	build_constructor_from_list instead of build_constructor.
+
+2005-07-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/16940
+	* resolve.c (resolve_symbol): A symbol with FL_UNKNOWN
+	is matched against interfaces in parent namespaces. If there
+	the symtree is set to point to the interface.
+
+2005-07-16  David Edelsohn  <edelsohn@gnu.org>
+
+	PR fortran/21730
+	* decl.c (do_parm): Adjust character initializer to character length
+	of symbol before assigning.
+
+2005-07-14  Steve Ellcey  <sje@cup.hp.com>
+
+	* trans-types.c (MAX_REAL_KINDS): Increase from 4 to 5.
+
+2005-07-14  Jakub Jelinek  <jakub@redhat.com>
+
+	* gfortran.h (MAX_ERROR_MESSAGE): Remove.
+	(gfc_error_buf): Add allocated and index fields.  Change message
+	field from array to a pointer.
+	* error.c (use_warning_buffer, error_ptr, warning_ptr): Remove.
+	(cur_error_buffer): New variable.
+	(error_char): Use cur_error_buffer->{message,index} instead of
+	{warning,error}_{buffer.message,ptr}.  Reallocate message buffer
+	if too small.
+	(gfc_warning, gfc_notify_std, gfc_error, gfc_error_now): Setup
+	cur_error_buffer and its index rather than {warning,error}_ptr
+	and use_warning_buffer.
+	(gfc_warning_check, gfc_error_check): Don't print anything if
+	message is NULL.
+	(gfc_push_error): Allocate saved message with xstrdup.
+	(gfc_pop_error): Free saved message with gfc_free.
+	(gfc_free_error): New function.
+	* primary.c (match_complex_constant): Call gfc_free_error if
+	gfc_pop_error will not be called.
+	* match.c (gfc_match_st_function): Likewise.
+
+	PR fortran/22417
+	* scanner.c (preprocessor_line): Don't treat flag 3 as the start of a new
+	file.  Fix file left but not entered warning.
+
+2005-07-14  Feng Wang  <fengwang@nudt.edu.cn>
+	Steven G. Kargl  <kargls@comcast.net>
+
+	* array.c (resolve_character_array_constructor): Allocate gfc_charlen
+	for the array and attach to namespace list for automatic deallocation.
+
+2005-07-13  Andreas Schwab  <schwab@suse.de>
+
+	* Make-lang.in (fortran/dependency.o): Depend on
+	$(GFORTRAN_TRANS_DEPS).
+
+2005-07-11  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-stmt.c (gfc_trans_forall_loop): Clear maskindex before
+	the outermost loop.
+	(gfc_trans_assign_need_temp, gfc_trans_pointer_assign_need_temp,
+	gfc_trans_forall_1, gfc_evaluate_where_mask, gfc_trans_where_2):
+	Don't clear maskindexes here.
+
+2005-07-08  Daniel Berlin  <dberlin@dberlin.org>
+
+	* trans-decl.c (create_function_arglist): DECL_ARG_TYPE_AS_WRITTEN
+	is removed.
+
+2005-07-08  Jakub Jelinek  <jakub@redhat.com>
+
+	* primary.c (gfc_match_rvalue): Handle ENTRY the same way
+	as FUNCTION.
+
+2005-07-07  Jakub Jelinek  <jakub@redhat.com>
+
+	* scanner.c (load_line): Add pbuflen argument, don't make
+	buflen static.  If maxlen == 0 or preprocessor_flag,
+	don't truncate at buflen, but at maxlen.  In xrealloc add
+	1 byte at the end for the terminating '\0'.  Don't fill
+	with spaces up to buflen, but gfc_option.fixed_line_length.
+	(load_file): Adjust load_line caller.  Add line_len variable.
+
+	* scanner.c (preprocessor_line): Only set current_file->line when errors
+	have not been encountered.  Warn and don't crash if a file leave
+	preprocessor line has no corresponding entering line.  Formatting.
+
+2005-07-07  Steven Bosscher  <stevenb@suse.de>
+
+	* primary.c (match_hollerith_constant): Use int, not unsigned int,
+	for the hollerith length.  Fix indentation.
+
+2005-07-07  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/16531
+	PR fortran/15966
+	PR fortran/18781
+	* arith.c (gfc_hollerith2int, gfc_hollerith2real,
+	gfc_hollerith2complex, gfc_hollerith2character, gfc_hollerith2logical):
+	New functions.
+	(eval_intrinsic): Don't evaluate if Hollerith constant arguments exist.
+	* arith.h (gfc_hollerith2int, gfc_hollerith2real,
+	gfc_hollerith2complex, gfc_hollerith2character, gfc_hollerith2logical):
+	Add prototypes.
+	* expr.c (free_expr0): Free memery allocated for Hollerith constant.
+	(gfc_copy_expr): Allocate and copy string if Expr is from Hollerith.
+	(gfc_check_assign): Enable conversion from Hollerith to other.
+	* gfortran.h (bt): Add BT_HOLLERITH.
+	(gfc_expr): Add from_H flag.
+	* intrinsic.c (gfc_type_letter): Return 'h' for BT_HOLLERITH.
+	(add_conversions): Add conversions from Hollerith constant to other.
+	(do_simplify): Don't simplify if  Hollerith constant arguments exist.
+	* io.c (resolve_tag): Enable array in FORMAT tag under GFC_STD_GNU.
+	* misc.c (gfc_basetype_name): Return "HOLLERITH" for BT_HOLLERITH.
+	(gfc_type_name): Print "HOLLERITH" for BT_HOLLERITH.
+	* primary.c (match_hollerith_constant): New function.
+	(gfc_match_literal_constant): Add match Hollerith before Integer.
+	* simplify.c (gfc_convert_constant): Add conversion from Hollerith
+	to other.
+	* trans-const.c (gfc_conv_constant_to_tree): Use VIEW_CONVERT_EXPR to
+	convert Hollerith constant to tree.
+	* trans-io.c (gfc_convert_array_to_string): Get array's address and
+	length to set string expr.
+	(set_string): Deal with array assigned Hollerith constant and character
+	array.
+	* gfortran.texi: Document Hollerith constants as extention support.
+
+2005-07-07  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/22327
+	* trans-array.c (gfc_trans_array_constructor_value): Fix index of data.
+
+2005-07-07  Jakub Jelinek  <jakub@redhat.com>
+
+	* decl.c (gfc_match_entry): Allow ENTRY without parentheses
+	even in FUNCTIONs.
+
+2005-07-03  Kazu Hirata  <kazu@codesourcery.com>
+
+	* gfortran.texi, intrinsic.texi: Fix typos.
+	* symbol.c: Fix a comment typo.
+
+2005-07-03  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* error.c (error_printf, error_print): Use ATTRIBUTE_GCC_GFC.
+	* gfortran.h (ATTRIBUTE_GCC_GFC): New.
+	(gfc_warning, gfc_warning_now, gfc_error, gfc_error_now,
+	gfc_fatal_error, gfc_internal_error, gfc_notify_std): Use
+	ATTRIBUTE_GCC_GFC.
+
+2005-07-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/20842
+	* io.c (match_dt_element): Do not allow END tag in PRINT or
+	WRITE statement.
+
+2005-07-02  Joseph S. Myers  <joseph@codesourcery.com>
+
+	* lang.opt: Remove "." from end of help texts.
+
+2005-07-01  Jerry DeLisle  <jvdelisle@verizon.net>
+
+	* gfortran.texi: Fix typos and grammar.
+	* invoke.texi: Fix typos and grammar.
+	* intrinsic.texi: Add documentaion for eoshift, epsilon, etime, and
+	exit. Fixed alignment of text for dtime syntax. Fixed a few line
+	lengths.
+
+2005-06-25  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-stmt.c (gfc_trans_forall_1): Prefer to use smaller logical
+	type than boolean_type_node.
+
+2005-06-25  Kelley Cook  <kcook@gcc.gnu.org>
+
+	* all files: Update FSF address in copyright headers.
+
+2005-06-24  Jerry DeLisle  <jvdelisle@verizon.net>
+
+	PR fortran/21915
+	* gfortran.h: Add symbols for new intrinsic functions.
+	* intrinsic.c: Add new functions acosh, asinh, and atanh.
+	* intrinsic.h: Add prototypes for the new functions.
+	* iresolve.c (gfc_resolve_acosh): New function.
+	(gfc_resolve_asinh): New function.
+	(gfc_resolve_atanh): New function.
+	* mathbuiltins.def: Add defines.
+	* simplify.c (gfc_simplify_acosh): New function.
+	(gfc_simplify_asinh): New function.
+	(gfc_simplify_atanh): New function.
+
+2005-06-24  Feng Wang  <fengwang@nudt.edu.cn>
+
+	* simplify.c (gfc_simplify_modulo): Don't clear before get result.
+
+2005-06-22  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/21034
+	* symbol.c (gfc_is_var_automatic): New function.
+	(save_symbol): Use it.
+
+2005-06-21  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/22010
+	Port from g95.
+	* module.c (mio_namelist): New function. Correct to set
+	namelist_tail and to give error on renaming namelist by use
+	association.
+	(mio_symbol): Call mio_namelist.
+
+2005-06-19  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* gfortran.h: Add flag_backslash compile-time option.
+	* lang.opt: Add support for -fbackslash option.
+	* options.c: Likewise.
+	* primary.c: Implement behavior for -fno-backslash.
+	* invoke.texi: Add doc for -fbackslash option.
+	* gfortran.texi: Remove mention of -fno-backslash as a
+	possible extension.
+
+2005-06-20  Steven G. Kargl  <kargls@comcast.net>
+	(port from g95)
+
+	PR fortran/21257
+	* match.c (gfc_match_label): Detect duplicate labels.
+
+
+2005-06-20  Erik Edelmann  <erik.edelmann@iki.fi>
+
+	* intrinsic.c (check_intrinsic_standard): Fix spelling error
+	in a warning message.
+
+2005-06-18  Erik Edelman  <eedelman@acclab.helsinki.fi>
+	    Steven G. Kargl  <kargls@comast.net>
+
+	PR fortran/19926
+	* primary.c (gfc_match_rvalue):  expr_type can be EXPR_CONSTANT
+	for an array; check that sym->as is NULL.
+
+
+2005-06-18  Steven G. Kargl  <kargls@comcast.net>
+
+	* intrinsic.c (gfc_intrinsic_func_interface): Enable errors for generic
+	functions whose simplification routine return FAILURE.
+
+2005-06-13  Geoffrey Keating  <geoffk@apple.com>
+
+	* Make-lang.in (fortran.install-man): Doesn't depend on installdirs.
+	(rule for installing f95.1 manpage): Does depend on installdirs.
+
+2005-06-13  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/22038
+	* trans-stmt.c (gfc_trans_forall_loop): Only increment maskindex
+	in the innermost loop.
+
+	* trans-expr.c (gfc_conv_function_call): Return int instead of
+	void.  Use a local variable for has_alternate_specifier and
+	return it.  Avoid modification of function type's return value
+	in place, since it may be shared.
+	* trans.h (has_alternate_specifier): Remove.
+	(gfc_conv_function_call): Change return type.
+	* trans-stmt.c (has_alternate_specifier): Remove.
+	(gfc_trans_call): Add a local has_alternate_specifier variable,
+	set it from gfc_conv_function_call return value.
+
+2005-06-12  Richard Henderson  <rth@redhat.com>
+
+	* trans-array.c (gfc_conv_descriptor_data_get): Rename from
+	gfc_conv_descriptor_data.  Cast the result to the DATAPTR type.
+	(gfc_conv_descriptor_data_set, gfc_conv_descriptor_data_addr): New.
+	(gfc_trans_allocate_array_storage): Use them.
+	(gfc_array_allocate, gfc_array_deallocate): Likewise.
+	(gfc_trans_dummy_array_bias, gfc_conv_expr_descriptor): Likewise.
+	(gfc_trans_deferred_array): Likewise.
+	* trans-expr.c (gfc_conv_function_call): Likewise.
+	(gfc_trans_subcomponent_assign): Likewise.
+	(gfc_trans_pointer_assignment): Likewise.
+	* trans-intrinsic.c (gfc_conv_allocated): Likewise.
+	* trans-types.c (gfc_array_descriptor_base): New.
+	(gfc_get_element_type): Use GFC_TYPE_ARRAY_DATAPTR_TYPE.
+	(gfc_get_array_descriptor_base): Break out from ...
+	(gfc_get_array_type_bounds): ... here.  Create type variants.
+	* trans-array.h (gfc_conv_descriptor_data_get): Declare.
+	(gfc_conv_descriptor_data_set, gfc_conv_descriptor_data_addr): Declare.
+
+2005-06-12  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-expr.c (gfc_conv_variable): POINTER results don't need f2c
+	calling conventions.  Look at sym instead of sym->result.
+	* trans-types.c (gfc_sym_type): Remove workaround for frontend bug.
+	Remove condition which is always false with workaround removed.
+	(gfc_return_by_reference): Always look at sym, never at sym->result.
+
+2005-06-11  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/17792
+	PR fortran/21375
+	* trans-array.c (gfc_array_deallocate): pstat is new argument
+	(gfc_array_allocate): update gfc_array_deallocate() call.
+	(gfc_trans_deferred_array): ditto.
+	* trans-array.h: update gfc_array_deallocate() prototype.
+	* trans-decl.c (gfc_build_builtin_function_decls): update declaration
+	* trans-stmt.c (gfc_trans_deallocate): Implement STAT= feature.
+
+2005-06-07  Jerry DeLisle  <jvdelisle@verizon.net>
+
+	* intrinsic.texi: Add documentation for	dcmplx, digits,
+	dim, idim, ddim, dot_product, dprod, dreal, and dtime.
+
+2005-06-05  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/21912
+	* trans-array.c (gfc_trans_array_constructor_value): Slightly reorder.
+	Generate correct exit condition in case of negative steps in
+	implied-do loops.
+
+	* invoke.texi: Fix description of flags required for compatibility
+	with g77.
+
+2005-06-04  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+	Erik Schnetter  <schnetter@aei.mpg.de>
+
+	PR fortran/19195
+	* trans.c (gfc_get_backend_locus): Remove unnecessary adjustment,
+	remove FIXME comment.
+
+2005-06-04  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* match.c (match_forall_iterator): Don't immediately give error if '='
+	is not followed by an expression.
+
+2005-06-04  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+	Erik Edelmann  <erik.edelmann@iki.fi>
+
+	* array.c (gfc_match_array_constructor): Disallow empty array
+	constructor.
+
+2005-06-03  Jerry DeLisle  <jvdelisle@verizon.net>
+
+	* fortran/intrinsic.texi: Add documentation for
+	command_argument_count, conjg, dconjg, count,
+	cpu_time, cshift, date_and_time, dble, dfloat.
+
+2005-06-01  Roger Sayle  <roger@eyesopen.com>
+
+	* intrinsic.c (add_conv): No longer take a "simplify" argument as
+	its always gfc_convert_constant, instead take a "standard" argument.
+	(add_conversions): Change all existing calls of add_conv to pass
+	GFC_STD_F77 as appropriate.  Additionally, if we're allowing GNU
+	extensions support integer-logical and logical-integer conversions.
+	(gfc_convert_type_warn): Warn about use the use of these conversions
+	as a extension when appropriate, i.e. with -pedantic.
+	* simplify.c (gfc_convert_constant): Add support for integer to
+	logical and logical to integer conversions, using gfc_int2log and
+	gfc_log2int.
+	* arith.c (gfc_log2int, gfc_int2log): New functions.
+	* arith.h (gfc_log2int, gfc_int2log): Prototype here.
+	* gfortran.texi: Document this new GNU extension.
+
+2005-06-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	* fortran/trans-expr.c (gfc_conv_variable): Clean up bracketting.
+	* fortran/trans-expr.c (gfc_conv_function_call): Insert spaces.
+	Correct comments and replace convert of integer_one_node with
+	build_int_cst.
+
+2005-06-01  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/21729
+	* resolve.c (resolve_contained_fntype): Use sym->attr.untyped
+	to avoid giving error multiple times.
+	(resolve_entries): Don't error about BT_UNKNOWN here.
+	(resolve_unknown_f): Capitalize IMPLICIT for consistency.
+	(resolve_fntype): New function.
+	(gfc_resolve): Call resolve_fntype.
+
+2005-06-01  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/20883
+	* fortran/io.c (resolve_tag): Fix error message.
+
+2005-05-31  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* fortran/trans-decl.c: Don't include errors.h.
+	* fortran/Make-lang.in: Updates dependencies.
+
+2005-05-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/18109
+	PR fortran/18283
+	PR fortran/19107
+	* fortran/trans-array.c (gfc_conv_expr_descriptor): Obtain the
+	string length from the expression typespec character length value
+	and set temp_ss->stringlength and backend_decl. Obtain the
+	tree expression from gfc_conv_expr rather than gfc_conv_expr_val.
+	Dereference the expression to obtain the character.
+	* fortran/trans-expr.c (gfc_conv_component_ref): Remove the
+	dereference of scalar character pointer structure components.
+	* fortran/trans-expr.c (gfc_trans_subarray_assign): Obtain the
+	string length for the structure component from the component
+	expression.
+
+2005-05-30  Roger Sayle  <roger@eyesopen.com>
+
+	* gfortran.h (GFC_STD_LEGACY): New "standard" macro.  Reindent.
+	* options.c (gfc_init_options): By default, allow legacy extensions
+	but warn about them.
+	(gfc_post_options): Make -pedantic warn about legacy extensions
+	even with -std=legacy.
+	(gfc_handle_option): Make -std=gnu follow the default behaviour
+	of warning about legacy extensions, but allowing them. Make the
+	new -std=legacy accept everything and warn about nothing.
+	* lang.opt (std=legacy): New F95 command line option.
+	* invoke.texi: Document both -std=f2003 and -std=legacy.
+	* gfortran.texi: Explain the two types of extensions and document
+	how they are affected by the various -std= command line options.
+
+2005-05-30  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* trans-expr.c: Remove trailing ^M.
+
+	* trans-expr.c: Fix comment typos.
+
+2005-05-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/16939
+	PR fortran/17192
+	PR fortran/17193
+	PR fortran/17202
+	PR fortran/18689
+	PR fortran/18890
+	* fortran/trans-array.c (gfc_conv_resolve_dependencies): Add string
+	length to temp_ss for character pointer array assignments.
+	* fortran/trans-expr.c (gfc_conv_variable): Correct errors in
+	dereferencing of characters and character pointers.
+	* fortran/trans-expr.c (gfc_conv_function_call): Provide string
+	length as return argument for various kinds of handling of return.
+	Return a char[]* temporary for character pointer functions and
+	dereference the temporary upon return.
+
+2005-05-29  Janne Blomqvist  <jblomqvi@vipunen.hut.fi>
+	    Steven G. Kargl  <kargls@comcast.net>
+
+	fortran/PR20846
+	* io.c (gfc_match_inquire): Implement constraints on UNIT and FILE usage.
+
+2005-05-29  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR libfortran/20006
+	* io.c (format_item_1): Add check and extension warning for
+	$ edit descriptor.
+
+2005-05-28  Steven G. Kargl  <kargls@comcast.net>
+
+	* arith.c (gfc_arith_init_1): Fix off by one problem;
+	(gfc_check_integer_range): Chop extra bits in subnormal numbers.
+
+2005-05-28  Jerry DeLisle   <jvdelisle@verizon.net>
+	    Steven G. Kargl  <kargls@comcast.net>
+
+	* intrinsic.texi: added documentation for BIT_SIZE, BTEST, CHAR, CEILING
+	and CMPLX
+
+2005-05-27  Steven G. Kargl  <kargls@comcast.net>
+
+	* trans-array.c (gfc_trans_deferred_array): Use build_int_cst to force
+	like types in comparsion.
+
+2005-05-26  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* data.c, parse.c, trans-array.c, trans-decl.c,
+	trans-intrinsic.c, trans-stmt.c, trans-types.c, trans.c,
+	trans.h: Fix comment typos.  Follow spelling conventions.
+
+2005-05-22  Roger Sayle  <roger@eyesopen.com>
+
+	* gfortran.texi: Document some more GNU extensions.
+
+2005-05-22  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* error.c (gfc_warning): Fix typo in comment.
+
+2005-05-18  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR libfortran/21127
+	* fortran/iresolve.c (gfc_resolve_reshape): Add
+	gfc_type_letter (BT_COMPLEX) for complex to
+	to resolved function name.
+
+2005-05-18  Erik Edelmann  <erik.edelmann@iki.fi>
+
+	* array.c (gfc_match_array_constructor): Support [ ... ]
+	style array constructors.
+
+2005-05-18  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* f95-lang.c (gfc_init_builtin_functions): Define BUILT_IN_TRUNC
+	and BUILT_IN_TRUNCF instead of BUILT_IN_FLOOR and BUILT_IN_FLOORF.
+	* trans-intrinsic.c (build_fix_expr): Change 'op' argument
+	to correct enum type.
+	(gfc_conv_intrinsic_aint): Likewise.  Clarify comment in front of
+	function.  Add default case to switch, deal with FIX_TRUNC_EXPR
+	instead of FIX_FLOOR_EXPR.
+
+2005-05-18  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/20954
+	* trans-const.c (gfc_conv_const_charlen): Use gfc_charlen_type_node to
+	build character length.
+
+2005-05-17  Zdenek Dvorak  <dvorakz@suse.cz>
+
+	* trans-types.c (gfc_array_range_type): New variable.
+	(gfc_init_types): Initialize gfc_array_range_type.
+	(gfc_get_array_type_bounds): Use gfc_array_range_type.
+
+2005-05-17  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/15080
+	* trans-stmt.c (generate_loop_for_temp_to_lhs): Remove SIZE and COUNT2
+	arguments.  If LSS is gfc_ss_terminator, increment COUNT1 by 1, instead
+	of incrementing COUNT2 and using COUNT1+COUNT2 increment COUNT1 and use
+	just that as index.
+	(generate_loop_for_rhs_to_temp): Likewise.
+	(compute_overall_iter_number): Add INNER_SIZE_BODY argument.
+	It non-NULL, add it to body.
+	(allocate_temp_for_forall_nest_1): New function, split from
+	allocate_temp_for_forall_nest.
+	(allocate_temp_for_forall_nest): Add INNER_SIZE_BODY argument,
+	propagate it down to compute_overall_iter_number.  Use
+	allocate_temp_for_forall_nest_1.
+	(gfc_trans_assign_need_temp): Remove COUNT2.  Call
+	compute_inner_temp_size into a new stmtblock_t.  Adjust calls to
+	allocate_temp_for_forall_nest, generate_loop_for_rhs_to_temp
+	and generate_loop_for_temp_to_lhs.
+	(gfc_trans_pointer_assign_need_temp): Adjust calls to
+	allocate_temp_for_forall_nest.
+	(gfc_evaluate_where_mask): Call compute_inner_temp_size into a new
+	stmtblock_t.  Call compute_overall_iter_number just once, then
+	allocate_temp_for_forall_nest_1 twice with the same size.
+	Initialize mask indexes if nested_forall_info != NULL.
+	(gfc_trans_where_2): Initialize mask indexes before calling
+	gfc_trans_nested_forall_loop.
+
+2005-05-15  Feng Wang  <fengwang@nudt.edu.cn>
+	Jerry DeLisle  <jvdelisle@verizon.net>
+
+	PR fortran/17432
+	* trans-stmt.c (gfc_trans_label_assign): fix pointer type, to
+	resolve ICE on assign of format label.
+	* trans-io.c (set_string): add fold-convert to properly
+	handle assigned format label in write.
+
+2005-05-13  Paul Brook  <paul@codesourcery.com>
+
+	* trans-stmt.c (gfc_trans_forall_1): Fix comment typo.
+
+2005-05-12  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-types.c (gfc_is_nodesc_array): Remove redundant check.
+
+2005-05-11  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/21260
+	* io.c (check_format): Look for literal characters inside
+	hollerith constant.
+
+2005-05-11  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* resolve.c (resolve_symbol): Copy 'pointer' and 'dimension'
+	attribute from result symbol to function symbol.
+	* trans-expr.c (gfc_conv_function_call): Look at sym->attr.dimension
+	instead of sym->result->attr.dimension.
+
+2005-05-10  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/20178
+	* gfortran.h (gfc_option): Add flag_f2c.
+	* invoke.texi: Document '-ff2c' command line option.  Adapt
+	documentation for '-fno-second-underscore' and '-fno-underscoring'.
+	* lang.opt (ff2c): New entry.
+	* options.c (gfc-init_options): Set default calling convention
+	to -fno-f2c.  Mark -fsecond-underscore unset.
+	(gfc_post_options): Set -fsecond-underscore if not explicitly set
+	by user.
+	(handle_options): Set gfc_option.flag_f2c according to requested
+	calling	convention.
+	* trans-decl.c (gfc_get_extern_function_decl): Use special f2c
+	intrinsics where necessary.
+	(gfc_trans_deferred_vars): Change todo error to	assertion.
+	* trans-expr.c (gfc_conv_variable): Dereference access
+	to hidden result argument.
+	(gfc_conv_function_call): Add hidden result argument to argument
+	list if f2c calling conventions requested.  Slightly restructure
+	tests.  Convert result of default REAL function to requested type
+	if f2c calling conventions are used.  Dereference COMPLEX result
+	if f2c cc are used.
+	* trans-types.c (gfc_sym_type):  Return double for default REAL
+	function if f2c cc are used.
+	(gfc_return_by_reference): Slightly restructure logic.  Return
+	COMPLEX by reference depending on calling conventions.
+	(gfc_get_function_type): Correctly make hidden result argument a
+	pass-by-reference argument for COMPLEX.  Remove old code which does
+	this for derived types.
+
+2005-05-09  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* match.c (gfc_match_return): Only require space after keyword when
+	it is obligatory.  Only give stdwarn to after matching is successful.
+	* dump-parse-tree.c (gfc_show_symbol): Deal with alternate returns.
+
+2005-05-08  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* intrinsic.texi: Fix typos.
+
+2005-05-07  Steven G. Kargl  <kargls@comcast.net>
+
+	* intrinsic.texi:  Document ASSOCIATED and ATAN2.  Update Bessel function
+	description to include information about scalar arguments.
+
+2005-05-03  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* Make-lang.in, dump-parse-tree.c, invoke.texi, lang.opt,
+	match.h, trans-array.h: Update copyright.
+
+2005-04-29  Tom Tromey  <tromey@redhat.com>
+
+	* f95-lang.c (poplevel): Updated for change to build_block.
+
+2005-04-29  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/13082
+	PR fortran/18824
+	* trans-expr.c (gfc_conv_variable): Handle return values in functions
+	with alternate entry points.
+	* resolve.c (resolve_entries): Remove unnecessary string termination
+	after snprintf.  Set result of entry master.
+	If all entries have the same type, set entry master's type
+	to that common type, otherwise set mixed_entry_master attribute.
+	* trans-types.c (gfc_get_mixed_entry_union): New function.
+	(gfc_get_function_type): Use it for mixed_entry_master functions.
+	* gfortran.h (symbol_attribute): Add mixed_entry_master bit.
+	* decl.c (gfc_match_entry): Set entry->result properly for
+	function ENTRY.
+	* trans-decl.c (gfc_get_symbol_decl): For entry_master, skip over
+	__entry argument.
+	(build_entry_thunks): Handle return values in entry thunks.
+	Clear BT_CHARACTER's ts.cl->backend_decl, so that it is not
+	shared between multiple contexts.
+	(gfc_get_fake_result_decl): Use DECL_ARGUMENTS from
+	current_function_decl instead of sym->backend_decl.  Skip over
+	entry master's entry id argument.  For mixed_entry_master entries or
+	their results, return a COMPONENT_REF of the fake result.
+	(gfc_trans_deferred_vars): Don't warn about missing return value if
+	at least one entry point uses RESULT.
+	(gfc_generate_function_code): For entry master returning
+	CHARACTER, copy ts.cl->backend_decl to all entry result syms.
+	* trans-array.c (gfc_trans_dummy_array_bias): Don't consider return
+	values optional just because they are in entry master.
+
+2005-04-29  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* gfortran.h (gfc_namespace): Add seen_implicit_none field,
+	Tobias forgot this in previous commit.
+
+2005-04-29  Paul Brook   <paul@codesourcery.com>
+
+	* trans-expr.c (gfc_conv_expr_present): Fix broken assert.  Update
+	comment.
+
+2005-04-29  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.h (gfc_namespace): Add seen_implicit_none field.
+	* symbol.c (gfc_set_implicit_none): Give error if there's a previous
+	IMPLICIT NONE, set seen_implicit_none.
+	(gfc_merge_new_implicit): Error if there's an IMPLICIT NONE statement.
+
+2005-04-28  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.h (gfc_gsymbol): Make name a const char *.
+	* symbol.c (gfc_get_gsymbol): Allocate gsymbol name via
+	gfc_get_string.
+
+2005-04-28  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/20865
+	* resolve.c (resolve_actual_arglist): Issue an error if a statement
+	functions is used as actual argument.
+
+2005-04-27  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/21177
+	* interface.c (compare_parameter): Ignore type for EXPR_NULL
+	only if type is BT_UNKNOWN.
+
+2005-04-25  Paul Brook  <paul@codesourcery.com>
+	Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/20879
+	* check.c (gfc_check_ichar_iachar): New function.
+	* instinsic.h (gfc_check_ichar_iachar): Add prototype.
+	* intrinsic.c (add_functions): Use it.
+	* primary.c (match_varspec, gfc_match_rvalue): Clear incorrect
+	character expression lengths.
+
+2005-04-24  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/20059
+	* trans-common.c (translate_common): Cast offset and
+	common_segment->offset to type int for warning message.
+
+2005-04-23  DJ Delorie  <dj@redhat.com>
+
+	* trans-decl.c: Adjust warning() callers.
+
+2005-04-23  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-const.c (gfc_conv_mpfr_to_tree): Use hexadecimal string as
+	intermediate representation.  Fix typo in comment.
+
+2005-04-21  Steven G. Kargl  <kargls@comcast.net>
+
+	* trans-const.c (gfc_conv_mpfr_to_tree): Remove unneeded computation;
+	simplify logic; Add a gcc_assert.
+
+2005-04-19  Steven G. Kargl  <kargls@comcast.net>
+
+	* trans-const.c (gfc_conv_mpz_to_tree): Fix comment.
+
+2005-04-19  Arnaud Desitter  <arnaud.desitter@ouce.ox.ac.uk>
+	    Steven G. Kargl  <kargls@comcast.net>
+
+	* invoke.texi: Update -Waliasing description
+
+2005-04-19  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/16861
+	* resolve.c (resolve_variable): If e->symtree is not set, this
+	ought to be a FAILURE, and not a segfault.
+
+2005-04-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/17472
+	PR fortran/18209
+	PR fortran/18396
+	PR fortran/19467
+	PR fortran/19657
+	* fortran/trans-io.c (gfc_build_io_library_fndecls): Create
+	declaration for	st_set_nml_var and st_set_nml_var_dim. Remove
+	declarations of old namelist functions.
+	(build_dt): Simplified call to transfer_namelist_element.
+	(nml_get_addr_expr): Generates address expression for start of
+	object data. New function.
+	(nml_full_name): Qualified name for derived type components. New
+	function.
+	(transfer_namelist_element): Modified for calls to new functions
+	and improved derived type handling.
+
+2005-04-17  Richard Guenther  <rguenth@gcc.gnu.org>
+
+	* scanner.c (gfc_next_char_literal): Reset truncation flag
+	for lines ending in a comment for both fixed and free form.
+	(load_line): Do not set truncated flag if only truncating
+	the EOL marker.
+
+2005-04-15  Richard Guenther  <rguenth@gcc.gnu.org>
+
+	PR fortran/14569
+	* gfortran.h (gfc_linebuf): Add truncated field.
+	* parse.c (next_statement): Handle warning for truncated
+	lines.
+	* scanner.c (load_line): Return if line was truncated.
+	No longer warn for truncated lines.  Remove unused parameters.
+	(load_file): Store load_line return value to linebuf.
+	(gfc_error_recovery): Do not advance line at the end.
+
+2005-04-14  Steven G. Kargl  <kargls@comcast.net>
+
+	* gfortran.h (gfc_real_info): Add subnormal struct member.
+	* arith.c (gfc_arith_init_1): Set it.
+	(gfc_check_real_range): Use it.
+	* simplify.c (gfc_simplify_nearest): Fix nearest(0.,1.).
+
+2005-04-12  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* simplify.c: Fix a comment typo.
+
+2005-04-11  Richard Sandiford  <rsandifo@redhat.com>
+
+	* lang.opt: Refer to the GCC internals documentation instead of c.opt.
+
+2005-04-11  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* simplify.c (gfc_simplify_nearest): Overhaul.
+
+2005-04-10  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* interface.c: Fix a comment typo.
+
+2005-04-10  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* match.c (match_arithmetic_if): Arithmetic IF is obsolete in
+	Fortran 95.
+
+2005-04-09  Steven G. Kargl  <kargls@comcast.net>
+
+	* simplify.c (gfc_simplify_anint): Use mpfr_round()
+	(gfc_simplify_dnint): ditto.
+	(gfc_simplify_nint): ditto.
+
+2005-04-09  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	PR fortran/13257
+	* io.c (check_format): Allow an optional comma
+	between descriptors.
+
+2005-04-09  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* match.c (match_arithmetic_if): Remove gfc_ prefix and correct
+	comment according to GNU coding style.
+	(gfc_match_if): Remove gfc_ prefix in call to
+	match_arithmetic_if.
+
+2005-04-08  Diego Novillo  <dnovillo@redhat.com>
+
+	* match.c (gfc_match_arithmetic_if): Declare static.
+
+2005-04-08  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/17229
+	* match.c (gfc_match_arithmetic_if): New function to match an
+	arithmetic IF statement.
+	(gfc_match_if): Use gfc_match_arithmetic_if to match an
+	arithmetic IF statement embedded in a simple IF statement.
+
+2005-04-07  Steven G. Kargl  <kargls@comcast.net>
+
+	* simplify.c (gfc_simplify_exponent): Fix exponent(tiny(x))
+
+2005-04-06  Steven G. Kargl  <kargls@comcast.net>
+
+	* invoke.texi: Remove documentation of -std=f90
+
+2005-04-06  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* expr.c (gfc_check_assign): Don't allow NULL as rhs in a
+	non-pointer assignment.
+
+2005-04-05  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/15959
+	PR fortran/20713
+
+	* array.c (resolve_character_array_constructor): New function. Set
+	constant character array's character length.
+	(gfc_resolve_array_constructor): Use it.
+	* decl.c (add_init_expr_to_sym): Set symbol and initializer character
+	length.
+	(gfc_set_constant_character_len): New function. Set constant character
+	expression according the given length.
+	* match.h (gfc_set_constant_character_len): Add prototype.
+
+2005-04-04  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsic.texi: BES?? functions are not in the f95 standard.
+
+2005-04-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsic.texi: Document COS, EXP, LOG, LOG10, SIN, SQRT, TAN.
+
+2005-04-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsic.texi: Document BESJ0, BESJ1, BESJN, BESY0, BESY1,
+	BESYN, ATAN, COSH, ERF, ERC, SINH, TANH.
+
+2005-04-02  Steven G. Kargl  <kargls@comcast.net>
+
+	* intrinsic.texi: Document ALLOCATED, ANINT, ANY, ASIN; fix typos
+
+2005-04-01  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* decl.c, f95-lang.c, interface.c, module.c, trans-stmt.c,
+	trans.h: Fix comment typos.
+
+2005-03-29  Steven G. Kargl  <kargls@comcast.net>
+
+	* gfortran.h (option_t): Change d8, i8, r8 to flag_default_double,
+	flag_default_integer, flag_default_real
+	* invoke.texi: Update documentation
+	* lang.opt: Remove d8, i8, r8 definitions; Add fdefault-double-8
+	fdefault-integer-8, and fdefault-real-8 definitions.
+	* options.c (gfc_init_options): Set option defaults
+	(gfc_handle_option): Handle command line options.
+	* trans-types.c (gfc_init_kinds): Use options.
+
+2005-03-29  Keith Besaw  <kbesaw@us.ibm.com>
+
+	* f95-lang.c (builtin_function): Process the attrs parameter
+	and apply the "const" attribute to the builtin if found.
+
+2005-03-27  Steven G. Kargl  <kargls@comcast.net>
+
+	* intrinsic.texi: Document AIMAG, AINT, ALL
+
+2005-03-26  Steven G. Kargl  <kargls@comcast.net>
+
+	* arith.c (check_result): Fix illogical logic.
+
+2005-03-26  Canqun Yang  <canqun@nudt.edu.cn>
+
+	* trans-common.c (create_common): Build RECORD_NODE for common blocks
+	contain no equivalence objects.
+	(add_equivalences): New argument saw_equiv.
+	(trans_common): New local variable saw_equiv.
+	(finish_equivalences): Add a local variable dummy, Always pass true
+	for the 3rd parameter to create_common.
+
+2005-03-25  Steven G. Kargl  <kargls@comcast.net>
+
+	* intrinsic.texi: Fix "make dvi"
+
+2005-03-24  Steven G. Kargl  <kargls@comcast.net>
+
+	* intrinsic.texi: New file.
+	* gfortran.texi: Include it; white space change; fix typo.
+
+2005-03-23  Joseph S. Myers  <joseph@codesourcery.com>
+
+	* f95-lang.c (LANG_HOOKS_TRUTHVALUE_CONVERSION): Remove.
+
+2005-03-23  Steven Bosscher  <stevenb@suse.de>
+
+	* convert.c (convert): Replace fold (buildN (...)) with fold_buildN.
+	* trans-array.c (gfc_trans_allocate_array_storage,
+	gfc_trans_allocate_temp_array gfc_trans_array_constructor_value,
+	gfc_conv_array_index_ref, gfc_trans_array_bound_check,
+	gfc_conv_array_index_offset, gfc_conv_scalarized_array_ref,
+	gfc_conv_array_ref, gfc_trans_preloop_setup, gfc_conv_ss_startstride,
+	gfc_conv_loop_setup, gfc_array_init_size, gfc_trans_array_bounds,
+	gfc_trans_auto_array_allocation, gfc_trans_dummy_array_bias,
+	gfc_conv_expr_descriptor): Likewise.
+	* trans-expr.c (gfc_conv_powi, gfc_conv_string_tmp,
+	gfc_conv_concat_op, gfc_conv_expr_op): Likewise.
+	* trans-intrinsic.c (build_round_expr, gfc_conv_intrinsic_bound,
+	gfc_conv_intrinsic_cmplx, gfc_conv_intrinsic_sign,
+	gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_minmaxval,
+	gfc_conv_intrinsic_btest, gfc_conv_intrinsic_bitop,
+	gfc_conv_intrinsic_singlebitop, gfc_conv_intrinsic_ibits,
+	gfc_conv_intrinsic_ishft, gfc_conv_intrinsic_ishftc,
+	gfc_conv_intrinsic_merge, prepare_arg_info,
+	gfc_conv_intrinsic_rrspacing, gfc_conv_intrinsic_repeat): Likewise.
+	* trans-stmt.c (gfc_trans_simple_do, gfc_trans_do, gfc_trans_do_while,
+	gfc_trans_forall_loop, gfc_do_allocate, generate_loop_for_temp_to_lhs,
+	generate_loop_for_rhs_to_temp, compute_inner_temp_size,
+	allocate_temp_for_forall_nest, gfc_trans_pointer_assign_need_temp,
+	gfc_trans_forall_1, gfc_evaluate_where_mask, gfc_trans_where_assign):
+	Likewise.
+	* trans-types.c (gfc_get_dtype, gfc_get_array_type_bounds): Likewise.
+	* trans.c (gfc_add_modify_expr): Likewise.
+
+2005-03-22  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* check.c (gfc_check_chdir, gfc_check_chdir_sub, gfc_check_kill,
+	gfc_check_kill_sub, gfc_check_link, gfc_check_link_sub,
+	gfc_check_symlnk, gfc_check_symlnk_sub, gfc_check_rename,
+	gfc_check_rename_sub, gfc_check_sleep_sub, gfc_check_gerror,
+	gfc_check_getlog, gfc_check_hostnm, gfc_check_hostnm_sub,
+	gfc_check_perror): new functions to check newly implemented
+	g77 intrinsics.
+	* gfortran.h: adding symbols for new intrinsics.
+	* intrinsic.c (add_functions): adding new intrinsics.
+	(add_subroutines): adding new intrinsics.
+	* intrinsic.h: prototype for all checking and resolving
+	functions.
+	* iresolve.c (gfc_resolve_chdir, gfc_resolve_chdir_sub,
+	gfc_resolve_hostnm, gfc_resolve_ierrno, gfc_resolve_kill,
+	gfc_resolve_link, gfc_resolve_rename, gfc_resolve_symlnk,
+	gfc_resolve_time, gfc_resolve_time8, gfc_resolve_rename_sub,
+	gfc_resolve_kill_sub, gfc_resolve_link_sub,
+	gfc_resolve_symlnk_sub, gfc_resolve_sleep_sub,
+	gfc_resolve_gerror, gfc_resolve_getlog, gfc_resolve_hostnm_sub,
+	gfc_resolve_perror): new functions to resolve intrinsics.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): add case
+	for new symbols.
+
+2005-03-19  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* dump-parse-tree.c (gfc_show_expr): Dump name of namespace
+	in which the variable is declared.
+
+	PR fortran/18525
+	* resolve.c (was_declared): Also check for dummy attribute.
+
+2005-03-19  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.h (arith): Remove ARITH_0TO0.
+	* arith.c (gfc_arith_error): Remove handling of ARITH_0TO0.
+	(gfc_arith_power): Remove special casing of zero to integral
+	power zero.
+
+2005-03-18  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in (fortran-warn): Remove -Wno-error.
+	(expr.o-warn, resolve.o-warn, simplify.o-warn,
+	trans-common.o-warn): Specify -Wno-error.
+
+2005-03-17  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-array.c (gfc_trans_static_array_pointer,
+	get_array_ctor_var_strlen, gfc_conv_array_index_offset): Fix
+	comment and formatting typos.
+
+2005-03-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* invoke.texi: Fix typos.
+
+2005-03-15  Zack Weinberg  <zack@codesourcery.com>
+
+	* Make-lang.in (GFORTRAN_TEXI): Add gcc-vers.texi.
+
+2005-03-15  Feng Wang  <fengwang@nudt.edu.cn>
+
+	* trans-stmt.c (gfc_trans_label_assign): Don't set DECL_ARTIFICIAL flag
+	to zero on label_tree.
+
+2005-03-15  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/18827
+	* io.c (resolve_tag): Add checking on assigned label.
+	(match_dt_format): Does not set symbol assign attribute.
+	* match.c (gfc_match_goto):Does not set symbol assign attribute.
+	* resolve.c (resolve_code): Add checking on assigned label.
+	* trans-common.c (build_field): Deals with common variable assigned
+	a label.
+	* trans-stmt.c (gfc_conv_label_variable): New function.
+	(gfc_trans_label_assign): Use it.
+	(gfc_trans_goto): Ditto.
+	* trans-io.c (set_string): Ditto.
+	* trans.h (gfc_conv_label_variable): Add prototype.
+
+2005-03-14  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/20467
+	* symbol.c (check_conflict): A dummy argument can't be a statement
+	function.
+
+2005-03-14  Zdenek Dvorak  <dvorakz@suse.cz>
+
+	* fortran/trans-intrinsic.c (gfc_conv_intrinsic_ishft): Convert
+	the argument of the shift to the unsigned type.
+
+2005-03-13  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/16907
+	* resolve.c (gfc_resolve_index): Allow REAL indices as an extension.
+
+2005-03-13  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/20323
+	* resolve.c (gfc_resolve): Check if character lengths are
+	specification expressions.
+
+2005-03-12  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/20361
+	* trans-array.c (gfc_stack_space_left): Remove unused variable.
+	(gfc_can_put_var_on_stack): Move to trans-decl.c, remove #if 0'ed
+	code.
+	* trans-array.h (gfc_stack_space_left, gfc_can_put_var_on_stack):
+	Remove declaration / prototype.
+	* trans-common.c (build_equiv_decl): Give union a name.  Check if
+	it can be put on the stack.
+	* trans-decl.c (gfc_stack_space_left): Move function here.
+	(gfc_build_qualified_array): Fix comment typo.
+	* trans.h (gfc_put_var_on_stack): Add prototype.
+
+2005-03-11  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in (fortran-warn): Set to $(STRICT_WARN) -Wno-error.
+	* decl.c, trans.c: Don't use C++ style comments.
+	* gfortran.h (sym_flavor, procedure_type, sym_intent, gfc_access,
+	ifsrc): Give names to enums and use ENUM_BITFIELD.
+	(gfc_access): Remove trailing comma.
+
+2005-03-05  Steven G. Kargl  <kargls@comcast.net>
+
+	PR 19936
+	* primary.c (match_complex_constant): Mangled complex constant may
+	be an implied do-loop.  Give implied do-loop matcher a chance.
+
+2005-03-05  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/19754
+	* resolve.c (compare_shapes):  New function.
+	(resolve_operator): Use it.
+
+2005-03-05  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-const.c (gfc_conv_constant_to_tree): Use correct tree
+	type for COMPLEX constants.
+
+2005-03-04  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/19673
+	* trans-expr.c (gfc_conv_function_call): Correctly dereference
+	argument from a pointer function also if it has a result clause.
+
+2005-03-04  Steven G. Kargl  <kargls@comcast.net>
+
+	* expr.c (gfc_copy_shape_excluding): Change && to ||.
+
+2005-03-04  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-intrinsic.c (gfc_get_symbol_for_expr): Fix comment typo,
+	clarify comment.
+
+2005-02-28  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+	(port from g95)
+
+	PR fortran/19479
+	* simplify.c (gfc_simplify_bound): Rename to ...
+	(simplify_bound): ... this and overhaul.
+
+2005-02-28  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_iargc): remove boolean argument.
+	(gfc_conv_intrinsic_function): update function calls
+
+2005-02-27  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/20058
+	* trans-types.c (gfc_max_integer_kind): Declare
+	(gfc_init_kinds): Initialize it.
+	* gfortran.h (gfc_max_integer_kind): extern it.
+	* primary.c (match_boz_constant): Use it; remove gfortran extension
+	of kind suffixes on BOZ literal constants
+
+
+2005-02-27  Steven G. Kargl  <kargls@comcast.net>
+
+	* arith.c (gfc_check_real_range):  Remove multiple returns
+	(check_result): New function.
+	(gfc_arith_uminus,gfc_arith_plus,gfc_arith_times,
+	gfc_arith_divide,gfc_arith_power,gfc_arith_minus): Use it.
+
+
+2005-02-24  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
+
+	* decl.c, resolve.c, trans-array.c, trans.h: Fix comment typo(s).
+
+
+2005-02-24  Tobias Schl"uter  <tobias.schlueter@physik.uni-meunchen.de>
+
+	Unrevert previously reverted patch.  Adding this fix:
+	* module.c (find_true_name): Deal with NULL module.
+
+2005-02-24  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	Revert yesterday's patch:
+	2005-02-23  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+		* gfortran.h (gfc_component, gfc_actual_arglist, ...
+		... argument.  Copy string instead of pointing to it.
+
+2005-02-23  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.h (gfc_get_namespace): Add second argument to prototype.
+	* intrinsic.c (gfc_intrinsic_init_1): Pass second argument to
+	gfc_get_namespace.
+	* module.c (mio_namespace_ref, load_needed): Likewise.
+	* parse.c (parse_interface, parse_contained): Likewise.  Here the
+	correct second argument matters.
+	* symbol.c (gfc_get_namespace): Add parent_types argument, only copy
+	parent's implicit types if this is set.
+	(gfc_symbol_init_2): Pass second argument to gfc_get_namespace.
+	* trans-common.c (build_common_decl): Likewise.
+
+	* gfortran.h (symbol_attribute): New 'untyped' field, fix comment
+	formatting.
+	* symbol.c (gfc_set_default_type): Issue error only once, by setting
+	and checking 'untyped' attribute.
+
+	* gfortran.h (gfc_expr): Move 'operator', 'op1', 'op2', and 'uop'
+	fields into new struct 'op' inside the 'value' union.
+	* arith.c (eval_intrinsic): Adapt all users.
+	* dependency.c (gfc_check_dependency): Likewise.
+	* dump-parse-tree.c (gfc_show_expr): Likewise.
+	* expr.c (gfc_get_expr): Don't clear removed fields.
+	(free_expr0, gfc_copy_expr, gfc_type_convert_binary,
+	gfc_is_constant_expr, simplify_intrinsic_op, check_init_expr,
+	check_intrinsic_op): Adapt to new field names.
+	* interface.c (gfc_extend_expr): Likewise.  Also explicitly
+	nullify 'esym' and 'isym' fields of new function call.
+	* iresolve.c (gfc_resolve_dot_product, gfc_resolve_matmul):
+	Adapt to renamed structure fields.
+	* matchexp.c (build_node, match_level_1, match_expr): Likewise.
+	* module.c (mio_expr): Likewise.
+	* resolve.c (resolve_operator): Likewise.
+	(gfc_find_forall_index): Likewise.  Only look through operands
+	if dealing with EXPR_OP
+	* trans-array.c (gfc_walk_op_expr): Adapt to renamed fields.
+	* trans-expr.c (gfc_conv_unary_op, gfc_conv_power_op,
+	gfc_conv_concat_op, gfc_conv_expr_op): Likewise.
+
+	[ Reverted ]
+	* gfortran.h (gfc_component, gfc_actual_arglist, gfc_user_op): Make
+	'name' a 'const char *'.
+	(gfc_symbol): Likewise, also for 'module'.
+	(gfc_symtree): Make 'name' a 'const char *'.
+	(gfc_intrinsic_sym): Likewise, also for 'lib_name'.
+	(gfc_get_gsymbol, gfc_find_gsymbol): Add 'const' qualifier to
+	'char *' argument.
+	(gfc_intrinsic_symbol): Use 'gfc_get_string' instead of 'strcpy' to
+	initialize 'SYM->module'.
+	* check.c (gfc_check_minloc_maxloc, check_reduction): Check for NULL
+	pointer instead of empty string.
+	* dump-parse-tree.c (gfc_show_actual_arglist): Likewise.
+	* interface.c (gfc_compare_types): Adapt check to account for possible
+	NULL pointer.
+	(compare_actual_formal): Check for NULL pointer instead of empty
+	string.
+	* intrinsic.c (gfc_current_intrinsic, gfc_current_intrinsic_arg):
+	Add 'const' qualifier.
+	(conv_name): Return a heap allocated string.
+	(find_conv): Add 'const' qualifier to 'target'.
+	(add_sym): Use 'gfc_get_string' instead of 'strcpy'.
+	(make_generic): Check for NULL pointer instead of empty	string.
+	(make_alias): Use 'gfc_get_string' instead of 'strcpy'.
+	(add_conv): No need to strcpy result from 'conv_name'.
+	(sort_actual): Check for NULL pointer instead of empty	string.
+	* intrinsic.h (gfc_current_intrinsic, gfc_current_intrinsic_arg):
+	Adapt prototype.
+	* module.c (compare_true_names): Compare pointers instead of strings
+	for 'module' member.
+	(find_true_name): Initialize string fields with gfc_get_string.
+	(mio_pool_string): New function.
+	(mio_internal_string): Adapt comment.
+	(mio_component_ref, mio_component, mio_actual_arg): Use
+	'mio_pool_string' instead of 'mio_internal_string'.
+	(mio_symbol_interface): Add 'const' qualifier to string arguments.
+	Add level of indirection. Use 'mio_pool_string' instead of
+	'mio_internal_string'.
+	(load_needed, read_module): Use 'gfc_get_string' instead of 'strcpy'.
+	(write_common, write_symbol): Use 'mio_pool_string' instead of
+	'mio_internal_string'.
+	(write_symbol0, write_symbol1): Likewise, also check for NULL pointer
+	instead of empty string.
+	(write_operator, write_generic): Pass correct type variable to
+	'mio_symbol_interface'.
+	(write_symtree): Use 'mio_pool_string' instead of
+	'mio_internal_string'.
+	* primary.c (match_keyword_arg): Adapt check to possible
+	case of NULL pointer.  Use 'gfc_get_string' instead of 'strcpy'.
+	* symbol.c (gfc_add_component, gfc_new_symtree, delete_symtree,
+	gfc_get_uop, gfc_new_symbol): Use 'gfc_get_string' instead of
+	'strcpy'.
+	(ambiguous_symbol): Check for NULL pointer instead of empty string.
+	(gfc_find_gsymbol, gfc_get_gsymbol): Add 'const' qualifier on string
+	arguments.
+	* trans-array.c (gfc_trans_auto_array_allocation): Check for NULL
+	pointer instead of empty string.
+	* trans-decl.c (gfc_sym_mangled_identifier,
+	gfc_sym_mangled_function_id, gfc_finish_var_decl, gfc_get_symbol_decl,
+	gfc_get_symbol_decl): Likewise.
+	* trans-io.c (gfc_new_nml_name_expr): Add 'const' qualifier to
+	argument.  Copy string instead of pointing to it.
+
+2005-02-23  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* intrinsic.h, st.c: Update copyright.
+
+2005-02-20  Steven G. Kargl  <kargls@comcast.net>
+
+	* symbol.c: Typos in comments.
+
+2005-02-20  Steven G. Kargl  <kargls@comcast.net>
+
+	* expr.c (gfc_type_convert_binary): Typo in comment.
+
+2005-02-19  Steven G. Kargl  <kargls@comcast.net>
+
+	* check.c (gfc_check_selected_int_kind): New function.
+	* intrinsic.h: Prototype it.
+	* intrinsic.c (add_function): Use it.
+	* simplify (gfc_simplify_ceiling,gfc_simplify_floor): Change
+	  BT_REAL to BT_INTEGER and use gfc_default_integer_kind.
+
+2005-02-19  Steven G. Kargl  <kargls@comcast.net>
+
+	* check.c (gfc_check_int): improve checking of optional kind
+	* simplify.c (gfc_simplify_int): Change BT_REAL to BT_INTEGER
+
+2005-02-19  Steven G. Kargl  <kargls@comcast.net>
+
+	* check.c (gfc_check_achar): New function
+	* intrinsic.h: Prototype it.
+	* intrinsic.c (add_function): Use it.
+
+2005-02-13  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-stmt.c (generate_loop_for_temp_to_lhs,
+	generate_loop_for_rhs_to_temp): Remove if whose condition is
+	always true.
+
+2005-02-12  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* symbol.c (gfc_use_ha_derived): Remove, fold functionality into ...
+	(gfc_use_derived): ... this function.
+
+2005-02-09  Richard Henderson  <rth@redhat.com>
+
+	* f95-lang.c (gfc_init_builtin_functions): Call
+	build_common_builtin_nodes; do not define any functions handled
+	by it.
+
+2005-02-08  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* expr.c (gfc_copy_expr): Don't copy 'op1' and 'op2' for
+	EXPR_SUBSTRING.
+	(gfc_is_constant_expr): Check 'ref' to determine if substring
+	reference is constant.
+	(gfc_simplify_expr): Simplify 'ref' instead of 'op1' and 'op2'.
+	(check_init_expr, check_restricted): Check 'ref' instead of 'op1'
+	and 'op2'.
+	* module.c (mio_expr): Read / write 'ref' instead of 'op1' and 'op2'.
+
+2005-02-07  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.h (gfc_add_dimension, gfc_add_result, gfc_add_save,
+	gfc_add_dummy, gfc_add_generic, gfc_add_in_common, gfc_add_data,
+	gfc_add_in_namelist, gfc_add_sequence, gfc_add_function,
+	gfc_add_subroutine, gfc_add_access, gfc_add_flavor, gfc_add_entry,
+	gfc_add_procedure): Add argument.
+	* array.c (gfc_set_array_spec), decl.c (var_element, get_proc_name,
+	gfc_match_null, match_type_spec, match_attr_spec,
+	gfc_match_formal_arglist, match_result, gfc_match_function_decl):
+	Update callers to match.
+	(gfc_match_entry): Likewise, fix comment typo.
+	(gfc_match_subroutine, attr_decl1, gfc_add_dimension,
+	access_attr_decl, do_parm, gfc_match_save, gfc_match_modproc,
+	gfc_match_derived_decl): Update callers.
+	* interface.c (gfc_match_interface): Likewise.
+	* match.c (gfc_match_label, gfc_add_flavor,
+	gfc_match_call, gfc_match_common, gfc_match_block_data,
+	gfc_match_namelist, gfc_match_module, gfc_match_st_function):
+	Likewise.
+	* parse.c (parse_derived, parse_interface, parse_contained),
+	primary.c (gfc_match_rvalue, gfc_match_variable): Likewise.
+	* resolve.c (resolve_formal_arglist, resolve_entries): Update callers.
+	* symbol.c (check_conflict, check_used): Add new 'name' argument,
+	use when printing error message.
+	(gfc_add_dimension, gfc_add_result, gfc_add_save, gfc_add_dummy,
+	gfc_add_generic, gfc_add_in_common, gfc_add_data,
+	gfc_add_in_namelist, gfc_add_sequence, gfc_add_function,
+	gfc_add_subroutine, gfc_add_access, gfc_add_flavor, gfc_add_entry,
+	gfc_add_procedure): Add new 'name' argument.  Pass along to
+	check_conflict and check_used.
+	(gfc_add_allocatable, gfc_add_external, gfc_add_intrinsic,
+	gfc_add_optional, gfc_add_pointer, gfc_add_target, gfc_add_elemental,
+	gfc_add_pure, gfc_add_recursive, gfc_add_intent,
+	gfc_add_explicit_interface, gfc_copy_attr): Pass NULL for new
+	argument in calls to any of the modified functions.
+
+2005-02-06  Joseph S. Myers  <joseph@codesourcery.com>
+
+	* gfortran.texi: Don't give last update date.
+
+2005-01-30  Richard Henderson  <rth@redhat.com>
+
+	* options.c (gfc_init_options): Zero flag_errno_math.
+
+2005-01-29  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/18565
+	* check.c (real_or_complex_check): New function.
+	(gfc_check_fn_c, gfc_check_fn_r, gfc_check_fn_rc): New functions.
+	* intrinsic.c (add_functions): Use new check functions.
+	* intrinsic.h (gfc_check_fn_c, gfc_check_fn_r, gfc_check_fn_rc):
+	Add prototypes.
+
+2005-01-29  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/19589
+	* expr.c (gfc_check_assign):  Check for conformance of logical operands
+
+2005-01-27  Steven Bosscher  <stevenb@suse.de>
+
+	* trans-decl.c (gfc_build_label_decl): Set DECL_ARTIFICAL and
+	TREE_USED for all labels.
+	(gfc_trans_entry_master_switch): Use it instead of building a
+	label by hand.
+	* trans-io.c (add_case): Likewise.
+	* trans-stmt.c (gfc_trans_integer_select): Likewise.
+
+2005-01-23  Paul Brook  <paul@codesourcery.com>
+	Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/17941
+	* arith.c (gfc_convert_real): Remove sign handling.
+	* primary.c (match_digits): Allow whitespace after initial sign.
+	(match_real_const): Handle signs here.  Allow whitespace after
+	initial sign.  Remove dead code.
+	(match_const_complex_part): Remove.
+	(match_complex_part): Use match_{real,integer}_const.
+	(match_complex_constant): Cross-promote integer types.
+
+2005-01-23  James A. Morrison  <phython@gcc.gnu.org>
+
+	PR fortran/19294
+	* iresolve.c (gfc_resolve_transpose): Resolve to transpose_c4 or
+	transpose_c8 for complex types.
+
+2005-01-23  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* data.c, dependency.c, f95-lang.c, io.c, trans-array.c,
+	trans-decl.c, trans-expr.c, trans-intrinsic.c, trans-io.c,
+	trans-stmt.c, trans-types.c, trans.h: Fix comment typos.
+	Follow spelling conventions.
+
+2005-01-22  Bud Davis  <bdavis9659@comcast.net>
+
+	PR fortran/19313
+	* trans-io.c (gfc_trans_inquire): Added code to support
+	pad.
+
+2005-01-22  Steven G. Kargl  <kargls@comcast.net>
+
+	* intrinsic.c (make_alias):  Add standard argument.
+	(add_functions): Update make_alias calls.
+
+2005-01-22  Paul Brook  <paul@codesourcery.com>
+
+	* trans-expr.c (gfc_conv_function_call): Remove bogus TODO.
+
+2005-01-22  Paul Brook  <paul@codesourcery.com>
+
+	* gfortran.h (gfc_check_access): Add prototype.
+	* match.c (gfc_match_namelist): Remove TODO.
+	* module.c (check_access): Rename ...
+	(gfc_check_access): ... to this.  Boolify.  Update callers.
+	* resolve.c (resolve_symbol): Check for private objects in public
+	namelists.
+
+2005-01-22  Paul Brook  <paul@codesourcery.com>
+
+	* primary.c (gfc_match_rvalue): Only apply implicit type if variable
+	does not have an explicit type.
+	(gfc_match_variable): Resolve implicit derived types in all cases.
+	Resolve contained function types from their own namespace, not the
+	parent.
+	* resolve.c (resolve_contained_fntype): Remove duplicate sym->result
+	checking.  Resolve from the contained namespace, not the parent.
+
+2005-01-22  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/19543
+	* trans-const.c (gfc_conv_constant_to_tree): Give logical
+	constants the correct type.
+
+	PR fortran/19194
+	* trans-io.c (ADD_STRING): Use gfc_charlen_type_node for string
+	length parameters.
+	(gfc_build_io_library_fndecls): 'rec' and 'recl_in' are not
+	pointer fields.
+
+2005-01-18  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* arith.c, array.c, check.c, decl.c, expr.c, f95-lang.c,
+	gfortran.h, interface.c, intrinsic.c, io.c, iresolve.c,
+	match.c, matchexp.c, misc.c, module.c, options.c, parse.c,
+	scanner.c, simplify.c, symbol.c, trans-array.c, trans-expr.c,
+	trans-io.c, trans-stmt.c, trans.c: Update copyright.
+
+2005-01-17  Ira Rosen  <irar@il.ibm.com>
+
+	* f95-lang.c (gfc_init_builtin_functions): Call targetm.init_builtins.
+
+2005-01-16  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/19182
+	* error.c (error_char): Line-buffer errors / warnings.
+
+2005-01-16  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_ishft): Fix signed /
+	unsigned issue.  Use build_int_cst instead of converting
+	integer_zero_node.  Remove unnecessary conversion.
+
+	* trans-types.c (gfc_get_character_type_len): Use
+	gfc_charlen_type_node as basic type for the range field.
+
+	* trans-intrinsic.c (build_fixbound_expr,
+	gfc_conv_intrinsic_bound, gfc_conv_intrinsic_anyall,
+	gfc_conv_intrinsic_count, gfc_conv_intrinsic_btest,
+	gfc_conv_intrinsic_singlebitop): Use 'build_int_cst' instead
+	of converting 'integer_zero_node' or 'integer_one_node'
+	respectively.
+	(gfc_conv_intrinsic_ishftc): Same, but store in local variable to
+	evade re-building.
+	(gfc_conv_intrinsic_strcmp, gfc_conv_intrinsic_rrspacing,
+	gfc_conv_intrinsic_trim, gfc_conv_intrinsic_iargc): Use
+	'build_int_cst' instead of converting 'integer_zero_node' or
+	'integer_one_node' respectively.
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_index,
+	gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove
+	'gfc'-prefix from local variable, remove dead code, use correct
+	type when inserting argument.
+
+	* trans-intrinsic.c, trans-types.c: Update copyright years.
+
+2005-01-16  Steven G. Kargl  <kargls@comcast.net>
+
+	PR 19168
+	* resolve.c (check_case_overlap): Typo in comment.
+	(validate_case_label_expr):  Fix up kinds of case values
+	(resolve_select): Properly handle kind mismatches.
+
+2005-01-16  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/17675
+	* trans-common.c (translate_common): Remove duplicate function call.
+	(finish_equivalences): Preserve alignment when biasing offsets.
+
+2005-01-15  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de
+
+	* primary.c (check_digit): Call 'ISXDIGIT' instead of assuming
+	ASCII-like character encoding.
+
+2005-01-14  Steven G. Kargl  <kargls@comcast.net>
+
+	* resolve.c (compare_case): Cleanup.
+
+2005-01-14  Steven G. Kargl  <kargls@comcast.net>
+
+	* resolve.c (compare_case): Give arguments correct type.
+
+2005-01-13  Kazu Hirata  <kazu@cs.umass.edu>
+
+	* iresolve.c, trans-common.c, trans-types.c: Fix comment
+	typos.
+
+2005-01-09  Paul Brook  <paul@codesourcery.com>
+
+	PR fortran/17675
+	* trans-common.c (current_common, current_offset): Remove.
+	(create_common): Add head argument.
+	(align_segment): New function.
+	(apply_segment_offset): New function.
+	(translate_common): Merge code from new_segment.  Handle alignment.
+	(new_segment): Remove.
+	(finish_equivalences): Ensure proper alignment.
+
+2005-01-08  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-const.c: Don't include unused math.h.
+
+	* trans-intrinsic.c (gfc_get_intrinsic_lib_fndecl,
+	gfc_conv_intrinsic_bound, gfc_conv_intrinsic_minmaxloc,
+	gfc_conv_intrinsic_ishft, gfc_conv_intrinsic_len): Remove
+	trailing whitespace.
+	(prepare_arg_info): Fix formatting, indenting and remove trailing
+	whitespace.
+	(gfc_conv_intrinsic_spacing, gfc_conv_intrinsic_trim): Remove
+	trailing whitespace.
+
+	* arith.c (arctangent2, gfc_arith_init_1, gfc_arith_done_1,
+	gfc_constant_result, gfc_range_check, gfc_arith_power,
+	eval_type_intrinsic0, eval_intrinsic_f2, gfc_real2real,
+	gfc_real2complex, gfc_complex2int, gfc_complex2real,
+	gfc_complex2complex): Fix whitespace issues.
+	* check.c (must_be, type_check, numeric_check, int_or_real_check,
+	logical_array_check, array_check, scalar_check, nonoptional_check,
+	variable_check, dim_check, check_a_kind, gfc_check_a_ikind,
+	gfc_check_a_xkind, gfc_check_abs, gfc_check_all_any,
+	gfc_check_allocated, gfc_check_a_p, gfc_check_besn,
+	gfc_check_btest, gfc_check_char, gfc_check_cmplx, gfc_check_count,
+	gfc_check_cshift, gfc_check_dcmplx, gfc_check_dble,
+	gfc_check_digits, gfc_check_dot_product, gfc_check_eoshift,
+	gfc_check_fnum, gfc_check_g77_math1, gfc_check_huge, gfc_check_i,
+	gfc_check_iand, gfc_check_ibclr, gfc_check_ibits, gfc_check_ibset,
+	gfc_check_idnint, gfc_check_ieor, gfc_check_index, gfc_check_int,
+	gfc_check_ior, gfc_check_ishft, gfc_check_ishftc, gfc_check_kind,
+	gfc_check_lbound, gfc_check_logical, min_max_args,
+	gfc_check_min_max_integer, gfc_check_min_max_real,
+	gfc_check_min_max_double, gfc_check_matmul,
+	gfc_check_minval_maxval, gfc_check_merge, gfc_check_nearest,
+	gfc_check_pack, gfc_check_precision, gfc_check_radix,
+	gfc_check_range, gfc_check_real, gfc_check_repeat,
+	gfc_check_scale, gfc_check_scan, gfc_check_selected_real_kind,
+	gfc_check_set_exponent): Fix formatting issues.
+	(gfc_check_size, gfc_check_sign): Alphabetize function order,
+	remove whitespace-only line.
+	(gfc_check_fstat, gfc_check_fstat_sub, gfc_check_stat,
+	gfc_check_stat_sub, gfc_check_transfer, gfc_check_transpose,
+	gfc_check_ubound, gfc_check_unpack, gfc_check_verify, gfc_check_x,
+	gfc_check_cpu_time, gfc_check_date_and_time, gfc_check_mvbits,
+	gfc_check_random_number, gfc_check_random_seed,
+	gfc_check_second_sub, gfc_check_system_clock,
+	gfc_check_getcwd_sub, gfc_check_exit, gfc_check_flush,
+	gfc_check_umask, gfc_check_umask_sub, gfc_check_unlink,
+	gfc_check_unlink_sub): Fix formatting issues.
+
+2005-01-08  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.h: Remove outdated comment.  Don't include stdio.h
+	explicitly.
+
+2005-01-06  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortranspec.c (lang_specific_driver): Change year to 2005 in
+	output of 'gfortran --version'.
+
+2005-01-03  Steven G. Kargl  <kargls@comcast.net>
+
+	* arith.c: Add system.h; remove string.h
+	* decl.c: Ditto
+	* matchexp.c: Ditto
+	* parse.c: Ditto
+	* resolve.c: Ditto
+	* st.c: Ditto
+	* check.c: Remove stdlib.h and stdarg.h
+	* error.c: Remove stdlib.h, stdarg.h, stdio.h, string.h
+	* expr.c: Add system.h; remove stdarg.h, stdio.h, and string.h
+	* f95-lang.c: Add system.h; remove stdio.h
+	* interface.c: Add system.h; remove stdlib.h and string.h
+	* intrinsic.c: Remove stdarg.h, stdio.h, and string.h
+	* io.c: Remove string.h
+	* simplify.c: Ditto
+	* match.c: Remove stdarg.h and string.h
+	* misc.c: Update copyright; add system.h; remove stdlib.h,
+	string.h, and sys/stat.h
+	* module.c: Add system.h; remove string.h, stdio.h, errno.h,
+	unistd.h, and time.h
+	* option.c: Remove string.h and stdlib.h
+	* primary.c: Ditto
+	* scanner.c: Update copyright; add system.h; remove stdlib.h,
+	stdio.h, string.h, and strings.h
+	* symbol.c: Add system.h; remove stdlib.h, stdio.h, and string.h
+	* trans-array.c: Remove stdio.h and gmp.h
+	* trans-const.c: Ditto
+	* trans-expr.c: Ditto
+	* trans-io.c: Ditto
+	* trans-stmt.c: Ditto
+	* trans.c: Ditto
+	* trans-intrinsic.c: Remove stdio.h and string.h
+
+
+Copyright (C) 2005 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved.
diff --git a/gcc/fortran/ChangeLog-2006 b/gcc/fortran/ChangeLog-2006
new file mode 100644
index 000000000..4e83f38fe
--- /dev/null
+++ b/gcc/fortran/ChangeLog-2006
@@ -0,0 +1,4545 @@
+2006-12-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/27900
+	* resolve.c (resolve_actual_arglist): If all else fails and a
+	procedure actual argument has no type, see if a specific
+	intrinsic matches.
+
+	PR fortran/24325
+	* resolve.c (resolve_function): If the function reference is
+	FL_VARIABLE this is an error.
+
+2006-12-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/23060
+	* intrinsic.c (compare_actual_formal ): Distinguish argument
+	list functions from keywords.
+	* intrinsic.c (sort_actual): If formal is NULL, the presence of
+	an argument list function actual is an error.
+	* trans-expr.c (conv_arglist_function) : New function to
+	implement argument list functions %VAL, %REF and %LOC.
+	(gfc_conv_function_call): Call it.
+	* resolve.c (resolve_actual_arglist): Add arg ptype and check
+	argument list functions.
+	(resolve_function, resolve_call): Set value of ptype before
+	calls to resolve_actual_arglist.
+	* primary.c (match_arg_list_function): New function.
+	(gfc_match_actual_arglist): Call it before trying for a
+	keyword argument.
+
+2006-12-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30034
+	* resolve.c (resolve_formal_arglist): Exclude the test for
+	pointers and procedures for subroutine arguments as well as
+	functions.
+
+	PR fortran/30237
+	* intrinsic.c (remove_nullargs): Do not pass up arguments with
+	a label. If the actual has a label and the formal has a type
+	then emit an error.
+
+2006-12-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/30014
+	*io.c (resolve_tag): Don't issue error for tag_size type not being
+	default integer size for -std=F2003.  Add similar check for
+	tag_iolength.
+	*ioparm.def: Change size and iolength parameters to ioint pointer, which
+	corresponds to GFC_IO_INT on the library side.
+
+2006-12-27  Gerald Pfeifer  <gerald@pfeifer.com>
+
+	* interface.c (compare_actual_formal): Remove unused variable
+	gsym.
+
+2006-12-27  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/20896
+	* interface.c (check_sym_interfaces): Try to resolve interface
+	reference as a global symbol, if it is not a nodule procedure.
+	(compare_actual_formal): Remove call to gfc_find_symbol; if
+	the expression is already a variable it is locally declared
+	and this has precedence.
+	gfortran.h : Add prototype for resolve_global_procedure.
+	resolve.c (resolve_global_procedure): Remove static attribute
+	from function declaration.
+	(resolve_fl_procedure): Remove symtree declaration and the
+	redundant check for an ambiguous procedure.
+
+	PR fortran/25135
+	* module.c (load_generic_interfaces): If the symbol is present
+	and is not generic it is ambiguous.
+
+2006-12-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25818
+	* trans-array.c (gfc_trans_g77_array): If the variable is
+	optional or not always present, make the statement conditional
+	on presence of the argument.
+	* gfortran.h : Add symbol_attribute not_always_present.
+	* resolve.c (check_argument_lists): New function to check if
+	arguments are not present in all entries.
+
+	PR fortran/30084
+	* module.c (mio_component_ref): Move treatment of unique name
+	variables, during output, to fix_mio_expr.
+	(fix_mio_expr): New function that fixes defective expressions
+	before they are written to the module file.
+	(mio_expr): Call the new function.
+	(resolve_entries): Call check_argument_lists.
+
+2006-12-21  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-array.c (gfc_trans_create_temp_array): When the size is known
+	at compile-time, avoid an unnecessary conditional assignment.
+	(gfc_array_init_size): Likewise.
+
+2006-12-22  Kazu Hirata  <kazu@codesourcery.com>
+
+	* interface.c: Fix a comment typo.
+
+2006-12-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30273
+	* dependency.c (gfc_check_dependency): There is no dependency
+	with EXPR_NULL so always return 0.
+
+2006-12-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30202
+	* trans-array.c (gfc_conv_function_call): Use parmse.expr for
+	the nullifying of intent(out) arguments rather than the backend
+	declaration.
+
+2006-12-20  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/25392
+	* trans-stmt.c (gfc_trans_return): Fix comment formatting.
+	* trans-types.c (gfc_sym_type): Don't return early for functions.
+	Remove special handling for -ff2c.
+	(gfc_get_function_type): Add special handling for -ff2c.
+	* trans-decl.c (gfc_create_function_decl): Fix comment formatting.
+	(gfc_get_fake_result_decl): Make sure we get the right type for
+	functions.
+	(gfc_generate_function_code): Convert type of result variable to
+	type of function.
+
+2006-12-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30190
+	* trans-array.c (gfc_conv_array_ref): Remove gfc_evaluate_now
+	from the -fbounds-check branch.
+
+2006-12-20  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-expr.c (is_zero_initializer_p): Determine whether a given
+	constant expression is a zero initializer.
+	(gfc_trans_zero_assign): New function to attempt to optimize
+	"a(:) = 0.0" as a call to __builtin_memset (a, 0, sizeof(a));
+	(gfc_trans_assignment): Special case array assignments to a
+	zero initializer constant, using gfc_trans_zero_assign.
+
+2006-12-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29992
+	* interface.c (check_sym_interfaces): Module procedures in a
+	generic must be use associated or contained in the module.
+	* decl.c (gfc_match_modproc): Set attribute mod_proc.
+	* gfortran.h (symbol_attribute): Add mod_proc atribute.
+
+	PR fortran/30081
+	* resolve.c (resolve_generic_f, resolve_generic_s): Use
+	gfc_intrinsic_name to find out if the function is intrinsic
+	because it does not have to be a generic intrinsic to be
+	overloaded.
+
+2006-12-19  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/39238
+	* trans-intrinsic.c: Check for associated(NULL,NULL). 
+
+2006-12-19  Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/30236
+	* interface.c (compare_interfaces): Handle NULL symbols.
+	(count_types_test): Count NULL symbols, which correspond to
+	alternate returns.
+
+	(check_interface1): Change final argument from int to bool
+	in the function and all references.
+
+2006-12-18  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-array.c (gfc_conv_array_index_offset): Avoid multiplying
+	index by one, or adding zero to it.
+
+2006-12-17  Roger Sayle  <roger@eyesopen.com>
+
+	PR fortran/30207
+	* dependency.c (gfc_full_array_ref_p): New function to test whether
+	the given array ref specifies the entire array.
+	(gfc_dep_resolver): Use gfc_full_array_ref_p to analyze AR_FULL
+	array refs against AR_SECTION array refs, and vice versa.
+	* dependency.h (gfc_full_array_ref_p): Prototype here.
+	* trans-array.c (gfc_conv_expr_descriptor): Use gfc_full_array_ref_p.
+
+2006-12-16  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* gfortran.texi: Added TeX support for document parts;
+	rearranged existing text into "About GNU Fortran",
+	"Invoking GNU Fortran", and "Language Reference" parts.
+
+2006-12-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/30200
+	* trans-io.c (build_dt): Move post block for format_expr to end.
+
+2006-12-14  Richard Guenther  <rguenther@suse.de>
+	    Diego Novillo  <dnovillo@redhat.com>
+
+	* Make-lang.in (fortran/options.o): Add $(PARAMS_H) dependency.
+	* options.c (params.h): Include.
+	(gfc_post_options): Set MAX_ALIASED_VOPS to 50.
+
+2006-12-13  Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/30115
+	* trans-array.c (gfc_array_allocate): Adjust for changed
+	library interface.
+	(gfc_array_deallocate): Likewise.
+	(gfc_trans_dealloc_allocated): Likewise.
+	* trans-stmt.c (gfc_trans_allocate): Likewise.
+	(gfc_trans_deallocate): Likewise.
+	* trans-decl.c (gfc_build_builtin_function_decls): Adjust
+	function declarations to match the library changes.  Mark
+	allocation functions with DECL_IS_MALLOC.
+
+2006-12-12  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* trans-expr.c (gfc_conv_substring): Check for empty substring.
+
+2006-12-11  Jan Hubicka  <jh@suse.cz>
+
+	* f95-lang.c (gfc_expand_function): Update for renamed varpool
+	functions.
+
+2006-12-10  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi: Update Fortran 2003 section.
+
+2006-12-10  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/23994
+	* interface.c (compare_actual_formal): PROTECTED is incompatible
+	  with intent(out).
+	* symbol.c (check_conflict): Check for PROTECTED conflicts.
+	  (gfc_add_protected): New function.
+	  (gfc_copy_attr): Copy PROTECTED attribute.
+	* decl.c (match_attr_spec): Add PROTECTED support.
+	  (gfc_match_protected): New function.
+	* dump-parse-tree.c (gfc_show_attr): Add PROTECTED support.
+	* gfortran.h (gfc_symbol): Add protected flag.
+	  Add gfc_add_protected prototype.
+	* expr.c (gfc_check_pointer_assign): Add PROTECTED support.
+	* module.c (ab_attribute, attr_bits, mio_symbol_attribute,
+	  mio_symbol_attribute): Add PROTECTED support.
+	* resolve.c (resolve_equivalence): Add PROTECTED support.
+	* match.c (gfc_match_assignment,gfc_match_pointer_assignment):
+	  Check PROTECTED attribute.
+	* match.h: Add gfc_match_protected prototype.
+	* parse.c (decode_statement): Match PROTECTED statement.
+	* primary.c (match_variable): Add PROTECTED support.
+
+2006-12-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29975
+	PR fortran/30068
+	PR fortran/30096
+	* interface.c (compare_type_rank_if): Reject invalid generic
+	interfaces.
+	(check_interface1): Give a warning for nonreferred to ambiguous
+	interfaces.
+	(check_sym_interfaces): Check whether an ambiguous interface is
+	referred to.  Do not check host associated interfaces since these
+	cannot be ambiguous with the local versions.
+	(check_uop_interface, gfc_check_interfaces): Update call to
+	check_interface1.
+	* symbol.c (gfc_get_sym_tree, gfc_get_sym_tree): Allow adding
+	unambiguous procedures to generic interfaces.
+	* gfortran.h (symbol_attribute): Added use_only and
+	ambiguous_interfaces.
+	* module.c (load_need): Set the use_only flag, if needed.
+	* resolve.c (resolve_fl_procedure): Warn for nonreferred
+	interfaces.
+	* expr.c (find_array_section): Fix initializer array contructor.
+
+2006-12-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29464
+	* module.c (load_generic_interfaces): Add symbols for all the
+	local names of an interface.  Share the interface amongst the
+	symbols.
+	* gfortran.h : Add generic_copy to symbol_attribute.
+	* symbol.c (free_symbol): Only free interface if generic_copy
+	is not set.
+
+2006-12-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29941
+	* resolve.c (resolve_function): Add LEN to the functions not
+	checked for assumed size actual args.
+
+2006-12-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/27546
+	* trans-decl.c (gfc_create_module_variable): Allow imported
+	symbols in interface bodies in modules.
+
+2006-12-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/29711
+	* error.c (error_print): Fix handling of printf-style position
+	specifiers of the form "%3$d".
+
+2006-12-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30003
+	* trans-array.c (gfc_trans_create_temp_array): Set the section
+	ends to zero.
+	(gfc_conv_array_transpose): Likewise.
+	(gfc_conv_section_startstride): Declare an expression for end,
+	set it from a the array reference and evaluate it for the info
+	structure. Zero the ends in the ss structure and set end, used
+	in the bounds check, from the info structure.
+	trans.h: Add and end array to the gfc_ss_info structure.
+
+2006-12-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29912
+	* trans-expr.c (gfc_trans_arrayfunc_assign): Return NULL if the
+	lhs and rhs character lengths are not constant and equal for
+	character array valued functions.
+
+2006-12-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/29962
+	* expr.c (check_intrinsic_op): Allow noninteger exponents for F2003.
+
+2006-12-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29821
+	* resolve.c (resolve_operator): Only return result of
+	gfc_simplify_expr if expression is constant.
+
+2006-12-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29916
+	* resolve.c (resolve_symbol): Allow host-associated variables
+	  the specification expression of an array-valued function.
+	* expr.c (check_restricted): Accept host-associated dummy
+	  array indices.
+
+2006-12-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29642
+	* trans-expr.c (gfc_conv_variable): A character expression with
+	the VALUE attribute needs an address expression; otherwise all
+	other expressions with this attribute must not be dereferenced.
+	(gfc_conv_function_call): Pass expressions with the VALUE
+	attribute by value, using gfc_conv_expr.
+	* symbol.c (check_conflict): Add strings for INTENT OUT, INOUT
+	and VALUE.  Apply all the constraints associated with the VALUE
+	attribute.
+	(gfc_add_value): New function.
+	(gfc_copy_attr): Call it for VALUE attribute.
+	* decl.c (match_attr_spec): Include the VALUE attribute.
+	(gfc_match_value): New function.
+	* dump-parse-tree.c (gfc_show_attr): Include VALUE.
+	* gfortran.h : Add value to the symbol_attribute structure and
+	add a prototype for gfc_add_value
+	* module.c (mio_internal_string): Include AB_VALUE in enum.
+	(attr_bits): Provide the VALUE string for it.
+	(mio_symbol_attribute): Read or apply the VLUE attribute.
+	* trans-types.c (gfc_sym_type): Variables with the VLAUE
+	attribute are not passed by reference!
+	* resolve.c (was_declared): Add value to those that return 1.
+	(resolve_symbol): Value attribute requires dummy attribute.
+	* match.h : Add prototype for gfc_match_public.
+	* parse.c (decode_statement): Try to match a VALUE statement.
+
+2006-12-01  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR libfortran/29568
+	* gfortran.h (gfc_option_t):  Add max_subrecord_length.
+	(top level): Define MAX_SUBRECORD_LENGTH.
+	* lang.opt:  Add option -fmax-subrecord-length=.
+	* trans-decl.c:  Add new function set_max_subrecord_length.
+	(gfc_generate_function_code): If we are within the main
+	program and max_subrecord_length has been set, call
+	set_max_subrecord_length.
+	* options.c (gfc_init_options):  Add defaults for
+	max_subrecord_lenght, convert and record_marker.
+	(gfc_handle_option):  Add handling for
+	-fmax_subrecord_length.
+	* invoke.texi:  Document the new default for
+	-frecord-marker=<n>.
+
+2006-11-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29976
+	* trans-expr.c (gfc_conv_missing_dummy): Remove build_int_const
+	and replace with cast to type of se->expr of integer_zero_node.
+
+2006-11-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/20880
+	* resolve.c (resolve_fl_procedure): Error if procedure is
+	ambiguous modified to require attr.referenced.
+
+2006-11-26  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/29892
+	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Use a locus in
+	the call to gfc_trans_runtime_check.
+	* trans-array.c (gfc_trans_array_bound_check): Try harder to find
+	the variable or function name for the runtime error message.
+	(gfc_trans_dummy_array_bias): Use a locus in the call to
+	gfc_trans_runtime_check
+
+2006-11-26  Andrew Pinski  <pinskia@gmail.com>
+
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Mark the
+	pow functions as constant functions.
+
+2006-11-25  Andrew Pinski  <pinskia@gmail.com>
+
+	PR fortran/29982
+	* trans-expr.c (gfc_conv_expr_reference): Strip off NOP_EXPRs.
+
+2006-11-25  Andrew Pinski  <pinskia@gmail.com>
+
+	PR fortran/29951
+	* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Change to
+	call memcpy instead of creating a VIEW_CONVERT_EXRP.
+
+2006-11-25  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/29711
+	* error.c (error_print): Handle printf-style position specifiers,
+	of the form "%3$d".
+
+2006-11-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/20880
+	* parse.c (parse_interface): Error if procedure name is that of
+	encompassing scope.
+	* resolve.c (resolve_fl_procedure): Error if procedure is
+	ambiguous.
+
+	PR fortran/29387
+	* interface.c (compare_actual_formal): Add missing condition
+	that 'where' be present for error that asserts that actual
+	arguments be definable.
+
+2006-11-24  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* resolve.c (resolve_actual_arglist): Remove the special case for
+	CHAR.
+	* intrinsic.c (add_functions): Remove the special case for CHAR.
+
+2006-11-22  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/29441
+	* intrinsic.c (gfc_intrinsic_func_interface): Always check if
+	intrinsic is allowed in initialization expression.
+
+2006-11-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25087
+	* resolve.c (resolve_fl_procedure): Add an error if an external
+	automatic character length function does not have an explicit
+	interface.
+
+2006-11-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29652
+	* interface.c (check_interface1): Use a local value, instead of
+	the dummy, as the inner iterator over interface symbols.
+
+2006-11-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29820
+	* trans-array.c (gfc_get_derived_type): Once done, spread the
+	backend_decl to all identical derived types in all sibling
+	namespaces.
+
+2006-11-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/27546
+	* primary.c (gfc_match_rvalue): Added IMPORT support.
+
+2006-11-20  Tobias Burnus  <burnus@net-b.de>
+
+	* symbol.c (check_conflict): Add conflict between VOLATILE
+	  attribute and program name.
+
+2006-11-20  Bernhard Fischer  <aldot@gcc.gnu.org>
+
+	PR fortran/24783
+	* resolve.c (resolve_variable): Get the implicit type from the
+	symbols namespace rather than the default namespace. Fix whitespace.
+	(resolve_formal_arglist, resolve_equivalence): Fix typo.
+
+2006-11-19  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	* resolve.c (resolve_ref): Check for ALLOCATABLEs to the right of
+	  nonzero rank part references too.
+
+2006-11-19  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* module.c (gfc_use_module): Uncomment the ISO_FORTRAN_ENV code.
+	Check that intrinsic and non-intrinsic modules don't conflict.
+	(use_iso_fortran_env_module): New function.
+	(create_int_parameter): New function.
+	* trans-types.c (gfc_init_kinds): Choose values for
+	gfc_numeric_storage_size and gfc_character_storage_size.
+	(gfc_numeric_storage_size, gfc_character_storage_size): New variables.
+	* resolve.c (resolve_symbol): Do no check intrinsic modules
+	against the list of intrinsic symbols.
+	* iso-fortran-env.def: New file.
+	* gfortran.h (gfc_numeric_storage_size,
+	gfc_character_storage_size): Add prototypes.
+
+2006-11-18  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/24285
+	* io.c (check_format): Allow dollars everywhere in format, and
+	issue a warning.
+
+2006-11-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* gfortran.h (gfc_add_intrinsic_modules_path,
+	gfc_open_intrinsic_module): New prototypes.
+	(gfc_add_include_path, gfc_open_included_file): Update prototypes.
+	* lang.opt: Add -fintrinsic-modules-path option.
+	* module.c (gfc_match_use): Match the Fortran 2003 form of
+	USE statement.
+	(gfc_use_module): Also handle intrinsic modules. 
+	* scanner.c (gfc_directorylist): Add use_for_modules for field.
+	(intrinsic_modules_dirs): New static variable.
+	(add_path_to_list, gfc_add_intrinsic_modules_path): New functions.
+	(gfc_add_include_path): Use the new add_path_to_list helper
+	function.
+	(gfc_release_include_path): Free memory for intrinsic_modules_dirs.
+	(open_included_file, gfc_open_intrinsic_module): New functions.
+	(gfc_open_included_file): Use the new open_included_file
+	helper function.
+	* lang-specs.h: Use the new -fintrinsic-modules-path option.
+	* parse.c (decode_statement): Do not match the required space
+	after USE here.
+	* options.c (gfc_handle_option): Handle the new option. Use new
+	prototype for gfc_add_include_path.
+	(gfc_post_options): Use new prototype for gfc_add_include_path.
+
+2006-11-16  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/29391
+	PR fortran/29489
+	* simplify.c (simplify_bound): Fix the simplification of
+	LBOUND/UBOUND intrinsics.
+	* trans-intrinsic.c (simplify_bound): Fix the logic, and
+	remove an erroneous assert.
+
+2006-11-16  Francois-Xavier Coudert  <fxcoudert@gcc.gnu,org>
+
+	* trans-decl.c (gfc_get_symbol_decl): Fix formatting.
+
+2006-11-15  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* data.c: Remove trailing periods from error messages.
+	* decl.c: Likewise.
+	* expr.c: Likewise.
+	* io.c: Likewise.
+	* match.c: Likewise.
+	* module.c: Likewise.
+	* options.c: Likewise.
+	* resolve.c: Likewise.
+	* symbol.c: Likewise.
+	* trans-io.c: Likewise.
+
+2006-11-15  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* lang.opt: Rearrange entries back into ASCII order.
+
+2006-11-15  Tobias Burnus  <burnus@net-b.de>
+
+	* parse.c (parse_contained): Fix indention
+	  of one line.
+
+2006-11-15  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/27546
+	* decl.c (gfc_match_import,variable_decl):
+	  Add IMPORT support.
+	  (gfc_match_kind_spec): Fix typo in gfc_error.
+	* gfortran.h (gfc_namespace, gfc_statement):
+	  Add IMPORT support.
+	* parse.c (decode_statement,gfc_ascii_statement,
+	  verify_st_order): Add IMPORT support.
+	* match.h: Add gfc_match_import.
+	* gfortran.texi: Add IMPORT to the supported
+	  Fortran 2003 features.
+
+2006-11-15  Tobias Burnus  <burnus@net-b.de>
+	    Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/27588
+	* trans-expr.c (gfc_conv_substring): Add bounds checking.
+	  (gfc_conv_variable, gfc_conv_substring_expr): Pass more
+	  arguments to gfc_conv_substring.
+
+2006-11-15  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/29806
+	* parse.c (parse_contained): Check for empty contains statement.
+
+2006-11-15  Bud Davis <bdavis9659@sbcglobal.net>
+
+	PR fortran/28974
+	* gfortran.h (gfc_expr): Add element which holds a splay-tree
+	for the exclusive purpose of quick access to a constructor by
+	offset.
+	* data.c (find_con_by_offset): Use the splay tree for the search.
+	(gfc_assign_data_value): Use the splay tree.
+	(gfc_assign_data_value_range): ditto.
+	* expr.c (gfc_get_expr): Initialize new element to null.
+	(gfc_free_expr): Delete splay tree when deleting gfc_expr.
+
+2006-11-14  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	PR fortran/29702
+	* error.c (show_loci): Move column-offset calculation to
+	show_locus.
+	(show_locus): Remove blank lines before "Included in"
+	lines, clean up code, calculate column-offsets, print
+	column number is error-header lines as appropriate.
+	(error_integer): (new function) Print integer to error
+	buffer.
+	(error_print): Use error_integer, avoid possible buffer
+	overflows from buggy error formats.
+
+2006-11-14  Brooks Moses  <brooks.moses@codesourcery.com>
+ 
+ 	* gfortran.h (GFC_MAX_LINE): Remove constant definition.
+ 	(gfc_option_t): Clarify comments.
+ 	* options.c: Set default line length limits to actual default
+ 	values, rather than flag values.
+ 	* scanner.c: Eliminate checking and handling of the
+ 	fixed/free_line_length flag values.
+
+2006-11-14  Brooks Moses  <brooks.moses@codesourcery.com>
+ 
+ 	* lang.opt: Remove -fno-backend option.
+ 	* gfortran.h (gfc_option_t): Remove flag_no_backend.
+ 	* options.c (gfc_init_options): Remove flag_no_backend.
+ 	(gfc_handle_option): Remove -fno-backend option handler.
+ 	* parse.c (gfc_parse_file): Remove references to
+ 	gfc_option.flag_no_backend.
+
+2006-11-14  Tobias Burnus  <burnus@net-b.de>
+
+	* match.c (gfc_match_namelist): Add missing space to
+	  error message.
+
+2006-11-14  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/29657
+	* symbol.c (check_conflict): Add further conflicts.
+
+2006-11-13  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/29759
+	* fortran/scanner.c (skip_free_comments): Clear openmp_flag
+	before returning true.
+
+2006-11-12  Andrew Pinski  <andrew_pinski@playstation.sony.com>
+
+	PR fortran/26994
+	* trans-expr.c (gfc_conv_expr_reference): Set TREE_STATIC on the
+	new CONST_DECL.
+
+2006-11-11  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* array.c: Add 2006 to copyright years.
+	* data.c: Same.
+	* interface.c: Same.
+	* misc.c: Same.
+	* trans-io.c: Same.
+
+2006-11-11  Richard Guenther  <rguenther@suse.de>
+
+	* trans-intrinsic.c (enum rounding_mode): New enum.
+	(build_fix_expr, gfc_conv_intrinsic_aint, gfc_conv_intrinsic_mod,
+	gfc_conv_intrinsic_function): Use it instead of FIX_CEIL_EXPR,
+	FIX_FLOOR_EXPR, FIX_ROUND_EXPR and FIX_TRUNC_EXPR.
+
+2006-11-10  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* lang.opt (-fmodule-private): Remove option.
+	* gfortran.h (gfc_option_t): Remove module_access_private flag.
+	* options.c (gfc_init_options): Remove initialization for it.
+	(gfc_handle_option): Remove handling for -fmodule-private.
+	* module.c (gfc_check_access): Add comments, remove check for
+	gfc_option.flag_module_access_private.
+
+2006-11-10 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29758
+	* check.c (gfc_check_reshape): Check that there are enough
+	elements in the source array as to be able to fill an array
+	defined by shape, when pad is absent.
+
+2006-11-10 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29315
+	* trans-expr.c (is_aliased_array): Treat correctly the case where the
+	component is itself and array or array reference.
+
+2006-11-09  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* check.c (same_type_check): Typo fix in comment.
+
+2006-11-09 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29431
+	* trans-array.c    (get_array_ctor_strlen): If we fall through to
+	default, use a constant character length if it is available.
+
+2006-11-09 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29744
+	* trans-types.c (gfc_get_derived_type): Ensure that the
+	proc_name namespace is not the same as the owner namespace and
+	that identical derived types in the same namespace share the
+	same backend_decl.
+
+2006-11-09 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29699
+	* trans-array.c (structure_alloc_comps): Detect pointers to
+	arrays and use indirect reference to declaration.
+	* resolve.c (resolve_fl_variable): Tidy up condition.
+	(resolve_symbol): The same and only add initialization code if
+	the symbol is referenced.
+	* trans-decl.c (gfc_trans_deferred_vars): Call gfc_trans_
+	deferred_array before gfc_trans_auto_array_allocation.
+
+	PR fortran/21370
+	* symbol.c (check_done): Remove.
+	(gfc_add_attribute): Remove reference to check_done and remove
+	the argument attr_intent.
+	(gfc_add_allocatable, gfc_add_dimension, gfc_add_external,
+	gfc_add_intrinsic, gfc_add_optional, gfc_add_pointer,
+	gfc_add_cray_pointer, gfc_add_cray_pointee, gfc_add_result,
+	gfc_add_target, gfc_add_in_common, gfc_add_elemental,
+	gfc_add_pure, gfc_add_recursive, gfc_add_procedure,
+	gfc_add_type): Remove references to check_done.
+	* decl.c (attr_decl1): Eliminate third argument in call to
+	gfc_add_attribute.
+	* gfortran.h : Change prototype for gfc_add_attribute.
+
+2006-11-08  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* invoke.texi: Added documentation for -fmax-errors option.
+
+2006-11-08  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* lang.opt: Add -fmax-errors= option.
+	* gfortran.h (gfc_option_t): Add max_errors element.
+	* options.c (gfc_init_options): Set max_errors default value
+	to 25.
+	(gfc_handle_options): Assign -fmax_errors value to
+	gfc_option.max_errors.
+	* error.c (gfc_increment_error_count): New function, which
+	also checks whether the error count exceeds max_errors.
+	(gfc_warning): Use it.
+	(gfc_warning_now): Use it.
+	(gfc_notify_std): Use it.
+	(gfc_error): Use it.
+	(gfc_error_now): Use it.
+	(gfc_error_check): Use it.
+
+2006-11-08  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* lang.opt: Remove non-working -qkind= option.
+	* gfortran.h (gfc_option_t): Remove q_kind member.
+	* options.c (gfc_init_options): Remove q_kind initialization.
+	(gfc_handle_option): Remove -qkind= option handling.
+	* primary.c: (match_real_constant): Remove 'Q' exponent.
+
+2006-11-08  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi: Add volatile and internal-file
+	  namelist to Fortran 2003 status.
+	* intrinsic.texi: Correct CHMOD entry.
+
+2006-11-07  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29539
+	PR fortran/29634
+	* decl.c (variable_decl): Add test for presence of proc_name.
+	* error.c (gfc_error_flag_test): New function.
+	* gfortran.h : Prototype for gfc_error_flag_test.
+
+2006-11-07  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/29601
+	* symbol.c (check_conflict, gfc_add_volatile): Add volatile support.
+	* decl.c (match_attr_spec, gfc_match_volatile): Add volatile support.
+	* gfortran.h (symbol_attribute): Add volatile_ to struct.
+	* resolve.c (was_declared): Add volatile support.
+	* trans-decl.c (gfc_finish_var_decl): Add volatile support.
+	* match.h: Declare gfc_match_volatile.
+	* parse.c (decode_statement): Recognize volatile.
+	* modules.c (ab_attribute, attr_bits, mio_symbol_attribute):
+	  Add volatile support.
+	* dump-parse-tree.c (gfc_show_attr): Add volatile support.
+
+2006-11-06  Tobias Burnus  <burnus@net-b.de>
+
+	* decl.c (match_attr_spec, gfc_match_enum): Unify gfc_notify_std
+	  message for GFC_STD_F2003.
+	* array.c (gfc_match_array_constructor): Unify gfc_notify_std
+	  message for GFC_STD_F2003.
+	* io.c (check_io_constraints): Unify gfc_notify_std message for
+	  GFC_STD_F2003.
+	* resolve.c (resolve_actual_arglist): Unify gfc_notify_std message
+	  for GFC_STD_F2003.
+
+2006-11-06  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi: Added documentation for FTELL, GETLOG, and
+	HOSTNM intrinsics.
+
+2006-11-06  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/29630
+	PR fortran/29679
+	* expr.c (find_array_section): Support vector subscripts.  Don't
+	  add sizes for dimen_type == DIMEN_ELEMENT to the shape array.
+
+2006-11-05  Bernhard Fischer  <aldot@gcc.gnu.org>
+
+	PR fortran/21061
+	* error.c (gfc_warning): If warnings_are_errors then treat
+	warnings as errors with respect to the exit code.
+	(gfc_notify_std): Ditto.
+	(gfc_warning_now): Ditto.
+
+2006-11-05  Francois-Xavier Coudert  <fxcoudert@gcc.gnu,org>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24518
+	* trans-intrinsic.c (gfc_conv_intrinsic_mod): Use built_in fmod
+	for both MOD and MODULO, if it is available.
+
+	PR fortran/29565
+	* trans-expr.c (gfc_conv_aliased_arg): For an INTENT(OUT), save
+	the declarations from the unused loops by merging the block
+	scope for each; this ensures that the temporary is declared.
+
+2006-11-04  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* error.c (show_locus): Add trailing colon in error messages.
+	(error_print): Avoid leading space in error lines.
+
+2006-11-04  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/29713
+	* expr.c (gfc_simplify_expr): Correct memory allocation.
+
+2006-11-02  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* error.c (show_locus): Remove "In file" from error messages.
+
+2006-10-31  Geoffrey Keating  <geoffk@apple.com>
+
+	* trans-decl.c (gfc_generate_constructors): Update for removal
+	of get_file_function_name.
+
+2006-11-01  Bernhard Fischer  <aldot@gcc.gnu.org>
+
+	PR fortran/29537
+	* trans-common.c (gfc_trans_common): If the blank common is
+	in a procedure or program without a name then proc_name is null, so
+	use the locus of the common.
+	(gfc_sym_mangled_common_id): Fix whitespace.
+	* match.c (gfc_match_common): Emit warning about blank common in
+	block data.
+
+2006-10-31  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/29067
+	* decl.c (gfc_set_constant_character_len): NULL-terminate the
+	character constant string.
+	* data.c (create_character_intializer): Likewise.
+	* expr.c (gfc_simplify_expr): NULL-terminate the substring
+	character constant.
+	* primary.c (match_hollerith_constant): NULL-terminate the
+	character constant string.
+
+2006-10-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29387
+	* trans-intrinsic.c (gfc_conv_intrinsic_len): Rearrange to have
+	a specific case for EXPR_VARIABLE and, in default, build an ss
+	to call gfc_conv_expr_descriptor for array expressions..
+
+	PR fortran/29490
+	* trans-expr.c (gfc_set_interface_mapping_bounds): In the case
+	that GFC_TYPE_ARRAY_LBOUND is not available, use descriptor
+	values for it and GFC_TYPE_ARRAY_UBOUND.
+
+	PR fortran/29641
+	* trans-types.c (gfc_get_derived_type): If the derived type
+	namespace has neither a parent nor a proc_name, set NULL for
+	the search namespace.
+
+2006-10-30  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/29452
+	* io.c (check_io_constraints): Fix keyword string comparison.
+
+2006-10-30  Andrew Pinski  <pinskia@gmail.com>
+
+	PR fortran/29410
+	* trans-intrinsic.c (gfc_conv_intrinsic_array_transfer):
+	Change over to create VIEW_CONVERT_EXPR instead of using an
+	ADDR_EXPR, a cast and then an indirect reference
+
+2006-10-29  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_loc): Make LOC return a
+	signed integer node.
+
+2006-10-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/17741
+	* decl.c (get_proc_name): Bump current namespace refs count.
+
+2006-10-29  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/29629
+	* trans-openmp.c (gfc_trans_omp_array_reduction): Set attr.flavor
+	of init_val_sym and outer_sym to FL_VARIABLE.
+
+2006-10-29  Kazu Hirata  <kazu@codesourcery.com>
+
+	* intrinsic.texi: Fix a typo.
+
+2006-10-27  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* gfortran.h: Remove GFC_MPFR_TOO_OLD.
+	* arith.c (arctangent2): Remove function
+	(gfc_check_real_range): Remove subnormal kludge.
+	* arith.h: Remove arctangent2 prototype.
+	* simplify.c: (gfc_simplify_atan2): Remove use of arctangent2.
+	(gfc_simplify_exponent, gfc_simplify_log, gfc_simplify_nearest,
+	gfc_simplify_rrspacing, gfc_simplify_spacing): Remove mpfr kludges.
+
+2006-10-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/28224
+	* io.c (check_io_constraints): Allow namelists
+	  for internal files for Fortran 2003.
+
+2006-10-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/27954
+	* decl.c (gfc_free_data_all): New function to free all data structures
+	after errors in DATA statements and declarations.
+	(top_var_list): Use new function.(top_val_list): Use new function.
+	(gfc_match_data_decl): Use new function.
+	* misc.c (gfc_typename): Fixed incorrect function name in error text. 
+
+2006-10-24  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/29393
+	* expr.c (simplify_parameter_variable): Keep rank of original
+	expression.
+
+2006-10-23 Rafael Ávila de Espíndola  <rafael.espindola@gmail.com>
+
+	* Make-lang.in (f951$(exeext)): Depend on and link with attribs.o.
+	* trans.h (builtin_function): Rename to	gfc_builtin_function.
+	Change the signature.
+	* 95-lang.c (LANG_HOOKS_BUILTIN_FUNCTION): Define as
+	gfc_builtin_function.
+	(builtin_function): Rename to gfc_builtin_function. Move common
+	code to builtin_function.
+	(gfc_define_builtin): Replace calls to builtin_function with
+	gfc_define_builtin.
+
+2006-10-22  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/26025
+	* lang.opt: Add -fexternal-blas and -fblas-matmul-limit options.
+	* options.c (gfc_init_options): Initialize new flags.
+	(gfc_handle_option): Handle new flags.
+	* gfortran.h (gfc_option): Add flag_external_blas and
+	blas_matmul_limit flags.
+	* trans-expr.c (gfc_conv_function_call): Use new argument
+	append_args, appending it at the end of the argument list
+	built for a function call.
+	* trans-stmt.c (gfc_trans_call): Use NULL_TREE for the new
+	append_args argument to gfc_trans_call.
+	* trans.h (gfc_conv_function_call): Update prototype.
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Add
+	prototypes for BLAS ?gemm routines.
+	* trans-intrinsic.c (gfc_conv_intrinsic_funcall): Generate the
+	extra arguments given to the library matmul function, and give
+	them to gfc_conv_function_call.
+	* invoke.texi: Add documentation for -fexternal-blas and
+	-fblas-matmul-limit.
+
+2006-10-21  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* Make-lang.in (F95_LIBS): Delete.
+	* f951$(exeext): Use $(LIBS) instead of $(F95_LIBS).
+	* config-lang.in (need_gmp): Delete.
+
+2006-10-19  Brooks Moses  <bmoses@stanford.edu>
+
+	* invoke.texi: Fixed "denormal" typo.
+
+2006-10-19  Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29216
+	PR fortran/29314
+	* gfortran.h : Add EXEC_INIT_ASSIGN.
+	* dump-parse-tree.c (gfc_show_code_node): The same.
+	* trans-openmp.c (gfc_trans_omp_array_reduction): Set new
+	argument for gfc_trans_assignment to false.
+	* trans-stmt.c (gfc_trans_forall_1): The same.
+	* trans-expr.c (gfc_conv_function_call, gfc_trans_assign,
+	gfc_trans_arrayfunc_assign, gfc_trans_assignment): The
+	same. In the latter function, use the new flag to stop
+	the checking of the lhs for deallocation.
+	(gfc_trans_init_assign): New function.
+	* trans-stmt.h : Add prototype for gfc_trans_init_assign.
+	* trans.c (gfc_trans_code): Implement EXEC_INIT_ASSIGN.
+	* trans.h : Add new boolean argument to the prototype of
+	gfc_trans_assignment.
+	* resolve.c (resolve_allocate_exp): Replace EXEC_ASSIGN by
+	EXEC_INIT_ASSIGN.
+	(resolve_code): EXEC_INIT_ASSIGN does not need resolution.
+	(apply_default_init): New function.
+	(resolve_symbol): Call it for derived types that become
+	defined but which do not already have an initialization
+	expression..
+	* st.c (gfc_free_statement): Include EXEC_INIT_ASSIGN.
+
+2006-10-16  Tobias Burnus  <burnus@net-b.de>
+
+	* primary.c: Revert 'significand'-to-'significant' comment change.
+	* invoke.texi (Warning Options): Minor cleanup for
+	  -Wimplicit-interface.
+
+2006-10-17  Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29451
+	* trans-array.c (gfc_trans_array_bounds): Test for and set
+	negative stride of a non-constant bound array to zero.
+
+	PR fortran/29392
+	* data.c (create_character_intializer): Copy and simplify
+	the expressions for the start and end of a sub-string
+	reference.
+
+2006-10-16  Kaz Kojima  <kkojima@rr.iij4u.or.jp>
+
+	* io.c (gfc_match_close): Ensure that status is terminated by
+	a NULL element.
+
+2006-10-16  Tobias Burnus  <burnus@net-b.de>
+
+	* trans-stmt.c: Fix a typo
+	* invoke.texi: Fix typos
+	* resolve.c: Fix a comment typo
+	* trans-decl.c: Fix a comment typo
+	* primary.c: Fix a comment typo
+
+2006-10-15  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/29403
+	* io.c (match_io):  Check for a default-char-expr for PRINT format.
+
+2006-10-15  Bernhard Fischer  <aldot@gcc.gnu.org>
+
+	PR fortran/24767
+	* lang.opt (Wunused-labels): Remove.
+	* options.c: Remove references to gfc_option.warn_unused_labels.
+	* gfortran.h: Remove variable warn_unused_labels.               
+	* resolve.c (warn_unused_fortran_label) : Use warn_unused_label
+	instead of gfc_option.warn_unused_labels.
+	* invoke.texi: Remove documentation of -Wunused-labels.
+
+2006-10-14  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi: Add link to GFortran apps
+	* intrinsic.texi: Updated documentation of ACCESS and CHMOD
+
+2006-10-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/19261
+	* scanner.c (load_line): Add checks for illegal use of '&' and issue
+	warnings.  Issue errors with -pedantic.
+
+2006-10-14 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29371
+	* trans-expr.c (gfc_trans_pointer_assignment): Add the expression
+	for the assignment of null to the data field to se->pre, rather
+	than block.	
+
+2006-10-14  Kazu Hirata  <kazu@codesourcery.com>
+
+	* intrinsic.texi: Fix typos.
+	* trans-array.c: Fix a comment typo.
+
+2006-10-13  Brooks Moses  <bmoses@stanford.edu>
+
+	* intrinsic.texi (STAT): Reverted a format in example code to
+	octal; noted this in accompanying string.
+
+2006-10-13 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29373
+	* decl.c (get_proc_name, gfc_match_function_decl): Add
+	attr.implicit_type to conditions that throw error for
+	existing explicit interface and that allow new type-
+	spec to be applied.
+
+	PR fortran/29407
+	* resolve.c (resolve_fl_namelist): Do not check for
+	namelist/procedure conflict, if the symbol corresponds
+	to a good local variable declaration.
+
+	PR fortran/27701
+	* decl.c (get_proc_name): Replace the detection of a declared
+	procedure by the presence of a formal argument list by the
+	attributes of the symbol and the presence of an explicit
+	interface.
+
+	PR fortran/29232
+	* resolve.c (resolve_fl_variable): See if the host association
+	of a derived type is blocked by the presence of another type I
+	object in the current namespace.
+
+	PR fortran/29364
+	* resolve.c (resolve_fl_derived): Check for the presence of
+	the derived type for a derived type component.
+
+	PR fortran/24398
+	* module.c (gfc_use_module): Check that the first words in a
+	module file are 'GFORTRAN module'.
+
+	PR fortran/29422
+	* resolve.c (resolve_transfer): Test functions for suitability
+	for IO, as well as variables.
+
+	PR fortran/29428
+	* trans-expr.c (gfc_trans_scalar_assign): Remove nullify of
+	rhs expression.
+
+2006-10-13  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/29391
+	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Generate correct
+	code for LBOUND and UBOUND intrinsics.
+
+2006-10-13  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/21435
+	* io.c (compare_to_allowed_values): New function.
+	(gfc_match_open): Add checks for constant values of specifiers.
+	(gfc_match_close): Add checks for constant values of the STATUS
+	specifier.
+
+2006-10-12  Brooks Moses  <bmoses@stanford.edu>
+
+	* intrinsic.texi (STAT): Fixed a format typo in sample code.
+
+2006-10-12  Brooks Moses  <bmoses@stanford.edu>
+
+	* intrinsic.texi (STAT): Shortened lines in sample code.
+
+2006-10-11  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.h (gfc_show_actual_arglist, gfc_show_array_ref,
+	gfc_show_array_spec, gfc_show_attr, gfc_show_code,
+	gfc_show_components, gfc_show_constructor, gfc_show_equiv,
+	gfc_show_expr, gfc_show_namelist, gfc_show_ref, gfc_show_symbol,
+	gfc_show_typespec): Add prototypes.
+	* dump-parse-tree.c (gfc_show_actual_arglist, gfc_show_array_ref,
+	gfc_show_array_spec, gfc_show_attr, gfc_show_code,
+	gfc_show_components, gfc_show_constructor, gfc_show_equiv,
+	gfc_show_expr, gfc_show_namelist, gfc_show_ref, gfc_show_symbol,
+	gfc_show_typespec): Remove 'static' from declaration.
+
+2006-10-10  Brooks Moses  <bmoses@stanford.edu>
+
+	* invoke.texi, gfortran.texi: Corrected erronous dashes.
+
+2006-10-10  Brooks Moses  <bmoses@stanford.edu>
+
+	* Make-lang.in: Added "fortran.pdf", "gfortran.pdf" target
+	support.
+
+2006-10-10  Daniel Franke  <franke.daniel@gmail.com>
+
+	* intrinsic.texi: added documentation for FSTAT, GETARG,GET_COMMAND,
+	GET_COMMAND_ARGUMENT, GETENV, GET_ENVIRONMENT_VARIABLE, IAND, IARGC,
+	LSTAT and STAT, removed the reference to PR19292 from ACCESS, CHMOD,
+	GMTIME, LSHIFT, LTIME, RSHIFT.
+
+2006-10-10  Brooks Moses  <bmoses@stanford.edu>
+
+	* gfortran.texi (Standards): Update to current status.
+
+2006-10-09  Brooks Moses  <bmoses@stanford.edu>
+
+	* Make-lang.in: Added intrinsic.texi to GFORTRAN_TEXI
+	dependences.
+
+2006-10-09  Brooks Moses  <bmoses@stanford.edu>
+
+	* intrinsic.texi (MOVE_ALLOC): changed "Options" to "Standards".
+
+2006-10-09  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* gfortran.h: Define GFC_MPFR_TOO_OLD via mpfr version info.
+	* arith.c (arctangent, gfc_check_real_range): Use it.	
+	* simplify.c (gfc_simplify_atan2, gfc_simplify_exponent,
+	gfc_simplify_log, gfc_simplify_nearest): Use it.
+
+	PR fortran/15441
+	PR fortran/29312
+	* iresolve.c (gfc_resolve_rrspacing): Give rrspacing library
+	routine hidden precision argument.
+	(gfc_resolve_spacing): Give spacing library routine hidden
+	precision, emin - 1, and tiny(x) arguments.
+	* simplify.c (gfc_simplify_nearest): Remove explicit subnormalization.
+	(gfc_simplify_rrspacing): Implement formula from Fortran 95 standard.
+	(gfc_simplify_spacing): Implement formula from Fortran 2003 standard.
+	* trans-intrinsic.c (gfc_intrinsic_map_t) Declare rrspacing and
+	spacing via LIBF_FUNCTION
+	(prepare_arg_info, call_builtin_clz, gfc_conv_intrinsic_spacing,
+	gfc_conv_intrinsic_rrspacing): Remove functions.
+	(gfc_conv_intrinsic_function): Remove calls to
+	gfc_conv_intrinsic_spacing and gfc_conv_intrinsic_rrspacing.
+	* f95-lang.c (gfc_init_builtin_functions): Remove __builtin_clz,
+	__builtin_clzl and __builtin_clzll
+
+2006-10-09  Richard Henderson  <rth@redhat.com>
+
+	Revert emutls patch.
+
+2006-10-09  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsic.c (add_sym_0s, add_sym_1s, add_sym_2s, add_sym_3s,
+	add_sym_4s, add_sym_5s, add_functions): Use macro ACTUAL_NO,
+	ACTUAL_YES, NOT_ELEMENTAL and ELEMENTAL instead of constants
+	0 and 1 as second and third arguments to add_sym* functions.
+
+2006-10-08  Erik Edelmann <edelmann@gcc.gnu.org>
+	    Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/20541
+	* interface.c (gfc_compare_derived_types): Add comparison of
+	the allocatable field.
+	* intrinsic.c (add_subroutines): Add MOVE_ALLOC.
+	* trans-expr.c (gfc_conv_aliased_arg, gfc_trans_subarray_assign,
+	gfc_trans_subcomponent_assign, gfc_conv_string_parameter,
+	gfc_trans_scalar_assign): Add extra arguments l_is_temp
+	and r_is_var to references to latter function.
+	(gfc_conv_function_call): Add enum for types of argument and
+	an associated variable parm_kind. Deallocate components of
+	INTENT(OUT) and non-variable arrays.
+	(gfc_trans_subcomponent_assign): Add block to assign arrays
+	to allocatable components.
+	(gfc_trans_scalar_assign): Add block to handle assignments of
+	derived types with allocatable components, using the above new
+	arguments to control allocation/deallocation of memory and the
+	copying of allocated arrays.
+	* trans-array.c (gfc_array_allocate): Remove old identification 
+	of pointer and replace with that of an allocatable array. Add
+	nullify of structures with allocatable components. 
+	(gfc_conv_array_initializer): Treat EXPR_NULL.
+	(gfc_conv_array_parameter): Deallocate allocatable components
+	of non-variable structures.
+	(gfc_trans_dealloc_allocated): Use second argument of library
+	deallocate to inhibit, without error, freeing NULL pointers.
+	(get_full_array_size): New function to return the size of a
+	full array.
+	(gfc_duplicate_allocatable): New function to allocate and copy
+	allocated data.
+	(structure_alloc_comps): New recursive function to deallocate,
+	nullify or copy allocatable components.
+	(gfc_nullify_alloc_comp, gfc_deallocate_alloc_comp,
+	gfc_copy_alloc_comp): New interface functions to call previous.
+	(gfc_trans_deferred_array): Add the code to nullify allocatable
+	components, when entering scope, and to deallocate them on
+	leaving. Do not call gfc_trans_static_array_pointer and return
+	for structures with allocatable components and default
+	initializers.
+	* symbol.c (gfc_set_component_attr): Set allocatable field.
+	(gfc_get_component_attr): Set the allocatable attribute.
+	* intrinsic.h : Prototype for gfc_check_move_alloc.
+	* decl.c (build_struct): Apply TR15581 constraints for
+	allocatable components.
+	(variable_decl): Default initializer is always NULL for
+	allocatable components.
+	(match_attr_spec): Allow, or not, allocatable components,
+	according to the standard in force.
+	* trans-array.h : Prototypes for gfc_nullify_alloc_comp,
+	gfc_deallocate_alloc_comp, gfc_copy_alloc_comp and
+	gfc_duplicate_allocatable.
+	* gfortran.texi : Add mention of TR15581 extensions.
+	* gfortran.h : Add attribute alloc_comp, add
+	gfc_components field allocatable and add the prototype
+	for gfc_expr_to_initialize.
+	* trans-stmt.c (generate_loop_for_temp_to_lhs,
+	generate_loop_for_rhs_to_temp, gfc_trans_where_assign,
+	gfc_trans_where_3): Add extra arguments to calls to
+	gfc_trans_scalar_assign and set appropriately.
+	(gfc_trans_allocate): Nullify allocatable components.
+	(gfc_trans_deallocate): Deallocate to ultimate allocatable
+	components but stop at ultimate pointer components.
+	* module.c (mio_symbol_attribute, mio_symbol_attribute,
+	mio_component): Add module support for allocatable
+	components.
+	* trans-types.c (gfc_get_derived_type): Treat allocatable
+	components.
+	* trans.h : Add two boolean arguments to
+	gfc_trans_scalar_assign.
+	* resolve.c (resolve_structure_cons): Check conformance of
+	constructor element and the component.
+	(resolve_allocate_expr): Add expression to nullify the
+	constructor expression for allocatable components.
+	(resolve_transfer): Inhibit I/O of derived types with
+	allocatable components.
+	(resolve_fl_derived): Skip check of bounds of allocatable
+	components.
+	* trans-decl.c (gfc_get_symbol_decl): Add derived types
+	with allocatable components to deferred variable.
+	(gfc_trans_deferred_vars): Make calls for derived types
+	with allocatable components to gfc_trans_deferred_array.
+	(gfc_generate_function_code): Nullify allocatable
+	component function result on entry.
+	* parse.c (parse_derived): Set symbol attr.allocatable if
+	allocatable components are present.
+	* check.c (gfc_check_allocated): Enforce attr.allocatable
+	for intrinsic arguments.
+	(gfc_check_move_alloc): Check arguments of move_alloc.
+	* primary.c (gfc_variable_attr): Set allocatable attribute.
+	* intrinsic.texi : Add index entry and section for
+	for move_alloc.
+
+2006-10-08  Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29115
+	* resolve.c (resolve_structure_cons): It is an error if the
+	pointer component elements of a derived type constructor are
+	not pointer or target.
+
+
+	PR fortran/29211
+	* trans-stmt.c (generate_loop_for_temp_to_lhs,
+	generate_loop_for_rhs_to_temp): Provide a string length for
+	the temporary by copying that of the other side of the scalar
+	assignment.
+
+2006-10-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/28585
+	* intrinsic.c (add_functions): Add new_line Fortran 2003 intrinsic.
+	* intrinsic.h: Add gfc_simplify_new_line and gfc_check_new_line
+	prototypes.
+	* check.c (gfc_check_new_line): New function.
+	* simplify.c (gfc_simplify_new_line): New function.
+	* intrinsic.texi: Document new_line intrinsic.
+
+2006-10-07  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/16580
+	PR fortran/29288
+	* gcc/fortran/intrinsic.c (add_sym): Define the actual_ok when a
+	gfc_intrinsic_sym structure is filled.
+	(gfc_intrinsic_actual_ok): New function.
+	(add_sym_0s, add_sym_1s, add_sym_2s, add_sym_3s, add_sym_4s,
+	add_sym_5s): Intrinsic subroutines are not allowed as actual
+	arguments, so we remove argument actual_ok.
+	(add_functions): Correct the values for actual_ok of all intrinsics.
+	Add comments for gfc_check_access_func and gfc_resolve_index_func.
+	(add_subroutines): Remove the actual_ok argument, which was never used.
+	* gcc/fortran/intrinsic.h (gfc_intrinsic_actual_ok): New prototype.
+	* gcc/fortran/gfortran.h (gfc_resolve_index_func): New prototype.
+	* gcc/fortran/resolve.c (resolve_actual_arglist): Check whether
+	an intrinsic used as an argument list is allowed there.
+	* gcc/fortran/iresolve.c (gfc_resolve_index_func): New function.
+	(gfc_resolve_len): Change intrinsic function name to agree with
+	libgfortran.
+	* gcc/fortran/trans-decl.c (gfc_get_extern_function_decl): Add
+	new case, because some specific intrinsics take 3 arguments.
+	* gcc/fortran/intrinsic.texi: DIMAG is a GNU extension.
+
+2006-10-06  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/28415
+	* trans-decl.c (gfc_finish_var_decl): With -fno-automatic, don't
+	make artificial variables or pointer to variable automatic array
+	TREE_STATIC.
+
+	* scanner.c (skip_free_comments): Return bool instead of void.
+	(gfc_next_char_literal): Don't return ' ' if & is missing after
+	!$omp or !$.  Use skip_{free,fixed}_comments directly instead
+	of gfc_skip_comments.
+
+2006-10-04  Brooks Moses  <bmoses@stanford.edu>
+
+	* gfortran.texi: (Current Status): update and rewrite to reflect
+	actual status more accurately.
+
+2006-10-04  Brooks Moses  <bmoses@stanford.edu>
+
+	* gfortran.texi: Consistently refer to the compiler as "GNU
+	Fortran".
+	* intrinsic.texi: Ditto.
+	* invoke.texi: Ditto.
+
+2006-10-04  Richard Henderson  <rth@redhat.com>
+	    Jakub Jelinek  <jakub@redhat.com>
+
+	* f95-lang.c (gfc_init_builtin_functions): Add __emutls_get_address
+	and __emutls_register_common.
+	* openmp.c (gfc_match_omp_threadprivate): Don't error if !have_tls.
+	* trans-common.c (build_common_decl): Don't check have_tls.
+	* trans-decl.c (gfc_finish_var_decl): Likewise.
+	* types.def (BT_WORD, BT_FN_PTR_PTR): New.
+	(BT_FN_VOID_PTR_WORD_WORD_PTR): New.
+
+2006-10-04  Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/29343
+	* resolve.c (resolve_allocate_expr): Exclude derived types from
+	search for dependences between allocated variables and the
+	specification expressions for other allocations in the same
+	statement.
+
+2006-10-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29098
+	* resolve.c (resolve_structure_cons): Do not return FAILURE if
+	component expression is NULL.
+
+2006-10-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/20779
+	PR fortran/20891
+	* resolve.c (find_sym_in_expr): New function that returns true
+	if a symbol is found in an expression.
+	(resolve_allocate_expr): Check whether the STAT variable is
+	itself allocated in the same statement.  Use the call above to
+	check whether any of the allocated arrays are used in array
+	specifications in the same statement.
+
+2006-10-03  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* arith.c (gfc_check_real_range):  Use correct exponent range for
+	subnormal numbers.
+
+2006-10-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29284
+	PR fortran/29321
+	PR fortran/29322
+	* trans-expr.c (gfc_conv_function_call): Check the expression
+	and the formal symbol are present when testing the actual
+	argument.
+
+	PR fortran/25091
+	PR fortran/25092
+	* resolve.c (resolve_entries): It is an error if the entries
+	of an array-valued function do not have the same shape.
+
+2006-10-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR middle-end/27478
+	* trans-decl.c (gfc_get_fake_result_decl): Mark var as
+	TREE_ADDRESSABLE.
+
+2006-10-02  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/19262
+	* gfortran.h (gfc_option_t): Add max_continue_fixed and
+	max_continue_free.
+	* options.c (gfc_init_options): Initialize fixed form and free form
+	consecutive continuation line limits.
+	* scanner.c (gfc_scanner_init_1): Initialize continue_line
+	and continue_count. (gfc_next_char_literal): Count the number of
+	continuation lines in the current statement and warn if limit
+	is exceeded.
+
+2006-10-02  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/19260
+	* scanner.c (gfc_next_char_literal): Add check for missing '&'
+	and warn if in_string, otherwise return ' '.
+
+2006-10-02  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/29210
+	* primary.c (match_sym_complex_part): Named constants as real or
+	imaginary part of complex a named constant are only allowed in
+	Fortran 2003.
+
+2006-10-01  Brooks Moses  <bmoses@stanford.edu>
+
+	* gfortran.texi: Corrected references to MALLOC intrinsic.
+	* invoke.texi: Minor cleanup and clarification to the Dialect
+	Options section.
+
+2006-09-30  Brooks Moses  <bmoses@stanford.edu>
+
+	* invoke.texi:  Add mention of BOZ constants and integer
+	overflow to -fno-range-check.
+	* gfortran.texi:  Add mention of -fno-range-check to
+	section on BOZ contants.
+
+2006-09-30  Bernhard Fischer  <aldot@gcc.gnu.org>
+
+	* resolve.c: Fix commentary typo.  Fix whitespace.
+
+2006-09-28  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	fortran/29147
+	* arith.c (gfc_check_integer_range): Disable range checking via
+	-fno-range-check.
+
+2006-09-28  Steven G. Kargl <kargl@gcc.gnu.org>
+
+	* arith.c: Change conditional test for inclusion of arctangent().
+	(gfc_check_real_range): Change conditional test for use of
+	mpfr_subnormalize.
+	* simplify.c (gfc_simplify_atan2): Fix conditional for use of
+	mpfr_atan2() instead of arctangent().
+	(gfc_simplify_exponent): Fix conditional for use of mpfr_get_exp().
+ 	(gfc_simplify_log): Fix conditional for use of mpfr_atan2() instead
+	 of arctangent().
+	(gfc_simplify_nearest): Fix conditional for use of mpfr_nextafter(). 
+
+2006-09-27  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* arith.c: Conditionally include arctangent2().
+	(gfc_check_real_range): Use mpfr_subnormalize in preference to local
+	hack.
+	* trans-intrinsic.c (gfc_get_intrinsic_lib_fndecl): Append
+	l for long double functions.
+	* simplify.c: Wrap Copyright to new line.
+	(gfc_simplify_atan2): Use mpfr_atan2 in preference to arctangent2().
+	(gfc_simplify_log): Ditto.
+
+
+	PR fortran/28276
+	* simplify.c (gfc_simplify_exponent): Use mpfr_get_exp in
+	preference to broken local hack.
+
+	PR fortran/27021
+	* simplify.c (gfc_simplify_nearest): Use mpfr_nexttoward and
+	mpfr_subnormalize to handle numbers near zero in preference to broken
+	 local hack.
+
+2006-09-26  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/29097
+	* scanner.c (include_line): Handle conditional include.
+
+2006-09-25  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/21203
+	* error.c (show_loci): No need to risk an ICE to output a
+	slightly nicer error message.
+
+2006-09-19 Paul Thomas <pault@gcc.gnu.org>
+	   Steven Bosscher  <steven@gcc.gnu.org>
+
+	PR fortran/29101
+	* trans-stmt.c (gfc_trans_character_select): Store the label
+	from select_string and then clean up any temporaries from the
+	conversion of the select expression, before branching to the
+	selected case.
+
+2006-09-18 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/28526
+	* primary.c (match_variable): If the compiler is in a module
+	specification block, an interface block or a contains section,
+	reset host_flag to force the changed symbols mechanism.
+
+	PR fortran/29101
+	* trans-stmt.c (gfc_trans_character_select): Add the post block
+	for the expression to the main block, after the call to
+	select_string and the last label.
+
+2006-09-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29060
+	* iresolve.c (resolve_spread): Build shape for result if the
+	source shape is available and dim and ncopies are constants.
+
+2006-09-18  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/28817
+	PR fortran/21918
+	* trans-decl.c (generate_local_decl): Change from 'warning' to
+	'gfc_warning' to have line numbers correctly reported.
+
+2006-09-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29051
+	* decl.c (match_old_style_init): Set the 'where' field of the
+	gfc_data structure 'newdata'.
+
+	* match.c (match_case_eos): Add a comprehensible error message.
+
+2006-09-13  Wolfgang Gellerich  <gellerich@de.ibm.com>
+
+	* trans-expr.c (gfc_add_interface_mapping): For characters, dereference
+	pointer if necessary and then perform the cast.
+
+2006-09-11  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* intrinsic.c: Update Copyright date.
+	* intrinsic.h: Ditto.
+
+2006-09-11  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28890
+	* trans-expr.c (gfc_conv_function_call): Obtain the string length
+	of a dummy character(*) function from the symbol if it is not
+	already translated.  For a call to a character(*) function, use
+	the passed, hidden string length argument, which is available
+	from the backend_decl of the formal argument.
+	* resolve.c (resolve_function): It is an error if a function call
+	to a character(*) function is other than a dummy procedure or
+	an intrinsic.
+
+2006-09-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28959
+	* trans-types.c (gfc_get_derived_type): Use the parent namespace of
+	the procedure if the type's own namespace does not have a parent.
+
+2006-09-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28923
+	* expr.c (find_array_section): Only use the array lower and upper
+	bounds for the start and end of the sections, where the expr is
+	NULL.
+
+2006-09-10  Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/28914
+	* trans-array.c (gfc_trans_array_constructor_value): Create a temporary
+	loop variable to hold the current loop variable in case it is modified
+	by the array constructor.
+
+2006-09-07  Steven G. Kargl  <kargls@comcast.net>
+
+	* gfortran.h (gfc_integer_info): Eliminate max_int.
+	* arith.c (gfc_arith_init_1): Remove initialization of max_int.
+	(gfc_arith_done_1): Remove clearing of max_int.
+	(gfc_check_integer_range): Fix range chekcing of overflow.
+	* simplify.c (gfc_simplify_not): Construct mask that was max_int.
+
+2006-09-05  Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/28908
+	* gfortran.h : Restore the gfc_dt_list structure and reference
+	to it in gfc_namespace.
+	* resolve.c (resolve_fl_derived): Restore the building of the
+	list of derived types for the current namespace. Modify the
+	restored code so that a check is made to see if the symbol is
+	already in the list.
+	(resolve_fntype): Make sure that the specification block
+	version of the derived type is used for a module function that
+	returns that type. 
+	* symbol.c (gfc_free_dt_list): Restore.
+	(gfc_free_namespace): Restore call to previous.
+	* trans-types.c (copy_dt_decls_ifequal): Restore.
+	(gfc_get_derived_type): Restore all the paraphenalia for
+	association of derived types, including calls to previous.
+	Modify the restored code such that all derived types are built
+	if their symbols are found in the parent namespace; not just
+	non-module types.  Add backend_decls to like derived types in
+	sibling namespaces, as well as that of the derived type.
+
+2006-08-30  Kazu Hirata  <kazu@codesourcery.com>
+
+	* match.c: Fix a comment typo.
+
+2006-08-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28885
+	* trans-expr.c (gfc_conv_aliased_arg): Ensure that the temp
+	declaration is retained for INTENT(OUT) arguments.
+
+	PR fortran/28873
+	PR fortran/20067
+	* resolve.c (resolve_generic_f): Make error message more
+	comprehensible.
+	(resolve_generic_s): Restructure search for specific procedures
+	to be similar to resolve_generic_f and change to similar error
+	message.  Ensure that symbol reference is refreshed, in case
+	the search produces a NULL.
+	(resolve_specific_s): Restructure search, as above and as
+	resolve_specific_f. Ensure that symbol reference is refreshed,
+	in case the search produces a NULL.
+
+	PR fortran/25077
+	PR fortran/25102
+	* interface.c (check_operator_interface): Throw error if the
+	interface assignment tries to change intrinsic type assigments
+	or has less than two arguments.  Also, it is an error if an
+	interface operator contains an alternate return.
+
+	PR fortran/24866
+	* parse.c (gfc_fixup_sibling_symbols): Do not modify the symbol
+	if it is a dummy in the contained namespace.
+
+2006-08-29  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/28866
+	* match.c: Wrap copyright.
+	(gfc_match_assignment):  Return MATCH_NO for failed lvalue.  Remove
+	gotos.  Move error handling of FL_PARAMETER to ...
+	* gfc_match_if: Deal with MATCH_NO from above.
+	* primary.c: Wrap copyright.
+	(match_variable): ... here.  Improve error messages.
+
+2006-08-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28788
+	* symbol.c (gfc_use_derived): Never eliminate the symbol,
+	following reassociation of use associated derived types.
+
+2006-08-26  Steven G. Kargl  <kargls@comcast.net>
+
+	* arith.h: Update Copyright dates.  Fix whitespace.
+	* arith.c: Update Copyright dates.  Fix whitespace.  Fix comments.
+	(gfc_arith_done_1): Clean up pedantic_min_int and subnormal.
+
+2006-08-26  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi: Note variable initialization causes SAVE attribute.
+	* intrinsic.texi: Clarify support for KIND=16 and KIND=10.
+	Mention -std=f2003.  Cross reference INQUIRE from ACCESS intrinsic.
+	Add missing ) in ACOS.
+
+2006-08-26  Daniel Franke  <franke.daniel@gmail.com>
+
+	* intrinsic.texi: Update Copyright date.  Added documentation
+	for ACOSH, AND, ASINH, ATANH, CHDIR, FGET, FGETC, FPUT, FPUTC,
+	GETCWD, OR and XOR intrinsics, removed inadvertently introduced
+	doc-stubs for EQV and NEQV, corrected some typographical errors.
+
+2006-08-24  Daniel Franke  <franke.daniel@gmail.com>,
+	    Brooks Moses  <bmoses@stanford.edu>
+
+	* intrinsic.texi: Added doc-stubs for undocumented intrinsics,
+	added a "See Also" section, renamed the "Options" section to
+	"Standard", improved the index, and made numerous minor
+	typo corrections and grammatical fixes.
+
+2006-08-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28788
+	* symbol.c (shift_types): Shift the derived type references in
+	formal namespaces.
+	(gfc_use_derived): Return if the derived type symbol is already
+	in another namspace.  Add searches for the derived type in
+	sibling namespaces.
+
+	PR fortran/28771
+	* decl.c (add_init_expr_to_sym): Restore the original but
+	restricted to parameter arrays to fix a regression.
+
+2006-08-23  Steven G. Kargl  <kargls@comcast.net>
+
+	* gfortran.texi:  Fix last commit where a "no" was deleted and
+	a grammatical error was introduced.
+
+2006-08-23  Steven G. Kargl  <kargls@comcast.net>
+
+	* gfortran.texi:  Spell check.  Add a few contributors to
+	Chapter 9.  Expand the description of BOZ constant handling.
+
+2006-08-20  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/25828
+	* gfortran.texi: Mention STREAM I/O among supported F2003
+	features.
+
+2006-08-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28601
+	PR fortran/28630
+	* gfortran.h : Eliminate gfc_dt_list structure and reference
+	to it in gfc_namespace.
+	* resolve.c (resolve_fl_derived): Remove the building of the
+	list of derived types for the current namespace.
+	* symbol.c (find_renamed_type): New function to find renamed
+	derived types by symbol name rather than symtree name.
+	(gfc_use_derived): Search parent namespace for identical
+	derived type and use it, even if local version is complete,
+	except in interface bodies. Ensure that renamed derived types
+	are found by call to find_renamed_type. Recurse for derived
+	type components.
+	(gfc_free_dt_list): Remove.
+	(gfc_free_namespace): Remove call to previous.
+	* trans-types.c (copy_dt_decls_ifequal): Remove.
+	(gfc_get_derived_type): Remove all the paraphenalia for
+	association of derived types, including calls to previous.
+	* match.c (gfc_match_allocate): Call gfc_use_derived to
+	associate any derived types that are being allocated.
+
+	PR fortran/20886
+	* resolve.c (resolve_actual_arglist): The passing of
+	a generic procedure name as an actual argument is an
+	error.
+
+	PR fortran/28735
+	* resolve.c (resolve_variable): Check for a symtree before
+	resolving references.
+
+	PR fortran/28762
+	* primary.c (match_variable): Return MATCH_NO if the symbol
+	is that of the program.
+
+	PR fortran/28425
+	* trans-expr.c (gfc_trans_subcomponent_assign): Translate
+	derived type component expressions other than another derived
+	type constructor.
+
+	PR fortran/28496
+	* expr.c (find_array_section): Correct errors in
+	the handling of a missing start value for the
+	index triplet in an array reference.
+
+	PR fortran/18111
+	* trans-decl.c (gfc_build_dummy_array_decl): Before resetting
+	reference to backend_decl, set it DECL_ARTIFICIAL.
+	(gfc_get_symbol_decl): Likewise for original dummy decl, when
+	a copy is made of an array.
+	(create_function_arglist): Likewise for the _entry paramter
+	in entry_masters.
+	(build_entry_thunks): Likewise for dummies in entry thunks.
+
+	PR fortran/28600
+	* trans-decl.c (gfc_get_symbol_decl): Ensure that the
+	DECL_CONTEXT of the length of a character dummy is the
+	same as that of the symbol declaration.
+
+	PR fortran/28771
+	* decl.c (add_init_expr_to_sym): Remove setting of charlen for
+	an initializer of an assumed charlen variable.
+
+	PR fortran/28660
+	* trans-decl.c (generate_expr_decls): New function.
+	(generate_dependency_declarations): New function.
+	(generate_local_decl): Call previous if not either a dummy or
+	a declaration in an entry master.
+
+2006-08-19  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/25217
+	* resolve.c (resolve_fl_variable): Set a default initializer for
+	derived types with INTENT(OUT) even if 'flag' is true.
+	* trans-expr.c (gfc_conv_function_call): Insert code to
+	reinitialize INTENT(OUT) arguments of derived type with default
+	initializers.
+
+2006-08-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/25828
+	* gfortran.h: Add new pointer for stream position to st_inquire.
+	Rename gfc_large_io_int_kind to gfc_intio_kind.
+	* trans-types.c (gfc_init_kinds): use gfc_intio_kind.
+	* io.c: Add new IO tag for file position going in and another for out.
+	(match_dt_element): Match new tag_spos.
+	(gfc_resolve_dt): Resolve new tag_spos.
+	(gfc_free_inquire): Free inquire->strm_pos.
+	(match_inquire_element): Match new tag_strm_out.
+	(gfc_resolve_inquire): Resolve new tag_strm_out.
+	* trans-io.c: Rename IOPARM_type_large_io_int to IOPARM_type_intio.
+	(gfc_build_st_parameter): Same.
+	(gfc_build_io_library_fndecls) Same. and add build pointer type pintio.
+	(gfc_trans_inquire): Translate strm_pos for inquire.
+	* ioparm.def: Reorder flags to accomodate addition of new inquire
+	flag for strm_pos_out and add it in.
+
+2006-08-06  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28590
+	* parse.c (parse_derived): Remove the test for sequence type
+	components of a sequence type.
+	* resolve.c (resolve_fl_derived): Put the test here so that
+	pointer components are tested.
+
+2006-08-05  Steven G. Kargl <kargls@comcast.nt>
+
+	PR fortran/28548
+	* resolve.c(resolve_elemental_actual): Add flags.h to use -pedantic
+	and exclude conversion functions in conditional.  Change gfc_error
+	to gfc_warning.
+	(warn_unused_label) Rename to ...
+	(warn_unused_fortran_label) avoid warn_unused_label in flags.h.
+
+2006-07-30  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsic.c (add_functions): Add ACCESS, CHMOD, RSHIFT, LSHIFT.
+	(add_subroutines): Add LTIME, GMTIME and CHMOD.
+	* intrinsic.h (gfc_check_access_func, gfc_check_chmod,
+	gfc_check_chmod_sub, gfc_check_ltime_gmtime, gfc_simplify_rshift,
+	gfc_simplify_lshift, gfc_resolve_access, gfc_resolve_chmod,
+	gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
+	gfc_resolve_gmtime, gfc_resolve_ltime): Add prototypes.
+	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_ACCESS,
+	GFC_ISYM_CHMOD, GFC_ISYM_LSHIFT, GFC_ISYM_RSHIFT.
+	* iresolve.c (gfc_resolve_access, gfc_resolve_chmod,
+	gfc_resolve_rshift, gfc_resolve_lshift, gfc_resolve_chmod_sub,
+	gfc_resolve_gmtime, gfc_resolve_ltime): New functions.
+	* check.c (gfc_check_access_func, gfc_check_chmod,
+	gfc_check_chmod_sub, gfc_check_ltime_gmtime): New functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_rlshift): New function.
+	(gfc_conv_intrinsic_function): Add cases for the new GFC_ISYM_*.
+
+2006-07-28  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
+
+	* Make-lang.in: Use $(HEADER_H) instead of header.h in dependencies.
+
+2006-07-26  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsic.c (add_functions): Add INT2, SHORT, INT8, LONG,
+	LSTAT, MCLOCK and MCLOCK8 intrinsic functions.
+	(add_subroutines): Add LSTAT intrinsic subroutine.
+	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_INT2,
+	GFC_ISYM_INT8, GFC_ISYM_LONG, GFC_ISYM_LSTAT, GFC_ISYM_MCLOCK
+	and GFC_ISYM_MCLOCK8.
+	* iresolve.c (gfc_resolve_int2, gfc_resolve_int8,
+	gfc_resolve_long, gfc_resolve_lstat, gfc_resolve_mclock,
+	gfc_resolve_mclock8, gfc_resolve_lstat_sub): New functions.
+	* check.c (gfc_check_intconv): New function.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
+	the added GFC_ISYM_*.
+	* simplify.c (gfc_simplify_intconv, gfc_simplify_int2,
+	gfc_simplify_int8, gfc_simplify_long): New functions.
+	* intrinsic.h (gfc_check_intconv, gfc_simplify_int2,
+	gfc_simplify_int8, gfc_simplify_long, gfc_resolve_int2,
+	gfc_resolve_int8, gfc_resolve_long, gfc_resolve_lstat,
+	gfc_resolve_mclock, gfc_resolve_mclock8, gfc_resolve_lstat_sub):
+	Add prototypes.
+
+2006-07-24  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/28416
+	* trans-array.c (gfc_conv_array_parameter): Give special treatment for
+	ALLOCATABLEs if they are themselves dummy variables.
+
+2006-07-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/25289
+	* gfortran.h: Declare gfc_large_io_int_kind.
+	* trans-types.c (gfc_init_kinds): Set gfc_large_io_int_kind
+	to size 8 or 4.
+	* trans-io.c (enum iofield_type): Add large_io_int type.
+	(gfc_build_st_parameter): Same.
+	(gfc_build_io_library_fndecls): Same.
+	* ioparm_def: Use large_io_int to define rec.
+
+2006-07-22  Steven Bosscher  <steven@gcc.gnu.org> 
+
+	PR fortran/28439
+	* trans-stmt.c (gfc_trans_arithmetic_if): Evaluate the condition once.
+
+2006-07-16  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/28390
+	* trans-openmp.c (gfc_trans_omp_do): Look for LASTPRIVATE in
+	code->exp.omp_clauses rather than in the 3rd function argument.
+
+2006-07-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28384
+	* trans-common.c (translate_common): If common_segment is NULL
+	emit error that common block does not exist.
+
+	PR fortran/20844
+	* io.c (check_io_constraints): It is an error if an ADVANCE
+	specifier appears without an explicit format.
+
+	PR fortran/28201
+	* resolve.c (resolve_generic_s): For a use_associated function,
+	do not search for an alternative symbol in the parent name
+	space.
+
+	PR fortran/20893
+	* resolve.c (resolve_elemental_actual): New function t combine
+	all the checks of elemental procedure actual arguments. In
+	addition, check of array valued optional args(this PR) has
+	been added.
+	(resolve_function, resolve_call): Remove parts that treated
+	elemental procedure actual arguments and call the above.
+
+2006-07-14  Steven G. Kargl  <kargls@comcast.net>
+
+	* trans-expr.c (gfc_trans_string_copy): Evaluate the string lengths
+
+006-07-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28353
+	* trans-expr.c (gfc_conv_aliased_arg): Missing formal arg means
+	that intent is INOUT (fixes regression).
+
+	PR fortran/25097
+	* check.c (check_present): The only permitted reference is a
+	full array reference.
+
+	PR fortran/20903
+	* decl.c (variable_decl): Add error if a derived type is not
+	from the current namespace if the namespace is an interface
+	body.
+
+2006-07-12  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/28163
+	* trans-expr.c (gfc_trans_string_copy): Generate inline code
+	to perform string copying instead of calling a library function.
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Don't build
+	decl for copy_string.
+	* trans.h (gfor_fndecl_copy_string): Remove prototype.
+
+2006-07-11  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/28213
+	* trans-io.c (transfer_expr): Deal with Hollerith constants used in
+	I/O list.
+
+2006-07-07  Kazu Hirata  <kazu@codesourcery.com>
+
+	* intrinsic.texi: Fix typos.
+
+2006-07-07  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28237
+	PR fortran/23420
+	* io.c (resolve_tag): Any integer that is not an assigned
+	variable is an error.
+
+2006-07-06  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/28129
+	* trans-array.c (gfc_trans_array_bound_check): Add a locus
+	argument, and use it in the error messages.
+	(gfc_conv_array_index_offset): Donc perform bounds checking on
+	the last dimension of assumed-size arrays.
+
+2006-07-06  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/27874
+	* trans-stmt.c (compute_inner_temp_size): Don't perform bounds
+	checking when calculating the bounds of scalarization.
+
+2006-07-05  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/20892
+	* interface.c (gfc_match_interface): Don't allow dummy procedures
+	to have a generic interface.
+
+2006-07-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28174
+	* trans-array.c (gfc_conv_expr_descriptor): When building temp,
+	ensure that the substring reference uses a new charlen.
+	* trans-expr.c (gfc_conv_aliased_arg): Add the formal intent to
+	the argument list, lift the treatment of missing string lengths
+	from the above and implement the use of the intent.
+	(gfc_conv_function_call): Add the extra argument to the call to
+	the above.
+
+	PR fortran/28167
+	* trans-array.c (get_array_ctor_var_strlen): Treat a constant
+	substring reference.
+	* array.c (gfc_resolve_character_array_constructor): Remove 
+	static attribute and add the gfc_ prefix, make use of element
+	charlens for the expression and pick up constant string lengths
+	for expressions that are not themselves constant.
+	* gfortran.h : resolve_character_array_constructor prototype
+	added.
+	* resolve.c (gfc_resolve_expr): Call resolve_character_array_
+	constructor again after expanding the constructor, to ensure
+	that the character length is passed to the expression.
+
+2006-07-04  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+	    Daniel Franke  <franke.daniel@gmail.com>
+
+	* intrinsic.c (add_subroutines): Add ITIME and IDATE.
+	* intrinsic.h (gfc_check_itime_idate,gfc_resolve_idate,
+	fc_resolve_itime): New protos.
+	* iresolve.c (gfc_resolve_itime, gfc_resolve_idate): New functions.
+	* check.c (gfc_check_itime_idate): New function.
+	* intrinsic.texi: Document the new intrinsics.
+
+2006-07-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsics/date_and_time.c (itime0,idate0,itime_i4,itime_i8,
+	idate_i4,idate_i8): New functions.
+
+
+2006-07-03  Asher Langton  <langton2@llnl.gov>
+
+	* decl.c (match_old_style_init): Add data attribute to symbol.
+
+2006-07-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* iresolve.c (gfc_resolve_cpu_time, gfc_resolve_random_number):
+	Remove ATTRIBUTE_UNUSED for used argument.
+
+2006-07-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsic.texi: Document new intrinsics.
+
+2006-07-01  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/19259
+	* parse.c (next_free): Error out on line starting with semicolon.
+	(next_fixed): Fix formatting.  Error out on line starting with
+	semicolon.
+
+2006-06-30  Kazu Hirata  <kazu@codesourcery.com>
+
+	* check.c: Fix a comment typo.
+
+2006-06-25  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25056
+	* interface.c (compare_actual_formal): Signal an error if the formal
+	argument is a pure procedure and the actual is not pure.
+
+	PR fortran/27554
+	* resolve.c (resolve_actual_arglist): If the type of procedure
+	passed as an actual argument is not already declared, see if it is
+	an intrinsic.
+
+	PR fortran/25073
+	* resolve.c (resolve_select): Use bits 1 and 2 of a new int to
+	keep track of  the appearance of constant logical case expressions.
+	Signal an error is either value appears more than once.
+
+	PR fortran/20874
+	* resolve.c (resolve_fl_procedure): Signal an error if an elemental
+	function is not scalar valued.
+
+	PR fortran/20867
+	* match.c (recursive_stmt_fcn): Perform implicit typing of variables.
+
+	PR fortran/22038
+	* match.c (match_forall_iterator): Mark new variables as
+	FL_UNKNOWN if the match fails.
+
+	PR fortran/28119
+	* match.c (gfc_match_forall): Remove extraneous call to
+	gfc_match_eos.
+
+	PR fortran/25072
+	* resolve.c (resolve_code, resolve_function): Rework
+	forall_flag scheme so that it is set and has a value of
+	2, when the code->expr (ie. the forall mask) is resolved.
+	This is used to change "block" to "mask" in the non-PURE
+	error message.
+
+2006-06-24  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/28081
+	* resolve.c (resolve_substring): Don't issue out-of-bounds
+	error messages when the range has zero size.
+
+2006-06-24  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/23862
+	* lang-specs.h (f95-cpp-input): Pass -ffree-form to f951 unless
+	-ffixed-form is explicitly specified.
+
+2006-06-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28118
+	* trans-array.c (gfc_conv_expr_descriptor): When building temp,
+	use the substring reference to calculate the length if the
+	expression does not have a charlen.
+
+2006-06-24  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/28094
+	* trans-intrinsic.c (gfc_conv_intrinsic_mod): Support cases where
+	there is no integer kind equal to the resulting real kind.
+	* intrinsic.c (add_functions): MODULO is not allowed as an actual
+	argument.
+
+2006-06-23  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/27981
+	* match.c (gfc_match_if):  Handle errors in assignment in simple if.
+
+2006-06-22  Asher Langton  <langton2@llnl.gov>
+
+	PR fortran/24748
+	* primary.c (gfc_match_rvalue): Don't call match_substring for
+	implicit non-character types.
+
+2006-06-22  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR libfortran/26769
+	* iresolve.c (gfc_resolve_reshape): Call reshape_r4 and
+	reshape_r8 instead of reshape_4 and reshape_8.
+	(gfc_resolve_transpose): Likewise for transpose.
+
+2006-06-21  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* trans-expr.c (gfc_conv_missing_dummy, gfc_conv_unary_op,
+	gfc_conv_cst_int_power, gfc_conv_string_tmp,
+	gfc_conv_function_call): Replace calls to convert on constant
+	integer nodes by build_int_cst.
+	* trans-stmt.c (gfc_trans_do): Likewise.
+	* trans-io.c (set_internal_unit, transfer_namelist_element):
+	Likewise.
+	* trans-decl.c (build_entry_thunks): Likewise.
+
+2006-06-20  Steven G. Kargl  <kargls@comcast.net>
+
+	* simplify.c (gfc_simplify_rrspacing): Initialize and clear mpfr_t
+	variable.
+
+2006-06-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25049
+	PR fortran/25050
+	* check.c (non_init_transformational): New function.
+	(find_substring_ref): New function to signal use of disallowed
+	transformational intrinsic in an initialization expression.
+	(gfc_check_all_any): Call previous if initialization expr.
+	(gfc_check_count): The same.
+	(gfc_check_cshift): The same.
+	(gfc_check_dot_product): The same.
+	(gfc_check_eoshift): The same.
+	(gfc_check_minloc_maxloc): The same.
+	(gfc_check_minval_maxval): The same.
+	(gfc_check_gfc_check_product_sum): The same.
+	(gfc_check_pack): The same.
+	(gfc_check_spread): The same.
+	(gfc_check_transpose): The same.
+	(gfc_check_unpack): The same.
+
+	PR fortran/18769
+	*intrinsic.c (add_functions): Add gfc_simplify_transfer.
+	*intrinsic.h : Add prototype for gfc_simplify_transfer.
+	*simplify.c (gfc_simplify_transfer) : New function to act as
+	placeholder for eventual implementation.  Emit error for now.
+
+	PR fortran/16206
+	* expr.c (find_array_element): Eliminate condition on length of
+	offset. Add bounds checking. Rearrange exit. Return try and
+	put gfc_constructor result as an argument.
+	(find_array_section): New function.
+	(find_substring_ref): New function.
+	(simplify_const_ref): Add calls to previous.
+	(simplify_parameter_variable): Return on NULL expr.
+	(gfc_simplify_expr): Only call gfc_expand_constructor for full
+	arrays.
+
+	PR fortran/20876
+	* match.c (gfc_match_forall): Add missing locus to gfc_code.
+
+2006-06-18  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/26801
+	* trans-intrinsic.c (gfc_conv_associated): Use pre and post blocks
+	of the scalarization expression.
+
+2006-06-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/19310
+	PR fortran/19904
+	* arith.c (gfc_range_check): Return ARITH_OK if -fno-range-check. Add
+	return of ARITH_NAN, ARITH_UNDERFLOW, and ARITH_OVERFLOW.
+	(gfc_arith_divide): If -fno-range-check allow mpfr to divide by zero.
+	* gfortran.h (gfc_option_t): Add new flag.
+	* invoke.texi: Document new flag.
+	* lang.opt: Add option -frange-check.
+	* options.c (gfc_init_options): Initialize new flag.
+	(gfc_handle_options): Set flag if invoked.
+	* simplify.c (range_check): Add error messages for
+	overflow, underflow, and other errors.
+	* trans-const.c (gfc_conv_mpfr_to_tree): Build NaN and Inf from mpfr
+	result.
+
+2006-06-17  Karl Berry  <karl@gnu.org>
+
+	* gfortran.texi (@dircategory): Use "Software development"
+	instead of "Programming", following the Free Software Directory.
+
+2006-06-16  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/27965
+	* trans-array.c (gfc_conv_ss_startstride): Correct the runtime
+	conditions for bounds-checking. Check for nonzero stride.
+	Don't check the last dimension of assumed-size arrays. Fix the
+	dimension displayed in the error message.
+
+2006-06-15  Thomas Koenig <Thomas.Koenig@online.de>
+
+	* trans-array.h (gfc_trans_create_temp_array):  Add bool
+	argument.
+	* trans-arrray.c (gfc_trans_create_temp_array): Add extra
+	argument "function" to show if we are translating a function.
+	If we are translating a function, perform checks whether
+	the size along any argument is negative.  In that case,
+	allocate size 0.
+	(gfc_trans_allocate_storage):  Add function argument (as
+	false) to gfc_trans_create_temp_array call.
+	* trans-expr.c (gfc_conv_function_call):  Add function
+	argument (as true) to gfc_trans_create_temp_array call.
+	* trans-stmt.c (gfc_conv_elemental_dependencies): Add
+	function argument (as false) to gfc_trans_create_temp_array
+	call.
+	* trans-intrinsic.c:  Likewise.
+
+2006-06-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24558
+	PR fortran/20877
+	PR fortran/25047
+	* decl.c (get_proc_name): Add new argument to flag that a
+	module function entry is being treated. If true, correct
+	error condition, add symtree to module namespace and add
+	a module procedure.
+	(gfc_match_function_decl, gfc_match_entry,
+	gfc_match_subroutine): Use the new argument in calls to
+	get_proc_name.
+	* resolve.c (resolve_entries): ENTRY symbol reference to
+	to master entry namespace if a module function.
+	* trans-decl.c (gfc_create_module_variable): Return if
+	the symbol is an entry.
+	* trans-exp.c (gfc_conv_variable): Check that parent_decl
+	is not NULL.
+
+2006-06-09  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/27916
+	* trans-openmp.c (gfc_omp_clause_default_ctor): New function.
+	* trans.h (gfc_omp_clause_default_ctor): New prototype.
+	* f95-lang.c (LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR): Define.
+
+2006-06-08  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/27958
+	* trans-expr.c (gfc_conv_substring): If the substring start is
+	greater than its end, the length of the substring is zero, and
+	not negative.
+	(gfc_trans_string_copy): Don't generate a call to
+	_gfortran_copy_string when destination length is zero.
+
+2006-06-08  Asher Langton  <langton2@llnl.gov>
+	
+	PR fortran/27786
+	* trans-array.c (gfc_conv_array_ref): Eliminate bounds checking
+	for assumed-size Cray pointees.
+
+2006-06-08  Steven G. Kargl  <kargls@comcat.net>
+
+	* intrinsic.c (add_subroutine):  Make make_noreturn() conditional on
+	the appropriate symbol name.
+	
+2006-06-07  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/23091
+	* resolve.c (resolve_fl_variable): Error if an automatic
+	object has the SAVE attribute.
+
+	PR fortran/24168
+	* expr.c (simplify_intrinsic_op): Transfer the rank and
+	the locus to the simplified expression.
+
+	PR fortran/25090
+	PR fortran/25058
+	* gfortran.h : Add int entry_id to gfc_symbol.
+	* resolve.c : Add static variables current_entry_id and
+	specification_expr.
+	(resolve_variable): During code resolution, check if a
+	reference to a dummy variable in an executable expression
+	is preceded by its appearance as a parameter in an entry.
+	Likewise check its specification expressions.
+	(resolve_code): Update current_entry_id on EXEC_ENTRY.
+	(resolve_charlen, resolve_fl_variable): Set and reset
+	specifiaction_expr.
+	(is_non_constant_shape_array): Do not return on detection
+	of a variable but continue to resolve all the expressions.
+	(resolve_codes): set current_entry_id to an out of range
+	value.
+
+2006-06-06  Mike Stump  <mrs@apple.com>
+
+	* Make-lang.in: Rename to htmldir to build_htmldir to avoid
+	installing during build.
+
+2006-06-06  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/27897
+	* match.c (gfc_match_common):  Fix code typo.  Remove
+	sym->name, since sym is NULL, and replace with name.
+
+2006-06-05  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR libfortran/27895
+	* resolve.c (compute_last_value_for_triplet): New function.
+	(check_dimension): Correctly handle zero-sized array sections.
+	Add checking on last element of array sections.
+
+2006-06-05  Steven G. Kargl  <kargls@comcast.net>
+
+	* data.c (gfc_assign_data_value):  Fix comment typo.  Remove
+	a spurious return.
+
+2006-06-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/14067
+	* data.c (create_character_intializer): Add warning message
+	for truncated string.
+
+	PR fortran/16943
+	* symbol.c : Include flags.h.
+	(gfc_add_type): If a procedure and types are the same do not
+	throw an error unless standard is less than gnu or pedantic.
+
+	PR fortran/20839
+	* parse.c (parse_do_block): Error if named block do construct
+	does not have a named enddo.
+
+	PR fortran/27655
+	* check.c (gfc_check_associated): Pick up EXPR_NULL for pointer
+	as well as target and put error return at end of function.
+
+2006-06-03  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* trans.c (gfc_msg_bounds, gfc_msg_fault, gfc_msg_wrong_return):
+	Add strings for common runtime error messages.
+	(gfc_trans_runtime_check): Add a locus argument, use a string
+	and not a string tree for the message.
+	* trans.h (gfc_trans_runtime_check): Change prototype accordingly.
+	(gfc_msg_bounds, gfc_msg_fault, gfc_msg_wrong_return): Add proto.
+	* trans-const.c (gfc_strconst_bounds, gfc_strconst_fault,
+	gfc_strconst_wrong_return, gfc_strconst_current_filename): Remove.
+	(gfc_init_constants): Likewise.
+	* trans-const.h: Likewise.
+	* trans-decl.c (gfc_build_builtin_function_decls): Call to
+	_gfortran_runtime_error has only one argument, the message string.
+	* trans-array.h (gfc_conv_array_ref): Add a symbol argument and a
+	locus.
+	* trans-array.c (gfc_trans_array_bound_check): Build precise
+	error messages.
+	(gfc_conv_array_ref): Use the new symbol argument and the locus
+	to build more precise error messages.
+	(gfc_conv_ss_startstride): More precise error messages.
+	* trans-expr.c (gfc_conv_variable): Give symbol reference and
+	locus to gfc_conv_array_ref.
+	(gfc_conv_function_call): Use the new prototype for
+	gfc_trans_runtime_check.
+	* trans-stmt.c (gfc_trans_goto): Build more precise error message.
+	* trans-io.c (set_string): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Use new prototype
+	for gfc_trans_runtime_check.
+
+2006-06-01  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/27715
+	* arith.c:  Cast the characters from the strings to unsigned
+	char to avoid values less than 0 for extended ASCII.
+
+2006-06-01  Per Bothner  <bothner@bothner.com>
+
+	* data.c (gfc_assign_data_value): Handle USE_MAPPED_LOCATION.
+	* scanner.c (gfc_gobble_whitespace): Likewise.
+
+2006-06-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25098
+	PR fortran/25147
+	* interface.c (compare_parameter): Return 1 if the actual arg
+	is external and the formal is a procedure.
+	(compare_actual_formal): If the actual argument is a variable
+	and the formal a procedure, this an error.  If a gsymbol exists
+	for a procedure of the same name, this is not yet resolved and
+	the error is cleared.
+
+	* trans-intrinsic.c (gfc_conv_associated): Make provision for
+	zero array length or zero string length contingent on presence
+	of target, for consistency with standard.
+
+2006-05-30  Asher Langton  <langton2@llnl.gov>
+
+	* symbol.c (check_conflict): Allow external, function, and
+	subroutine attributes with Cray pointees.
+	* trans-expr.c (gfc_conv_function_val): Translate Cray pointees
+	that point to procedures.
+	* gfortran.texi: Document new feature.
+
+2006-05-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/27634
+	* io.c (check_format): Add error for missing period in format
+	specifier unless -std=legacy.
+	* gfortran.texi: Add description of expanded namelist read and
+	missing period in format extensions.
+
+2006-05-29  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/19777
+	* trans-array.c (gfc_conv_array_ref): Perform out-of-bounds
+	checking for assumed-size arrrays for all but the last dimension.
+
+2006-05-29  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* invoke.texi: Change -fpackderived into -fpack-derived.
+
+2006-05-29  Kazu Hirata  <kazu@codesourcery.com>
+
+	* options.c, primary.c, resolve.c, trans-common.c: Fix typos
+	in error messages.
+
+2006-05-28  Kazu Hirata  <kazu@codesourcery.com>
+
+	* check.c, expr.c, resolve.c, trans-common.c,
+	trans-intrinsic.c, trans-stmt.c, trans-types.c: Fix comment typos.
+
+2006-05-27  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/19777
+	* trans-array.c (gfc_conv_array_ref): Don't perform out-of-bounds
+	checking for assumed-size arrrays.
+
+2006-05-27  Paul Thomas  <pault@gcc.gnu.org>
+
+	* trans-intrinsic.c (gfc_conv_associated): If pointer in first
+	arguments has zero array length of zero string length, return
+	false.
+
+2006-05-26  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/27524
+	* trans-array.c (gfc_trans_dummy_array_bias): Don't use stride as
+	a temporary variable when -fbounds-check is enabled, since its
+	value will be needed later.
+
+2006-05-26  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/23151
+	* io.c (match_io):  print (1,*) is an error.
+
+2006-05-26  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/27709
+	* resolve.c (find_array_spec): Add gfc_symbol, derived, and
+	use to track repeated component references.
+
+	PR fortran/27155
+	PR fortran/27449
+	* trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Use
+	se->string_length throughout and use memcpy to populate the
+	expression returned to the scalarizer.
+	(gfc_size_in_bytes): New function.
+
+2006-05-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/27613
+	* primary.c (gfc_match_rvalue): Test if symbol represents a
+	direct recursive function reference.  Error if array valued,
+	go to function0 otherwise.
+
+2006-05-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25746
+	* interface.c (gfc_extend_assign): Use new EXEC_ASSIGN_CALL.
+	* gfortran.h : Put EXEC_ASSIGN_CALL in enum.
+	* trans-stmt.c (gfc_conv_elemental_dependencies): New function.
+	(gfc_trans_call): Call it.  Add new boolian argument to flag
+	need for dependency checking. Assert intent OUT and IN for arg1
+	and arg2.
+	(gfc_trans_forall_1): Use new code EXEC_ASSIGN_CALL.
+	trans-stmt.h : Modify prototype of gfc_trans_call.
+	trans.c (gfc_trans_code): Add call for EXEC_ASSIGN_CALL.
+	st.c (gfc_free_statement): Free actual for EXEC_ASSIGN_CALL.
+	* dependency.c (gfc_check_fncall_dependency): Don't check other
+	against itself.
+
+	PR fortran/25090
+	* resolve.c : Remove resolving_index_expr.
+	(entry_parameter): Remove.
+	(gfc_resolve_expr, resolve_charlen, resolve_fl_variable): Lift
+	calls to entry_parameter and references to resolving_index_expr.
+
+	PR fortran/27584
+	* check.c (gfc_check_associated): Replace NULL assert with an
+	error message, since it is possible to generate bad code that
+	has us fall through to here..
+
+	PR fortran/19015
+	* iresolve.c (maxloc, minloc): If DIM is not present, pass the
+	rank of ARRAY as the shape of the result.  Otherwise, pass the
+	shape of ARRAY, less the dimension DIM.
+	(maxval, minval): The same, when DIM is present, otherwise no
+	change.
+
+2006-05-19  H.J. Lu  <hongjiu.lu@intel.com>
+
+	PR fortran/27662
+	* trans-array.c (gfc_conv_expr_descriptor): Don't zero the
+	first stride to indicate a temporary.
+	* trans-expr.c (gfc_conv_function_call): Likewise.
+
+2006-05-18  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+	    Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/27552
+	* dump-parse-tree.c (gfc_show_expr): Deal with Hollerith constants.
+	* data.c (create_character_intializer): Set from_H flag if character is
+	initialized by Hollerith constant.
+
+2006-05-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/26551
+	* resolve.c (resolve_call, resolve_function): Issue an error
+	if a function or subroutine call is recursive but the function or
+	subroutine wasn't declared as such.
+
+2006-05-07  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/26551
+	* gfortran.dg/recursive_check_1.f: New test.
+
+
+2006-05-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/27320
+	* dump-parse-tree.c (gfc_show_code_node): Try harder to find the
+	called procedure name.
+
+2006-05-17  Jakub Jelinek  <jakub@redhat.com>
+
+	PR middle-end/27415
+	* trans-openmp.c (gfc_trans_omp_parallel_do,
+	gfc_trans_omp_parallel_sections, gfc_trans_omp_parallel_workshare): Set
+	OMP_PARALLEL_COMBINED flag.
+
+2006-05-16  H.J. Lu  <hongjiu.lu@intel.com>
+
+	PR driver/26885
+	* Make-lang.in (GFORTRAN_D_OBJS): Replace gcc.o with
+	$(GCC_OBJS).
+
+2006-05-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25090
+	* resolve.c: Static resolving_index_expr initialized.
+	(entry_parameter): New function to emit errors for variables
+	that are not entry parameters.
+	(gfc_resolve_expr): Call entry_parameter, when resolving
+	variables, if the namespace has entries and resolving_index_expr
+	is set.
+	(resolve_charlen): Set resolving_index_expr before the call to
+	resolve_index_expr and reset it afterwards.
+	(resolve_fl_variable): The same before and after the call to
+	is_non_constant_shape_array, which ultimately makes a call to
+	gfc_resolve_expr.
+
+	PR fortran/25082
+	* resolve.c (resolve_code): Add error condition that the return
+	expression must be scalar.
+
+	PR fortran/27411
+	* matchexp.c (gfc_get_parentheses): New function.
+	(match_primary): Remove inline code and call above.
+	* gfortran.h: Provide prototype for gfc_get_parentheses.
+	* resolve.c (resolve_array_ref): Call the above, when start is a
+	derived type variable array reference.
+
+2006-05-15  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/27446
+	* trans-openmp.c (gfc_trans_omp_array_reduction): Ensure
+	OMP_CLAUSE_REDUCTION_{INIT,MERGE} are set to BIND_EXPR.
+
+2006-05-14  H.J. Lu  <hongjiu.lu@intel.com>
+
+	* Make-lang.in (fortran/options.o): Depend on $(TARGET_H).
+
+2006-05-11  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/27553
+	* parse.c (next_free): Return instead of calling decode_statement
+	upon error.
+
+2006-05-10  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/27470
+	* trans-array.c(gfc_array_allocate):  If ref->next exists
+	that is if there is a statement like ALLOCATE(foo%bar(2)),
+	F95 rules require that bar should be a pointer.
+
+2006-05-10  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/20460
+	* resolve.c (gfc_resolve_index): Make REAL array indices a
+	GFC_STD_LEGACY feature.
+
+2006-05-10  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/24549
+	* parse.c (reject_statement): Clear gfc_new_block.
+
+2006-05-09  Steven G. Kargl  <kargls@comcast.net>
+
+	* invoke.texi: Missed file in previous commit.  Update
+	 description of -fall-intrinsics
+
+2006-05-07  Steven Boscher  <steven@gcc.gnu.org>
+
+	PR fortran/27378
+	* parse.c (next_statement): Add check to avoid an ICE when
+	gfc_current_locus.lb is not set.
+
+2006-05-07  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/27457
+	* match.c (match_case_eos): Error out on garbage following
+	CASE(...).
+
+2006-05-07  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24813
+	* trans-array.c (get_array_ctor_strlen): Remove static attribute.
+	* trans.h: Add prototype for get_array_ctor_strlen.
+	* trans-intrinsic.c (gfc_conv_intrinsic_len): Switch on EXPR_ARRAY
+	and call get_array_ctor_strlen.
+
+2006-05-05  Steven G. Kargl  <kargls@comcast.net>
+
+	* invoke.texi: Update description of -fall-intrinsics
+	* options.c (gfc_post_options): Disable -Wnonstd-intrinsics if
+	-fall-intrinsics is used.
+	(gfc_handle_option): Permit -Wno-nonstd-intrinsics.
+
+2006-05-04  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* simplify.c (ascii_table): Fix wrong entry.
+
+2006-05-02  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/26896
+	* lang.opt: Fix -Wtab description
+
+	PR fortran/20248  
+	* lang.opt: New flag -fall-intrinsics.
+	* invoke.texi:  Document option.
+	* gfortran.h (options_t):  New member flag_all_intrinsics.
+	* options.c (gfc_init_options, gfc_handle_option): Set new option.
+	sort nearby misplaced options.
+	* intrinsic.c (add_sym, make_generic, make_alias):  Use it.
+
+2006-05-02 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/27269
+	* module.c: Add static flag in_load_equiv.
+	(mio_expr_ref): Return if no symtree and in_load_equiv.
+	(load_equiv): If any of the equivalence members have no symtree, free
+	the equivalence and the associated expressions.
+
+	PR fortran/27324
+	* trans-common.c (gfc_trans_common): Invert the order of calls to
+	finish equivalences and gfc_commit_symbols.
+
+2006-04-29  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/25681
+	* simplify.c (simplify_len): Character variables with constant
+	length can be simplified.
+
+2006-04-29  H.J. Lu  <hongjiu.lu@intel.com>
+
+	PR fortran/27351
+	* trans-array.c (gfc_conv_array_transpose): Move gcc_assert
+	before gfc_conv_expr_descriptor.
+
+2006-04-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25099
+	* resolve.c (resolve_call): Check conformity of elemental
+	subroutine actual arguments.
+
+2006-04-22  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/26769
+	* iresolve.c (gfc_resolve_reshape): Use reshape_r16 for real(16).
+	(gfc_resolve_transpose): Use transpose_r16 for real(16).
+
+2006-04-21 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/27122
+	* resolve.c (resolve_function): Remove general restriction on auto
+	character length function interfaces.
+	(gfc_resolve_uops): Check restrictions on defined operator
+	procedures.
+	(resolve_types): Call the check for defined operators.
+
+	PR fortran/27113
+	* trans-array.c (gfc_trans_array_constructor_subarray): Remove
+	redundant gfc_todo_error.
+	(get_array_ctor_var_strlen): Remove typo in enum.
+
+2006-04-18  Bernhard Fischer  <aldot@gcc.gnu.org>
+
+	* parse.c (next_free): Use consistent error string between
+	free-form and fixed-form for illegal statement label of zero.
+	(next_fixed): Use consistent warning string between free-form
+	and fixed-form for statement labels for empty statements.
+
+2006-04-18  Steve Ellcey  <sje@cup.hp.com>
+
+	* trans-io.c (gfc_build_io_library_fndecls): Align pad.
+
+2006-04-16  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/26017
+	* trans-array.c(gfc_array_init_size):  Introduce or_expr
+	which is true if the size along any dimension
+	is negative.  Create a temporary variable with base
+	name size.  If or_expr is true, set the temporary to 0,
+	to the normal size otherwise.
+
+2006-04-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/26822
+	* intrinsic.c (add_functions): Mark LOGICAL as elemental.
+
+	PR fortran/26787
+	* expr.c (gfc_check_assign): Extend scope of error to include
+	assignments to a procedure in the main program or, from a
+	module or internal procedure that is not that represented by
+	the lhs symbol. Use VARIABLE rather than l-value in message.
+
+	PR fortran/27096
+	* trans-array.c (gfc_trans_deferred_array): If the backend_decl
+	is not a descriptor, dereference and then test and use the type.
+
+	PR fortran/25597
+	* trans-decl.c (gfc_trans_deferred_vars): Check if an array
+	result, is also automatic character length.  If so, process
+	the character length.
+
+	PR fortran/18003
+	PR fortran/25669
+	PR fortran/26834
+	* trans_intrinsic.c (gfc_walk_intrinsic_bound): Set
+	data.info.dimen for bound intrinsics.
+	* trans_array.c (gfc_conv_ss_startstride): Pick out LBOUND and
+	UBOUND intrinsics and supply their shape information to the ss
+	and the loop.
+
+	PR fortran/27124
+	* trans_expr.c (gfc_trans_function_call):  Add a new block, post,
+	in to which all the argument post blocks are put.  Add this block
+	to se->pre after a byref call or to se->post, otherwise.
+
+2006-04-14  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-io.c (set_string): Use fold_build2 and build_int_cst instead
+	of build2 and convert to construct "x < 0" rather than "x <= -1".
+
+2006-04-13  Richard Henderson  <rth@redhat.com>
+
+	* trans-openmp.c (gfc_trans_omp_sections): Adjust for changed
+	number of operands to OMP_SECTIONS.
+
+2006-04-08  Kazu Hirata  <kazu@codesourcery.com>
+
+	* gfortran.texi: Fix typos.  Follow spelling conventions.
+	* resolve.c, trans-expr.c, trans-stmt.c: Fix comment typos.
+	Follow spelling conventions.
+
+2006-04-05  Roger Sayle  <roger@eyesopen.com>
+
+	* dependency.c (get_no_elements): Delete function.
+	(get_deps): Delete function.
+	(transform_sections): Delete function.
+	(gfc_check_section_vs_section): Significant rewrite.
+
+2006-04-04  H.J. Lu  <hongjiu.lu@intel.com>
+
+	PR fortran/25619
+	* trans-array.c (gfc_conv_expr_descriptor): Only dereference
+	character pointer when copying temporary.
+
+	PR fortran/23634
+	* trans-array.c (gfc_conv_expr_descriptor): Properly copy
+	temporary character with non constant size.
+
+2006-04-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/26891
+	* trans.h: Prototype for gfc_conv_missing_dummy.
+	* trans-expr (gfc_conv_missing_dummy): New function
+	(gfc_conv_function_call): Call it and tidy up some of the code.
+	* trans-intrinsic (gfc_conv_intrinsic_function_args): The same.
+
+	PR fortran/26976
+	* array.c (gfc_array_dimen_size): If available, return shape[dimen].
+	* resolve.c (resolve_function): If available, use the argument
+	shape for the function expression.
+	* iresolve.c (gfc_resolve_transfer): Set shape[0] = size.
+
+2006-04-02  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	* trans-array.c (gfc_trans_dealloc_allocated): Take a
+	tree representation of the array to be deallocated as argument
+	instead of its gfc_symbol.
+	(gfc_trans_deferred_array): Update call to
+	gfc_trans_dealloc_allocated.
+	* trans-array.h (gfc_trans_dealloc_allocated): Update
+	prototype.
+	* trans-expr.c (gfc_conv_function_call): Update call to
+	gfc_trans_dealloc_allocated, get indirect reference to dummy
+	arguments.
+
+2006-04-01  Roger Sayle  <roger@eyesopen.com>
+
+	PR fortran/25270
+	* trans-array.c (gfc_trans_allocate_array_storage): In array index
+	calculations use gfc_index_zero_node and gfc_index_one_node instead
+	of integer_zero_node and integer_one_node respectively.
+	(gfc_conv_array_transpose): Likewise.
+	(gfc_conv_ss_startstride): Likewise.
+	(gfc_trans_dummy_array_bias): Likewise.
+
+2006-04-01  Roger Sayle  <roger@eyesopen.com>
+
+	* dependency.c (gfc_is_inside_range): Delete.
+	(gfc_check_element_vs_section): Significant rewrite.
+
+2006-04-01  Roger Sayle  <roger@eyesopen.com>
+
+	* dependency.c (gfc_dep_compare_expr): Strip parentheses and unary
+	plus operators when comparing expressions.  Handle comparisons of
+	the form "X+C vs. X", "X vs. X+C", "X-C vs. X" and "X vs. X-C" where
+	C is an integer constant.  Handle comparisons of the form "P+Q vs.
+	R+S" and "P-Q vs. R-S".  Handle comparisons of integral extensions
+	specially (increasing functions) so extend(A) > extend(B), when A>B.
+	(gfc_check_element_vs_element): Move test later, so that we ignore
+	the fact that "A < B" or "A > B" when A or B contains a forall index.
+
+2006-03-31  Asher Langton  <langton2@llnl.gov>
+
+	PR fortran/25358
+	* expr.c (gfc_check_assign): Allow cray pointee to be assumes-size.
+	
+2006-03-30  Paul Thomas <paulthomas2@wanadoo.fr>
+	    Bud Davis  <bdavis9659@sbcglobal.net>
+
+	PR 21130
+	* module.c (load_needed): Traverse entire tree before returning.
+
+2006-03-30  Roger Sayle  <roger@eyesopen.com>
+
+	PR middle-end/22375
+	* trans.c (gfc_trans_runtime_check): Promote the arguments of
+	__builtin_expect to the correct types, and the result back to
+	boolean_type_node.
+
+2006-03-29  Carlos O'Donell  <carlos@codesourcery.com>
+
+	* Make-lang.in: Rename docdir to gcc_docdir.
+
+2006-03-28  Steven G. Kargl  <kargls@comcast.net>
+
+	* intrinsic.texi: s/floor/float in previous commit.
+
+2006-03-28 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/26779
+	* resolve.c (resolve_fl_procedure): Do not check the access of
+	derived types for internal procedures.
+
+2006-03-27  Jakub Jelinek  <jakub@redhat.com>
+
+	* io.c (check_io_constraints): Don't look at
+	dt->advance->value.charater.string, unless it is a CHARACTER
+	constant.
+
+	* f95-lang.c (gfc_get_alias_set): New function.
+	(LANG_HOOKS_GET_ALIAS_SET): Define.
+
+2006-03-25  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/26816
+	* intrinsic.c (add_functions): Allow FLOAT to accept all integer kinds.
+	* intrinsic.texi: Document FLOAT.
+
+2006-03-25  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/26769
+	* iresolve.c (gfc_resolve_reshape):  Remove doubling of
+	kind for complex. For real(kind=10), call reshape_r10.
+	(gfc_resolve_transpose):  For real(kind=10), call
+	transpose_r10.
+
+2006-03-25  Roger Sayle  <roger@eyesopen.com>
+
+	* dependency.c (gfc_check_dependency): Improve handling of pointers;
+	Two variables of different types can't have a dependency, and two
+	variables with the same symbol are equal, even if pointers.
+
+2006-03-24  Roger Sayle  <roger@eyesopen.com>
+
+	* gfortran.h (gfc_symbol): Add a new "forall_index" bit field.
+	* match.c (match_forall_iterator): Set forall_index field on
+	the iteration variable's symbol.
+	* dependency.c (contains_forall_index_p): New function to
+	traverse a gfc_expr to check whether it contains a variable
+	with forall_index set in it's symbol.
+	(gfc_check_element_vs_element): Return GFC_DEP_EQUAL for scalar
+	constant expressions that don't variables used as FORALL indices.
+
+2006-03-22  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
+
+	PR driver/22600
+	* error.c (gfc_fatal_error): Return ICE_EXIT_CODE instead of 4.
+
+2006-03-22  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/19303
+	* gfortran.h (gfc_option_t):  Add record_marker.
+	* lang.opt:  Add -frecord-marker=4 and -frecord-marker=8.
+	* trans-decl.c:  Add gfor_fndecl_set_record_marker.
+	(gfc_build_builtin_function_decls): Set
+	gfor_fndecl_set_record_marker.
+	(gfc_generate_function_code):  If we are in the main program
+	and -frecord-marker was provided, call set_record_marker.
+	* options.c (gfc_handle_option):  Add handling for
+	-frecord-marker=4 and -frecord-marker=8.
+	* invoke.texi:  Document -frecord-marker.
+
+2006-03-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/17298
+	* trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): New
+	function to implement array valued TRANSFER intrinsic.
+	(gfc_conv_intrinsic_function): Call the new function if TRANSFER
+	and non-null se->ss.
+	(gfc_walk_intrinsic_function): Treat TRANSFER as one of the
+	special cases by calling gfc_walk_intrinsic_libfunc directly.
+
+2006-03-21  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* options.c (gfc_init_options): Initialize
+	flag_argument_noalias to 3.
+
+2006-03-20  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/20935
+	* iresolve.c (gfc_resolve_maxloc):   If mask is scalar,
+	prefix the function name with an "s".  If the mask is scalar
+	or if its kind is smaller than gfc_default_logical_kind,
+	coerce it to default kind.
+	(gfc_resolve_maxval):  Likewise.
+	(gfc_resolve_minloc):  Likewise.
+	(gfc_resolve_minval):  Likewise.
+	(gfc_resolve_product):  Likewise.
+	(gfc_resolve_sum):  Likewise.
+
+2006-03-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/26741
+	*expr.c (external_spec_function): Permit elemental functions.
+
+	PR fortran/26716
+	*interface.c (compare_actual_formal): Detect call for procedure
+	usage and require rank checking, in this case, for assumed shape
+	and deferred shape arrays.
+	(gfc_procedure_use): Revert to pre-PR25070 call to
+	compare_actual_formal that does not require rank checking..
+
+2006-03-16  Roger Sayle  <roger@eyesopen.com>
+
+	* gfortran.h (gfc_equiv_info): Add length field.
+	* trans-common.c (copy_equiv_list_to_ns): Set the length field.
+	* dependency.c (gfc_are_equivalenced_arrays): Use both the offset
+	and length fields to determine whether the two equivalenced symbols
+	overlap in memory.
+
+2006-03-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/19101
+	* gfortran.h: Add warn_ampersand.
+	* invoke.texi: Add documentation for new option.
+	* lang.opt: Add Wampersand.
+	* options.c (gfc_init_options): Initialize warn_ampersand.
+	(gfc_post_options): Set the warn if pedantic.
+	(set_Wall): Set warn_ampersand.
+	(gfc_handle_option: Add Wampersand for itself, -std=f95, and -std=f2003.
+	* scanner.c (gfc_next_char_literal): Add test for missing '&' in
+	continued character constant and give warning if missing.
+
+2006-03-14  Steven G. Kargl  <kargls@comcast.net>
+
+	PR 18537
+	* gfortran.h: Wrap Copyright line.
+	(gfc_option_t): add warn_tabs member.
+	* lang.opt: Update Coyright year.  Add the Wtabs.
+	* invoke.texi: Document -Wtabs.
+	* scanner.c (gfc_gobble_whitespace): Use warn_tabs.  Add linenum to
+	suppress multiple warnings.
+	(load_line): Use warn_tabs.  Add linenum, current_line, seen_comment
+	to suppress multiple warnings.
+	* options.c (gfc_init_options): Initialize warn_tabs.
+	(set_Wall): set warn_tabs for -Wall.
+	(gfc_post_options): Adjust flag_tabs depending on -pedantic.
+	(gfc_handle_option):  Process command-line option -W[no-]tabs
+
+2006-03-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25378
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Set the initial position to zero and
+	modify the condition for updating it, to implement the F2003 requirement for all(mask)
+	is false.
+
+2006-03-13  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-openmp.c (gfc_trans_omp_variable): Handle references
+	to parent result.
+	* trans-expr.c (gfc_conv_variable): Remove useless setting
+	of parent_flag, formatting.
+
+	* trans-decl.c (gfc_get_fake_result_decl): Re-add setting of
+	GFC_DECL_RESULT flag.
+
+2006-03-11  Roger Sayle  <roger@eyesopen.com>
+
+	* dependency.c (gfc_dep_compare_expr) <EXPR_OP>: Allow unary and
+	binary operators to compare equal if their operands are equal.
+	<EXPR_FUNCTION>: Allow "constant" intrinsic conversion functions
+	to compare equal, if their operands are equal.
+
+2006-03-11  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	* symbol.c (check_conflict): Allow allocatable function results,
+	except for elemental functions.
+	* trans-array.c (gfc_trans_allocate_temp_array): Rename to ...
+	(gfc_trans_create_temp_array): ... this, and add new argument
+	callee_alloc.
+	(gfc_trans_array_constructor, gfc_conv_loop_setup): Update call
+	to gfc_trans_allocate_temp_array.
+	* trans-array.h (gfc_trans_allocate_temp_array): Update prototype.
+	* trans-expr.c (gfc_conv_function_call): Use new arg of
+	gfc_trans_create_temp_array avoid pre-allocation of temporary
+	result variables of pointer AND allocatable functions.
+	(gfc_trans_arrayfunc_assign): Return NULL for allocatable
+	functions.
+	* resolve.c (resolve_symbol): Copy value of 'allocatable' attribute
+	from sym->result to sym.
+
+2006-03-09  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	* trans-expr.c (gfc_add_interface_mapping): Copy 'allocatable'
+	attribute from sym to new_sym.  Call build_fold_indirect_ref()
+	for allocatable arguments.
+
+2006-03-09 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/26257
+	* trans-array.c (gfc_conv_expr_descriptor): Exclude calculation of
+	the offset and data when se->data_not_needed is set.
+	* trans.h: Include the data_not_need bit in gfc_se.
+	* trans-intrinsic.c (gfc_conv_intrinsic_size): Set it for SIZE.
+
+2006-03-06  Paul Thomas  <pault@gcc.gnu.org>
+	    Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	* trans-array.c (gfc_trans_dealloc_allocated): New function.
+	(gfc_trans_deferred_array): Use it, instead of inline code.
+	* trans-array.h: Prototype for gfc_trans_dealloc_allocated().
+	* trans-expr.c (gfc_conv_function_call): Deallocate allocated
+	ALLOCATABLE, INTENT(OUT) arguments upon procedure entry.
+
+2006-03-06  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/26107
+	* resolve.c (resolve_function): Add name after test for pureness.
+
+	PR fortran/19546
+	* trans-expr.c (gfc_conv_variable): Detect reference to parent result,
+	store current_function_decl, replace with parent, whilst calls are
+	made to gfc_get_fake_result_decl, and restore afterwards. Signal this
+	to gfc_get_fake_result_decl with a new argument, parent_flag.
+	* trans-stmt.c (gfc_trans_return): gfc_get_fake_result_decl 2nd arg
+	is set to zero.
+	* trans.h: Add parent_flag to gfc_get_fake_result_decl prototype.
+	* trans-decl.c (gfc_get_fake_result_decl): On parent_flag, being set,
+	add decl to parent function. Replace refs to current_fake_result_decl
+	with refs to this_result_decl.
+	(gfc_generate_function_code): Null parent_fake_result_decl before the
+	translation of code for contained procedures. Set parent_flag to zero
+	in call to gfc_get_fake_result_decl.
+	* trans-intrinsic.c (gfc_conv_intrinsic_len): The same.
+
+2006-03-05  Steven G. Kargl  <kargls@comcast.net>
+
+	* simplify.c (gfc_simplify_verify):  Fix return when SET=''.
+
+2006-03-05  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/16136
+	* symbol.c (conf_std): New macro.
+	(check_conflict): Use it to allow ALLOCATABLE dummy
+	arguments for F2003.
+	* trans-expr.c (gfc_conv_function_call): Pass the
+	address of the array descriptor when dummy argument is
+	ALLOCATABLE.
+	* interface.c (compare_allocatable): New function.
+	(compare_actual_formal): Use it.
+	* resolve.c (resolve_deallocate_expr,
+	resolve_allocate_expr): Check that INTENT(IN) variables
+	aren't (de)allocated.
+	* gfortran.texi (Fortran 2003 status): List ALLOCATABLE
+	dummy arguments as supported.
+
+2006-03-03  Roger Sayle  <roger@eyesopen.com>
+
+	* dependency.c (gfc_check_element_vs_element): Revert last change.
+
+2006-03-03  Roger Sayle  <roger@eyesopen.com>
+
+	* dependency.c (gfc_check_element_vs_element): Consider two
+	unordered scalar subscripts as (potentially) equal.
+
+2006-03-03  Roger Sayle  <roger@eyesopen.com>
+
+	* dependency.c (gfc_check_dependency): Call gfc_dep_resolver to
+	check whether two array references have a dependency.
+	(gfc_check_element_vs_element): Assume lref and rref must be
+	REF_ARRAYs.  If gfc_dep_compare_expr returns -2, assume these
+	references could potentially overlap.
+	(gfc_dep_resolver): Whitespace and comment tweaks.  Assume a
+	dependency if the references have different depths.  Rewrite
+	final term to clarrify we only have a dependency for overlaps.
+
+2006-03-03  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/25031
+	* trans-array.h:  Adjust gfc_array_allocate prototype.
+	* trans-array.c (gfc_array_allocate):  Change type of
+	gfc_array_allocatate to bool.  Function returns true if
+	it operates on an array.  Change second argument to gfc_expr.
+	Find last reference in chain.
+	If the function operates on an allocatable array, emit call to
+	allocate_array() or allocate64_array().
+	* trans-stmt.c (gfc_trans_allocate):  Code to follow to last
+	reference has been moved to gfc_array_allocate.
+	* trans.h:  Add declaration for gfor_fndecl_allocate_array and
+	gfor_fndecl_allocate64_array.
+	(gfc_build_builtin_function_decls):  Add gfor_fndecl_allocate_array
+	and gfor_fndecl_allocate64_array.
+
+2006-03-01  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-stmt.c (generate_loop_for_temp_to_lhs): Add an additional
+	INVERT argument to invert the sense of the WHEREMASK argument.
+	Remove unneeded code to AND together a list of masks.
+	(generate_loop_for_rhs_to_temp): Likewise.
+	(gfc_trans_assign_need_temp): Likewise.
+	(gfc_trans_forall_1): Likewise.
+	(gfc_evaluate_where_mask): Likewise, add a new INVERT argument
+	to specify the sense of the MASK argument.
+	(gfc_trans_where_assign): Likewise.
+	(gfc_trans_where_2): Likewise.  Restructure code that decides
+	whether we need to allocate zero, one or two temporary masks.
+	If this is a top-level WHERE (i.e. the incoming MASK is NULL),
+	we only need to allocate at most one temporary mask, and can
+	invert it's sense to provide the complementary pending execution
+	mask.  Only calculate the size of the required temporary arrays
+	if we need any.
+	(gfc_trans_where): Update call to gfc_trans_where_2.
+
+2006-03-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	* iresolve.c (gfc_resolve_dot_product):  Remove any difference in
+	treatment of logical types.
+	* trans-intrinsic.c (gfc_conv_intrinsic_dot_product):  New function. 
+
+	PR fortran/26393
+	* trans-decl.c (gfc_get_symbol_decl): Extend condition that symbols
+	must be referenced to include unreferenced symbols in an interface
+	body. 
+
+	PR fortran/20938
+	* trans-array.c (gfc_conv_resolve_dependencies): Add call to
+	gfc_are_equivalenced_arrays.
+	* symbol.c (gfc_free_equiv_infos, gfc_free_equiv_lists): New
+	functions. (gfc_free_namespace): Call them.
+	* trans-common.c (copy_equiv_list_to_ns): New function.
+	(add_equivalences): Call it.
+	* gfortran.h: Add equiv_lists to gfc_namespace and define
+	gfc_equiv_list and gfc_equiv_info.
+	* dependency.c (gfc_are_equivalenced_arrays): New function.
+	(gfc_check_dependency): Call it.
+	* dependency.h: Prototype for gfc_are_equivalenced_arrays.
+
+2006-03-01  Roger Sayle  <roger@eyesopen.com>
+
+	* dependency.c (gfc_is_same_range): Compare the stride, lower and
+	upper bounds when testing array reference ranges for equality.
+	(gfc_check_dependency): Fix indentation whitespace.
+	(gfc_check_element_vs_element): Likewise.
+	(gfc_dep_resolver): Likewise.
+
+2006-02-28  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc):
+	If the mask expression exists and has rank 0, enclose the
+	generated loop in an "if (mask)".  Put the default
+	initialization into the else branch.
+
+2006-02-25  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/23092
+	* trans-intrinsic.c (gfc_conv_intrinsic_arith):  If the
+	mask expression exists and has rank 0, enclose the generated
+	loop in an "if (mask)".
+	* (gfc_conv_intrinsic_minmaxloc):  Likewise.
+
+2006-02-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/26409
+	* resolve.c (resolve_contained_functions, resolve_types,
+	gfc_resolve): Revert patch of 2006-02-19.
+
+2006-02-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24519
+	* dependency.c (gfc_is_same_range): Correct typo.
+	(gfc_check_section_vs_section): Call gfc_is_same_range.
+
+	PR fortran/25395
+	* trans-common.c (add_equivalences): Add a new flag that is set when
+	an equivalence is seen that prevents more from being reset until the
+	start of a new traversal of the list, thus ensuring completion of
+	all the equivalences.
+
+2006-02-23  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	* module.c (read_module): Remove redundant code lines.
+
+2006-02-20 Rafael Ávila de Espíndola <rafael.espindola@gmail.com>
+	* Make-lang.in (FORTRAN): Remove
+	(.PHONY): Remove F95 and f95. Add fortran
+
+2006-02-20  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-stmt.c (gfc_trans_where_2): Avoid updating unused current
+	execution mask for empty WHERE/ELSEWHERE clauses.  Don't allocate
+	temporary mask arrays if they won't be used.
+
+2006-02-20  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-stmt.c (gfc_trans_where_assign): Remove code to handle
+	traversing a linked list of MASKs.  The MASK is now always a
+	single element requiring no ANDing during the assignment.
+
+2006-02-19  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	* gfortran.texi:  Document environment variables which
+	influence runtime behavior.
+
+2006-02-19  H.J. Lu  <hongjiu.lu@intel.com>
+
+	* resolve.c (resolve_contained_functions): Call resolve_entries
+	first.
+	(resolve_types): Remove calls to resolve_entries and
+	resolve_contained_functions.
+	(gfc_resolve): Call resolve_contained_functions.
+
+2006-02-19  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/26201
+	* intrinsic.c (gfc_convert_type_warn): Call
+	gfc_intrinsic_symbol() on the newly created symbol.
+
+2006-02-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25054
+	* resolve.c (is_non_constant_shape_array): New function.
+	(resolve_fl_variable): Remove code for the new function and call it.
+	(resolve_fl_namelist): New function.  Add test for namelist array
+	with non-constant shape, using is_non_constant_shape_array.
+	(resolve_symbol): Remove code for resolve_fl_namelist and call it.
+
+	PR fortran/25089
+	* match.c (match_namelist): Increment the refs field of an accepted
+	namelist object symbol.
+	* resolve.c (resolve_fl_namelist): Test namelist objects for a conflict
+	with contained or module procedures.
+
+2006-02-18  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-stmt.c (struct temporary_list): Delete.
+	(gfc_trans_where_2): Major reorganization.  Remove no longer needed
+	TEMP argument.  Allocate and deallocate the control mask and
+	pending control mask locally.
+	(gfc_trans_forall_1): Delete TEMP local variable, and update
+	call to gfc_trans_where_2.  No need to deallocate arrays after.
+	(gfc_evaluate_where_mask): Major reorganization.  Change return
+	type to void.  Pass in parent execution mask, MASK, and two
+	already allocated mask arrays CMASK and PMASK.  On return
+	CMASK := MASK & COND, PMASK := MASK & !COND.  MASK, CMASK and
+	CMASK may all be NULL, or refer to the same temporary arrays.
+	(gfc_trans_where): Update call to gfc_trans_where_2.  We no
+	longer need a TEMP variable or to deallocate temporary arrays
+	allocated by gfc_trans_where_2.
+
+2006-02-18   Danny Smith  <dannysmith@users.sourceforeg.net>
+
+	* gfortran.h (gfc_add_attribute): Change uint to unsigned int.
+	* symbol.c (gfc_add_attribute): Likewise for definition.
+	* resolve.c (resolve_global_procedure): Likewise for variable 'type'.
+
+2006-02-17  Richard Sandiford  <richard@codesourcery.com>
+
+	* trans-common.c: Include rtl.h earlier.
+	* trans-decl.c: Likewise.
+
+2006-02-16  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/26224
+	* parse.c (parse_omp_do, parse_omp_structured_block): Call
+	gfc_commit_symbols and gfc_warning_check.
+
+	* openmp.c (resolve_omp_clauses): Add a dummy case label to workaround
+	PR middle-end/26316.
+
+2006-02-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24557
+	* trans-expr.c (gfc_add_interface_mapping): Use the actual argument
+	for character(*) arrays, rather than casting to the type and kind
+	parameters of the formal argument.
+
+2006-02-15  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	PR fortran/26054
+	* options.c: Do not warn for Fortran 2003 features by default.
+
+2006-02-15  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* check.c: Update copyright years.
+	
+	* check.c (gfc_check_minloc_maxloc, check_reduction): Don't call
+	dim_range_check on not-present optional dim argument.
+
+2006-02-15  Jakub Jelinek  <jakub@redhat.com>
+
+	PR libgomp/25938
+	PR libgomp/25984
+	* Make-lang.in (install-finclude-dir): New goal.
+	(fortran.install-common): Depend on install-finclude-dir.
+	* lang-specs.h: If not -nostdinc, add -I finclude.
+
+2006-02-14  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/25045
+	* check.c (dim_check):  Perform all checks if dim is optional.
+	(gfc_check_minloc_maxloc):  Use dim_check and dim_rank_check
+	to check dim argument.
+	(check_reduction):  Likewise.
+
+2006-02-14  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/26277
+	* io.c (match_ltag): Mark label as referenced.
+
+2006-02-14  Jakub Jelinek  <jakub@redhat.com>
+	    Richard Henderson  <rth@redhat.com>
+	    Diego Novillo  <dnovillo@redhat.com>
+
+	* invoke.texi: Document -fopenmp.
+	* gfortran.texi (Extensions): Document OpenMP.
+
+	Backport from gomp-20050608-branch
+	* trans-openmp.c: Call build_omp_clause instead of
+	make_node when creating OMP_CLAUSE_* trees.
+	(gfc_trans_omp_reduction_list): Remove argument 'code'.
+	Adjust all callers.
+
+	* trans.h (build4_v): Define.
+	* trans-openmp.c: Call build4_v to create OMP_PARALLEL nodes.
+	Call build3_v to create OMP_SECTIONS nodes.
+
+	PR fortran/25162
+	* openmp.c (gfc_match_omp_variable_list): Call gfc_set_sym_referenced
+	on all symbols added to the variable list.
+
+	* openmp.c (gfc_match_omp_clauses): Fix check for non-INTRINSIC
+	procedure symbol in REDUCTION.
+
+	* trans-openmp.c (gfc_trans_omp_array_reduction): Use gfc_add
+	for MINUS_EXPR OMP_CLAUSE_REDUCTION_CODE.
+
+	* trans-openmp.c (gfc_trans_omp_do): Add PBLOCK argument.  If PBLOCK
+	is non-NULL, evaluate INIT/COND/INCR and chunk size expressions in
+	that statement block.
+	(gfc_trans_omp_parallel_do): Pass non-NULL PBLOCK to gfc_trans_omp_do
+	for non-ordered non-static combined loops.
+	(gfc_trans_omp_directive): Pass NULL PBLOCK to gfc_trans_omp_do.
+
+	* openmp.c: Include target.h and toplev.h.
+	(gfc_match_omp_threadprivate): Emit diagnostic if target does
+	not support TLS.
+	* Make-lang.in (fortran/openmp.o): Add dependencies on
+	target.h and toplev.h.
+
+	* trans-decl.c (gfc_get_fake_result_decl): Set GFC_DECL_RESULT.
+	* trans-openmp.c (gfc_omp_privatize_by_reference): Make
+	DECL_ARTIFICIAL vars predetermined shared except GFC_DECL_RESULT.
+	(gfc_omp_disregard_value_expr): Handle GFC_DECL_RESULT.
+	(gfc_trans_omp_variable): New function.
+	(gfc_trans_omp_variable_list, gfc_trans_omp_reduction_list): Use it.
+	* trans.h (GFC_DECL_RESULT): Define.
+
+	* trans-openmp.c (gfc_omp_firstprivatize_type_sizes): New function.
+	* f95-lang.c (LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES): Define.
+	* trans.h (gfc_omp_firstprivatize_type_sizes): New prototype.
+
+	* trans-openmp.c (gfc_omp_privatize_by_reference): Return
+	true if a pointer has GFC_DECL_SAVED_DESCRIPTOR set.
+	(gfc_trans_omp_array_reduction, gfc_trans_omp_reduction_list): New
+	functions.
+	(gfc_trans_omp_clauses): Add WHERE argument.  Call
+	gfc_trans_omp_reduction_list rather than gfc_trans_omp_variable_list
+	for reductions.
+	(gfc_trans_omp_do, gfc_trans_omp_parallel, gfc_trans_omp_parallel_do,
+	gfc_trans_omp_parallel_sections, gfc_trans_omp_parallel_workshare,
+	gfc_trans_omp_sections, gfc_trans_omp_single): Adjust
+	gfc_trans_omp_clauses callers.
+
+	* openmp.c (omp_current_do_code): New var.
+	(gfc_resolve_omp_do_blocks): New function.
+	(gfc_resolve_omp_parallel_blocks): Call it.
+	(gfc_resolve_do_iterator): Add CODE argument.  Don't propagate
+	predetermination if argument is !$omp do or !$omp parallel do
+	iteration variable.
+	* resolve.c (resolve_code): Call gfc_resolve_omp_do_blocks
+	for EXEC_OMP_DO.  Adjust gfc_resolve_do_iterator caller.
+	* fortran.h (gfc_resolve_omp_do_blocks): New prototype.
+	(gfc_resolve_do_iterator): Add CODE argument.
+
+	* trans.h (gfc_omp_predetermined_sharing,
+	gfc_omp_disregard_value_expr, gfc_omp_private_debug_clause): New
+	prototypes.
+	(GFC_DECL_COMMON_OR_EQUIV, GFC_DECL_CRAY_POINTEE): Define.
+	* trans-openmp.c (gfc_omp_predetermined_sharing,
+	gfc_omp_disregard_value_expr, gfc_omp_private_debug_clause): New
+	functions.
+	* trans-common.c (build_equiv_decl, build_common_decl,
+	create_common): Set GFC_DECL_COMMON_OR_EQUIV flag on the decls.
+	* trans-decl.c (gfc_finish_cray_pointee): Set GFC_DECL_CRAY_POINTEE
+	on the decl.
+	* f95-lang.c (LANG_HOOKS_OMP_PREDETERMINED_SHARING,
+	LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR,
+	LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE): Define.
+
+	* openmp.c (resolve_omp_clauses): Remove extraneous comma.
+
+	* symbol.c (check_conflict): Add conflict between cray_pointee and
+	threadprivate.
+	* openmp.c (gfc_match_omp_threadprivate): Fail if
+	gfc_add_threadprivate returned FAILURE.
+	(resolve_omp_clauses): Diagnose Cray pointees in SHARED,
+	{,FIRST,LAST}PRIVATE and REDUCTION clauses and Cray pointers in
+	{FIRST,LAST}PRIVATE and REDUCTION clauses.
+
+	* resolve.c (omp_workshare_flag): New variable.
+	(resolve_function): Diagnose use of non-ELEMENTAL user defined
+	function in WORKSHARE construct.
+	(resolve_code): Cleanup forall_save use.  Make sure omp_workshare_flag
+	is set to correct value in different contexts.
+
+	* openmp.c (resolve_omp_clauses): Replace %s with '%s' when printing
+	variable name.
+	(resolve_omp_atomic): Likewise.
+
+	PR fortran/24493
+	* scanner.c (skip_free_comments): Set at_bol at the beginning of the
+	loop, not before it.
+	(skip_fixed_comments): Handle ! comments in the middle of line here
+	as well.
+	(gfc_skip_comments): Use skip_fixed_comments for FIXED_FORM even if
+	not at BOL.
+	(gfc_next_char_literal): Fix expected canonicalized *$omp string.
+
+	* trans-openmp.c (gfc_trans_omp_do): Use make_node and explicit
+	initialization to build OMP_FOR instead of build.
+
+	* trans-decl.c (gfc_gimplify_function): Invoke
+	diagnose_omp_structured_block_errors.
+
+	* trans-openmp.c (gfc_trans_omp_master): Use OMP_MASTER.
+	(gfc_trans_omp_ordered): Use OMP_ORDERED.
+
+	* gfortran.h (gfc_resolve_do_iterator, gfc_resolve_blocks,
+	gfc_resolve_omp_parallel_blocks): New prototypes.
+	* resolve.c (resolve_blocks): Renamed to...
+	(gfc_resolve_blocks): ... this.  Remove static.
+	(gfc_resolve_forall): Adjust caller.
+	(resolve_code): Only call gfc_resolve_blocks if code->block != 0
+	and not for EXEC_OMP_PARALLEL* directives.  Call
+	gfc_resolve_omp_parallel_blocks for EXEC_OMP_PARALLEL* directives.
+	Call gfc_resolve_do_iterator if resolved successfully EXEC_DO
+	iterator.
+	* openmp.c: Include pointer-set.h.
+	(omp_current_ctx): New variable.
+	(gfc_resolve_omp_parallel_blocks, gfc_resolve_do_iterator): New
+	functions.
+	* Make-lang.in (fortran/openmp.o): Depend on pointer-set.h.
+
+	* openmp.c (gfc_match_omp_clauses): For max/min/iand/ior/ieor,
+	look up symbol if it exists, use its name instead and, if it is not
+	INTRINSIC, issue diagnostics.
+
+	* parse.c (parse_omp_do): Handle implied end do properly.
+	(parse_executable): If parse_omp_do returned ST_IMPLIED_ENDDO,
+	return it instead of continuing.
+
+	* trans-openmp.c (gfc_trans_omp_critical): Update for changed
+	operand numbering.
+	(gfc_trans_omp_do, gfc_trans_omp_parallel, gfc_trans_omp_parallel_do,
+	gfc_trans_omp_parallel_sections, gfc_trans_omp_parallel_workshare,
+	gfc_trans_omp_sections, gfc_trans_omp_single): Likewise.
+
+	* trans.h (gfc_omp_privatize_by_reference): New prototype.
+	* f95-lang.c (LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE): Redefine
+	to gfc_omp_privatize_by_reference.
+	* trans-openmp.c (gfc_omp_privatize_by_reference): New function.
+
+	* trans-stmt.h (gfc_trans_omp_directive): Add comment.
+
+	* openmp.c (gfc_match_omp_variable_list): Add ALLOW_COMMON argument.
+	Disallow COMMON matching if it is set.
+	(gfc_match_omp_clauses, gfc_match_omp_flush): Adjust all callers.
+	(resolve_omp_clauses): Show locus in error messages.  Check that
+	variable types in reduction clauses are appropriate for reduction
+	operators.
+
+	* resolve.c (resolve_symbol): Don't error if a threadprivate module
+	variable isn't SAVEd.
+
+	* trans-openmp.c (gfc_trans_omp_do): Put count into BLOCK, not BODY.
+	Fix typo in condition.  Fix DOVAR initialization.
+
+	* openmp.c (gfc_match_omp_clauses): Match min/iand/ior/ieor
+	rather than .min. etc.
+
+	* trans-openmpc.c (omp_not_yet): Remove.
+	(gfc_trans_omp_parallel_do): Keep listprivate clause on parallel.
+	Force creation of BIND_EXPR around the workshare construct.
+	(gfc_trans_omp_parallel_sections): Likewise.
+	(gfc_trans_omp_parallel_workshare): Likewise.
+
+	* types.def (BT_I16, BT_FN_I16_VPTR_I16,
+	BT_FN_BOOL_VPTR_I16_I16, BT_FN_I16_VPTR_I16_I16): Add.
+
+	* trans-openmp.c (gfc_trans_omp_clauses): Create OMP_CLAUSE_DEFAULT.
+	(gfc_trans_omp_code): New function.
+	(gfc_trans_omp_do): Use it, remove omp_not_yet uses.
+	(gfc_trans_omp_parallel, gfc_trans_omp_single): Likewise.
+	(gfc_trans_omp_sections): Likewise.  Only treat empty last section
+	specially if lastprivate clause is present.
+	* f95-lang.c (gfc_init_builtin_functions): Create BUILT_IN_TRAP
+	builtin.
+
+	* trans-openmp.c (gfc_trans_omp_variable_list): Update for
+	OMP_CLAUSE_DECL name change.
+	(gfc_trans_omp_do): Likewise.
+
+	* trans-openmp.c (gfc_trans_omp_clauses): Create OMP_CLAUSE_REDUCTION
+	clauses.
+	(gfc_trans_omp_atomic): Build OMP_ATOMIC instead of expanding
+	sync builtins directly.
+	(gfc_trans_omp_single): Build OMP_SINGLE statement.
+
+	* trans-openmp.c (gfc_trans_add_clause): New.
+	(gfc_trans_omp_variable_list): Take a tree code and build the clause
+	node here.  Link it to the head of a list.
+	(gfc_trans_omp_clauses): Update to match.
+	(gfc_trans_omp_do): Use gfc_trans_add_clause.
+
+	* trans-openmp.c (gfc_trans_omp_clauses): Change second argument to
+	gfc_omp_clauses *.  Use gfc_evaluate_now instead of creating
+	temporaries by hand.
+	(gfc_trans_omp_atomic, gfc_trans_omp_critical): Use buildN_v macros.
+	(gfc_trans_omp_do): New function.
+	(gfc_trans_omp_master): Dont' check for gfc_trans_code returning NULL.
+	(gfc_trans_omp_parallel): Adjust gfc_trans_omp_clauses caller.
+	Use buildN_v macros.
+	(gfc_trans_omp_parallel_do, gfc_trans_omp_parallel_sections,
+	gfc_trans_omp_parallel_workshare, gfc_trans_omp_sections,
+	gfc_trans_omp_single, gfc_trans_omp_workshare): New functions.
+	(gfc_trans_omp_directive): Use them.
+	* parse.c (parse_omp_do): Allow new_st.op == EXEC_NOP.
+	* openmp.c (resolve_omp_clauses): Check for list items present
+	in multiple clauses.
+	(resolve_omp_do): Check that iteration variable is not THREADPRIVATE
+	and is not present in any clause variable lists other than PRIVATE
+	or LASTPRIVATE.
+
+	* gfortran.h (symbol_attribute): Add threadprivate bit.
+	(gfc_common_head): Add threadprivate member, change use_assoc
+	and saved into char to save space.
+	(gfc_add_threadprivate): New prototype.
+	* symbol.c (check_conflict): Handle threadprivate.
+	(gfc_add_threadprivate): New function.
+	(gfc_copy_attr): Copy threadprivate.
+	* trans-openmp.c (gfc_trans_omp_clauses): Avoid creating a temporary
+	if IF or NUM_THREADS is constant.  Create OMP_CLAUSE_SCHEDULE and
+	OMP_CLAUSE_ORDERED.
+	* resolve.c (resolve_symbol): Complain if a THREADPRIVATE symbol
+	outside a module and not in COMMON has is not SAVEd.
+	(resolve_equivalence): Ensure THREADPRIVATE objects don't get
+	EQUIVALENCEd.
+	* trans-common.c: Include target.h and rtl.h.
+	(build_common_decl): Set DECL_TLS_MODEL if THREADPRIVATE.
+	* trans-decl.c: Include rtl.h.
+	(gfc_finish_var_decl): Set DECL_TLS_MODEL if THREADPRIVATE.
+	* dump-parse-tree.c (gfc_show_attr): Handle THREADPRIVATE.
+	* Make-lang.in (fortran/trans-decl.o): Depend on $(RTL_H).
+	(fortran/trans-common.o): Depend on $(RTL_H) and $(TARGET_H).
+	* openmp.c (gfc_match_omp_variable_list): Ensure COMMON block
+	is from current namespace.
+	(gfc_match_omp_threadprivate): Rewrite.
+	(resolve_omp_clauses): Check some clause restrictions.
+	* module.c (ab_attribute): Add AB_THREADPRIVATE.
+	(attr_bits): Add THREADPRIVATE.
+	(mio_symbol_attribute, mio_symbol_attribute): Handle threadprivate.
+	(load_commons, write_common, write_blank_common): Adjust for type
+	change of saved, store/load threadprivate bit from the integer
+	as well.
+
+	* types.def (BT_FN_UINT_UINT): New.
+	(BT_FN_VOID_UINT_UINT): Remove.
+
+	* trans-openmp.c (gfc_trans_omp_clauses, gfc_trans_omp_barrier,
+	gfc_trans_omp_critical, gfc_trans_omp_flush, gfc_trans_omp_master,
+	gfc_trans_omp_ordered, gfc_trans_omp_parallel): New functions.
+	(gfc_trans_omp_directive): Use them.
+
+	* openmp.c (expr_references_sym): Add SE argument, don't look
+	into SE tree.
+	(is_conversion): New function.
+	(resolve_omp_atomic): Adjust expr_references_sym callers.  Handle
+	promoted expressions.
+	* trans-openmp.c (gfc_trans_omp_atomic): New function.
+	(gfc_trans_omp_directive): Call it.
+
+	* f95-lang.c (builtin_type_for_size): New function.
+	(gfc_init_builtin_functions): Initialize synchronization and
+	OpenMP builtins.
+	* types.def: New file.
+	* Make-lang.in (f95-lang.o): Depend on $(BUILTINS_DEF) and
+	fortran/types.def.
+
+	* trans-openmp.c: Rename GOMP_* tree codes into OMP_*.
+
+	* dump-parse-tree.c (show_symtree): Don't crash if ns->proc_name
+	is NULL.
+
+	* dump-parse-tree.c (gfc_show_namelist, gfc_show_omp_node): New
+	functions.
+	(gfc_show_code_node): Call gfc_show_omp_node for EXEC_OMP_* nodes.
+
+	* parse.c (parse_omp_do): Call pop_state before next_statement.
+	* openmp.c (expr_references_sym, resolve_omp_atomic, resolve_omp_do):
+	New functions.
+	(gfc_resolve_omp_directive): Call them.
+	* match.c (match_exit_cycle): Issue error if EXIT or CYCLE statement
+	leaves an OpenMP structured block or if EXIT terminates !$omp do
+	loop.
+
+	* Make-lang.in (F95_PARSER_OBJS): Add fortran/openmp.o.
+	(F95_OBJS): Add fortran/trans-openmp.o.
+	(fortran/trans-openmp.o): Depend on $(GFORTRAN_TRANS_DEPS).
+	* lang.opt: Add -fopenmp option.
+	* options.c (gfc_init_options): Initialize it.
+	(gfc_handle_option): Handle it.
+	* gfortran.h (ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL,
+	ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER,
+	ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO,
+	ST_OMP_END_PARALLEL_SECTIONS, ST_OMP_END_PARALLEL_WORKSHARE,
+	ST_OMP_END_SECTIONS, ST_OMP_END_SINGLE, ST_OMP_END_WORKSHARE,
+	ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED,
+	ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
+	ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION,
+	ST_OMP_SINGLE, ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE): New
+	statement codes.
+	(OMP_LIST_PRIVATE, OMP_LIST_FIRSTPRIVATE, OMP_LIST_LASTPRIVATE,
+	OMP_LIST_COPYPRIVATE, OMP_LIST_SHARED, OMP_LIST_COPYIN,
+	OMP_LIST_PLUS, OMP_LIST_REDUCTION_FIRST, OMP_LIST_MULT,
+	OMP_LIST_SUB, OMP_LIST_AND, OMP_LIST_OR, OMP_LIST_EQV,
+	OMP_LIST_NEQV, OMP_LIST_MAX, OMP_LIST_MIN, OMP_LIST_IAND,
+	OMP_LIST_IOR, OMP_LIST_IEOR, OMP_LIST_REDUCTION_LAST, OMP_LIST_NUM):
+	New OpenMP variable list types.
+	(gfc_omp_clauses): New typedef.
+	(gfc_get_omp_clauses): Define.
+	(EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
+	EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
+	EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
+	EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
+	EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
+	EXEC_OMP_END_SINGLE): New OpenMP gfc_exec_op codes.
+	(struct gfc_code): Add omp_clauses, omp_name, omp_namelist
+	and omp_bool fields to ext union.
+	(flag_openmp): Declare.
+	(gfc_free_omp_clauses, gfc_resolve_omp_directive): New prototypes.
+	* scanner.c (openmp_flag, openmp_locus): New variables.
+	(skip_free_comments, skip_fixed_comments, gfc_next_char_literal):
+	Handle OpenMP directive lines and conditional compilation magic
+	comments.
+	* parse.h (COMP_OMP_STRUCTURED_BLOCK): New compile state.
+	* parse.c (decode_omp_directive, parse_omp_do, parse_omp_atomic,
+	parse_omp_structured_block): New functions.
+	(next_free, next_fixed): Parse OpenMP directives.
+	(case_executable, case_exec_markers, case_decl): Add ST_OMP_*
+	codes.
+	(gfc_ascii_statement): Handle ST_OMP_* codes.
+	(parse_executable): Rearrange the loop slightly, so that
+	parse_omp_do can return next_statement.
+	* match.h (gfc_match_omp_eos, gfc_match_omp_atomic,
+	gfc_match_omp_barrier, gfc_match_omp_critical, gfc_match_omp_do,
+	gfc_match_omp_flush, gfc_match_omp_master, gfc_match_omp_ordered,
+	gfc_match_omp_parallel, gfc_match_omp_parallel_do,
+	gfc_match_omp_parallel_sections, gfc_match_omp_parallel_workshare,
+	gfc_match_omp_sections, gfc_match_omp_single,
+	gfc_match_omp_threadprivate, gfc_match_omp_workshare,
+	gfc_match_omp_end_nowait, gfc_match_omp_end_single): New prototypes.
+	* resolve.c (resolve_blocks): Ignore EXEC_OMP_* block directives.
+	(resolve_code): Call gfc_resolve_omp_directive on EXEC_OMP_*
+	directives.
+	* trans.c (gfc_trans_code): Call gfc_trans_omp_directive for
+	EXEC_OMP_* directives.
+	* st.c (gfc_free_statement): Handle EXEC_OMP_* statement freeing.
+	* trans-stmt.h (gfc_trans_omp_directive): New prototype.
+	* openmp.c: New file.
+	* trans-openmp.c: New file.
+
+2006-02-13  Andrew Pinski  <pinskia@physics.uc.edu>
+	    Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/26246
+	* trans-decl.c (gfc_get_symbol_decl, gfc_get_fake_result_decl): Use
+	gfc_add_decl_to_function rather than gfc_finish_var_decl on length.
+
+2006-02-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/26074
+	PR fortran/25103
+	* resolve.c (resolve_symbol): Extend the requirement that module
+	arrays have constant bounds to those in the main program.  At the
+	same time simplify the array bounds, to avoiding trapping parameter
+	array references, and exclude automatic character length from main
+	and modules. Rearrange resolve_symbol and resolve_derived to put as
+	each flavor together, as much as is possible and move all specific
+	code for flavors FL_VARIABLE, FL_PROCEDURE and FL_PARAMETER into new
+	functions.
+	(resolve_fl_var_and_proc, resolve_fl_variable, resolve_fl_procedure):
+	New functions to do work of resolve_symbol.
+	(resolve_index_expr): New function that is called from resolved_symbol
+	and is extracted from resolve_charlen.
+	(resolve_charlen): Call this new function.
+	(resolve_fl_derived): Renamed resolve_derived to be consistent with
+	the naming of the new functions for the other flavours.  Change the
+	charlen checking so that the style is consistent with other similar
+	checks. Add the generation of the gfc_dt_list, removed from resolve_
+	symbol.
+
+	PR fortran/20861
+	* resolve.c (resolve_actual_arglist): Prevent internal procedures
+	from being dummy arguments.
+
+	PR fortran/20871
+	* resolve.c (resolve_actual_arglist): Prevent pure but non-intrinsic
+	procedures from being dummy arguments.
+
+	PR fortran/25083
+	* resolve.c (check_data_variable): Add test that data variable is in
+	COMMON.
+
+	PR fortran/25088
+	* resolve.c (resolve_call): Add test that the subroutine does not
+	have a type.
+
+2006-02-12  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/25806
+	* trans-array.c (gfc_trans_allocate_array_storage): New argument
+	dealloc; free the temporary only if dealloc is true.
+	(gfc_trans_allocate_temp_array): New argument bool dealloc, to be
+	passed onwards to gfc_trans_allocate_array_storage.
+	(gfc_trans_array_constructor, gfc_conv_loop_setup): Update call to
+	gfc_trans_allocate_temp_array.
+	* trans-array.h (gfc_trans_allocate_temp_array): Update function
+	prototype.
+	* trans-expr.c (gfc_conv_function_call): Set new argument 'dealloc'
+	to gfc_trans_allocate_temp_array to false in case of functions
+	returning pointers.
+	(gfc_trans_arrayfunc_assign): Return NULL for functions returning
+	pointers.
+
+2006-02-10  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/20858
+	*decl.c (variable_decl): Improve error message.  Remove initialization
+	typespec.  Wrap long line.
+	*expr.c (gfc_check_pointer_assign): Permit checking of type, kind type,
+	and rank.
+	*simplify.c (gfc_simplify_null): Ensure type, kind type, and rank
+	are set.
+
+
+2006-02-10  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/14771
+	* arith.c (eval_intrinsic): Accept INTRINSIC_PARENTHESES.
+	* expr.c (check_intrinsic_op): Likewise.
+	* module.c (mio_expr): Likewise.
+
+2006-02-09  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* dump-parse-tree.c: Update copyright years.
+	* matchexp.c: Likewise.
+	* module.c: Likewise.
+
+	PR fortran/14771
+	* gfortran.h (gfc_intrinsic_op): Add INTRINSIC_PARENTHESES.
+	* dump-parse-tree (gfc_show_expr): Handle INTRINSIC_PARENTHESES.
+	* expr.c (simplify_intrinsic_op): Treat INTRINSIC_PARENTHESES as
+	if it were INTRINSIC_UPLUS.
+	* resolve.c (resolve_operator): Handle INTRINSIC_PARENTHESES.
+	* match.c (intrinsic_operators): Add INTRINSIC_PARENTHESES.
+	* matchexp.c (match_primary): Record parentheses surrounding
+	numeric expressions.
+	* module.c (intrinsics): Add INTRINSIC_PARENTHESES for module
+	dumping.
+	* trans-expr.c (gfc_conv_expr_op): Handle INTRINSIC_PARENTHESES.
+
+2006-02-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/26038
+	* trans-stmt.c (gfc_trans_allocate): Provide assumed character length
+	scalar with missing backend_decl for the hidden dummy charlen.
+
+	PR fortran/25059
+	* interface.c (gfc_extend_assign): Remove detection of non-PURE
+	subroutine in assignment interface, with gfc_error, and put it in
+	* resolve.c (resolve_code).
+
+	PR fortran/25070
+	* interface.c (gfc_procedure_use): Flag rank checking for non-
+	elemental, contained or interface procedures in call to
+	(compare_actual_formal), where ranks are checked for assumed
+	shape arrays..
+
+2006-02-08  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR libfortran/25425
+	* trans-decl.c (gfc_generate_function_code): Add new argument,
+	pedantic, to set_std call.
+
+2006-02-06  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR libfortran/23815
+	* gfortran.texi: Document the GFORTRAN_CONVERT_UNIT environment
+	variable.
+	* invoke.texi:  Mention the "Runtime" chapter.
+	Document the -fconvert= option.
+	* gfortran.h:  Add options_convert.
+	* lang.opt:  Add fconvert=little-endian, fconvert=big-endian,
+	fconvert=native and fconvert=swap.
+	* trans-decl.c (top level):  Add gfor_fndecl_set_convert.
+	(gfc_build_builtin_function_decls):  Set gfor_fndecl_set_convert.
+	(gfc_generate_function_code):  If -fconvert was specified,
+	and this is the main program, add a call to set_convert().
+	* options.c:  Handle the -fconvert options.
+
+2006-02-06  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-stmt.c (gfc_evaluate_where_mask): Allow the NMASK argument
+	to be NULL to indicate that the not mask isn't required.
+	(gfc_trans_where_2): Remove PMASK argument.  Avoid calculating the
+	pending mask for the last clause of a WHERE chain.  Update recursive
+	call.
+	(gfc_trans_forall_1): Update call to gfc_trans_where_2.
+	(gfc_trans_where): Likewise.
+
+2006-02-06  Jakub Jelinek  <jakub@redhat.com>
+
+	Backport from gomp-20050608-branch
+	* trans-decl.c (create_function_arglist): Handle dummy functions.
+
+	* trans-decl.c (gfc_get_symbol_decl): Revert explicit setting of
+	TYPE_SIZE_UNIT.
+	(gfc_trans_vla_type_sizes): Also "gimplify"
+	GFC_TYPE_ARRAY_DATAPTR_TYPE for GFC_DESCRIPTOR_TYPE_P types.
+	* trans-array.c (gfc_trans_deferred_array): Call
+	gfc_trans_vla_type_sizes.
+
+	* trans-decl.c (saved_function_decls, saved_parent_function_decls):
+	Remove unnecessary initialization.
+	(create_function_arglist): Make sure __result has complete type.
+	(gfc_get_fake_result_decl): Change current_fake_result_decl into
+	a tree chain.  For entry master, create a separate variable
+	for each result name.  For BT_CHARACTER results, call
+	gfc_finish_var_decl on length even if it has been already created,
+	but not pushdecl'ed.
+	(gfc_trans_vla_type_sizes): For function/entry result, adjust
+	result value type, not the FUNCTION_TYPE.
+	(gfc_generate_function_code): Adjust for current_fake_result_decl
+	changes.
+	(gfc_trans_deferred_vars): Likewise.  Call gfc_trans_vla_type_sizes
+	even on result if it is assumed-length character.
+
+	* trans-decl.c (gfc_trans_dummy_character): Add SYM argument.
+	Call gfc_trans_vla_type_sizes.
+	(gfc_trans_auto_character_variable): Call gfc_trans_vla_type_sizes.
+	(gfc_trans_vla_one_sizepos, gfc_trans_vla_type_sizes_1,
+	gfc_trans_vla_type_sizes): New functions.
+	(gfc_trans_deferred_vars): Adjust gfc_trans_dummy_character
+	callers.  Call gfc_trans_vla_type_sizes on assumed-length
+	character parameters.
+	* trans-array.c (gfc_trans_array_bounds,
+	gfc_trans_auto_array_allocation, gfc_trans_dummy_array_bias): Call
+	gfc_trans_vla_type_sizes.
+	* trans.h (gfc_trans_vla_type_sizes): New prototype.
+
+	* trans-decl.c (gfc_build_qualified_array): For non-assumed-size
+	arrays without constant size, create also an index var for
+	GFC_TYPE_ARRAY_SIZE (type).  If the type is incomplete, complete
+	it as 0..size-1.
+	(gfc_create_string_length): Don't call gfc_defer_symbol_init
+	if just creating DECL_ARGUMENTS.
+	(gfc_get_symbol_decl): Call gfc_finish_var_decl and
+	gfc_defer_symbol_init even if ts.cl->backend_decl is already
+	set to a VAR_DECL that doesn't have DECL_CONTEXT yet.
+	(create_function_arglist): Rework, so that hidden length
+	arguments for CHARACTER parameters are created together with
+	the parameters.  Resolve ts.cl->backend_decl for CHARACTER
+	parameters.  If the argument is a non-constant length array
+	or CHARACTER, ensure PARM_DECL has different type than
+	its DECL_ARG_TYPE.
+	(generate_local_decl): Call gfc_get_symbol_decl even
+	for non-referenced non-constant length CHARACTER parameters
+	after optionally issuing warnings.
+	* trans-array.c (gfc_trans_array_bounds): Set last stride
+	to GFC_TYPE_ARRAY_SIZE (type) to initialize it as well.
+	(gfc_trans_dummy_array_bias): Initialize GFC_TYPE_ARRAY_SIZE (type)
+	variable as well.
+
+	* trans-expr.c (gfc_conv_expr_val): Fix comment typo.
+
+	* trans-stmt.c (gfc_trans_simple_do): Fix comment.
+
+2006-02-04  Roger Sayle  <roger@eyesopen.com>
+
+	* dependency.c (gfc_check_dependency): Remove unused vars and nvars
+	arguments.  Replace with an "identical" argument.  A full array
+	reference to the same symbol is a dependency if identical is true.
+	* dependency.h (gfc_check_dependency): Update prototype.
+	* trans-array.h (gfc_check_dependency): Delete duplicate prototype.
+	* trans-stmt.c: #include dependency.h for gfc_check_dependency.
+	(gfc_trans_forall_1): Update calls to gfc_check_dependency.
+	(gfc_trans_where_2): Likewise.  Remove unneeded variables.
+	(gfc_trans_where_3): New function for simple non-dependent WHEREs.
+	(gfc_trans_where): Call gfc_trans_where_3 to translate simple
+	F90-style WHERE statements without internal dependencies.
+	* Make-lang.in (trans-stmt.o): Depend upon dependency.h.
+
+2006-02-05  H.J. Lu  <hongjiu.lu@intel.com>
+
+	PR fortran/26041
+	PR fortran/26064
+	* resolve.c (resolve_types): New function.
+	(resolve_codes): Likewise.
+	(gfc_resolve): Use them.
+
+2006-02-05  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-stmt.c (gfc_evaluate_where_mask): Use LOGICAL*1 for WHERE
+	masks instead of LOGICAL*4.
+
+2006-02-05  Jakub Jelinek  <jakub@redhat.com>
+
+	* resolve.c (resolve_symbol): Initialize constructor_expr to NULL.
+
+2006-02-04  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/25075
+	check.c (identical_dimen_shape):  New function.
+	(check_dot_product):  Use identical_dimen_shape() to check sizes
+	for dot_product.
+	(gfc_check_matmul):  Likewise.
+	(gfc_check_merge):  Check conformance between tsource and fsource
+	and between tsource and mask.
+	(gfc_check_pack):  Check conformance between array and mask.
+
+2006-02-03  Steven G. Kargl  <kargls@comcast>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/20845
+	* resolve.c (resolve_symbol): Default initialization of derived type
+	component reguires the SAVE attribute.
+
+2006-02-02  Steven G. Kargl  <kargls@comcast>
+
+	PR fortran/24958
+	match.c (gfc_match_nullify):  Free the list from head not tail.
+
+	PR fortran/25072
+	* match.c (match_forall_header): Fix internal error caused by bogus
+	gfc_epxr pointers.
+
+
+2006-01-31  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/26039
+	expr.c (gfc_check_conformance):  Reorder error message
+	to avoid plural.
+	check.c(gfc_check_minloc_maxloc):  Call gfc_check_conformance
+	for checking arguments array and mask.
+	(check_reduction):  Likewise.
+
+2006-01-30  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/24266
+	* trans-io.c (set_internal_unit): Check the rank of the
+	expression node itself instead of its symbol.
+
+2006-01-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/18578
+	PR fortran/18579
+	PR fortran/20857
+	PR fortran/20885
+	* interface.c (compare_actual_formal): Error for INTENT(OUT or INOUT)
+	if actual argument is not a variable.
+
+2006-01-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/17911
+	* expr.c (gfc_check_assign, gfc_check_pointer_assign): Emit error if
+	the lvalue is a use associated procedure.
+
+	PR fortran/20895
+	PR fortran/25030
+	* expr.c (gfc_check_pointer_assign): Emit error if lvalue and rvalue
+	character lengths are not the same.  Use gfc_dep_compare_expr for the
+	comparison.
+	* gfortran.h: Add prototype for gfc_dep_compare_expr.
+	* dependency.h: Remove prototype for gfc_dep_compare_expr.
+
+2006-01-27  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25964
+	* resolve.c (resolve_function): Add GFC_ISYM_LOC to the list of
+	generic_ids exempted from assumed size checking.
+
+2006-01-27  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/25324
+	* Make-lang.in (fortran/scanner.o): Depend on toplev.h.
+	* lang.opt (fpreprocessed): New option.
+	* scanner.c: Include toplev.h.
+	(gfc_src_file, gfc_src_preprocessor_lines): New variables.
+	(preprocessor_line): Unescape filename if there were any
+	backslashes.
+	(load_file): If initial and gfc_src_file is not NULL,
+	use it rather than opening the file.  If gfc_src_preprocessor_lines
+	has non-NULL elements, pass it to preprocessor_line.
+	(unescape_filename, gfc_read_orig_filename): New functions.
+	* gfortran.h (gfc_option_t): Add flag_preprocessed.
+	(gfc_read_orig_filename): New prototype.
+	* options.c (gfc_init_options): Clear flag_preprocessed.
+	(gfc_post_options): If flag_preprocessed, call
+	gfc_read_orig_filename.
+	(gfc_handle_option): Handle OPT_fpreprocessed.
+	* lang-specs.h: Pass -fpreprocessed to f951 if preprocessing
+	sources.
+
+2006-01-27  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	* symbol.c (free_old_symbol): Fix confusing comment, and add code
+	  to free old_symbol->formal.
+
+2006-01-26  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25964
+	* resolve.c (resolve_function): Exclude statement functions from
+	global reference checking.
+
+	PR fortran/25084
+	PR fortran/20852
+	PR fortran/25085
+	PR fortran/25086
+	* resolve.c (resolve_function): Declare a gfc_symbol to replace the
+	references through the symtree to the symbol associated with the
+	function expresion. Give error on reference to an assumed character
+	length function is defined in an interface or an external function
+	that is not a dummy argument.
+	(resolve_symbol): Give error if an assumed character length function
+	is array-valued, pointer-valued, pure or recursive. Emit warning
+	that character(*) value functions are obsolescent in F95.
+
+	PR fortran/25416
+	* trans-expr.c (gfc_conv_function_call): The above patch to resolve.c
+	prevents any assumed character length function call from getting here
+	except intrinsics such as SPREAD. In this case, ensure that no
+	segfault occurs from referencing non-existent charlen->length->
+	expr_type and provide a backend_decl for the charlen from the charlen
+	of the first actual argument.
+
+	Cure temp name confusion.
+	* trans-expr.c (gfc_get_interface_mapping_array): Change name of
+	temporary from "parm" to "ifm" to avoid clash with temp coming from
+	trans-array.c.
+
+2006-01-25  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/25716
+	* symbol.c (free_old_symbol): New function.
+	(gfc_commit_symbols): Use it.
+	(gfc_commit_symbol): New function.
+	(gfc_use_derived): Use it.
+	* gfortran.h: Add prototype for gfc_commit_symbol.
+	* intrinsic.c (gfc_find_function): Search in 'conversion'
+	if not found in 'functions'.
+	(gfc_convert_type_warn): Add a symtree to the new
+	expression node, and commit the new symtree->n.sym.
+	* resolve.c (gfc_resolve_index): Make sure typespec is
+	properly initialized.
+
+2006-01-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25901
+	* decl.c (get_proc_name): Replace subroutine and function attributes
+	in "already defined" test by the formal arglist pointer being non-NULL.
+
+	Fix regression in testing of admissability of attributes.
+	* symbol.c (gfc_add_attribute): If the current_attr has non-zero
+	intent, do not do the check for a dummy being used.
+	* decl.c (attr_decl1): Add current_attr.intent as the third argument
+	in the call to gfc_add_attribute.
+	* gfortran.h: Add the third argument to the prototype for
+	gfc_add_attribute.
+
+2006-01-21  Joseph S. Myers  <joseph@codesourcery.com>
+
+	* gfortranspec.c (lang_specific_driver): Update copyright notice
+	date.
+
+2006-01-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25124
+	PR fortran/25625
+	* decl.c (get_proc_name): If there is an existing
+	symbol in the encompassing namespace, call errors
+	if it is a procedure of the same name or the kind
+	field is set, indicating a type declaration.
+
+	PR fortran/20881
+	PR fortran/23308
+	PR fortran/25538
+	PR fortran/25710
+	* decl.c (add_global_entry): New function to check
+	for existing global symbol with this name and to
+	create new one if none exists.
+	(gfc_match_entry): Call add_global_entry before
+	matching argument lists for subroutine and function
+	entries.
+	* gfortran.h: Prototype for existing function,
+	global_used.
+	* resolve.c (resolve_global_procedure): New function
+	to check global symbols for procedures.
+	(resolve_call, resolve_function): Calls to this
+	new function for non-contained and non-module
+	procedures.
+	* match.c (match_common): Add check for existing
+	global symbol, creat one if none exists and emit
+	error if there is a clash.
+	* parse.c (global_used): Remove static and use the
+	gsymbol name rather than the new_block name, so that
+	the function can be called from resolve.c.
+	(parse_block_data, parse_module, add_global_procedure):
+	Improve checks for existing gsymbols.  Emit error if
+	already defined or if references were to another type.
+	Set defined flag.
+
+	PR fortran/PR24276
+	* trans-expr.c (gfc_conv_aliased_arg): New function called by 
+	gfc_conv_function_call that coverts an expression for an aliased
+	component reference to a derived type array into a temporary array
+	of the same type as the component.  The temporary is passed as an
+	actual argument for the procedure call and is copied back to the
+	derived type after the call.
+	(is_aliased_array): New function that detects an array reference
+	that is followed by a component reference.
+	(gfc_conv_function_call): Detect an aliased actual argument with
+	is_aliased_array and convert it to a temporary and back again
+	using gfc_conv_aliased_arg.
+
+2006-01-19  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortranspec.c: Update copyright years.
+	* trans.c: Likewise.
+	* trans-array.c: Likewise.
+	* trans-array.h: Likewise.
+	* trans-decl.c: Likewise.
+	* trans-stmt.c: Likewise.
+	* trans-stmt.h: Likewise.
+	* trans-types.c: Likewise.
+
+2006-01-18  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/18540
+	PR fortran/18937
+	* gfortran.h (BBT_HEADER): Move definition up.
+	(gfc_st_label): Add BBT_HEADER, remove 'prev' and 'next'.
+	* io.c (format_asterisk): Adapt initializer.
+	* resolve.c (resolve_branch): Allow FORTRAN 66 cross-block GOTOs
+	as extension.
+	(warn_unused_label): Take gfc_st_label label as argument, adapt to
+	new data structure.
+	(gfc_resolve): Adapt call to warn_unused_label.
+	* symbol.c (compare_st_labels): New function.
+	(gfc_free_st_label, free_st_labels, gfc_get_st_label): Convert to
+	using balanced binary tree.
+	* decl.c (match_char_length, gfc_match_old_kind_spec): Do away
+	with 'cnt'.
+	(warn_unused_label): Adapt to binary tree.
+	* match.c (gfc_match_small_literal_int): Only set cnt if non-NULL.
+	* primary.c (match_kind_param): Do away with cnt.
+
+2006-01-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/20869
+	PR fortran/20875
+	PR fortran/25024
+	* symbol.c (check_conflict): Add pointer valued elemental
+	functions and internal procedures with the external attribute
+	to the list of conflicts.
+	(gfc_add_attribute): New catch-all function to perform the
+	checking of symbol attributes for attribute declaration
+	statements.
+	* decl.c (attr_decl1): Call gfc_add_attribute for each of -
+	(gfc_match_external, gfc_match_intent, gfc_match_intrinsic,
+	gfc_match_pointer, gfc_match_dimension, gfc_match_target):
+	Remove spurious calls to checks in symbol.c.  Set the
+	attribute directly and use the call to attr_decl() for
+	checking.
+	* gfortran.h:  Add prototype for gfc_add_attribute.
+
+	PR fortran/25785
+	* resolve.c (resolve_function): Exclude PRESENT from assumed size
+	argument checking. Replace strcmp's with comparisons with generic
+	codes.
+
+2006-01-16  Rafael Ávila de Espíndola  <rafael.espindola@gmail.com>
+
+	* gfortranspec.c (lang_specific_spec_functions): Remove.
+
+2006-01-16  Richard Guenther  <rguenther@suse.de>
+
+	* trans-stmt.c (gfc_trans_if_1): Use fold_buildN and build_int_cst.
+	(gfc_trans_arithmetic_if): Likewise.
+	(gfc_trans_simple_do): Likewise.
+	(gfc_trans_do): Likewise.
+	(gfc_trans_do_while): Likewise.
+	(gfc_trans_logical_select): Likewise.
+	(gfc_trans_forall_loop): Likewise.
+	(generate_loop_for_temp_to_lhs): Likewise.
+	(generate_loop_for_rhs_to_temp): Likewise.
+	(gfc_trans_allocate): Likewise.
+	* trans.c (gfc_add_expr_to_block): Do not fold expr again.
+
+2006-01-16  Richard Guenther  <rguenther@suse.de>
+
+	* trans-expr.c (gfc_conv_function_call): Use fold_build2.
+	* trans-stmt.c (gfc_trans_goto): Likewise.  Use build_int_cst.
+	* trans.c (gfc_trans_runtime_check): Don't fold the condition
+	again.
+
+2006-01-13  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/25756
+	* symbol.c (gfc_free_st_label): Give variable meaningful name. Remove
+	unneeded parenthesis. Fix-up the head of the list (2 lines gleaned
+	from g95).
+
+2006-01-13  Diego Novillo  <dnovillo@redhat.com>
+
+	* trans.c (gfc_add_expr_to_block): Do not fold tcc_statement
+	nodes.
+
+2006-01-11  Tobias Schlüter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* parse.c (next_fixed): Remove superfluous string concatenation.
+
+2006-01-11  Bernhard Fischer  <rep.nop@aon.at>
+
+	PR fortran/25486
+	* scanner.c (load_line): use maxlen to determine the line-length used
+	for padding lines in fixed form.
+
+2006-01-11  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/25730
+	* trans-types.c (copy_dt_decls_ifequal): Copy backend decl for
+	character lengths.
+
+2006-01-09  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	fortran/24936
+	* trans-stmt.c (gfc_trans_pointer_assign_need_temp): Use fold_convert
+	to avoid type mismatch.
+
+2006-01-09  Andrew Pinski  <pinskia@physics.uc.edu>
+
+	PR fortran/21977
+	* trans-decl.c (gfc_generate_function_code): Move the NULLing of
+	current_fake_result_decl down to below generate_local_vars.
+
+2006-01-09  Feng Wang  <fengwang@nudt.edu.cn>
+
+	PR fortran/12456
+	* trans-expr.c (gfc_to_single_character): New function that converts
+	string to single character if its length is 1.
+	(gfc_build_compare_string):New function that compare string and handle
+	single character specially.
+	(gfc_conv_expr_op): Use gfc_build_compare_string.
+	(gfc_trans_string_copy): Use gfc_to_single_character.
+	* trans-intrinsic.c (gfc_conv_intrinsic_strcmp): Use
+	gfc_build_compare_string.
+	* trans.h (gfc_build_compare_string): Add prototype.
+
+2006-01-09  Feng Wang  <fengwang@nudt.edu.cn>
+
+	* simplify.c (gfc_simplify_char): Use UCHAR_MAX instead of literal
+	constant.
+	(gfc_simplify_ichar): Get the result from unsinged char and in the
+	range 0 to UCHAR_MAX instead of CHAR_MIN to CHAR_MAX.
+
+2006-01-08  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/25093
+	* resolve.c (resolve_fntype): Check that PUBLIC functions
+	aren't of PRIVATE type.
+
+2006-01-07  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* decl.c (gfc_match_function_decl): Correctly error out in case of
+	omitted function argument list.
+
+2006-01-07  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/22146
+	* trans-array.c (gfc_reverse_ss): Remove static attribute.
+	(gfc_walk_elemental_function_args): Replace gfc_expr * argument for
+	the function call with the corresponding gfc_actual_arglist*.  Change
+	code accordingly.
+	(gfc_walk_function_expr): Call to gfc_walk_elemental_function_args
+	now requires the actual argument list instead of the expression for
+	the function call.
+	* trans-array.h: Modify the prototype for gfc_walk_elemental_function_args
+	and provide a prototype for gfc_reverse_ss.
+	* trans-stmt.h (gfc_trans_call): Add the scalarization code for the case
+	where an elemental subroutine has array valued actual arguments.
+
+	PR fortran/25029
+	PR fortran/21256
+	PR fortran/20868
+	PR fortran/20870
+	* resolve.c (check_assumed_size_reference): New function to check for upper
+	bound in assumed size array references.
+	(resolve_assumed_size_actual): New function to do a very restricted scan
+	of actual argument expressions of those procedures for which incomplete
+	assumed size array references are not allowed.
+	(resolve_function, resolve_call): Switch off assumed size checking of
+	actual arguments, except for elemental procedures and intrinsic
+	inquiry functions, in some circumstances.
+	(resolve_variable): Call check_assumed_size_reference.
+
+2006-01-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/24268
+	* io.c (next_char_not_space): New function that returns the next
+	character that is not white space.
+	(format_lex): Use the new function to skip whitespace within
+	a format string.
+
+2006-01-05  Erik Edelmann  <eedelman@gcc.gnu.org>
+
+	PR fortran/23675
+	* expr.c (gfc_expr_set_symbols_referenced): New function.
+	* gfortran.h: Add a function prototype for it.
+	* resolve.c (resolve_function): Use it for
+	use associated character functions lengths.
+	* expr.c, gfortran.h, resolve.c: Updated copyright years.
+
+2006-01-03  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/25101
+	* resolve.c (resolve_forall_iterators):  Check for scalar variables;
+	Check stride is nonzero.
+
+2006-01-02  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/24640
+	* parse.c (next_free): Check for whitespace after the label.
+	* match.c (gfc_match_small_literal_int): Initialize cnt variable.
+
+2006-01-01  Steven G. Kargl  <kargls@comcast.net>
+
+	* ChangeLog: Split previous years into ...
+	* ChangeLog-2002: here.
+	* ChangeLog-2003: here.
+	* ChangeLog-2004: here.
+	* ChangeLog-2005: here.
+
+
+Copyright (C) 2006 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved.
diff --git a/gcc/fortran/ChangeLog-2007 b/gcc/fortran/ChangeLog-2007
new file mode 100644
index 000000000..421dc886e
--- /dev/null
+++ b/gcc/fortran/ChangeLog-2007
@@ -0,0 +1,5776 @@
+2007-12-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34558
+	* interface.c (gfc_compare_types): Prevent linked lists from
+	putting this function into an endless recursive loop.
+
+2007-12-26  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/34532
+	* gfortran.texi: Fixed section about implicit conversion of
+	logical and integer variables.
+
+2007-12-25  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34514
+	* decl.c (attr_decl1): Reject specifying the DIMENSION for
+	already initialized variable.
+	(do_parm): Reject PARAMETER for already initialized variable.
+
+2007-12-25  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/34533
+	* intrinsic.h (gfc_check_etime): Renamed to ...
+	(gfc_check_dtime_etime): ... this.
+	(gfc_check_etime_sub): Renamed to ...
+	(gfc_check_dtime_etime_sub): ... this.
+	(gfc_resolve_dtime_sub): New prototype.
+	* check.c (gfc_check_etime): Renamed to ...
+	(gfc_check_dtime_etime): ... this.
+	(gfc_check_etime_sub): Renamed to ...
+	(gfc_check_dtime_etime_sub): ... this.
+	* iresolve.c (gfc_resolve_dtime_sub): New implementation.
+	* intrinsic.c (add_functions): Removed alias from ETIME to DTIME,
+	added stand-alone intrinsic DTIME.
+	(add_subroutines): Adjusted check and resolve function names for
+	DTIME and ETIME.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Added DTIME
+	to known functions in switch.
+	* intrinsic.texi (DTIME): Added paragraph about thread-safety,
+	fixed return value section.
+	(CPU_TIME): Clarified intent and added implementation notes.
+
+2007-12-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34421
+	* resolve.c (resolve_entries): Add standard error for functions
+	returning characters with different length.
+
+2007-12-23  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/34536 
+	* matchexp.c (match_ext_mult_operand): Print warning for unary 
+	operators following arithmetic ones by default.
+	(match_ext_add_operand): Likewise.
+
+2007-12-22  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/34559
+	* simplify.c (gfc_simplify_repeat): Added safeguard for empty
+	string literals.
+
+2007-12-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/34549
+	* check.c (gfc_check_cshift):  Add check that shift is
+	type INTEGER.
+
+2007-12-21  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/34540
+	* iresolve.c (gfc_resolve_cshift): Take optional dim path
+	only if the argument is an optional itself.
+	* iresolve.c (gfc_resolve_eoshift): Same.
+
+2007-12-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34438
+	* trans-decl.c (gfc_finish_var_decl): Do not mark derived types
+	with default initializers as TREE_STATIC unless they are in the
+	main program scope.
+	(gfc_get_symbol_decl): Pass derived types with a default
+	initializer to gfc_defer_symbol_init.
+	(init_default_dt): Apply default initializer to a derived type.
+	(init_intent_out_dt): Call init_default_dt.
+	(gfc_trans_deferred_vars): Ditto.
+
+	* module.c (read_module): Check sym->module is there before
+	using it in a string comparison.
+
+2007-12-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34482
+	* gfortran.texi (BOZ): Document behavior for complex
+	numbers.
+	* target-memory.h (gfc_convert_boz): Update prototype.
+	* target-memory.c (gfc_convert_boz): Add error check
+	and convert BOZ to smallest possible bit size.
+	* resolve.c (resolve_ordinary_assign): Check return value.
+	* expr.c (gfc_check_assign): Ditto.
+	* simplify.c (simplify_cmplx, gfc_simplify_dble,
+	gfc_simplify_float, gfc_simplify_real): Ditto.
+
+2007-12-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/34325
+	* match.h: New function declaration.
+	* match.c (gfc_match_parens): New function to look for mismatched
+	parenthesis. (gfc_match_if): Use new function to catch missing '('.
+
+2007-12-19  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/34495
+	* expr.c (check_init_expr): Check whether variables with flavor
+	FL_PARAMETER do have a value assigned. Added error messages where
+	appropriate.
+	* simplify.c (gfc_simplify_transfer): Added check if the MOLD
+	argument is a constant if working with initialization
+	expressions.
+
+2007-12-17  Tobias Burnus  <burnus@net-b.de>
+
+	* intrinsic.c (add_functions): Undo change; mark float and
+	sngl as STD_F77.
+	* intrinsic.texi (FLOAT, SNGL): Change standard to F77 and later.
+	* gfortran.texi (BOZ): Make note about FLOAT etc. clearer.
+
+2007-12-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34495
+	* intrinsic.c (add_functions): Mark float and sngl as STD_GNU.
+	(gfc_intrinsic_func_interface): Reject REAL, DBLE and CMPLX
+	in initialization expressions for -std=f95.
+
+2007-12-16  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/34305
+	* resolve.c (compare_bound):  If either of the types of
+	the arguments isn't INTEGER, return CMP_UNKNOWN.
+
+2007-12-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34246
+	* trans-types.c (gfc_init_types): Change build_type_variant
+	to build_qualified_type.
+	(gfc_sym_type): Return gfc_character1_type_node for
+	character-returning bind(C) functions.
+	* trans-expr.c (gfc_conv_function_call): Do not set
+	se->string_length for character-returning bind(c) functions.
+	(gfc_trans_string_copy,gfc_trans_scalar_assign):
+	Support also single characters.
+
+2007-12-16  Bernhard Fischer  <aldot@gcc.gnu.org>
+
+	* errors.c (gfc_notify_std): As originally stated but improperly
+	changed, disregard warnings_are_errors for deciding which buffer
+	to use for warnings.
+
+2007-12-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31213
+	PR fortran/33888
+	PR fortran/33998
+	* trans-array.c (gfc_trans_array_constructor_value): If the
+	iterator variable does not have a backend_decl, use a local
+	temporary.
+	(get_elemental_fcn_charlen): New function to map the character
+	length of an elemental function onto its actual arglist.
+	(gfc_conv_expr_descriptor): Call the above so that the size of
+	the temporary can be evaluated.
+	* trans-expr.c : Include arith.h and change prototype of
+	gfc_apply_interface_mapping_to_expr to return void.  Change all
+	references to gfc_apply_interface_mapping_to_expr accordingly.
+	(gfc_free_interface_mapping): Free the 'expr' field.
+	(gfc_add_interface_mapping): Add an argument for the actual
+	argument expression. This is copied to the 'expr' field of the
+	mapping.  Only stabilize the backend_decl if the se is present.
+	Copy the character length expression and only add it's backend
+	declaration if se is present.  Return without working on the
+	backend declaration for the new symbol if se is not present.
+	(gfc_map_intrinsic_function) : To simplify intrinsics 'len',
+	'size', 'ubound' and 'lbound' and then to map the result.
+	(gfc_map_fcn_formal_to_actual): Performs the formal to actual
+	mapping for the case of a function found in a specification
+	expression in the interface being mapped.
+	(gfc_apply_interface_mapping_to_ref): Remove seen_result and
+	all its references. Remove the inline simplification of LEN
+	and call gfc_map_intrinsic_function instead.  Change the
+	order of mapping of the actual arguments and simplifying
+	intrinsic functions.  Finally, if a function maps to an
+	actual argument, call gfc_map_fcn_formal_to_actual.
+	(gfc_conv_function_call): Add 'e' to the call to
+	gfc_add_interface_mapping.
+	* dump-parse-tree.c (gfc_show_symbol_n): New function for
+	diagnostic purposes.
+	* gfortran.h : Add prototype for gfc_show_symbol_n.
+	* trans.h : Add 'expr' field to gfc_add_interface_mapping.
+	Add 'expr' to prototype for gfc_show_symbol_n.
+	* resolve.c (resolve_generic_f0): Set specific function as
+	referenced.
+
+2007-12-14  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34438
+	* resolve.c (resolve_symbol): Do not emit public-variable-
+	of-private-derived-type error for non-module variables.
+
+2007-12-14  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34398
+	* expr.c (gfc_check_assign): Add range checks for assignments of BOZs.
+	* resolve.c (resolve_ordinary_assign): Ditto.
+	* arith.c (gfc_range_check): Fix return value for complex numbers.
+
+2007-12-14  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/34324
+	* module.c (parse_atom): Fixed parsing of modules files whose
+	lines are terminated by CRLF.
+
+2007-12-13  Anton Korobeynikov  <asl@math.spbu.ru>
+
+	* trans-decl.c (gfc_build_builtin_function_decls): Correct decl
+	construction for select_string() and internal_unpack()
+
+2007-12-13  Duncan Sands  <baldrick@free.fr>
+	    Anton Korobeynikov  <asl@math.spbu.ru>
+
+	* trans-expr.c (gfc_conv_structure): Make sure record constructors
+	for static variables are marked constant.
+
+2007-12-12  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34254
+	* decl.c (match_char_kind): Support use-associated/imported
+	kind parameters.
+	(gfc_match_kind_spec): Support als BT_CHARACTER, when
+	re-scanning kind spec.
+
+2007-12-11  Aldy Hernandez  <aldyh@redhat.com>
+
+	* decl.c (add_global_entry): Make type unsigned.
+
+2007-12-11  Bernhard Fischer  <aldot@gcc.gnu.org>
+
+	* decl.c (match_prefix): Make seen_type a boolean.
+	(add_global_entry): Cache type distinction.
+	* trans-decl.c: Whitespace cleanup.
+
+2007-12-10  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34425
+	* interface.c (get_expr_storage_size): Use signed integer when
+	obtaining the bounds.
+
+2007-12-09  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/22244
+	* trans.h (struct array_descr_info): Forward declaration.
+	(gfc_get_array_descr_info): New prototype.
+	(enum gfc_array_kind): New type.
+	(struct lang_type): Add akind field.
+	(GFC_TYPE_ARRAY_AKIND): Define.
+	* trans-types.c: Include dwarf2out.h.
+	(gfc_build_array_type): Add akind argument.  Adjust
+	gfc_get_array_type_bounds call.
+	(gfc_get_nodesc_array_type): Include proper debug info even for
+	assumed-size arrays.
+	(gfc_get_array_type_bounds): Add akind argument, set
+	GFC_TYPE_ARRAY_AKIND to it.
+	(gfc_sym_type, gfc_get_derived_type): Adjust gfc_build_array_type
+	callers.
+	(gfc_get_array_descr_info): New function.
+	* trans-array.c (gfc_trans_create_temp_array,
+	gfc_conv_expr_descriptor): Adjust gfc_get_array_type_bounds
+	callers.
+	* trans-stmt.c (gfc_trans_pointer_assign_need_temp): Likewise.
+	* trans-types.h (gfc_get_array_type_bounds): Adjust prototype.
+	* Make-lang.in (fortran/trans-types.o): Depend on dwarf2out.h.
+	* f95-lang.c (LANG_HOOKS_GET_ARRAY_DESCR_INFO): Define.
+
+2007-12-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32129
+	* dump-parse-tree.c (gfc_show_expr_n): New function for
+	debugging.
+	* gfortran.h : Add prototype for gfc_show_expr_n.
+	* expr.c (simplify_constructor): Copy the constructor
+	expression and try to simplify that.  If success, replace the
+	original.  Otherwise discard the copy, keep going through
+	the structure and return success.
+
+	PR fortran/31487
+	* decl.c (build_struct): Pad out default initializers with
+	spaces to the component character length.
+
+2007-12-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34342
+	PR fortran/34345
+	PR fortran/18026
+	PR fortran/29471
+	* gfortran.texi (BOZ literal constants): Improve documentation
+	and adapt for BOZ changes.
+	* Make-lang.ini (resolve.o): Add target-memory.h dependency.
+	* gfortran.h (gfc_expr): Add is_boz flag.
+	* expr.c: Include target-memory.h.
+	(gfc_check_assign): Support transferring BOZ for real/cmlx.
+	* resolve.c: Include target-memory.h
+	(resolve_ordinary_assign): Support transferring BOZ for real/cmlx.
+	* target-memory.c (gfc_convert_boz): New function.
+	* target-memory.c (gfc_convert_boz): Add prototype.
+	* primary.c (match_boz_constant): Set is_boz, enable F95 error
+	also without -pedantic, and allow for Fortran 2003 BOZ.
+	(match_real_constant): Fix comment.
+	* simplify.c (simplify_cmplx,gfc_simplify_dble,gfc_simplify_float,
+	gfc_simplify_real): Support Fortran 2003 BOZ.
+
+2007-12-08  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/34359
+	* gfortran.h (gfc_file): Remove sibling and down fields.
+	* scanner.c (file_changes, file_changes_cur, file_changes_count,
+	file_changes_allocated): New variables.
+	(add_file_change, report_file_change): New functions.
+	(change_file): Remove.
+	(gfc_start_source_files, gfc_end_source_files): Call
+	report_file_change instead of change_file.
+	(gfc_advance_line): Call report_file_change instead of change_file,
+	call it even if lb->file == lb->next->file.
+	(get_file): Revert last changes.
+	(preprocessor_line): Call add_file_change when entering or leaving
+	a file.
+	(load_file): Likewise.  Set file_change[...].lb for all newly added
+	file changes.
+
+2007-12-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34333
+	* primary.c (match_boz_constant): Add gfc_notify_std diagnostics.
+
+2007-12-06  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34335
+	* module.c (find_symbol): Do not return symtrees with unique
+	names, which shows that they are private.
+
+2007-12-05  Jakub Jelinek  <jakub@redhat.com>
+
+	PR debug/33739
+	* gfortran.h (gfc_file): Remove included_by field, add sibling and
+	down.
+	(gfc_start_source_files, gfc_end_source_files): New prototypes.
+	* parse.c (gfc_parse_file): Call gfc_start_source_files and
+	gfc_end_source_files instead of calling the debugging hooks directly.
+	* error.c (show_locus): Use up field instead of included_by.
+	* scanner.c (change_file, gfc_start_source_files,
+	gfc_end_source_files): New functions.
+	(gfc_advance_line): Call change_file instead of calling debug hooks
+	directly.
+	(get_file): Set up rather than included_by.  Initialize down and
+	sibling.
+	(preprocessor_line, load_file): Don't set up field here.
+
+2007-12-05  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34333
+	* arith.h (gfc_compare_expr): Add operator argument, needed
+	for compare_real.
+	* arith.c (gfc_arith_init_1): Use mpfr_min instead of mpfr_cmp/set
+	to account for NaN.
+	(compare_real): New function, as mpfr_cmp but takes NaN into account.
+	(gfc_compare_expr): Use compare_real.
+	(compare_complex): Take NaN into account.
+	(gfc_arith_eq,gfc_arith_ne,gfc_arith_gt,gfc_arith_ge,gfc_arith_lt,
+	gfc_arith_le): Pass operator to gfc_compare_expr.
+	* resolve.c (compare_cases,resolve_select): Pass operator
+	to gfc_compare_expr.
+	* simplify.c (simplify_min_max): Take NaN into account.
+
+2007-12-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34318
+	* module.c (mio_gmp_real): Properly write NaN and Infinity.
+
+2007-12-02  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34186
+	* symbol.c (generate_isocbinding_symbol): Fix setting string length.
+
+2007-11-30  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34133
+	* match.h: Add bool allow_binding_name to gfc_match_bind_c.
+	* decl.c (match_attr_spec,gfc_match_bind_c_stmt,gfc_match_entry):
+	Adjust accordingly.
+	(gfc_match_bind_c): Add allow_binding_name argument, reject
+	binding name for dummy arguments.
+	(gfc_match_suffix,gfc_match_subroutine): Make use of
+	allow_binding_name.
+
+2007-11-30  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34186
+	* symbol.c (generate_isocbinding_symbol): Set string length.
+	* dump-parse-tree.c (gfc_show_attr): Show BIND(C) attribute.
+	* misc.c (gfc_basic_typename): Handle BT_VOID.
+
+2007-11-29  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/34230
+	* fortran/arith.c (gfc_check_real_range): Set intermediate values
+	to +-Inf and 0 when -fno-range-check is in effect.
+	* fortran/invoke.texi: Improve -fno-range-check description.
+
+	PR fortran/34203
+	* fortran/invoke.texi: Document the C escaped characters activated
+	by -fbackslash.
+
+2007-11-29  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34248
+	* trans-decl.c (generate_dependency_declarations): Check
+	for NULL pointers before accessing the string length.
+
+2007-11-29  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34262
+	* intrinsic.c (gfc_get_intrinsic_sub_symbol): Add comment.
+	(gfc_intrinsic_sub_interface): Copy elemental state if needed.
+	* iresolve.c (gfc_resolve_mvbits): Mark procedure as elemental.
+
+2007-11-28  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-expr.c (gfc_trans_string_copy): Convert both dest and
+	src to void *.
+
+	PR fortran/34247
+	* trans-openmp.c (gfc_omp_privatize_by_reference): For REFERENCE_TYPE
+	pass by reference only PARM_DECLs or non-artificial decls.
+
+2007-11-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/32928
+	* decl.c (match_data_constant): Use gfc_match_init_expr to match the
+	array spec and set the initializer expression.
+
+2007-11-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/34227
+	* match.c (gfc_match_common): Add additional check for BLOCK DATA.
+
+2007-11-27  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29389
+	*resolve.c (resolve_ordinary_assign): Use find_sym_in_expr to
+	test if a temporary should be written for a vector subscript
+	on the lhs.
+
+	PR fortran/33850
+	* restore.c (pure_stmt_function): Add prototype and new
+	function. Calls impure_stmt_fcn.
+	(pure_function): Call it.
+	(impure_stmt_fcn): New function.
+
+	* expr.c (gfc_traverse_expr): Call *func for all expression
+	types, not just variables. Add traversal of character lengths,
+	iterators and component character lengths and arrayspecs.
+	(expr_set_symbols_referenced): Return false if not a variable.
+	* trans-stmt.c (forall_replace, forall_restore): Ditto.
+	* resolve.c (forall_index): Ditto.
+	(sym_in_expr): New function.
+	(find_sym_in_expr): Rewrite to traverse expression calling
+	sym_in_expr.
+	*trans-decl.c (expr_decls): New function.
+	(generate_expr_decls): Rewrite to traverse expression calling
+	expr_decls.
+	*match.c (check_stmt_fcn): New function.
+	(recursive_stmt_fcn): Rewrite to traverse expression calling
+	check_stmt_fcn.
+
+2007-11-27  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33541
+	*interface.c (compare_actual_formal): Exclude assumed size
+	arrays from the possibility of scalar to array mapping.
+	* decl.c (get_proc_name): Fix whitespace problem.
+
+	PR fortran/34231
+	* gfortran.h : Add 'use_rename' bit to symbol_attribute.
+	* module.c : Add 'renamed' field to pointer_info.u.rsym.
+	(load_generic_interfaces): Add 'renamed' that is set after the
+	number_use_names is called.  This is used to set the attribute
+	use_rename, which, in its turn identifies those symbols that
+	have not been renamed.
+	(load_needed): If pointer_info.u.rsym->renamed is set, then
+	set the use_rename attribute of the symbol.
+	(read_module): Correct an erroneous use of use_flag. Use the
+	renamed flag and the use_rename attribute to determine which
+	symbols are not renamed.
+
+2007-11-26  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/34203
+	* options.c:  Change default behavior of backslash processing.
+	* invoke.texi: Update documentation.
+
+2007-11-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33152
+	* decl.c (add_init_expr_to_sym): Remove error message.
+	* resolve.c (check_data_variable): Add new check for a data variable
+	that has an array spec, but no ref and issue an error.
+	* match.c (gfc_match_common): Remove error message.
+
+2007-11-25  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34079
+	* trans-types.c (gfc_return_by_reference,
+	gfc_get_function_type): Do not return result of
+	character-returning bind(C) functions as argument.
+	* trans-expr.c (gfc_conv_function_call): Ditto.
+
+2007-11-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/34175
+	* gfortran.texi: Document default forms assumed for various file
+	extensions.
+
+2007-11-25  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33499
+	* decl.c (get_proc_name): If ENTRY statement occurs before type
+	specification, set the symbol untyped and ensure that it is in
+	the procedure namespace.
+
+2007-11-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33541
+	* module.c (find_symtree_for_symbol): Move to new location.
+	(find_symbol): New function.
+	(load_generic_interfaces): Rework completely so that symtrees
+	have the local name and symbols have the use name.  Renamed
+	generic interfaces exclude the use of the interface without an
+	ONLY clause (11.3.2).
+	(read_module): Implement 11.3.2 in the same way as for generic
+	interfaces.
+
+2007-11-23 Christopher D. Rickett <crickett@lanl.gov>
+
+	* trans-common.c (build_common_decl): Fix the alignment for
+	BIND(C) common blocks.
+
+2007-11-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/34209
+	* iresolve.c (gfc_resolve_nearest): If sign variable kind does not match
+	kind of input variable, convert it to match.
+
+	PR fortran/33317
+	* trans.h: Modify prototype for gfc_conv_missing_dummy.
+	* trans-expr.c (gfc_conv_missing_dummy): Modify to pass an integer kind
+	parameter in.  Set the type of the dummy to the kind given.
+	(gfc_conv_function_call): Pass representation.length to
+	gfc_conv_missing_dummy.
+	* iresolve.c (gfc_resolve_cshift): Determine the correct kind to use and
+	if appropriate set representation.length to this kind value.
+	(gfc_resolve_eoshift): Likewise.
+	* check.c (gfc_check_cshift): Enable dim_check to allow DIM as an
+	optional argument. (gfc_check_eoshift): Likewise.
+	* trans_intrinsic.c (gfc_conv_intrinsic_function_args): Update call to
+	gfc_conv_missing_dummy.
+
+2007-11-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34187
+	* module.c (load_needed): Ensure binding_label is not lost.
+
+	* decl.c (set_binding_label,gfc_match_bind_c): Replace
+	strncpy by strcpy.
+
+2007-11-23  Tobias Burnus  <burnus@net-b.de>
+	    Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/34192
+	* simplify.c (gfc_simplify_nearest): Fix NEAREST for
+	subnormal numbers.
+
+2007-11-23  Aldy Hernandez  <aldyh@redhat.com>
+
+	* trans-expr.c (gfc_trans_string_copy): Use "void *" when building a
+	memset.
+		
+2007-11-22  Tobias Burnus  <burnus@net-b.de>
+
+	* primary.c (gfc_match_structure_constructor): Allow
+	constructor for types without components.
+
+2007-11-22  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34079
+	* trans-expr.c (gfc_conv_function_call): Do not append
+	string length arguments when calling bind(c) procedures.
+	* trans-decl.c (create_function_arglist): Do not append
+	string length arguments when declaring bind(c) procedures.
+
+2007-11-21  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/34083
+	* resolve.c (resolve_structure_cons): Also check for zero rank.
+
+2007-11-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33317
+	* trans-expr.c (gfc_conv_missing_dummy): Revert.
+	* iresolve.c (gfc_resolve_cshift): Revert.
+	(gfc_resolve_eoshift): Likewise.
+	* check.c (gfc_check_cshift): Revert.
+	(gfc_check_eoshift): Likewise.
+
+2007-11-19  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34079
+	* decl.c (gfc_match_entry): Support BIND(C).
+	(gfc_match_subroutine): Fix comment typo.
+
+2007-11-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33317
+	* trans-expr.c (gfc_conv_missing_dummy): Set the type of the dummy
+	argument to default integer if flagged to do so. Fix typo in comment.
+	* resolve.c (gfc_resolve_dim_arg): Whitespace cleanup.
+	* iresolve.c (gfc_resolve_cshift): Do not convert type, mark attribute
+	for converting the DIM type appropriately in trans-expr.c.
+	(gfc_resolve_eoshift): Likewise.
+	* check.c (dim_check): Remove pre-existing dead code.
+	(gfc_check_cshift): Enable dim_check to allow DIM as an optional.
+	(gfc_check_eoshift): Likewise.
+	* trans_intrinsic.c (gfc_conv_intrinsic_function_args): Fix whitespace.
+
+2007-11-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31608
+	* trans-array.c (gfc_conv_expr_descriptor): Remove exception
+	for indirect references in the call to gfc_trans_scalar_assign.
+	* trans-expr.c (gfc_conv_string_parameter): Instead of asserting
+	that the expression is not an indirect reference, cast it to a
+	pointer type of the length given by se->string_length.
+
+2007-11-18  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34137
+	* primary.c (match_variable): Reject non-result entry symbols.
+	* resolve.c (resolve_contained_fntype): Do not check entry master
+	functions.
+
+2007-11-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans-types.c (gfc_init_types): Use wider buffer.
+
+2007-11-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans-types.c (gfc_init_types): Use Fortran-90-style type
+	names, with kinds.
+
+2007-11-17  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34133
+	* decl.c (gfc_match_suffix,gfc_match_subroutine): Disallow
+	bind(c) attribute for internal procedures.
+
+2007-11-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/25252
+	* interface.c (gfc_current_interface_head,
+	gfc_set_current_interface_head): New functions.
+	* decl.c (gfc_match_modproc): Move check for syntax error earlier.
+	On syntax error, restore previous state of the interface.
+	* gfortran.h (gfc_current_interface_head,
+	gfc_set_current_interface_head): New prototypes.
+
+2007-11-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/30285
+	* module.c (struct written_common, written_commons): New structure.
+	(compare_written_commons, free_written_common, write_common_0):
+	New functions.
+	(write_common): Call recursive function write_common_0.
+
+2007-11-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/34108
+	* io.c (check_format_string): Only check character expressions.
+	(match_dt_format): Return MATCH_ERROR if that is what
+	gfc_match_st_label said.
+
+2007-11-16  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33957
+	* expr.c (check_inquiry): Don't call gfc_error now.
+
+2007-11-16  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33739
+	PR fortran/34084
+	* scanner.c (start_source_file, end_source_file,
+	exit_remaining_files, gfc_advance_line): Revert rev. 130016.
+
+2007-11-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34008
+	* trans-stmt.c (gfc_conv_elemental_dependencies): Add check for
+	INTENT_INOUT as well as INTENT_OUT.
+	(gfc_trans_call): Remove redundant gcc_asserts in dependency
+	check.
+
+2007-11-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33986
+	* trans-array.c (gfc_conv_array_parameter ): Allow allocatable
+	function results.
+
+2007-11-15  Tobias Burnus  <burnus@net-b.de>
+ 
+	PR fortran/33917
+	* decl.c (match_procedure_decl): Pre-resolve interface.
+	* resolve.c (resolve_symbol): Reject interfaces later
+	declared in procedure statements.
+
+2007-11-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33162
+	* decl.c (match_procedure_decl): Remove TODO and allow intrinsics in
+	PROCEDURE declarations.  Set attr.untyped to allow the interface to be
+	resolved later where the symbol type will be set.
+	* interface.c (compare_intr_interfaces): Remove static from pointer
+	declarations.  Add type and kind checks for dummy function arguments.
+	(compare_actual_formal_intr): New function to compare an actual
+	argument with an intrinsic function. (gfc_procedures_use): Add check for
+	interface that points to an intrinsic function, use the new function.
+	* resolve.c (resolve_specific_f0): Resolve the intrinsic interface.
+	(resolve_specific_s0): Ditto.
+
+2007-11-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34080
+	* iresolve.c (gfc_resolve_transfer): Do not try to convert
+	to a constant MOLD expression, if it is an assumed size
+	dummy.
+
+2007-11-10  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans-common.c: Remove prototype for gfc_get_common.
+
+2007-11-10  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33592
+	* trans.c (gfc_call_realloc): Fix the logic and rename variables.
+
+2007-11-08  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33739
+	* scanner.c (start_source_file, end_source_file,
+	exit_remaining_files): New functions.
+	(gfc_advance_line): Use the new functions.
+
+2007-11-08  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/34028
+	* trans-intrinsic.c (gfc_conv_intrinsic_ishft): Use correct type.
+
+2007-11-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33917
+	* interface.c (check_sym_interfaces): Disallow PROCEDURE-declared
+	procedures for MODULE PROCEDURE.
+	* decl.c (match_procedure_in_interface): Do not mark as procedure.
+
+2007-11-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33881
+	* trans-array.c (gfc_conv_array_parameter): Evaluate
+	se->string_length instead of the expr->ts.cl->backend_decl.
+
+2007-11-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* gfortran.h: Shorten comment.
+	* trans-types.c (gfc_get_function_type): Allow argument to have
+	flavor FL_PROGRAM.
+	* trans-decl.c (gfc_sym_mangled_function_id): Mangle main program
+	name into MAIN__.
+	(build_function_decl): Fix comment.
+	* parse.c (main_program_symbol): Give the main program its proper
+	name, if any. Set its flavor to FL_PROGRAM.
+	(gfc_parse_file): Likewise.
+
+2007-11-02  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* intrinsic.texi (ALLOCATED): Fix typo.
+
+2007-10-31  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33941
+	* modules.c (intrinsics): Use only alphabetic names for
+	intrinsic operators.
+
+2007-10-31  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33162
+	* interface.c (compare_intr_interfaces): New function to check intrinsic
+	function arguments against formal arguments. (compare_interfaces): Fix
+	logic in comparison of function and subroutine attributes.
+	(compare_parameter): Use new function for intrinsic as argument.
+	* resolve.c (resolve_actual_arglist): Allow an intrinsic without
+	function attribute to be checked further.  Set function attribute if
+	intrinsic symbol is found, return FAILURE if not.
+
+2007-10-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33897
+	* decl.c (gfc_match_entry): Do not make ENTRY name
+	global for contained procedures.
+	* parse.c (gfc_fixup_sibling_symbols): Fix code for
+	determining whether a procedure is external.
+
+2007-10-30  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33596
+	* trans-intrinsic.c (gfc_conv_intrinsic_isnan): Strip NOP_EXPR
+	from the result of build_call_expr.
+
+2007-10-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31217
+	PR fortran/33811
+	PR fortran/33686
+
+	* trans-array.c (gfc_conv_loop_setup): Send a complete type to
+	gfc_trans_create_temp_array if the temporary is character.
+	* trans-stmt.c (gfc_trans_assign_need_temp): Do likewise for
+	allocate_temp_for_forall_nest.
+	(forall_replace): New function.
+	(forall_replace_symtree): New function.
+	(forall_restore): New function.
+	(forall_restore_symtree): New function.
+	(forall_make_variable_temp): New function.
+	(check_forall_dependencies): New function.
+	(cleanup_forall_symtrees): New function.
+	gfc_trans_forall_1): Add and initialize pre and post blocks.
+	Call check_forall_dependencies to check for all dependencies
+	and either trigger second forall block to copy temporary or
+	copy lval, outside the forall construct and replace all
+	dependent references. After assignment clean-up and coalesce
+	the blocks at the end of the function.
+	* gfortran.h : Add prototypes for gfc_traverse_expr and
+	find_forall_index.
+	expr.c (gfc_traverse_expr): New function to traverse expression
+	and visit all subexpressions, under control of a logical flag,
+	a symbol and an integer pointer. The slave function is caller
+	defined and is only called on EXPR_VARIABLE.
+	(expr_set_symbols_referenced): Called by above to set symbols
+	referenced.
+	(gfc_expr_set_symbols_referenced): Rework of this function to
+	use two new functions above.
+	* resolve.c (find_forall_index): Rework with gfc_traverse_expr,
+	using forall_index.
+	(forall_index): New function used by previous.
+	* dependency.c (gfc_check_dependency): Use gfc_dep_resolver for
+	all references, not just REF_ARRAY.
+	(gfc_dep_resolver): Correct the logic for substrings so that
+	overlapping arrays are handled correctly.
+
+2007-10-28  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/32147
+	* module.c (write_symbol): Fix whitespace.
+	(write_symbol0): Walk symtree from left-to-right instead
+	breadth-first.
+	(write_symbol1): Similarly change walk of pointer info tree.
+	(write_module): Insert linebreak.
+	* symbol.c (gfc_traverse_symtree): Change to left-to-right order.
+	(traverse_ns): Likewise.
+
+2007-10-27 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+	PR fortran/31306
+	* decl.c (char_len_param_value): Add check for conflicting attributes of
+	function argument.
+
+2007-10-27  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33862
+	* lang-specs.h: Support .ftn and .FTN extension, use CPP for .FOR.
+	* options.c (form_from_filename): Support .ftn extension.
+	* gfortran.texi: Document support of .for and .ftn file extension.
+
+2007-10-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33162
+	* intrinsic.h: Add prototypes for four new functions, gfc_check_datan2,
+	gfc_check_dprod, gfc_check_fn_d, and gfc_check_x_yd.
+	* intrinsic.c (add_functions): Add double precision checks for dabs,
+	dacos, dacosh, dasin, dasinh, datan, datanh, datan2, dbesj0, dbesj1,
+	dbesy0, dbesy1, dcos, dcosh, ddim, derf, derfc, dexp, dgamma,
+	dlgama, dlog, dlog10, dmod, dsign, dsin, dsinh, dsqrt, dtan, and dtanh.
+	Add real check dprod.
+	* check.c (gfc_check_datan2): New function to check for double precision
+	argumants. (gfc_check_dprod, gfc_check_fn_d, and gfc_check_x_yd): Ditto.
+
+2007-10-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	* invoke.texi: Fix typo in -fmax-errors=.
+
+2007-10-26  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/29784
+	* gfortran.texi: Document that there is no logical/integer
+	conversion performed during I/O operations.
+
+2007-10-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33849
+	* resolve.c (resolve_actual_arglist): Fix error message text.
+
+2007-10-22  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/31244
+	* gfortran.h (gfc_data_value): Change repeat from unsigned int
+	to mpz_t.
+	* decl.c(top_val_list): Remove msg variable.  Use mpz_t for
+	repeat count.
+	* resolve.c (values):  Change left from unsigned int to mpz_t.
+	(next_data_value): Change for mpz_t.
+	(check_data_variable): Change ??? to FIXME in a comment.  Use
+	"mpz_t left".
+	(resolve_data ): Use "mpz_t left".
+
+2007-10-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33749
+	* resolve.c (resolve_ordinary_assign): New function that takes
+	the code to resolve an assignment from resolve_code. In
+	addition, it makes a temporary of any vector index, on the
+	lhs, using gfc_get_parentheses.
+	(resolve_code): On EXEC_ASSIGN call the new function.
+
+2007-10-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33818
+	* resolve.c (resolve_variable): Check that symbol is in the same
+	namespace as the entry function.
+
+2007-10-20  Paul Thomas  <pault@gcc.gnu.org>
+	    FX Coudert <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31608
+	* trans-array.c (gfc_conv_expr_descriptor): For all except
+	indirect references, use gfc_trans_scalar_assign instead of
+	gfc_add_modify_expr.
+	* iresolve.c (check_charlen_present): Separate creation of cl
+	if necessary and add code to treat an EXPR_ARRAY.
+	(gfc_resolve_char_achar): New function.
+	(gfc_resolve_achar, gfc_resolve_char): Call it.
+	(gfc_resolve_transfer): If the MOLD expression does not have a
+	character length expression, get it from a constant length.
+
+2007-10-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33544
+	* simplify.c (gfc_simplify_transfer): Only warn for short transfer when
+	-Wsurprising is given.
+	* invoke.texi: Document revised behavior.
+
+2007-10-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33795
+	* gfortran.texi: Document GFORTRAN_UNBUFFERED_PRECONNECTED
+	environment variable.  Delete mention of environment variable
+	GFORTRAN_UNBUFFERED_n.
+
+2007-10-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33233
+	* resolve.c (check_host_association): Check singly contained
+	namespaces and start search for symbol in current namespace.
+
+2007-10-18  Paul Thomas  <pault@gcc.gnu.org>
+	    Dominique d'Humières  <dominiq@lps.ens.fr>
+
+	PR fortran/33733
+	* simplify.c (gfc_simplify_transfer): Return null if the source
+	expression is EXPR_FUNCTION.
+
+2007-10-17 Christopher D. Rickett <crickett@lanl.gov>
+
+	PR fortran/33760
+	* symbol.c (gen_special_c_interop_ptr): Remove code to create
+	constructor for c_null_ptr and c_null_funptr with value of 0.
+	* expr.c (check_init_expr): Prevent check on constructors for
+	iso_c_binding derived types.
+	* resolve.c (resolve_structure_cons): Verify that the user isn't
+	trying to invoke a structure constructor for one of the
+	iso_c_binding derived types.
+
+2007-10-15 Christopher D. Rickett <crickett@lanl.gov>
+
+	PR fortran/32600
+	* trans-expr.c (gfc_conv_function_call): Generate code to inline
+	c_associated.
+	* symbol.c (get_iso_c_sym): Preserve from_intmod and intmod_sym_id
+	attributes in the resolved symbol.
+	* resolve.c (gfc_iso_c_sub_interface): Remove dead code.
+
+2007-10-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33055
+	* trans-io.c (create_dummy_iostat): New function to create a unique
+	dummy variable expression to use with IOSTAT.
+	(gfc_trans_inquire): Use the new function to pass unit number error info
+	to run-time library if a regular IOSTAT variable was not given.
+
+2007-10-14  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33745
+	* trans-array.c (gfc_conv_ss_startstride): Fix dimension check.
+	(gfc_trans_array_bound_check, gfc_conv_array_ref,
+	gfc_conv_ss_startstride): Simplify error message.
+	* resolve.c (check_dimension): Fix dimension-type switch;
+	improve error message.
+
+2007-10-13  Tobias Schlüter  <tobi@gcc.gnu.org>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33254
+	PR fortran/33727
+	* trans-array.c (get_array_ctor_var_strlen): Check upper bound for
+	constness instead of lower bound.
+	(get_array_ctor_strlen): Add bounds-checking code.
+
+2007-10-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33542
+	* resolve.c (resolve_actual_arglist): If the actual argument is
+	ambiguous, then there is an error.
+
+2007-10-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33664
+	* expr.c (gfc_specification_expr): If a function is not
+	external, intrinsic or pure is an error.  Set the symbol pure
+	to prevent repeat errors.
+
+2007-10-10  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33636
+	* expr.c (find_array_section): Check for constructor constantness.
+
+2007-10-08  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/33689
+	* resolve.c (gfc_resolve_expr): Fix indentation.
+	(resolve_fl_variable_derived): Rename argument.
+	(resolve_fl_variable): Fix case in message.  Clarify logic.
+	Correctly simplify array bounds.
+
+2007-10-07  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR libfortran/33683
+	* mathbuiltins.def (GAMMA):  Change function name to
+	"tgamma" instad of "gamma".
+
+2007-10-07  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/20851
+	* expr.c (check_inquiry): Typo fix in error message.
+	(check_init_expr): Same * 3.
+	(check_restricted): Verify that no dummy arguments appear in
+	restricted expressions in ELEMENTAL procedures.
+	* resolve.c (resolve_fl_variable): Exchange order of checks to
+	avoid side-effect.
+
+2007-10-06  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33609
+	* simplify.c (range_check): Return gfc_bad_expr if incoming expression 
+	is NULL.
+
+2007-10-06  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* simplify.c (gfc_simplify_size): Fix typo.
+
+2007-10-06  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/25076
+	* resolve.c (gfc_find_forall_index): Move towards top,
+	renaming to ...
+	(find_forall_index): ... this.  Add check for NULL expr.
+	(resolve_forall_iterators): Verify additional constraint.
+	(resolve_forall): Remove checks obsoleted by new code in
+	resolve_forall_iterators.
+
+2007-10-05  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* gfortran.h (gfc_get_data_variable, gfc_get_data_value,
+	gfc_get_data): Move to decl.c.
+	(global_used): Rename into gfc_global_used.
+	(gfc_formalize_init_value, gfc_get_section_index,
+	gfc_assign_data_value, gfc_assign_data_value_range,
+	gfc_advance_section): Move to data.h.
+	(gfc_set_in_match_data): Remove.
+	* decl.c (gfc_get_data_variable, gfc_get_data_value,
+	gfc_get_data): Move here.
+	(gfc_set_in_match_data): Rename into set_in_match_data.
+	(gfc_match_data): Likewise.
+	(add_global_entry): Rename global_used into gfc_global_used.
+	* data.c: Include data.h.
+	* trans.h (gfc_todo_error): Remove.
+	* trans-array.c (gfc_trans_array_constructor,
+	gfc_conv_ss_startstride, gfc_conv_loop_setup): Change
+	gfc_todo_error into assertions.
+	* resolve.c (resolve_global_procedure): Rename global_used into
+	gfc_global_used.
+	* parse.c (gfc_global_used, parse_module, add_global_procedure,
+	add_global_program): Likewise.
+	* trans-intrinsic.c (gfc_walk_intrinsic_function): Rename
+	global_used into gfc_global_used.
+	* Make-lang.in: Add dependencies on fortran/data.h.
+	* data.h: New file.
+
+2007-10-04  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33529
+	* decl.c (match_char_kind): New function.
+	(match_char_spec): Use match_char_kind.
+
+2007-10-04  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33502
+	* scanner.c (gfc_advance_line): Call debug_hooks->end_source_file
+	and debug_hooks->start_source_file when appropriate, and set
+	dbg_emitted.
+	(gfc_define_undef_line): New function.
+	(load_file): Don't error out on #define and #undef lines.
+	* parse.c (next_statement): Call gfc_define_undef_line.
+	(gfc_parse_file): Call debug_hooks->start_source_file and
+	debug_hooks->end_source_file for the main source file if
+	required.
+	* gfortran.h (gfc_linebuf): Add dbg_emitted field.
+	(gfc_define_undef_line): New prototype.
+
+2007-10-04  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/33626
+	* resolve.c (resolve_operator): Always copy the type for
+	expressions in parentheses.
+
+2007-10-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33646
+	PR fortran/33542
+	* interface.c (check_interface1): Revert patch of 10-02.
+
+2007-10-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/26682
+	* trans-decl.c (build_function_decl): Set "externally_visible"
+	attribute on the MAIN program decl.
+
+2007-10-03  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/33198
+	* resolve.c (has_default_initializer): Move to top.  Make bool.
+	(resolve_common_blocks): Simplify logic.  Add case for derived
+	type initialization.
+	(resolve_fl_variable_derived): Split out from ...
+	(resolve_fl_variable): ... here, while adapting to new h_d_i
+	interface.
+
+2007-10-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/26682
+	* options.c (gfc_post_options): Issue an error when
+	-fwhole-program is used.
+
+2007-10-02  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33542
+	* interface.c (check_interface1): Specific procedures are
+	always ambiguous if they have the same name.
+
+2007-10-02  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33566
+	* primary.c (gfc_match_rvalue): Make all expressions with array
+	references to structure parameters into variable expressions.
+
+2007-10-02  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33554
+	* trans-decl.c (init_intent_out_dt): New function.
+	(gfc_trans_deferred_vars): Remove the code for default
+	initialization of INTENT(OUT) derived types and put it
+	in the new function.  Call it earlier than before, so
+	that array offsets and lower bounds are available.
+
+2007-10-02  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33550
+	* decl.c (get_proc_name): Return rc if rc is non-zero; ie. if
+	the name is a reference to an ambiguous symbol.
+
+2007-10-02  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31154
+	PR fortran/31229
+	PR fortran/33334
+	* decl.c : Declare gfc_function_kind_locs and
+	gfc_function_type_locus.
+	(gfc_match_kind_spec): Add second argument kind_expr_only.
+	Store locus before trying to match the expression. If the
+	current state corresponds to a function declaration and there
+	is no match to the expression, read to the parenthesis, return
+	kind = -1, dump the expression and return.
+	(gfc_match_type_spec): Renamed from match_type_spec and all
+	references changed.  If an interface or an external function,
+	store the locus, set kind = -1 and return.  Otherwise, if kind
+	is already = -1, use gfc_find_symbol to try to find a use
+	associated or imported type.
+	match.h : Prototype for gfc_match_type_spec.
+	* parse.c (match_deferred_characteristics): New function.
+	(parse_spec): If in a function, statement is USE or IMPORT
+	or DERIVED_DECL and the function kind=-1, call
+	match_deferred_characteristics.  If kind=-1 at the end of the
+	specification expressions, this is an error.
+	* parse.h : Declare external gfc_function_kind_locs and
+	gfc_function_type_locus.
+
+2007-09-27  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* module.c (mio_expr): Avoid -Wcast-qual warning.
+
+2007-09-27  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* arith.c (reduce_binary_aa): Fix capitalization.
+	* check.c (gfc_check_dot_product): Likewise.
+	(gfc_check_matmul): Likewise.
+	* expr.c (gfc_check_conformance): Likewise.
+	(gfc_check_assign): Likewise.
+	(gfc_default_initializer): Simplify logic.
+	* trans.c (gfc_msg_bounds): Make const.
+	(gfc_msg_fault): Likewise.
+	(gfc_msg_wrong_return): Likewise.
+	* trans.h: Add const to corresponding extern declarations.
+
+2007-09-27  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33568
+	* trans-intrinsic.c (gfc_conv_intrinsic_aint): Allow for the 
+	possibility of the optional KIND argument by making arg
+	an array, counting the number of arguments and using arg[0].
+
+2007-09-26  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/30780
+	* invoke.texi: Add note to -ffpe-trap option. Fix typos.
+
+2007-09-23  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/33269
+	* io.c (check_format_string): Move NULL and constant checks into
+	this function.
+	(check_io_constraints): Call gfc_simplify_expr() before calling
+	check_format_string().  Remove NULL and constant checks.
+
+2007-09-24  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33538
+	* scanner.c, parse.c, gfortran.h: Revert revision 128671.
+
+2007-09-23  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33528
+	* scanner.c (preprocessor_line): Call linemap_add when exiting
+	a file.
+	(gfc_new_file): Adjust debug code for USE_MAPPED_LOCATION.
+
+2007-09-22  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33522
+	* trans-types.c (gfc_get_desc_dim_type): Mark artificial
+	variables with TREE_NO_WARNING.
+	(gfc_get_array_descriptor_base): Likewise.
+
+2007-09-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33337
+	PR fortran/33376
+	* trans-decl.c (gfc_create_module_variable): Output
+	derived type parameters.
+	* arith.c (gfc_parentheses): Return the argument if
+	it is a constant expression.
+	* primary.c (gfc_match_rvalue): Remove the clearing of
+	the module name and the use_assoc attribute for derived
+	type parameter expressions.
+
+2007-09-22  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33502
+	* scanner.c (gfc_advance_line): Call debug_hooks->start_source_file
+	and debug_hooks->end_source_file when entering and exiting
+	included files.
+	(gfc_define_undef_line): New function.
+	(load_file): Ignore #define and #undef preprocessor lines
+	while reading source files.
+	* parse.c (next_statement): Handle #define and #undef
+	preprocessor lines.
+	(gfc_parse_file): Call debug_hooks->start_source_file and
+	debug_hooks->end_source_file for the main source file if
+	requested by the debug format.
+	* gfortran.h (gfc_define_undef_line): Add prototype.
+
+2007-09-22  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33445
+	* scanner.c (skip_free_comments): Warn if !$OMP& is used
+	if no OpenMP directive is to be continued.
+
+2007-09-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	*trans-expr.c (gfc_trans_pointer_assignment): Convert array
+	descriptor for subref pointer assignements, rather than using
+	the loop info version.
+
+2007-09-21  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33037
+	* simplify.c (gfc_simplify_transfer): Warn if source size
+	is smaller than result size.
+
+2007-09-20  Asher Langton  <langton2@llnl.gov>
+
+	PR fortran/20441
+	* gfortran.h : Add init_local_* enums and init_flag_* flags to
+	gfc_option_t.
+	* lang.opt: Add -finit-local-zero, -finit-real, -finit-integer,
+	-finit-character, and -finit-logical flags.
+	* invoke.texi: Document new options.
+	* resolve.c (build_init_assign): New function.
+	(apply_init_assign): Move part of function into build_init_assign.
+	(build_default_init_expr): Build local initializer (-finit-*).
+	(apply_default_init_local): Apply local initializer (-finit-*).
+	(resolve_fl_variable): Try to add local initializer (-finit-*).
+	* options.c (gfc_init_options, gfc_handle_option,
+	gfc_post_options): Handle -finit-local-zero, -finit-real,
+	-finit-integer, -finit-character, and -finit-logical flags.
+
+2007-09-20  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33221
+	* gfortran.h (symbol_attribute): Add zero_comp field.
+	* symbol.c (gfc_use_derived): Handle case of emtpy derived types.
+	* decl.c (gfc_match_data_decl): Likewise.
+	(gfc_match_derived_decl): Likewise.
+	* module.c (ab_attribute, attr_bits): Add AB_ZERO_COMP member.
+	(mio_symbol_attribute): Write and read AB_ZERO_COMP.
+	* resolve.c (resolve_symbol): Handle case of emtpy derived types.
+	* parse.c (parse_derived): Likewise.
+
+2007-09-20  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33288
+	* arith.c (reduce_unary, reduce_binary_ac, reduce_binary_ca,
+	reduce_binary_aa): Call ourselves recursively if an element of
+	the constructor is itself a constant array.
+
+2007-09-20  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* io.c (resolve_tag_format): New function using code split out
+	and simplified from ...
+	(resolve_tag): ... this function.  Simplify logic.  Unify
+	IOSTAT, IOLENGTH and SIZE handling.
+
+2007-09-20  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/33497
+	* resolve.c (gfc_iso_c_func_interface): Use information from
+	subcomponent if applicable.
+
+2007-09-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33325
+	* intrinsic.text: Add documentation of the intrinsic modules.
+	* gfortran.texi: Link to intrinsic-modules section and to
+	the GOMP manual.
+
+2007-09-18  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31119
+	* trans-array.c (gfc_conv_ss_startstride): Only perform bounds
+	checking for optional args when they are present.
+
+2007-09-18  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33231
+	* resolve.c (resolve_elemental_actual): Check for conformance
+	of intent out/inout dummies.
+
+2007-09-17  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33106
+	* resolve.c (resolve_symbol): Reject public variable of
+	private derived-types for Fortran 95.
+
+2007-09-17  Tobias Burnus  <burnus@net-b.de>
+
+	* resolve.c (resolve_fl_procedure): Allow private dummies
+	for Fortran 2003.
+
+2007-09-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans-types.c (gfc_get_desc_dim_type): Do not to try
+	emit debug info.
+	(gfc_get_array_descriptor_base): Likewise.
+	(gfc_get_mixed_entry_union): Likewise
+	(gfc_get_derived_type): Set decl location for fields and
+	derived type itself.
+
+2007-09-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29396
+	PR fortran/29606
+	PR fortran/30625
+	PR fortran/30871
+	* trans.h : Add extra argument to gfc_build_array_ref. Rename
+	gfc_conv_aliased_arg to gfc_conv_subref_array_arg.  Move
+	prototype of is_aliased_array to gfortran.h and rename it
+	gfc_is_subref_array.  Add field span to lang_decl, add a new
+	decl lang specific flag accessed by GFC_DECL_SUBREF_ARRAY_P
+	and a new type flag GFC_DECL_SUBREF_ARRAY_P.
+	* trans.c (gfc_build_array_ref): Add the new argument, decl.
+	If this is a subreference array pointer, use the lang_decl
+	field 'span' to calculate the offset in bytes and use pointer
+	arithmetic to address the element.
+	* trans-array.c (gfc_conv_scalarized_array_ref,
+	gfc_conv_array_ref): Add the backend declaration as the third
+	field, if it is likely to be a subreference array pointer.
+	(gfc_conv_descriptor_dimension, gfc_trans_array_ctor_element,
+	gfc_trans_array_constructor_element, structure_alloc_comps,
+	gfc_conv_array_index_offset): For all other references to
+	gfc_build_array_ref, set the third argument to NULL.
+	(gfc_get_dataptr_offset): New function.
+	(gfc_conv_expr_descriptor): If the rhs of a pointer assignment
+	is a subreference array, then calculate the offset to the
+	subreference of the first element and set the descriptor data
+	pointer to this, using gfc_get_dataptr_offset.
+	trans-expr.c (gfc_get_expr_charlen): Use the expression for the
+	character length for a character subreference.
+	(gfc_conv_substring, gfc_conv_subref_array_arg): Add NULL for
+	third argument in call to gfc_build_array_ref.
+	(gfc_conv_aliased_arg): Rename to gfc_conv_subref_array_arg.
+	(is_aliased_array): Remove.
+	(gfc_conv_function_call): Change reference to is_aliased_array
+	to gfc_is_subref_array and reference to gfc_conv_aliased_arg to
+	gfc_conv_subref_array_arg.
+	(gfc_trans_pointer_assignment): Add the array element length to
+	the lang_decl 'span' field.
+	* gfortran.h : Add subref_array_pointer to symbol_attribute and
+	add the prototype for gfc_is_subref_array.
+	* trans-stmt.c : Add NULL for third argument in all references
+	to gfc_build_array_ref.
+	* expr.c (gfc_is_subref_array): Renamed is_aliased_array.
+	If this is a subreference array pointer, return true.
+	(gfc_check_pointer_assign): If the rhs is a subreference array,
+	set the lhs subreference_array_pointer attribute.
+	* trans-decl.c (gfc_get_symbol_decl): Allocate the lang_decl
+	field if the symbol is a subreference array pointer and set an
+	initial value of zero for the 'span' field.
+	* trans-io.c (set_internal_unit): Refer to is_subref_array and
+	gfc_conv_subref_array_arg.
+	(nml_get_addr_expr): Add NULL third argument to
+	gfc_build_array_ref. 
+	(gfc_trans_transfer): Use the scalarizer for a subreference
+	array.
+
+2007-09-13  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	* iresolve.c (resolve_mask_arg): If a mask is an array
+	expression, convert it to kind=1.
+
+2007-09-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33343
+	* expr.c (gfc_check_conformance): Print ranks in the error message.
+	* resolve.c (resolve_elemental_actual): Check also conformance of
+	the actual arguments for elemental functions.
+
+2007-09-13  Tobias Burnus  <burnus@net-b.de>
+
+	* symbol.c (gfc_add_elemental,gfc_add_pure,gfc_add_recursive):
+	Allow prefixes only to be specified once.
+
+2007-09-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33412
+	* symbol.c (check_conflict): Add conflict of ELEMENTAL with Bind(C).
+
+2007-09-12  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33297
+	* check.c (scalar_check): Move up in the file.
+	(kind_check): Call scalar_check.
+	(dim_check): If optional, do not call nonoptional_check; use
+	bool for optional.
+	(gfc_check_all_any,gfc_check_count,gfc_check_cshift,gfc_check_eoshift,
+	gfc_check_lbound,gfc_check_minloc_maxloc,check_reduction,
+	gfc_check_spread,gfc_check_ubound): Use true/false instead of 0/1
+	for dim_check; honor changed meaning of optional.
+	(gfc_check_int): Replace checks by kind_check.
+	(gfc_check_size): Replace checks by dim_check.
+
+2007-09-12  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33284
+	PR fortran/33310
+	* symbol.c (check_conflict): Add conflict between INTRINSIC and ENTRY
+	and between BIND(C) and PARAMETER.
+
+2007-09-12  Tobias Burnus  <burnus@net-b.de>
+
+	* trans-expr.c (gfc_conv_initializer): Fix expr == NULL check.
+
+2007-09-12  Jan Hubicka  <jh@suse.cz>
+
+	* f95-lang.c (LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION): Kill.
+
+2007-09-12  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/33395
+	* trans-expr.c (gfc_conv_initializer): Remove unnecessary test for
+	intmod_sym_id and use derived symbol to set new kind of C_NULL_PTR
+	and C_NULL_FUNPTR expressions.
+
+2007-09-11  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/33040
+	* trans-expr.c (gfc_trans_structure_assign): Convert component
+	C_NULL_PTR and C_NULL_FUNPTR component initializers to (void *).
+	* trans-types.c (gfc_get_derived_type): Create a backend_decl for
+	the c_address field of C_PTR and C_FUNPTR and ensure initializer
+	is of proper type/kind for (void *).
+
+2007-09-11  Jan Hubicka <jh@suse.cz>
+
+	* f95-lang.c (gfc_expand_function): Kill.
+	(LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION): Kill.
+
+2007-09-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/31547
+	* gfortran.texi: Document when CPP is called.
+
+	* intrinsic.texi (IOR): Fix typos.
+
+2007-09-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33370
+	* trans-expr.c (copyable_array_p):  Add tests that expression
+	is a variable, that it has no subreferences and that it is a
+	full array.
+	(gfc_trans_assignment): Change conditions to suit modifications
+	to copyable_array_p.
+
+2007-09-06  Tom Tromey  <tromey@redhat.com>
+
+	* scanner.c (get_file): Update.
+	(load_file): Update.
+	(gfc_next_char_literal): Use gfc_linebuf_linenum.
+	* f95-lang.c (gfc_init): Update.
+	* gfortran.h (gfc_linebuf_linenum): New macro.
+
+2007-09-05  Sandra Loosemore  <sandra@codesourcery.com>
+
+	* trans-decl.c (build_entry_thunks): Use set_cfun.
+	(gfc_generate_function_code): Likewise.
+
+2007-09-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31564
+	* primary.c (gfc_match_rvalue): Make expressions that refer
+	to derived type parameters that have array references into
+	variable expressions.  Remove references to use association
+	from the symbol.
+
+	PR fortran/33241
+	* decl.c (add_init_expr_to_sym): Provide assumed character
+	length parameters with the length of the initialization
+	expression, if a constant, or that of the first element of
+	an array.
+
+2007-09-04  Janus Weil  <jaydub66@gmail.com>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	* decl.c (match_procedure_decl,match_procedure_in_interface,
+	gfc_match_procedure): Handle PROCEDURE statements.
+	* gfortran.h (struct gfc_symbol): New member "gfc_symbol *interface".
+	(enum gfc_statement): New element "ST_PROCEDURE".
+	(strcut symbol_attribute): New member "unsigned procedure".
+	* interface.c (check_interface0): Extended error checking.
+	* match.h: Add gfc_match_procedure prototype.
+	* parse.c (decode_statement,next_statement,gfc_ascii_statement,
+	parse_derived,parse_interface): Implement PROCEDURE statements.
+	* resolve.c (resolve_symbol): Ditto.
+	* symbol.c (check_conflict): Ditto.
+	(gfc_add_proc): New function for setting the procedure attribute.
+	(copy_formal_args): New function for copying formal argument lists.
+
+2007-09-03  Daniel Jacobowitz  <dan@codesourcery.com>
+
+	* Make-lang.in (gfortranspec.o): Remove SHLIB_MULTILIB.
+
+2007-09-03  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* gfortranspec.c (lang_specific_driver): Use CONST_CAST2.
+	* options.c (gfc_post_options): Supply a TYPE for CONST_CAST.
+	* parse.c (parse_omp_structured_block): Likewise,
+	* st.c (gfc_free_statement): Likewise,
+
+2007-09-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31675
+	* libgfortran.h: New file.
+	* iso-fortran-env.def: Use macros in the new header instead of
+	hardcoded integer constants.
+	* Make-lang.in (F95_PARSER_OBJS, GFORTRAN_TRANS_DEPS): Add
+	fortran/libgfortran.h.
+	* gfortran.h (GFC_STD_*, GFC_FPE_*, options_convert,
+	ioerror_codes): Remove.
+	* trans.c (ERROR_ALLOCATION): Remove.
+	(gfc_call_malloc, gfc_allocate_with_status,
+	gfc_allocate_array_with_status): Use LIBERROR_ALLOCATION.
+	* trans-types.h (GFC_DTYPE_*): Remove.
+	* trans-decl.c (gfc_generate_function_code): Use
+	GFC_CONVERT_NATIVE instead of CONVERT_NATIVE.
+	* trans-io.c (set_parameter_value, set_parameter_ref): Use
+	LIBERROR_* macros instead of IOERROR_ macros.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Use
+	LIBERROR_END and LIBERROR_EOR instead of hardcoded constants.
+	* options.c (gfc_init_options): Use GFC_CONVERT_NATIVE instead of
+	CONVERT_NATIVE.
+	(gfc_handle_option): Use GFC_CONVERT_* macros instead of CONVERT_*.
+
+2007-09-02  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* invoke.texi: Fix the -frange-checking option entry.
+
+2007-09-02  Roger Sayle  <roger@eyesopen.com>
+
+	* decl.c (match_string_p): New helper function to explicitly match
+	a string of characters.
+	(match_attr_spec): Remove no longer needed DECL_COLON from decl_types.
+	Delete decls array and peek_char.  Rewrite decl attribute parser to
+	avoid calling gfc_match_strings.
+	* match.c (gfc_match_strings): Delete unused function.
+	* match.h (gfc_match_strings): Delete prototype.
+
+2007-09-02  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* dump-parse-tree.c (show_char_const): New function.
+	(gfc_show_expr): Use it.
+	* expr.c (find_substring_ref): Rework to not keep characters
+	dangling beyond end of string.
+
+2007-09-02  H.J. Lu  <hongjiu.lu@intel.com>
+
+	PR fortran/33276
+	* array.c (expand_iterator): Initialize frame.prev.
+
+2007-08-31  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33232
+	* io.c (match_io): Also diagnose extra comma for READ.
+
+2007-08-31  Joseph Myers  <joseph@codesourcery.com>
+
+	* intrinsic.texi (LGAMMA): Remove empty @cindex line.
+
+2007-08-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31879
+	PR fortran/31197
+	PR fortran/31258
+	PR fortran/32703
+	* gfortran.h : Add prototype for gfc_resolve_substring_charlen.
+	* resolve.c (gfc_resolve_substring_charlen): New function.
+	(resolve_ref): Call gfc_resolve_substring_charlen.
+	(gfc_resolve_character_operator): New function.
+	(gfc_resolve_expr): Call the new functions in cases where the
+	character length is missing.
+	* iresolve.c (cshift, eoshift, merge, pack, reshape, spread,
+	transpose, unpack): Call gfc_resolve_substring_charlen for
+	source expressions that are character and have a reference.
+	* trans.h (gfc_trans_init_string_length) Change name to
+	gfc_conv_string_length; modify references in trans-expr.c,
+	trans-array.c and trans-decl.c.
+	* trans-expr.c (gfc_trans_string_length): Handle case of no
+	backend_decl.
+	(gfc_conv_aliased_arg): Remove code for treating substrings
+	and replace with call to gfc_trans_string_length.
+	* trans-array.c (gfc_conv_expr_descriptor): Remove code for
+	treating strings and call gfc_trans_string_length instead.
+
+2007-08-30  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33228
+	* interface.c (check_interface0): Improve error for external procs.
+	(check_sym_interfaces): Fix checking of module procedures.
+
+2007-08-29  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32989
+	* iresolve.c (gfc_resolve_getarg): Handle non-default integer
+	kinds.
+	* check.c (gfc_check_getarg): New function
+	* intrinsic.h: Add prototype for gfc_check_getarg.
+	* intrinsic.c (add_subroutines): Add reference to gfc_check_getarg.
+	* intrinsic.texi (GETARG): Adjust documentation.
+
+2007-08-29  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+	    Tobias Burnus  <burnus@gcc.gnu.org>
+
+	PR fortran/33105
+	* intrinsic.c (add_functions): Add IS_IOSTAT_END and
+	IS_IOSTAT_EOR intrinsics.
+	* gfortran.h (gfc_isym_id): Add GFC_ISYM_IS_IOSTAT_END and
+	GFC_ISYM_IS_IOSTAT_EOR.
+	* trans-intrinsic.c (gfc_conv_has_intvalue): New function.
+	(gfc_conv_intrinsic_function): Call gfc_conv_has_intvalue for
+	GFC_ISYM_IS_IOSTAT_END and GFC_ISYM_IS_IOSTAT_EOR.
+	* intrinsic.texi: Add IS_IOSTAT_END and IS_IOSTAT_EOR.
+
+2007-08-28  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/33215
+	* decl.c (build_sym): Pass number of identifiers on line to
+	set_binding_label.
+	(set_binding_label): Verify that only one identifier given if
+	NAME= specified, even if the given binding label has zero length.
+	(gfc_match_bind_c): Remove declaration for has_name_equals because
+	it hides the static global one that is needed.
+
+2007-08-29  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans-array.c (gfc_grow_array): Use gfc_call_realloc.
+	(gfc_array_allocate): Use gfc_allocate_with_status and
+	gfc_allocate_array_with_status.
+	(gfc_array_deallocate): Use gfc_deallocate_with_status.
+	(gfc_trans_dealloc_allocated): Use gfc_deallocate_with_status.
+	* trans-stmt.c (gfc_trans_allocate): Use gfc_allocate_with_status.
+	(gfc_trans_deallocate): Use gfc_deallocate_with_status.
+	* trans.c (gfc_allocate_with_status, gfc_allocate_array_with_status,
+	gfc_deallocate_with_status, gfc_call_realloc): New functions.
+	* trans.h (gfc_allocate_with_status, gfc_allocate_array_with_status,
+	gfc_deallocate_with_status, gfc_call_realloc): New prototypes.
+	(gfor_fndecl_internal_realloc, gfor_fndecl_allocate,
+	gfor_fndecl_allocate_array, gfor_fndecl_deallocate): Remove.
+	* f95-lang.c (gfc_init_builtin_functions): Create decl for
+	BUILT_IN_REALLOC.
+	* trans-decl.c (gfor_fndecl_internal_realloc,
+	gfor_fndecl_allocate, gfor_fndecl_allocate_array,
+	gfor_fndecl_deallocate): Remove function decls.
+	(gfc_build_builtin_function_decls): Likewise.
+
+2007-08-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33055
+	Revert previous patch.
+
+2007-08-28  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/22244
+	* Make-lang.in (fortran/trans-types.o): Depend on $(FLAGS_H).
+	* trans-types.c: Include flags.h.
+	(gfc_get_nodesc_array_type): Add TYPE_DECL TYPE_NAME with
+	correct bounds and dimensions for packed arrays.
+
+2007-08-27  Tobias Burnus  <burnus@net-b.de>
+
+	* simplify.c (gfc_simplify_lgamma): Fix mpfr_lgamma call.
+
+2007-08-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33055
+	* trans-io.c (create_dummy_iostat): New function to create a unique
+	dummy variable expression to use with IOSTAT.
+	(gfc_trans_inquire): Use the new function to pass unit number error info
+	to run-time library if a regular IOSTAT variable was not given.
+
+2007-08-26  H.J. Lu  <hongjiu.lu@intel.com>
+
+	* gfortran.h (gfc_isym_id): Add GFC_ISYM_GAMMA and
+	GFC_ISYM_LGAMMA.
+
+2007-08-26  Asher Langton  <langton2@llnl.gov>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.h (gfc_option_t): Add flag_recursive.
+	* lang.opt: Add -frecursive option and update -fopenmp.
+	* invoke.texi (-frecursive): Document new option.
+	(-fopenmp,-fno-automatic,-fmax-stack-var-size): Update.
+	* options.c (gfc_init_options, gfc_post_options,
+	gfc_handle_option): Add -frecursive and modify -fopenmp.
+	(gfc_post_options): Add warning for conflicting flags.
+
+2007-08-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/31298
+	* module.c (mio_symbol_ref,mio_interface_rest):  Return pointer_info.
+	(load_operator_interfaces): Support multible loading of an operator.
+
+2007-08-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32985
+	* match.c (gfc_match_common): Remove SEQUENCE diagnostics.
+	* resolve.c (resolve_common_blocks): Add SEQUENCE diagnostics;
+	fix walking through the tree.
+
+2007-08-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32980
+	* intrinsic.h (gfc_simplify_gamma,gfc_simplify_lgamma,
+	gfc_resolve_gamma,gfc_resolve_lgamma): New function declations.
+	* mathbuiltins.def: Define GAMMA and LGAMMA.
+	* intrinsic.c (add_functions): Add GAMMA, DGAMMA, LGAMMA, ALGAMA
+	and DLGAMA.
+	* simplify.c (gfc_simplify_gamma,gfc_simplify_lgamma): New functions.
+	* iresolve.c (gfc_resolve_gamma,gfc_resolve_lgamma): New functions.
+	* intrinsic.texi: Add documentation for GAMMA and LGAMMA.
+
+2007-08-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33188
+	* parse.c (parse_derived): Support empty derived type
+	definitions for Fortran 2003.
+
+2007-08-25  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* trans-openmp.c (gfc_omp_privatize_by_reference): Constify.
+	* trans.h (gfc_omp_privatize_by_reference): Likewise.
+
+2007-08-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33178
+	* intrinsic.c (gfc_intrinsic_func_interface): Fix initialization
+	expression check.
+
+2007-08-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/32972
+	* iresolve.c:  Don't convert array masks.
+
+2007-08-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33139
+	* trans-array.c (gfc_conv_expr_descriptor): Copy bounds for
+	whole-array pointer assignments.
+
+2007-08-23  Jakub Jelinek  <jakub@redhat.com>
+
+	* decl.c (variable_decl): Don't share charlen structs if
+	length == NULL.
+	* trans-decl.c (create_function_arglist): Assert
+	f->sym->ts.cl->backend_decl is NULL instead of unsharing
+	charlen struct here.
+
+2007-08-23  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33095
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmax): Remove
+	runtime error checking.
+
+2007-08-22  Roger Sayle  <roger@eyesopen.com>
+	    Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
+
+	* match.c (intrinsic_operators): Delete.
+	(gfc_match_intrinsic_op): Rewrite matcher to avoid calling
+	gfc_match_strings.
+
+2007-08-22  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/33020
+	* resolve.c (gfc_iso_c_sub_interface): Remove setting of type and
+	kind for optional SHAPE parameter of C_F_POINTER.
+
+2007-08-22  Janus Weil  <jaydub66@gmail.com>
+
+	* decl.c (match_attr_spec): Pass on errors from gfc_match_bind_c.
+	(gfc_match_bind_c): Bugfix in check for NAME= with abstract interfaces.
+	(gfc_match_mopdproc): Bugfix to reject module procedures in
+	abstract interfaces.
+
+2007-08-22  Kai Tietz  <kai.tietz@onevision.com>
+
+	* f95-lang.c: (gfc_init_decl_processing): Choose sizetype by using
+	Pmode.
+
+2007-08-21  Paul Brook  <paul@codesourcery.com>
+	    Nathan Sidwell  <nathan@codesourcery.com>
+	    Mark Mitchell  <mark@codesourcery.com>
+	    Joseph Myers  <joseph@codesourcery.com>
+
+	* gfortranspec.c (lang_specific_driver): Use pkgversion_string.
+	* Make-lang.in (gfortran.pod): Define BUGURL.
+	* invoke.texi: Use BUGURL for bug-reporting instructions.
+
+2007-08-19  Roger Sayle  <roger@eyesopen.com>
+
+	* match.c (intrinsic_operators): Make static.
+	(gfc_op2string): New function for converting a gfc_intrinsic_op to
+	to a "const char*", replacing the macro of the same name.
+	* gfortran.h (intrinsic_operators): Delete prototype.
+	(gfc_op2string): Replace macro with function prototype.
+
+2007-08-18  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.h (gfc_is_intrinsic_typename): Add declaration.
+	* symbol.c (gfc_is_intrinsic_typename): New function.
+	* parse.c (decode_statement): Check for space in ABSTRACT INTERFACE.
+	(parse_interface): Use gfc_is_intrinsic_typename.
+	* decl.c (gfc_match_derived_decl): Ditto.
+	* module.c (gfc_match_use): Use gcc_unreachable() for
+	INTERFACE_ABSTRACT in switch().
+
+2007-08-18  Roger Sayle  <roger@eyesopen.com>
+
+	* primary.c (match_logical_constant_string): New function to match
+	a ".true." or a ".false.".
+	(match_logical_constant): Use it instead of gfc_match_strings.
+
+2007-08-18  Paul Thomas  <pault@gcc.gnu.org>
+	    Janus Weil  <jaydub66@gmail.com>
+
+	* interface.c (gfc_match_interface,gfc_match_abstract_interface,
+	gfc_match_end_interface,gfc_add_interface): Add abstract interface.
+	* dump-parse-tree.c (gfc_show_attr): Ditto.
+	* gfortran.h (interface_type,symbol_attribute): Ditto.
+	* module.c (gfc_match_use,ab_attribute,attr_bits,
+	mio_symbol_attribute): Ditto.
+	* resolve.c (resolve_function): Ditto.
+	* match.h: Ditto.
+	* parse.c (decode_statement): Ditto.
+	(parse_interface): Ditto, check for C1203 (name of abstract interface
+	cannot be the same as an intrinsic type).
+	* decl.c (gfc_match_bind_c): Check for NAME= with abstract interfaces.
+	(access_attr_decl): Handle Abstract interfaces.
+
+2007-08-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32881
+	* expr.c (gfc_check_pointer_assign): If the rhs is the
+	initialization expression for the rhs, there is no error.
+
+2007-08-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32875
+	* trans-array.c	(get_array_ctor_strlen): Set the character
+	length of a zero length array to zero.
+
+2007-08-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33072
+	* module.c (gfc_match_use): Mark user operators as such.
+	(find_use_name_n): Distinguish between operators and other symbols.
+	(find_use_name,number_use_names,mio_namelist,
+	 load_operator_interfaces,load_generic_interfaces,read_module,
+	 write_generic): Update find_use_name_n calls.
+
+2007-08-15  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/29459
+	* trans.c (gfc_create_var_np): Do not emit warnings for
+	anonymous variables.
+
+2007-08-15  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33066
+	* decl.c (gfc_get_type_attr_spec): Fix whitespace.
+	(gfc_match_derived_decl): Fix logic.
+
+2007-08-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33073
+	* trans-intrinsic.c (build_fixbound_expr): Convert to result type
+	in all cases.
+
+2007-08-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32594
+	* trans-expr.c (gfc_conv_substring_expr): Only call
+	gfc_conv_substring if expr->ref is not NULL.
+	* expr.c (gfc_is_constant_expr): If e->ref is NULL, the substring
+	expression might be a constant.
+	(gfc_simplify_expr): Handle missing start and end, as well as
+	missing ref.
+
+2007-08-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32926
+	* match.c (gfc_match_call): Do not create a new symtree in the
+	case where the existing symbol is external and not referenced.
+
+2007-08-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32827
+	* decl.c (variable_decl): Check for an imported symbol
+	by looking for its symtree and testing for the imported
+	attribute.
+	(gfc_match_import): Remove change of symbol's namespace
+	and set the attribute imported instead.
+	* symbol.c (gfc_get_sym_tree): It is not an error if a
+	symbol is imported.
+	* gfortran.h : Add the 'imported' to symbol_attribute.
+
+2007-08-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32962
+	* trans-array.c (gfc_conv_array_transpose): Set the offset
+	of the destination to zero if the loop is zero based.
+
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/29600
+	* intrinsic.c (add_functions): Add optional KIND argument to ACHAR.
+	* iresolve.c (gfc_resolve_achar): Handle the KIND argument.
+	* check.c (gfc_check_achar): Check for the optional KIND argument.
+	* simplify.c (gfc_simplify_achar): Use KIND argument.
+	* intrinsic.h (gfc_check_achar, gfc_simplify_achar,
+	gfc_resolve_achar): Adjust prototypes.
+
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/30964
+	PR fortran/33054
+	* trans-expr.c (gfc_conv_function_call): When no formal argument
+	list is available, we still substitute missing optional arguments.
+	* check.c (gfc_check_random_seed): Correct the check on the
+	number of arguments to RANDOM_SEED.
+	* intrinsic.c (add_subroutines): Add a resolution function to
+	RANDOM_SEED.
+	* iresolve.c (gfc_resolve_random_seed): New function.
+	* intrinsic.h (gfc_resolve_random_seed): New prototype.
+
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32860
+	* error.c (error_uinteger): New function.
+	(error_integer): Call error_uinteger.
+	(error_print): Handle %u, %lu, %li and %ld format specifiers.
+	* interface.c (compare_actual_formal): Use the new %lu specifier.
+
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31629
+	* lang.opt (-fmodule-private): New option.
+	* gfortran.h (gfc_option_t): Add flag_module_private member.
+	* invoke.texi (-fmodule-private): Document the new option.
+	* module.c (gfc_check_access): Allow the -fmodule-private option
+	to modify the default behaviour.
+	* options.c (gfc_init_options): Initialize flag_module_private.
+	(gfc_handle_option): Handle -fmodule-private.
+
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/29600
+	* intrinsic.c (add_functions): Add KIND arguments to COUNT,
+	IACHAR, ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND
+	and VERIFY.
+	* iresolve.c (gfc_resolve_count): Add kind argument.
+	(gfc_resolve_iachar): New function.
+	(gfc_resolve_ichar): Add kind argument.
+	(gfc_resolve_index_func): Likewise.
+	(gfc_resolve_lbound): Likewise.
+	(gfc_resolve_len): Likewise.
+	(gfc_resolve_len_trim): Likewise.
+	(gfc_resolve_scan): Likewise.
+	(gfc_resolve_size): New function.
+	(gfc_resolve_ubound): Add kind argument.
+	(gfc_resolve_verify): Likewise.
+	* trans-decl.c (gfc_get_extern_function_decl): Allow specific
+	intrinsics to have 4 arguments.
+	* check.c (gfc_check_count): Add kind argument.
+	(gfc_check_ichar_iachar): Likewise.
+	(gfc_check_index): Likewise.
+	(gfc_check_lbound): Likewise.
+	(gfc_check_len_lentrim): New function.
+	(gfc_check_scan): Add kind argument.
+	(gfc_check_size): Likewise.
+	(gfc_check_ubound): Likewise.
+	(gfc_check_verify): Likewise.
+	* intrinsic.texi: Update documentation for COUNT, IACHAR, ICHAR,
+	INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND and VERIFY.
+	* simplify.c (get_kind): Whitespace fix.
+	(int_expr_with_kind): New function.
+	(gfc_simplify_iachar): Add kind argument.
+	(gfc_simplify_iachar): Likewise.
+	(gfc_simplify_ichar): Likewise.
+	(gfc_simplify_index): Likewise.
+	(simplify_bound_dim): Likewise.
+	(simplify_bound): Likewise.
+	(gfc_simplify_lbound): Likewise.
+	(gfc_simplify_len): Likewise.
+	(gfc_simplify_len_trim): Likewise.
+	(gfc_simplify_scan): Likewise.
+	(gfc_simplify_shape): Pass NULL as kind argument to gfc_simplify_size.
+	(gfc_simplify_size): Add kind argument.
+	(gfc_simplify_ubound): Likewise.
+	(gfc_simplify_verify): Likewise.
+	* intrinsic.h: Update prototypes and add new ones.
+	* trans-intrinsic.c (gfc_conv_intrinsic_index): Rename into
+	gfc_conv_intrinsic_index_scan_verify.
+	(gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify): Remove.
+	(gfc_conv_intrinsic_function): Call
+	gfc_conv_intrinsic_index_scan_verify to translate the INDEX,
+	SCAN and VERIFY intrinsics.
+
+2007-08-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31189
+	* invoke.texi (-fbacktrace): Document the new behaviour.
+
+2007-08-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32937
+	* trans-array.c (gfc_conv_expr_descriptor): Use
+	gfc_conv_const_charlen to generate backend_decl of right type.
+	* trans-expr.c (gfc_conv_expr_op): Use correct return type.
+	(gfc_build_compare_string): Use int type instead of default
+	integer kind for single character comparison.
+	(gfc_conv_aliased_arg): Give backend_decl the right type.
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Make
+	compare_string return an int.
+
+2007-08-11  Ian Lance Taylor  <iant@google.com>
+
+	* f95-lang.c (gfc_get_alias_set): Change return type to
+	alias_set_type.
+
+2007-08-10  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31270
+	* trans.c (gfc_trans_runtime_check): Reorder arguments and
+	add extra variable arguments. Hand them to the library function.
+	* trans.h (gfc_trans_runtime_check): Update prototype.
+	* trans-array.c (gfc_trans_array_bound_check): Issue more
+	detailled error messages.
+	(gfc_conv_array_ref): Likewise.
+	(gfc_conv_ss_startstride): Likewise.
+	(gfc_trans_dummy_array_bias): Reorder arguments to
+	gfc_trans_runtime_check.
+	* trans-expr.c (gfc_conv_substring): Issue more detailled
+	error messages.
+	(gfc_conv_function_call): Reorder arguments to gfc_trans_runtime_check.
+	* trans-stmt.c (gfc_trans_goto): Likewise.
+	* trans-io.c (set_string): Reorder arguments to
+	gfc_trans_runtime_check and issue a more detailled error message.
+	* trans-decl.c (gfc_build_builtin_function_decls): Make
+	runtime_error and runtime_error_at handle a variable number of
+	arguments.
+	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Reorder arguments
+	to gfc_trans_runtime_check.
+	(gfc_conv_intrinsic_minmax): Likewise.
+	(gfc_conv_intrinsic_repeat): Issue more detailled error messages.
+
+2007-08-10  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* gfortranspec.c (lang_specific_driver): Use CONST_CAST.
+	* options.c (gfc_post_options): Likewise.
+	* parse.c (parse_omp_structured_block): Likewise.
+	* st.c (gfc_free_statement): Likewise.
+
+2007-08-10  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32933
+	* trans-decl.c (gfc_build_builtin_function_decls): Change
+	prototype for associated.
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmax): Convert the
+	result of __builtin_isnan into a boolean.
+	(gfc_conv_intrinsic_strcmp): Cleanup.
+	(gfc_conv_associated): Convert the result of the associated
+	function into a boolean.
+
+2007-08-09  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32987
+	* io.c (format_token): Add FMT_ERROR.
+	(next_char_not_space): Print error/warning when
+	'\t' are used in format specifications.
+	(format_lex): Propagate error.
+	(check_format): Ditto.
+
+2007-08-09  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33001
+	* arith.c (arith_error): Point in the error message
+	to -fno-range-check.
+
+2007-08-09  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32902
+	* intrinsic.texi (SIZEOF): Add mention to C_SIZE_T.
+
+2007-08-06  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/32732
+	* trans-expr.c (gfc_conv_scalar_char_value): Convert the tree and
+	actual arg expressions for scalar characters passed by-value to
+	bind(c) routines.
+	(gfc_conv_function_call): Call gfc_conv_scalar_char_value.
+	* trans.h: Add prototype for gfc_conv_scalar_char_value.
+	* trans-decl.c (generate_local_decl): Convert by-value character
+	dummy args of bind(c) procedures using
+	gfc_conv_scalar_char_value.
+
+2007-08-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/30947
+	* iresolve.c (gfc_resolve_alarm_sub): Suffix the subroutine name
+	with the kind of the STATUS argument.
+
+2007-08-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/30948
+	* intrinsic.c (add_functions): Fix name of argument to CHDIR.
+
+2007-08-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/30933
+	* iresolve.c (gfc_resolve_exit): Convert argument to default
+	integer kind.
+
+2007-08-06  Daniel Franke  <franke.daniel@gmail.com>
+
+	* resolve.c (derived_pointer): Removed, replaced callers by access 
+	to appropiate attribute bit.
+	(derived_inaccessable): Shortcut recursion depth.
+	(resolve_fl_namelist): Fixed checks for private components in namelists.
+
+2007-08-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/29828
+	* trans.h (gfor_fndecl_string_minmax): New prototype.
+	* trans-decl.c (gfor_fndecl_string_minmax): New variable.
+	(gfc_build_intrinsic_function_decls): Create gfor_fndecl_string_minmax.
+	* check.c (gfc_check_min_max): Allow for character arguments.
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmax_char): New function.
+	(gfc_conv_intrinsic_function): Add special case for MIN and MAX
+	intrinsics with character arguments.
+	* simplify.c (simplify_min_max): Add simplification for character
+	arguments.
+
+2007-08-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31612
+	* invoke.texi: Adjust documentation for option -fsyntax-only.
+
+2007-08-05  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+	    Tobias Burnus  <burnus@gcc.gnu.org>
+
+	PR fortran/32979
+	* intrinsic.h (gfc_check_isnan): Add prototype.
+	* gfortran.h (gfc_isym_id): Add GFC_ISYM_ISNAN.
+	* intrinsic.c (add_functions): Add ISNAN intrinsic.
+	* check.c (gfc_check_isnan): New function.
+	* trans-intrinsic.c (gfc_conv_intrinsic_isnan): New function.
+	(gfc_conv_intrinsic_function): Call gfc_conv_intrinsic_isnan
+	to translate ISNAN.
+	* intrinsic.texi: Document ISNAN.
+
+2007-08-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31214
+	* symbol.c (get_unique_symtree): Moved from module.c.
+	* module.c (get_unique_symtree): Moved to symbol.c.
+	* decl.c (get_proc_name): Transfer the typespec from the local
+	symbol to the module symbol, in the case that an entry is also
+	a module procedure.  Ensure the local symbol is cleaned up by
+	pointing to it with a unique symtree.
+
+	* dump_parse_tree (gfc_show_code_node): Add EXEC_ASSIGN_CALL.
+
+2007-08-04  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/32969
+	* iresolve.c (gfc_resolve_rrspacing): Convert argument(s) to
+	expected KIND.
+	(gfc_resolve_scale): Ditto.
+	(gfc_resolve_set_exponent): Ditto.
+	(gfc_resolve_spacing): Ditto.
+ 
+	PR fortran/32968
+	* trans-intrinsic.c (gfc_conv_intrinsic_si_kind,
+	gfc_conv_intrinsic_sr_kind): Convert the argument(s) to the
+	expected KIND, and fold the result to the expected KIND.
+
+2007-08-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31202
+	* f95-lang.c (gfc_init_builtin_functions): Defin builtins for 
+	lround{f,,l} and llround{f,,l}.
+	* trans-intrinsic.c (build_fix_expr): Generate calls to the
+	{l,}round{f,,l} functions.
+
+2007-08-01  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR libfortran/32954
+	* intrinsic.c (resolve_mask_arg):  New function.
+	(gfc_resolve_maxloc):  Use resolve_mask_arg for mask resolution.
+	(gfc_resolve_maxval):  Likewise.
+	(gfc_resolve_minloc):  Likewise.
+	(gfc_resolve_minval):  Likewise.
+	(gfc_resolve_pack):  Likewise.
+	(gfc_resolve_product):  Likewise.
+	(gfc_resolve_sum):  Likewise.
+	(gfc_resolve_unpack):  Likewise.
+
+2007-08-01  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32936
+	* match.c (gfc_match_allocate): Better check that STAT is
+	a variable.
+
+	* check.c (gfc_check_allocated): Reorder checks to improve
+	error message.
+
+2007-08-01  Nick Clifton  <nickc@redhat.com>
+
+	* arith.c: Change copyright header to refer to version 3 of the
+	GNU General Public License and to point readers at the COPYING3
+	file and the FSF's license web page.
+	* openmp.c, interface.c, intrinsic.c, trans-array.c, trans-expr.c,
+	symbol.c, iso-fortran-env.def, intrinsic.h, decl.c, trans-array.h,
+	matchexp.c, dump-parse-tree.c, trans-common.c, array.c,
+	Make-lang.in, trans-openmp.c, gfortran.h, error.c,
+	iso-c-binding.def, lang.opt, data.c, trans-const.c, trans-stmt.c,
+	expr.c, trans-const.h, trans-stmt.h, module.c, trans.c, scanner.c,
+	trans-types.c, trans.h, gfortranspec.c, trans-types.h,
+	lang-specs.h, io.c, bbt.c, resolve.c, f95-lang.c, st.c,
+	iresolve.c, match.c, trans-decl.c, trans-io.c, target-memory.c,
+	match.h, target-memory.h, parse.c, arith.h, check.c, dependency.c,
+	parse.h, types.def, convert.c, dependency.h, primary.c,
+	trans-intrinsic.c, options.c, misc.c, simplify.c: Likewise.
+
+2007-08-01  Daniel Franke  <franke.daniel@gmail.com>
+
+	* trans-decl.c (generate_local_decl): Emit warning on unused parameter
+	on "-Wall -Wextra" or "-Wunused-parameter" but not on "-Wall", changed
+	messages that start with lower case to upper case.
+	* invoke.texi (-Wparameter-unused): Document differences between gcc
+	and gfortran regarding this option.
+
+2007-08-01  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32945
+	* expr.c (check_specification_function): Skip check if no symtree 
+	is available.
+
+2007-08-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31609
+	* resolve.c (resolve_entries): Entries declared to be module
+	procedures must point to the function namespace.
+
+2007-07-31  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32938
+	* trans-stmt.c (gfc_trans_return): Convert to correct type.
+
+2007-07-31  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/32942
+	* trans-intrinsic.c (gfc_conv_intrinsic_exponent): Convert to correct
+	type.
+
+2007-07-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	* invoke.texi: Document -fsign-zero flag.
+
+2007-07-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31211
+	* trans-expr.c (gfc_conv_expr_reference): Add block for case of
+	scalar pointer functions so that NULL result is correctly
+	handled.
+
+	PR fortran/32682
+	* trans-array.c (gfc_trans_array_constructor): On detecting a
+	multi-dimensional parameter array, set the loop limits.
+
+2007-07-29  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32906
+	* resolve.c (resolve_fl_parameter): Check for constant shape arrays,
+	adjusted error message.
+
+2007-07-29  Daniel Franke  <franke.daniel@gmail.com>
+
+	* invoke.texi: Removed -w from option summary.
+
+2007-07-29  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32879
+	* intrinsic.texi (IRAND, RAND, RANDOM_NUMBER): Document algorithm
+	used for random number generator.
+
+2007-07-28  Kazu Hirata  <kazu@codesourcery.com>
+
+	* gfortran.h, interface.c, resolve.c, symbol.c: Fix comment
+	typos.
+	* intrinsic.texi, invoke.texi: Fix typos.
+
+2007-07-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/31609
+	* resolve.c (generic_sym): Check for a same symbol and if so, return to
+	avoid infinite recursion.
+
+2007-07-28  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31818
+	PR fortran/32876
+	PR fortran/32905
+	* gfortran.h (symbol_attribute): Added bits for pointer_comp, 
+	private_comp.
+	* parse.c (parse_derived): Set pointer_comp/private_comp bits if 
+	the derived type ultimately contains pointer components or private 
+	components.
+	* module.c (ab_attribute): New values AB_POINTER_COMP, AB_PRIVATE_COMP.
+	(attr_bits): Added names for new ab_attributes.
+	(mio_symbol_attribute): Save/restore new attribute bits in modules.
+	* match.c (gfc_match_namelist): Removed check for namelist objects
+	of assumed shape.
+	* resolve.c (resolve_fl_namelist): Added check for pointer or
+	private components in nested types. Added check for namelist objects
+	of assumed shape.
+
+2007-07-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32880
+	* trans-expr.c (gfc_trans_scalar_assign): Revert to fixed order
+	for lse and rse pre expressions, for derived types with
+	allocatable components.  Instead, assign the lhs to a temporary
+	and deallocate after the assignment.
+
+2007-07-28  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/32909
+	* trans-stmt.c (gfc_trans_character_select): Replace occurrences
+	of gfc_c_int_type_node with integer_type_node.
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Likewise.
+	(gfc_build_builtin_function_decls): Likewise.
+	(gfc_generate_function_code): Likewise.
+	* trans-io.c (gfc_build_io_library_fndecls): Likewise.
+
+2007-07-27  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	* trans-decl.c (gfc_build_builtin_function_decls): Use existing
+	gfc_array_index_type rather than creating another typenode for
+	gfc_index_integer_kind.
+
+2007-07-27  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	* trans-io.c (gfc_build_io_library_fndecls): Change to use
+	gfc_array_index_type for array descriptor triplets instead of
+	gfc_int4_type_node.
+
+2007-07-26  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/32899
+	* resolve.c (resolve_operator): Add INTRINSIC_EQ_OS comparison.
+
+2007-07-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+	    Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32760
+	* primary.c (match_variable): Do not call gfc_add_flavor if symbol has
+	attribute of ACCESS_PUBLIC or ACCESS_PRIVATE already marked.
+
+2007-07-27  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32035
+	* trans-stmt.c (gfc_trans_character_select): Replace the
+	mechanism with labels by a SWITCH_EXPR.
+	* trans-decl.c (gfc_build_builtin_function_decls): Change
+	return type for select_string.
+
+2007-07-27  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32903
+	* trans-decl.c (gfc_trans_deferred_vars): Set intent(out)
+	derived types as referenced, if they have the the default
+	initializer set.
+
+2007-07-25  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* gfortran.h (generate_isocbinding_symbol): Constify.
+	* symbol.c (gen_special_c_interop_ptr, gen_cptr_param,
+	generate_isocbinding_symbol): Likewise.
+
+2007-07-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31205
+	PR fortran/32842
+	* trans-expr.c (gfc_conv_function_call): Remove the default
+	initialization of intent(out) derived types.
+	* symbol.c (gfc_lval_expr_from_sym): New function.
+	* matchexp.c (gfc_get_parentheses): Return argument, if it is
+	character and posseses a ref.
+	* gfortran.h : Add prototype for gfc_lval_expr_from_sym.
+	* resolve.c (has_default_initializer): Move higher up in file.
+	(resolve_code): On detecting an interface assignment, check
+	if the rhs and the lhs are the same symbol.  If this is so,
+	enclose the rhs in parenetheses to generate a temporary and
+	prevent any possible aliasing.
+	(apply_default_init): Remove code making the lval and call
+	gfc_lval_expr_from_sym instead.
+	(resolve_operator): Give a parentheses expression a type-
+	spec if it has no type.
+	* trans-decl.c (gfc_trans_deferred_vars): Apply the a default
+	initializer, if any, to an intent(out) derived type, using
+	gfc_lval_expr_from_sym and gfc_trans_assignment.  Check if
+	the dummy is present.
+
+2007-07-24  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32867
+	* expr.c (check_init_expr): Simplify matched functions.
+
+2007-07-24  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32778
+	* intrinsic.c (add_sym): Do not exclude any symbols, even if not part
+	of the selected standard.
+	(make generic): Likewise.
+	(make alias): Likewise, set standard the alias belongs to.
+	(add_subroutines): Call make_noreturn unconditionally.
+	(check_intrinsic_standard): Change return value to try.
+	(gfc_intrinsic_func_interface): Check return value of above function.
+	(gfc_intrinsic_sub_interface): Likewise.
+
+2007-07-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/30814
+	* trans-decl.c (generate_function_code):  Add argument
+	for flag_bounds_check to the array for set_options.
+	* invoke.texi (-fbounds-check): Document new libarary run-time
+	behaviour.
+
+2007-07-23  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/25104
+	PR fortran/31639
+	* expr.c (check_transformational): Reject valid transformational
+	intrinsics to avoid ICE.
+	(check_inquiry): Report error for assumed character lengths for
+	all supported standards.
+	(check_init_expr): Whitespace fix.
+
+2007-07-23  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/32797
+	PR fortran/32800
+	* decl.c (verify_bind_c_sym): Use the result symbol for functions
+	with a result clause.  Warn if implicitly typed.  Verify the type
+	and rank of the SHAPE argument, if given.
+	* resolve.c (gfc_iso_c_sub_interface): Use gfc_procedure_use to
+	check the actual args against the formal, sorting them if
+	necessary.
+	* symbol.c (gen_shape_param): Initialize type of SHAPE param to
+	BT_VOID.
+
+2007-07-23  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/32732
+	* trans-decl.c (generate_local_decl): Convert the TREE_TYPE for by
+	value character dummy args of BIND(C) procedures.
+	* trans-expr.c (gfc_conv_variable): Do not build address
+	expression for BT_CHARACTER dummy args.
+
+2007-07-23  Christopher D. Rickett  <crickett@lanl.gov>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32600
+	* trans-expr.c (gfc_conv_function_call): Handle c_funloc.
+	* trans-types.c: Add pfunc_type_node.
+	(gfc_init_types,gfc_typenode_for_spec): Use it.
+	* resolve.c (gfc_iso_c_func_interface): Fix whitespace and
+	improve error message.
+
+2007-07-22  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32710
+	* parse.c (gfc_fixup_sibling_symbols): No replacement of symbols if
+	the current is a namelist.
+
+2007-07-22  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/29962
+	PR fortran/31253
+	PR fortran/31265
+	PR fortran/31639
+	* gfortran.h (gfc_intrinsic_sym): Changed members elemental, pure,
+	generic, specific, actual_ok, noreturn into bits of a bitfield, 
+	added bits for inquiry, transformational, conversion.
+	* check.c (non_init_transformational): Removed, removed all callers.
+	* intrinsic.c (enum class): New.
+	(add_sym*): Replaced argument elemetal by enum class. Changed all
+	callers.
+	(add_functions): Assign appropriate classes to intrinsic functions.
+	(add_subroutines): Assign appropriate classes to intrinsic subroutines.
+	(add_conv): Set conversion attribute.
+	(gfc_init_expr_extensions): Removed, removed all callers.
+	(gfc_intrinsic_func_interface): Reimplemented check for non-standard
+	initializatione expressions.
+	* expr.c (check_specification_function): New.
+	(gfc_is_constant_expr): Added check for specification functions.
+	(check_init_expr_arguments): New.
+	(check_inquiry): Changed return value to MATCH, added checks for
+	inquiry functions defined by F2003.
+	(check_transformational): New.
+	(check_null): New.
+	(check_elemental): New.
+	(check_conversion): New.
+	(check_init_expr): Call new check functions, add more specific error
+	messages.
+
+2007-07-21  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/32627
+	* resolve.c (set_name_and_label): Set kind number for character
+	version of c_f_pointer.
+	(gfc_iso_c_sub_interface): Set the kind of the SHAPE formal arg to
+	that of the actual SHAPE arg.
+	* symbol.c (gen_shape_param): Initialize kind for SHAPE arg.
+
+2007-07-21  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/32801
+	* symbol.c (generate_isocbinding_symbol): Remove unnecessary
+	conditional.
+
+	PR fortran/32804
+	* resolve.c (gfc_iso_c_func_interface): Reject assumed-shape and
+	deferred-shape arrays as args to C_LOC.  Fix bug in testing
+	character args to C_LOC.
+
+2007-07-21  Lee Millward  <lee.millward@gmail.com>
+
+	PR fortran/32823
+	* trans-intrinsic.c (gfc_conv_intrinsic_int): Evaluate all
+	arguments passed, not just the first one. Adjust code to 
+	refer to "args[0]" instead of "arg" as a result.
+	
+2007-07-19  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/32600
+	* trans-expr.c (gfc_conv_function_call): Inline C_LOC.
+
+2007-07-18  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/32801
+	* symbol.c (generate_isocbinding_symbol): Fix bug where
+	ISOCBINDING_FUNPTR was generated for C_LOC instead of the needed
+	ISOCBINDING_PTR.
+
+2007-07-17  Janus Weil  <jaydub66@gmail.com> 
+
+	PR fortran/32535
+	* resolve.c (resolve_fl_namelist): Check for namelist private 
+	components in contained subprograms.
+
+2007-07-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31320
+	PR fortran/32665
+	* trans-expr.c (gfc_trans_subcomponent_assign): Ensure that
+	renormalization unity base is done independently of existing
+	lbound value.
+	(gfc_trans_scalar_assign): If rhs is not a variable, put
+	lse->pre after rse->pre to ensure that de-allocation of lhs
+	occurs after evaluation of rhs.
+
+2007-07-16  Lee Millward  <lee.millward@gmail.com>
+
+	PR fortran/32222
+	PR fortran/32238
+	PR fortran/32242	
+	* trans-intrinsic.c (gfc_conv_intrinsic_function_args): Adjust
+	to operate on a stack allocated array for the intrinsic arguments
+	instead of creating a TREE_LIST. Add two new parameters for the
+	array and the number of elements. Update all callers to allocate
+	an array of the correct length to pass in. Update comment.
+	(gfc_intrinsic_argument_list_length): New function.
+	(gfc_conv_intrinsic_conversion): Call it.
+	(gfc_conv_intrinsic_mnimax): Likewise.
+	(gfc_conv_intrinsic_merge): Likewise.
+	(gfc_conv_intrinsic_lib_function): Call it. Use new CALL_EXPR
+	constructors.
+	(gfc_conv_intrinsic_cmplx): Likewise.
+	(gfc_conv_intrinsic_ctime): Likewise.
+	(gfc_covn_intrinsic_fdate): Likewise.
+	(gfc_conv_intrinsic_ttynam): Likewise.
+	(gfc_conv_intrinsic_ishftc): Likewise.
+	(gfc_conv_intrinsic_index): Likewise.
+	(gfc_conv_intrinsic_scan): Likewise.
+	(gfc_conv_intrinsic_verify): Likewise.
+	(gfc_conv_intrinsic_trim): Likewise.
+	(gfc_conv_intrinsic_aint): Use new CALL_EXPR constructors.
+	(gfc_conv_intrinsic_exponent): Likewise.
+	(gfc_conv_intrinsic_bound): Likewise.
+	(gfc_conv_intrinsic_abs): Likewise.
+	(gfc_conv_intrinsic_mod): Likewise.
+	(gfc_conv_intrinsic_sign): Likewise.
+	(gfc_conv_intrinsic_len): Likewise.
+	(gfc_conv_intrinsic_adjust): Likewise.
+	(gfc_conv_intrinsic_si_kind): Likewise. 
+	
+2007-07-16  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/32748
+	* trans-decl.c (gfc_build_builtin_function_decls): Remove
+	DECL_IS_MALLOC attribute from internal_realloc, thus reverting
+	part of my 2007-07-03 patch.
+
+2007-07-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+	    Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32611
+	* gfortran.h (gfc_option_t): Add flag_sign_zero field.
+	* lang.opt (-fsign-zero): New option.
+	* trans.h: Rename gfor_fndecl_set_std into gfor_fndecl_set_options.
+	* trans-decl.c (gfc_build_builtin_function_decls): Build the function
+	declaration to pass an array containing the options to be used by the
+	runtime library. (gfc_generate_function_code): Build an array that
+	contains option values to be passed to the runtime library and the call
+	to the function. 
+	* options.c (gfc_init_options): Initialize the flag_sign_zero field.
+	(gfc_handle_option): Handle the -fsign-zero option.
+
+2007-07-15  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32036
+	* trans-array.c (gfc_conv_array_ref): Only evaluate index once.
+
+2007-07-15  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32357
+	* iresolve.c (gfc_resolve_mvbits): Convert FROMPOS, LEN and TOPOS
+	to C int.
+
+2007-07-14  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR libfortran/32731
+	* iresolve.c(gfc_resolve_pack):  A scalar mask has
+	to be kind=4, an array mask with kind<4 is converted
+	to gfc_default_logical_kind automatically.
+	(gfc_resolve_unpack):  Convert mask to gfc_default_lotical_kind
+	if it has a kind<4.
+
+2007-07-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32724
+	* parse.c (parse_spec): Emit error on unexpected statement
+	function.
+
+2007-07-13  Daniel Franke  <franke.daniel@gmail.com>
+
+	* invoke.texi: Unified upper- and lower-case in menus.
+	(-w, -W): Removed, documented by gcc.
+	* intrinsic.texi: Unified Class-section entries, added
+	subroutine/function warning where appropiate.
+
+2007-07-12  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31639
+	* decl.c (gfc_match_suffix): Removed surplus general error that hides
+	a more specific message.
+	* resolve.c (resolve_fl_variable): Reject illegal initializiers only
+	if not already done.
+	(resolve_fl_procedure): Added check for initializers of functions.
+
+2007-07-12  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32704
+	* invoke.texi (-static-libgfortran): Document new option.
+
+2007-07-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32634
+	PR fortran/32727
+	* module.c (write_generic): Restore patch of 2007-07-10 and use
+	symbol name if there are no use names. 
+
+2007-07-12  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/32599
+	* decl.c (verify_c_interop_param): Require character string dummy
+	args to BIND(C) procedures to have length 1.
+	* resolve.c (resolve_fl_procedure): Modify parameter checking for
+	BIND(C) procedures.
+
+	PR fortran/32601
+	* resolve.c (gfc_iso_c_func_interface): Verify that a valid
+	expression is given as an argument to C_LOC and C_ASSOCIATED.
+	* trans-io.c (transfer_expr): Add argument for code block.  Add
+	standards check to determine if an error message should be
+	reported for printing C_PTR or C_FUNPTR.
+	(transfer_array_component): Update arguments to transfer_expr.
+	(gfc_trans_transfer): Ditto.
+
+	* symbol.c (gen_cptr_param): Fix whitespace.
+
+2007-07-12  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/32550
+	* trans.h (GFC_POINTER_TYPE_P): Define.
+	* trans-types.c (gfc_sym_type): Set it for types on attr->sym.pointer.
+	* trans-openmp.c (gfc_omp_privatize_by_reference): Return false
+	if GFC_POINTER_TYPE_P is set on the type.
+
+2007-07-12  Richard Guenther  <rguenther@suse.de>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_repeat): Convert
+	arguments to gfc_charlen_type_node.
+	* trans-io.c (gfc_convert_array_to_string): Convert type
+	size to gfc_array_index_type.
+
+2007-07-12  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32634
+	PR fortran/32727
+	* module.c: Reverted Paul's patch from 2007-07-10.
+
+2007-07-11  Richard Guenther  <rguenther@suse.de>
+
+	* trans-array.c (gfc_conv_array_parameter): Use correct
+	types for comparison.
+	* trans-intrinsic.c (gfc_conv_intrinsic_repeat): Use
+	correct types for POINTER_PLUS_EXPR.
+	* trans-stmt.c (gfc_trans_forall_loop): Use correct type
+	for integer one constant.
+
+2007-07-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32157
+	* resolve.c (is_external_proc): New function.  Adds test that
+	the symbol is not an intrinsic procedure.
+	* (resolve_function, resolve_call): Replace logical statements
+	with call to is_external_proc.
+
+	PR fortran/32689
+	* simplify.c (gfc_simplify_transfer): If mold has rank, the
+	result is an array.
+
+	PR fortran/32634
+	* module.c (write_generic): Write the local name of the
+	interface. 
+
+2007-07-09  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/29459
+	* trans-array.c (gfc_trans_array_constructor): Mark offset field
+	with TREE_NO_WARNING.
+	* trans-decl.c (gfc_build_qualified_array): Mark lbound, ubound,
+	stride and size variables with TREE_NO_WARNING.
+
+2007-07-09  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* trans-decl.c (set_tree_decl_type_code): Remove function.
+	(generate_local_decl): Remove reference to set_tree_decl_type_code.
+
+2007-07-09  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31129
+	* trans-decl.c (generate_local_decl) Emit a warning if an unused
+	parameter is found.
+
+2007-07-08  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/29876
+	* module.c (gfc_match_use): Do not set an non-existant 
+	intrinsic operator if a user-defined operator is found.
+
+2007-07-08  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/24784
+	PR fortran/28004
+	* trans-decl.c (generate_local_decl): Adjusted warning on unused 
+	dummy arguments, tell middle-end not to emit additional warnings.
+
+2007-07-08  Daniel Franke  <franke.daniel@gmail.com>
+	    Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
+
+	PR fortran/17711
+	* gfortran.h (gfc_intrinsic_op): Added INTRINSIC_EQ_OS,
+	INTRINSIC_NE_OS, INTRINSIC_GT_OS, INTRINSIC_GE_OS, 
+	INTRINSIC_LT_OS and INTRINSIC_LE_OS.
+	* arith.c (eval_intrinsic, eval_type_intrinsic0): Likewise.
+	* arith.h (gfc_eq, gfc_ne, gfc_gt, gfc_ge, gfc_lt, gfc_le):
+	Added gfc_intrinsic_op as third argument type.
+	* dump-parse-tree.c (gfc_show_expr): Account for new enum values.
+	* expr.c (simplify_intrinsic_op, check_intrinsic_op): Likewise.
+	* interface.c (check_operator_interface): Likewise.
+	(gfc_check_interfaces): Added cross-checks for FORTRAN 77 and 
+	Fortran 90 style operators using new enum values.
+	(gfc_extend_expr): Likewise.
+	(gfc_add_interface): Likewise.
+	* match.c (intrinsic_operators): Distinguish FORTRAN 77 style
+	operators from Fortran 90 style operators using new enum values.
+	* matchexp.c (match_level_4): Account for new enum values.
+	* module.c (mio_expr): Likewise.
+	* resolve.c (resolve_operator): Deal with new enum values, fix
+	inconsistent error messages.
+	* trans-expr.c (gfc_conv_expr_op): Account for new enum values.
+
+2007-07-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32669
+	* interface.c (get_expr_storage_size): Properly obtain lower bound.
+	(compare_actual_formal): Add space before parenthesis.
+
+2007-07-08  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/25094
+	* resolve.c (resolve_fl_procedure): Added check for PRIVATE types 
+	in PUBLIC interfaces.
+
+2007-07-07  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/32644
+	* decl.c (match_attr_spec): Don't return MATCH_ERROR if comma found and
+	gfc_match_bind_c does not return MATCH_YES.
+
+2007-07-07  Kazu Hirata  <kazu@codesourcery.com>
+
+	* decl.c, gfortran.h, interface.c, module.c, resolve.c,
+	trans-array.c, trans-decl.c: Fix comment typos.  Follow
+	spelling conventions.
+	* intrinsic.texi: Fix typos.  Follow spelling conventions.
+
+2007-05-06  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32633
+	* symbol.c (save_status): New.
+	* gfortran.h (save_status): Added external declaration.
+	(check_conflict): Check for conflicting explicite SAVE statements
+	only.
+	(gen_special_c_interop_ptr): Use SAVE_EXPLICIT constant.
+	* module.c (ab_attribute, attr_bits): Removed enumerator value 
+	AB_SAVE for save attribute.
+	(mio_symbol_attribute): Import/export the full SAVE status, 
+	removed usage of AB_SAVE.
+	* dump-parse-tree.c (gfc_show_attr): Dump full SAVE status.
+	* decl.c (add_init_expr_to_sym): Set SAVE_IMPLICIT only if not
+	already explicit.
+
+2007-07-05  Daniel Franke  <franke.daniel@gmail.com>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32359
+	* gfortran.h (symbol_attribute): Change save attribute into an enum.
+	* decl.c (add_init_expr_to_sym): Set it to SAVE_IMPLICIT.
+	* symbol.c (gfc_add_save): Check for SAVE_EXPLICIT.
+	* resolve.c (resolve_fl_variable): Check for SAVE_EXPLICIT.
+	(resolve_symbol): Allow OMP threadprivate with
+	initialization SAVEd and save_all variable.
+	* trans-decl.c (gfc_finish_var_decl): Remove obsolete sym->value check.
+
+2007-07-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32526
+	* match.c (gfc_match_call): Check, in all cases, that a symbol
+	is neither generic nor a subroutine before trying to add it as
+	a subroutine.
+
+	PR fortran/32613
+	* match.c (gfc_match_do): Reset the implied_index attribute.
+
+2007-07-04  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31198
+	* trans-intrinsic.c (trans-intrinsic.c): Handle optional
+	arguments correctly for MIN and MAX intrinsics.
+
+2007-07-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/32545
+	* io.c (check_format): Always call gfc_error for errors.
+	(check_format_string): Change type of this function to try and
+	return the result of check_format.
+	(check_io_constraints): Return MATCH_ERROR if check_format_string
+	returns FAILURE.
+
+2007-07-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/32612
+	* decl.c (get_proc_name): Include attr->mod_proc in check for error.
+
+2007-07-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/32432
+	* gfortran.h: Change type of gfc_assign_data_value from void to try.
+	* data.c (gfc_assign_data_value): Return FAILURE if error found.
+	* resolve.c (check_data_variable): If gfc_assign_data_value returns
+	failure, break out of loop and return failure.
+
+2007-07-03  Christopher D. Rickett  <crickett@lanl.gov>
+
+	PR fortran/32579
+	* symbol.c (gen_cptr_param): Generate C_PTR and C_FUNPTR if necessary.
+	(build_formal_args): Pass intrinsic module symbol id to
+	gen_cptr_param.
+
+2007-07-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/25062
+	* resolve.c (resolve_common_blocks): New check function.
+	(resolve_types): Use it.
+
+2007-07-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/30940
+	* interface.c (get_sym_storage_size): New function.
+	(get_sym_storage_size): New function.
+	(compare_actual_formal): Enhance sequence association
+	support and improve checking.
+
+2007-07-03  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	* trans-decl.c (gfc_build_builtin_function_decls): Mark
+	internal_realloc as a malloc function.
+
+2007-07-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/20888
+	* resolve.c (resolve_operator): Check for NULL as operand.
+
+2007-07-02  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi (Fortran 2003): Add ISO Bind C.
+	* intrinsic.texi (C_ASSOCIATED,C_F_POINTER,C_F_PROCPOINTER,
+	C_FUNLOC,C_LOC): Document new ISO Bind C intrinsics.
+
+2007-07-01  Christopher D. Rickett  <crickett@lanl.gov>
+
+	* interface.c (gfc_compare_derived_types): Special case for comparing
+	derived types across namespaces.
+	(gfc_compare_types): Deal with BT_VOID.
+	(compare_parameter): Use BT_VOID to accept ISO C Binding pointers.
+	* trans-expr.c (gfc_conv_function_call): Remove setting parm_kind
+	to SCALAR
+	(gfc_conv_initializer): Deal with ISO C Binding NULL_PTR and 
+	NULL_FUNPTR.
+	(gfc_conv_expr): Convert expressions for ISO C Binding derived types.
+	* symbol.c (gfc_set_default_type): BIND(C) variables should not be
+	Implicitly declared.
+	(check_conflict): Add BIND(C) and check for conflicts.
+	(gfc_add_explicit_interface): Whitespace.	
+	(gfc_add_is_bind_c): New function.  
+	(gfc_copy_attr): Use it.
+	(gfc_new_symbol): Initialize ISO C Binding objects.
+	(get_iso_c_binding_dt):  New function.
+	(verify_bind_c_derived_type): Ditto.
+	(gen_special_c_interop_ptr): Ditto.
+	(add_formal_arg): Ditto.
+	(gen_cptr_param): Ditto.
+	(gen_fptr_param): Ditto.
+	(gen_shape_param): Ditto.
+	(add_proc_interface): Ditto.
+	(build_formal_args): Ditto.
+	(generate_isocbinding_symbol):  Ditto.
+	(get_iso_c_sym):  Ditto.
+	* decl.c (num_idents_on_line, has_name_equals): New variables.
+	(verify_c_interop_param): New function.
+	(build_sym): Finish binding labels and deal with COMMON blocks.
+	(add_init_expr_to_sym): Check if the initialized expression is
+	an iso_c_binding named constants
+	(variable_decl): Set ISO C Binding type_spec components.
+	(gfc_match_kind_spec): Check match for C interoperable kind.
+	(match_char_spec): Fix comment. Chnage gfc_match_small_int
+	to gfc_match_small_int_expr.  Check for C interoperable kind.
+	(match_type_spec): Clear the current binding label.
+	(match_attr_spec): Add DECL_IS_BIND_C.  If BIND(C) is found, use it
+	to set attributes.
+	(set_binding_label): New function.
+	(set_com_block_bind_c): Ditto.
+	(verify_c_interop): Ditto.
+	(verify_com_block_vars_c_interop): Ditto.
+	(verify_bind_c_sym): Ditto.
+	(set_verify_bind_c_sym): Ditto.
+	(set_verify_bind_c_com_block): Ditto.
+	(get_bind_c_idents): Ditto.
+	(gfc_match_bind_c_stmt): Ditto.
+	(gfc_match_data_decl): Use num_idents_on_line.
+	(match_result): Deal with right paren in BIND(C).
+	(gfc_match_suffix): New function.
+	(gfc_match_function_decl): Use it.  Code is re-arranged to deal with
+	ISO C Binding result clauses.
+	(gfc_match_subroutine):  Deal with BIND(C).
+ 	(gfc_match_bind_c): New function.
+	(gfc_get_type_attr_spec): New function.  Code is re-arranged in and
+	taken from gfc_match_derived_decl.
+	(gfc_match_derived_decl): Add check for BIND(C).
+	* trans-common.c: Forward declare gfc_get_common.
+	(gfc_sym_mangled_common_id): Change arg from 'const char *name' to
+	'gfc_common_head *com'.  Check for ISO C Binding of the common block.
+	(build_common_decl): 'com->name' to 'com in SET_DECL_ASSEMBLER_NAME.
+	* gfortran.h: Add GFC_MAX_BINDING_LABEL_LEN
+	(bt): Add BT_VOID
+	(sym_flavor): Add FL_VOID.
+ 	(iso_fortran_env_symbol, iso_c_binding_symbol, intmod_id): New enum
+	(CInteropKind_t): New struct.
+	(c_interop_kinds_table): Use it.  Declare an array of structs.
+	(symbol_attribute): Add is_bind_c, is_c_interop, and is_iso_c
+	bitfields.
+	(gfc_typespec): Add is_c_interop; is_iso_c, and f90_type members.
+	(gfc_symbol): Add from_intmod, intmod_sym_id, binding_label, and
+	common_block members.
+	(gfc_common_head): Add binding_label and is_bind_c members.
+	(gfc_gsymbol): Add sym_name, mod_name, and binding_label members.
+	Add prototypes for get_c_kind, gfc_validate_c_kind, 
+	gfc_check_any_c_kind, gfc_add_is_bind_c, gfc_add_value,
+	verify_c_interop, verify_c_interop_param, verify_bind_c_sym,
+	verify_bind_c_derived_type, verify_com_block_vars_c_interop,
+	generate_isocbinding_symbol, get_iso_c_sym, gfc_iso_c_sub_interface
+	* iso-c-binding.def: New file. This file contains the definitions
+	of the types provided by the Fortran 2003 ISO_C_BINDING intrinsic
+	module.
+	* trans-const.c (gfc_conv_constant_to_tree): Deal with C_NULL_PTR
+	 or C_NULL_FUNPTR expressions.
+	* expr.c (gfc_copy_expr): Add BT_VOID case.  For BT_CHARACTER, the
+	ISO C Binding requires a minimum string length of 1 for '\0'.  
+	* module.c (intmod_sym): New struct.
+	(pointer_info): Add binding_label member.
+	(write_atom): Set len to 0 for NULL pointers. Check for NULL p and *p.
+	(ab_attribute): Add AB_IS_BIND_C, AB_IS_C_INTEROP and AB_IS_ISO_C.
+	(attr_bits): Add "IS_BIND_C", "IS_C_INTEROP", and "IS_ISO_C".
+	(mio_symbol_attribute): Deal with ISO C Binding attributes.
+	(bt_types): Add "VOID".
+	(mio_typespec): Deal with ISO C Binding components.
+	(mio_namespace_ref): Add intmod variable. 
+	(mio_symbol): Check for symbols from an intrinsic module.
+	(load_commons): Check for BIND(C) common block.
+	(read_module): Read binding_label and use it.
+	(write_common): Add label.  Write BIND(C) info.
+	(write_blank_common): Blank commons are not BIND(C).  Explicitly
+	set is_bind_c=0.
+	(write_symbol): Deal with binding_label.
+	(sort_iso_c_rename_list): New function.
+	(import_iso_c_binding_module): Ditto.
+	(create_int_parameter): Add to args.
+	(use_iso_fortran_env_module): Adjust to deal with iso_c_binding
+	intrinsic module.
+	* trans-types.c (c_interop_kinds_table): new array of structs. 
+	(gfc_validate_c_kind): New function.
+	(gfc_check_any_c_kind): Ditto.
+	(get_real_kind_from_node): Ditto.
+	(get_int_kind_from_node): Ditto.
+	(get_int_kind_from_width): Ditto.
+	(get_int_kind_from_minimal_width): Ditto.
+	(init_c_interop_kinds): Ditto.
+	(gfc_init_kinds): call init_c_interop_kinds.
+	(gfc_typenode_for_spec): Adjust for BT_VOID and ISO C Binding pointers.
+	Adjust handling of BT_DERIVED.
+	(gfc_sym_type): Whitespace.
+	(gfc_get_derived_type):  Account for iso_c_binding derived types
+	* resolve.c (is_scalar_expr_ptr): New function.
+	(gfc_iso_c_func_interface): Ditto.
+	(resolve_function): Use gfc_iso_c_func_interface. 
+	(set_name_and_label): New function.
+	(gfc_iso_c_sub_interface): Ditto.
+	(resolve_specific_s0): Use gfc_iso_c_sub_interface.
+	(resolve_bind_c_comms): New function.
+	(resolve_bind_c_derived_types): Ditto.
+	(gfc_verify_binding_labels): Ditto.
+	(resolve_fl_procedure): Check for ISO C interoperability.
+	(resolve_symbol): Check C interoperability.
+	(resolve_types): Walk the namespace.  Check COMMON blocks.
+	* trans-decl.c (gfc_sym_mangled_identifier):  Prevent the mangling
+	of identifiers that have an assigned binding label.
+	(gfc_sym_mangled_function_id): Use the binding label rather than
+	the mangled name.
+	(gfc_finish_var_decl): Put variables that are BIND(C) into a common
+	segment of the object file, because this is what C would do.
+	(gfc_create_module_variable): Conver to proper types
+	(set_tree_decl_type_code): New function.
+	(generate_local_decl): Check dummy variables and derived types for
+	ISO C Binding attributes.
+	* match.c (gfc_match_small_int_expr): New function.
+	(gfc_match_name_C): Ditto.
+	(match_common_name): Deal with ISO C Binding in COMMON blocks
+	* trans-io.c (transfer_expr):  Deal with C_NULL_PTR or C_NULL_FUNPTR
+	expressions
+	* match.h: Add prototypes for gfc_match_small_int_expr,
+	gfc_match_name_C, match_common_name, set_com_block_bind_c,
+	set_binding_label, set_verify_bind_c_sym,
+	set_verify_bind_c_com_block, get_bind_c_idents,
+	gfc_match_bind_c_stmt, gfc_match_suffix, gfc_match_bind_c,
+	gfc_get_type_attr_spec
+	* parse.c (decode_statement): Use gfc_match_bind_c_stmt
+	(parse_derived): Init *derived_sym = NULL, and gfc_current_block
+	later for valiadation.
+	* primary.c (got_delim): Set ISO C Binding components of ts.
+	(match_logical_constant): Ditto.
+	(match_complex_constant): Ditto.
+	(match_complex_constant): Ditto.
+	(gfc_match_rvalue): Check for existence of at least one arg for
+	C_LOC, C_FUNLOC, and C_ASSOCIATED.
+	* misc.c (gfc_clear_ts): Clear ISO C Bindoing components in ts.
+	(get_c_kind): New function.
+
+2007-07-01  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/32239
+	* trans-expr.c (gfc_conv_power_op): Use builtin_powi for
+	real**int4 powers.
+	* f95-lang.c (gfc_init_builtin_functions): Add builtin_powi to the
+	builtins table.
+
+2007-07-01  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	* trans.h: Remove decls for 64-bit allocation functions.
+	* trans-array.c (gfc_grow_array): Always pick the standard realloc
+	function decl.
+	(gfc_array_allocate): Likewise.
+	* trans-decl.c: Remove trees for 64-bit allocation functions.
+	(gfc_build_builtin_function_decls): Don't build fndecls for 64-bit
+	allocations functions, use index_int_type for normal allocation
+	functions.
+
+2007-06-30  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/20373
+	* intrinsic.c (add_functions): Additional function types.
+	(gfc_convert_type_warn): Remove intrinsic-flag from
+	conversion functions.
+	* resolve.c (resolve_symbol): Added type checks to 
+	explicitly defined intrinsics.
+
+2007-06-30  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32555
+	* io.c (check_format): Allow zero to precede the
+	P edit descriptor.
+
+2007-06-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32472
+	* simplify.c (gfc_simplify_repeat): Add handling of character
+	literal for first argument.
+
+2007-06-29  Daniel Franke  <franke.daniel@gmail.com>
+
+	* resolve.c (resolve_operator): Added check whether a user
+	defined operator is available.
+
+2007-06-29  Daniel Franke <franke.daniel@gmail.com>
+
+	* openmp.c (resolve_omp_clauses): Adjust error message to
+	better reflect the actual requirement.
+
+2007-06-29  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32483
+	* io.c (format_lex): Fix FMT_ZERO.
+	(check_format,check_format_string,gfc_match_format,
+	check_io_constraints) Additional checking for READ.
+
+2007-06-28 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+	PR other/31400
+	* lang.opt (static-libgfortran): New option.
+	* gfortranspec.c (ADD_ARG_LIBGFORTRAN): New macro.
+	(Option): Add OPTION_static and OPTION_static_libgfortran.
+	(lookup_option): Handle the new -static-libgfortran option.
+	(lang_specific_driver): Check whether -static is passed.
+	Handle the new -static-libgfortran option.
+	* options.c (gfc_handle_option): If -static-libgfortran is
+	passed and isn't supported on this configuration, error out.
+
+2007-06-27  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32467
+	* openmp.c (resolve_omp_clauses): Emit error on allocatable
+	components in COPYIN, COPYPRIVATE, FIRSTPRIVATE and LASTPRIVATE
+	clauses.
+
+2007-06-25  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32464
+	* resolve.c (check_host_association): Return if the old symbol
+	is use associated.  Introduce retval to reduce the number of
+	evaluations of the first-order return value.
+
+	PR fortran/31494
+	* match.c (gfc_match_call): If a host associated symbol is not
+	a subroutine, build a new symtree/symbol in the current name
+	space.
+
+2007-06-24  Tobias Burnus  <burnus@net-de>
+
+	PR fortran/32460
+	* interface.c (gfc_compare_derived_types): Add access check.
+	* symbol.c (gfc_find_component): Ditto.
+	(gfc_set_component_attr,gfc_get_component_attr) Copy access state.
+	* dump-parse-tree.c (gfc_show_components): Dump access state.
+	* gfortran.h (struct gfc_component): Add gfc_access.
+	* module.c (mio_component): Add access state.
+	* (gfc_match_structure_constructor): Check for private access state.
+
+2007-06-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32298
+	PR fortran/31726
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Calculate
+	the offset between the loop counter and the position as
+	defined. Add the offset within the loop so that the mask acts
+	correctly.  Do not advance the location on the basis that it
+	is zero.
+
+2007-06-22  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31473
+	* symbol.c (gfc_copy_attr): Emit errors for duplicate 
+	EXTERNAL/INTRINSIC statements.
+
+2007-06-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/32360
+	* expr.c (gfc_check_assign): If the rvalue expression type is NULL_EXPR,
+	check to see if the lvalue has attribute pointer and data.  
+
+2007-06-21  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/31162
+	* resolve.c (gfc_resolve_iterator_expr): Add check for REAL using
+	gfc_notify_standard. (gfc_resolve_iterator): Remove check.
+	(resolve_branch): Change "Obsolete" to "Deleted feature".
+	* io.c (resolve_tag): Ditto.
+	* match.c (gfc_match_pause, gfc_match_assign, gfc_match_goto): Ditto.
+
+2007-06-20  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/32361
+	* match.c (gfc_match_common): If the symbol value expression type is
+	NULL_EXPR, don't error if previously initialized.
+
+2007-06-20  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/25061
+	* decl.c (get_proc_name) Check symbol for generic interface
+	and issue an error.
+
+2007-06-20  Andrew Pinski  <andrew_pinski@playstation.sony.com>
+	Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/32140
+	* trans.c (gfc_build_addr_expr): Use the correct types.
+
+2007-06-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/20863
+	PR fortran/20882
+	* resolve.c (resolve_code): Use gfc_impure_variable as a
+	condition for rejecting derived types with pointers, in pure
+	procedures.
+	(gfc_impure_variable): Add test for dummy arguments of pure
+	procedures; any for functions and INTENT_IN for subroutines.
+
+	PR fortran/32236
+	* data.c (gfc_assign_data_value): Change the ICE on an array
+	reference initializer not being an array into an error and
+	clear init to prevent a repetition of the error.
+
+2007-06-17  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	* gfortran.texi: Add documentation for GFORTRAN_UNBUFFERED_n
+	environment variables. Fix documentation for
+	GFORTRAN_UNBUFFERED_ALL environment variable.
+
+2007-06-15  Andrew Pinski  <andrew_pinski@playstation.sony.com>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_repeat): Use
+	POINTER_PLUS_EXPR instead of PLUS_EXPR for pointer addition.
+	* trans-expr.c (gfc_trans_string_copy): Create
+	POINTER_PLUS_EXPR instead of a PLUS_EXPR
+	for pointer types.
+
+2007-06-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32302
+	* trans-common.c (build_common_decl): If resizing of common
+	decl is needed, update the TREE_TYPE.
+
+2007-06-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32323
+	* interface.c (has_vector_section): New.
+	(compare_actual_formal): Check for array sections with vector subscript.
+
+2007-06-12  Dirk Mueller  <dmueller@suse.de>
+
+	* trans-stmt.c (gfc_trans_call): fix gcc_assert to
+	a comparison, not an assignment.
+
+2007-06-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	* trans-common.c (create_common): Initialize 'field_init'.
+
+2007-06-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29786
+	PR fortran/30875
+	* trans-common.c (get_init_field): New function.
+	(create_common): Call get_init_field for overlapping
+	initializers in equivalence blocks.
+	* resolve.c (resolve_equivalence_derived, resolve_equivalence):
+	Remove constraints on initializers in equivalence blocks.
+	* target-memory.c (expr_to_char, gfc_merge_initializers):
+	New functions.
+	(encode_derived): Add the bit offset to the byte offset to get
+	the total offset to the field.
+	* target-memory.h : Add prototype for gfc_merge_initializers.
+
+2007-06-11  Rafael Ávila de Espíndola  <espindola@google.com>
+
+	* trans-types.c (gfc_signed_type): Remove.
+	* trans-types.h (gfc_signed_type): Remove.
+	* f95-lang.c (LANG_HOOKS_SIGNED_TYPE): Remove.
+
+2007-06-08 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+	* trans-intrinsic.c: Revert Lee's 2007-06-04 patch.
+
+2007-06-07  Steven G. Kargl  <kargl@gcc.gnu.org>
+	    Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/32223
+	* match.c (gfc_match_special_char): New function.  Match special char.
+	Add handling '\0'.
+	* match.h: Add prototype.
+	* io.c (next_char): Use it.
+	* primary.c (next_string_char): Ditto.
+
+2007-06-06  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* decl.c: Miscellaneous whitespace fixes.
+	* expr.c: Likewise.
+	* gfortran.h: Likewise.
+	* interface.c : Likewise.
+	* io.c: Likewise.
+	* match.c: Likewise.
+	* match.h: Likewise.
+	* module.c: Likewise.
+	* parse.c: Likewise.
+	* resolve.c: Likewise.
+	* symbol.c: Likewise.
+	* trans-array.c: Likewise.
+	* trans-common.c: Likewise.
+	* trans-decl.c: Likewise.
+	* trans-intrinsic.c: Likewise.
+	* trans-io.c: Likewise.
+	* trans-stmt.c: Likewise.
+	* trans-types.c: Likewise.
+
+2007-06-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/18923
+	* parse.c (decode_statement): Don't call gfc_undo_symbols on MATCH_ERROR
+	for ST_FUNCTION since it is called in reject_statement.
+	(parse_contained): If error, loop back after reject_statement and try
+	again.  Free the namespace if an error occured.
+
+2007-06-04 Lee Millward <lee.millward@codesourcery.com>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_function_args): Adjust
+	to operate on a stack allocated array for the intrinsic arguments
+	instead of creating a TREE_LIST. Add two new parameters for the
+	array and the number of elements. Update all callers to allocate
+	an array of the correct length to pass in. Update comment.
+	(gfc_intrinsic_argument_list_length): New function.
+	(gfc_conv_intrinsic_mnimax): Call it.
+	(gfc_conv_intrinsic_merge): Likewise.
+	(gfc_conv_intrinsic_lib_function): Call it. Use new CALL_EXPR
+	constructors.
+	(gfc_conv_intrinsic_cmplx): Likewise.
+	(gfc_conv_intrinsic_ctime): Likewise.
+	(gfc_covn_intrinsic_fdate): Likewise.
+	(gfc_conv_intrinsic_ttynam): Likewise.
+	(gfc_conv_intrinsic_ishftc): Likewise.
+	(gfc_conv_intrinsic_index): Likewise.
+	(gfc_conv_intrinsic_scan): Likewise.
+	(gfc_conv_intrinsic_verify): Likewise.
+	(gfc_conv_intrinsic_trim): Likewise.
+	(gfc_conv_intrinsic_aint): Use new CALL_EXPR constructors.
+	(gfc_conv_intrinsic_exponent): Likewise.
+	(gfc_conv_intrinsic_bound): Likewise.
+	(gfc_conv_intrinsic_abs): Likewise.
+	(gfc_conv_intrinsic_mod): Likewise.
+	(gfc_conv_intrinsic_sign): Likewise.
+	(gfc_conv_intrinsic_len): Likewise.
+	(gfc_conv_intrinsic_adjust): Likewise.
+	(gfc_conv_intrinsic_si_kind): Likewise.
+
+2007-06-04  Steve Ellcey  <sje@cup.hp.com>
+
+	* trans-array.c (gfc_conv_array_parameter): Initialize tmp.
+
+2007-05-31  Richard Guenther  <rguenther@suse.de>
+
+	* trans-expr.c (gfc_conv_expr_op): Use zero constant
+	that matches the lse type.
+	(gfc_trans_string_copy): Use sizetype zero constant.
+	* intrinsic.c (add_functions): The sizeof intrinsic has
+	index type result.
+	* trans-types.c (gfc_get_dtype): Convert size to index
+	type before shifting.
+	* trans-array.c (gfc_trans_array_constructor_value): Use
+	index type for offset computation.
+	* trans-intrinsic.c (gfc_conv_associated): Use correct type
+	for zero constant.
+
+2007-05-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32156
+	* trans-array.c (gfc_trans_array_constructor): Treat the case
+	where the ss expression charlen is missing.
+
+2007-05-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32103
+	* module.c (mio_symtree_ref): If an equivalence group member
+	is not used, give it a hidden symbol and set the pointer_info.
+	(load_equiv): Only free the equivalence if none of the members
+	are used.
+
+2007-05-29  Daniel Franke  <franke.daniel@gmail.com>
+
+	* gfortran.h: Renamed 'enum gfc_generic_isym_id' to 'enum gfc_isym_id',
+	added missing GFC_ISYM_* enumerators, ordered alphabetically.
+	(struct gfc_intrinsic_sym): Renamed 'generic_id' to 'id'.
+	(gfc_find_subroutine): New prototype.
+	* intrinsic.c (add_sym, add_sym_*): Added argument 'id' and changed all callers.
+	(find_subroutine): Renamed to 'gfc_find_subroutine', removed static.  
+	* dependency.c: Changed usage of isym->generic_id to isym->id.  
+	* openmp.c: Likewise.  
+	* resolve.c: Likewise.  
+	* trans-array.c: Likewise.  
+	* trans-expr.c: Likewise.  
+	* trans-intrinsic.c: Likewise.  
+	* trans-openmp.c: Likewise.
+
+2007-05-28  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* gfortran.h (gfc_generic_isym_id): Add GFC_ISYM_SIZEOF.
+	* intrinsic.c (add_functions): Add stuff for SIZEOF intrinsic.
+	* intrinsic.h (gfc_check_sizeof): Add prototype of ...
+	* check.c (gfc_check_sizeof): .. new function.
+	* trans-intrinsic.c (gfc_conv_intrinsic_sizeof): New function.
+	(gfc_conv_intrinsic_strcmp): Whitespace fix.
+	(gfc_conv_intrinsic_array_transfer): Remove double initialization,
+	use fold_build. where appropriate.
+	(gfc_conv_intrinsic_function): Add case for SIZEOF.
+	* intrinsic.texi: Add documentation for SIZEOF.
+
+2007-05-28  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* trans-array.c (gfc_conv_expr_descriptor): Edit comment.
+
+2007-05-28  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	PR fortran/31972
+	* target-memory.c (gfc_target_expr_size): Add handling
+	for size of BT_HOLLERITH variables.
+	* check.c (gfc_check_transfer): Reject BT_HOLLERITH
+	variables in MOLD argument of TRANSFER.
+
+2007-05-28  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* gfortran.h (gfc_expr): Remove from_H, add "representation"
+	struct.
+	* primary.c (match_hollerith_constant): Store the representation
+ 	of the Hollerith in representation, not in value.character.
+	* arith.c: Add dependency on target-memory.h.
+	(eval_intrinsic): Remove check for from_H.
+	(hollerith2representation): New function.
+	(gfc_hollerith2int): Determine value of the new constant.
+	(gfc_hollerith2real): Likewise.
+	(gfc_hollerith2complex): Likewise.
+	(gfc_hollerith2logical): Likewise.
+	(gfc_hollerith2character): Point both representation.string and
+	value.character.string at the value string.
+	* data.c (create_character_initializer): For BT_HOLLERITH
+	rvalues, get the value from the representation rather than
+	value.character.
+	* expr.c (free_expr0): Update handling of BT_HOLLERITH values
+	and values with representation.string.
+	(gfc_copy_expr): Likewise.
+	* intrinsic.c (do_simplify): Remove special treatement of
+	variables resulting from Hollerith constants.
+	* dump-parse-trees.c (gfc_show_expr): Update handling of
+	Holleriths.
+	* trans-const.c (gfc_conv_constant_to_tree): Replace from_H
+	check with check for representation.string; get Hollerith
+	representation from representation.string, not value.character.
+	* trans-expr.c (is_zero_initializer_p): Replace from_H check
+	with check for representation.string.
+	* trans-stmt.c (gfc_trans_integer_select): Use
+	gfc_conv_mpz_to_tree for case values, so as to avoid picking up
+	the memory representation if the case is given by a transfer
+	expression.
+	* target-memory.c (gfc_target_encode_expr): Use the known memory
+	representation rather than the value, if it exists.
+	(gfc_target_interpret_expr): Store the memory representation of
+	the interpreted expression as well as its value.
+	(interpret_integer): Move to gfc_interpret_integer, make
+	non-static.
+	(interpret_float): Move to gfc_interpret_float, make non-static.
+	(interpret_complex): Move to gfc_interpret_complex, make
+	non-static.
+	(interpret_logical): Move to gfc_interpret_logical, make
+	non-static.
+	(interpret_character): Move to gfc_interpret_character, make
+	non-static.
+	(interpret_derived): Move to gfc_interpret_derived, make
+	non-static.
+	* target-memory.h: Add prototypes for newly-exported
+	gfc_interpret_* functions.
+
+2007-05-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/31812
+	* parse.c (next_statement): Warn for truncated lines if source is free
+	form.
+
+2007-05-27 Paul Thomas  <pault@gcc.gnu.org>
+	   Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32088
+	* symbol.c (gfc_check_function_type): Copy dimensions of
+	  result variable.
+	* resolve.c (resolve_contained_fntype): Improve symbol output in
+	  the error message.
+
+2007-05-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/31813
+	* io.c (check_format): Add warning for H specifier in format.
+	
+2007-05-26  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi: Document the GFORTRAN_ERROR_DUMPCORE and
+	GFORTRAN_ERROR_BACKTRACE environment variables.
+
+2007-05-26  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31219
+	* trans.h : Add no_function_call bitfield to gfc_se structure.
+	Add stmtblock_t argument to prototype of get_array_ctor_strlen.
+	* trans-array.c (get_array_ctor_all_strlen): New function.
+	(get_array_ctor_strlen): Add new stmtblock_t argument and call
+	new function for character elements that are not constants,
+	arrays or variables.
+	(gfc_conv_array_parameter): Call get_array_ctor_strlen to get
+	good string length.
+	* trans-intrinsic (gfc_conv_intrinsic_len): Add new argument
+	to call of get_array_ctor_strlen.
+
+2007-05-25  Kazu Hirata  <kazu@codesourcery.com>
+
+	* intrinsic.texi: Fix typos.
+
+2007-05-25  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32047
+	* trans-expr.c (gfc_apply_interface_mapping_to_expr): Change
+	order in logic under EXPR_FUNCTION to handle functions with
+	no arguments.
+
+2007-05-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/31716
+	* array.c (spec_dimen_size): Test for correct BT_INTEGER type. 
+
+2007-05-23  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32046
+	* trans-expr.c (gfc_trans_zero_assign): Convert the result of
+	TYPE_SIZE_UNIT into a signed type.
+	(gfc_trans_array_copy):  Likewise.
+	(gfc_trans_array_constructor_copy): Likewise.
+	* trans-array.c (gfc_trans_create_temp_array): Likewise.
+	(gfc_grow_array): Likewise.
+	(gfc_array_init_size): Likewise.
+	(gfc_duplicate_allocatable): Likewise.
+	* trans-stmt.c (allocate_temp_for_forall_nest_1): Likewise.
+
+2007-05-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/18923
+	* resolve.c (resolve_function): Don't call resolve_global_procedure if
+	there is no name. Delete duplicated statement in ELSE clause.
+
+2007-05-22 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31627
+	* trans-array.c (gfc_trans_array_bound_check): Take extra argument to
+	indicate whether we should check the upper bound in that dimension.
+	(gfc_conv_array_index_offset): Check only the lower bound of the
+	last dimension for assumed-size arrays.
+	(gfc_conv_array_ref): Likewise.
+	(gfc_conv_ss_startstride): Likewise.
+
+2007-05-21  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+	    Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32002
+	* resolve.c (resolve_actual_arglist): Resolve actual argument after
+	being identified as variable.
+
+2007-05-21  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32027
+	* trans-stmt.c (gfc_trans_do): Fix the value of loop variable
+	when the loop ends.
+
+2007-05-21  H.J. Lu  <hongjiu.lu@intel.com>
+
+	* trans-stmt.c (gfc_trans_do): Fix a typo in comment.
+
+2007-05-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31867
+	PR fortran/31994
+	* trans-array.c (gfc_conv_expr_descriptor): Obtain the stored
+	offset for non-descriptor, source arrays and correct for stride
+	not equal to one before writing to field of output descriptor.
+
+2007-05-20  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32001
+	* check.c (check_rest): Improved argument conformance check and 
+	fixed error message generation.
+
+2007-05-19  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/30820
+	* Make-lang.in: Remove use of -Wno-error for expr.o, resolve.o,
+	simplify.o and trans-common.o.
+
+2007-05-19  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31974
+	* trans-array.c (gfc_trans_auto_array_allocation): Avoid
+	multiplication of mismatched types.
+
+2007-05-18  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/24633
+	* symbol.c (gfc_add_flavor): Add the NAME to error message if
+	available.
+
+2007-05-15  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31919
+	PR fortran/31929
+	PR fortran/31930
+	* intrinsic.c (check_specific): Check elemental intrinsics for
+	rank and shape.
+	(add_functions): Fixed dummy argument names of BESJN and BESYN.
+	Fixed elemental status of MCLOCK and MCLOCK8.
+	* check.c (check_rest): Added check for array conformance.
+	(gfc_check_merge): Removed check for array conformance.
+	(gfc_check_besn): Removed check for scalarity.
+	* intrinsic.texi (CSHIFT, EOSHIFT): Fixed typos.
+	(BESJN, BESYN): Clarified documentation.
+
+2007-05-17  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi (GFORTRAN_CONVERT_UNIT): Improve documentation.
+
+2007-05-16  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	PR fortran/18769
+	PR fortran/30881
+	PR fortran/31194
+	PR fortran/31216
+	PR fortran/31427
+	* target-memory.c: New file.
+	* target-memory.h: New file.
+	* simplify.c: Add #include "target-memory.h".
+	(gfc_simplify_transfer): Implement constant-
+	folding for TRANSFER intrinsic.
+	* Make-lang.in: Add dependencies on new target-memory.* files.
+
+2007-05-15  Paul Brook  <paul@codesourcery.com>
+
+	* trans-types.c (gfc_type_for_size): Handle signed TImode.
+
+2007-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/30723
+	* trans.h (gfor_fndecl_internal_malloc, gfor_fndecl_internal_malloc64,
+	gfor_fndecl_internal_free): Remove prototypes.
+	(gfor_fndecl_os_error, gfc_call_free, gfc_call_malloc): Add prototypes.
+	* trans.c (gfc_call_malloc, gfc_call_free): New functions.
+	* f95-lang.c (gfc_init_builtin_functions): Add __builtin_free
+	and __builtin_malloc builtins.
+	* trans-decl.c (gfor_fndecl_internal_malloc,
+	gfor_fndecl_internal_malloc64, gfor_fndecl_internal_free): Remove.
+	(gfor_fndecl_os_error): Add.
+	(gfc_build_builtin_function_decls): Don't create internal_malloc,
+	internal_malloc64 and internal_free library function declaration.
+	Create os_error library call function declaration.
+	* trans-array.c (gfc_trans_allocate_array_storage,
+	gfc_trans_auto_array_allocation, gfc_trans_dummy_array_bias,
+	gfc_conv_array_parameter, gfc_duplicate_allocatable): Use
+	gfc_call_malloc and gfc_call_free instead of building calls to
+	internal_malloc and internal_free.
+	* trans-expr.c (gfc_conv_string_tmp): Likewise.
+	* trans-stmt.c (gfc_do_allocate, gfc_trans_assign_need_temp,
+	gfc_trans_pointer_assign_need_temp, gfc_trans_forall_1,
+	gfc_trans_where_2: Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_ctime,
+	gfc_conv_intrinsic_fdate, gfc_conv_intrinsic_ttynam,
+	gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_trim): Likewise.
+
+2007-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31725
+	* trans-expr.c (gfc_conv_substring): Evaluate substring bounds
+	only once.
+
+2007-05-14  Rafael Ávila de Espíndola  <espindola@google.com>
+
+	* f95-lang.c (LANG_HOOKS_UNSIGNED_TYPE): Remove.
+	* trans-intrinsic.c (gfc_conv_intrinsic_ishft): Use unsigned_type_for
+	instead of gfc_unsigned_type.
+	* trans-stmt.c (gfc_trans_do): Use unsigned_type_for instead of
+	gfc_unsigned_type.
+	* trans-types.c (gfc_unsigned_type): Remove.
+	* trans-types.h (gfc_unsigned_type): Remove.
+
+2007-05-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30746
+	* resolve.c (check_host_association): New function that detects
+	incorrect host association and corrects it.
+	(gfc_resolve_expr): Call the new function for variables and
+	functions.
+	* match.h : Remove prototype for gfc_match_rvalue.
+	* gfortran.h : Add prototype for gfc_match_rvalue.
+
+2007-05-11 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/30876
+	* trans-expr.c (gfc_conv_function_call): Reduce indirection for
+	direct assignments of recursive array valued functions.
+	* primary.c (gfc_match_rvalue): Correct error for recursive
+	function calls such that directly recursive calls of scalar
+	function without an explicit result are disallowed.
+
+2007-05-11 Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/30878
+	* resolve.c (resolve_fl_namelist): It is not an error if the
+	namelist element is the result variable of the enclosing
+	function.  Search for the symbol in current and all parent
+	namespaces for a potential conflict.
+	* symbol.c (check_conflict): Remove the conflict between
+	'in_namelist' and 'FL_PROCEDURE' because the symbol info
+	is not available to exclude function result variables.
+	* trans-io.c (nml_get_addr_expr): Use the fake result decl
+	if the symbol is an implicit result variable.
+
+2007-05-11  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31474
+	* decl.c (get_proc_name): If an entry has already been declared
+	as a module procedure, pick up the symbol and the symtree and
+	use them for the entry.
+
+2007-05-08  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31630
+	* resolve.c (resolve_symbol): Remove the flagging mechanism from the
+	formal namespace resolution and instead check that the formal
+	namespace is not the current namespace.
+
+2007-05-08  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31692
+	* trans-array.c (gfc_conv_array_parameter): Convert full array
+	references to the result of the procedure enclusing the call.
+
+2007-05-08  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29397
+	PR fortran/29400
+	* decl.c (add_init_expr_to_sym): Expand a scalar initializer
+	for a parameter array into an array expression with the right
+	shape.
+	* array.c (spec_dimen_size): Remove static attribute.
+	* gfortran.h : Prototype for spec_dimen_size.
+
+2007-05-07  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31399
+	* trans-stmt.c (gfc_trans_do): Handle large loop counts.
+
+2007-05-07  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31764
+	* simplify.c (gfc_simplify_new_line): NEW_LINE can be simplified
+	even for non constant arguments.
+
+2007-05-06  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+	    Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31201
+	* gfortran.h: Add runtime error codes from libgfortran.h. Define
+	MAX_UNIT_NUMBER.
+	* trans.c (gfc_trans_runtime_check): Update the format of runtime error
+	messages to match library runtime errors.  Use call to new library
+	function runtime_error_at().
+	* trans.h: Add prototype for new function gfc_trans_io_runtime_check.
+	Add declaration for library functions runtime_error_at and
+	generate_error.
+	* trans_io.c (gfc_trans_io_runtime_check): New function.
+	(set_parameter_value): Add error checking for UNIT numbers.
+	(set_parameter_ref): Initialize the users variable to zero. 
+	(gfc_trans_open): Move setting of unit number to after setting of common
+	flags so that runtime error trapping can be detected.
+	(gfc_trans_close): Likewise. (build_filepos): Likewise.
+	(gfc_trans_inquire): Likewise. (build_dt): Likewise.
+	* trans-decl.c: Add declarations for runtime_error_at and
+	generate_error. (gfc_build_builtin_function_decls): Build function
+	declarations for runtime_error_at and generate_error.
+
+2007-05-06  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31540
+	* resolve.c (resolve_fl_procedure): Resolve constant character
+	lengths.
+
+2007-05-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/31251
+	* decl.c (match_char_spec): Add check for invalid character lengths.
+
+2007-05-04  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi (CMPLX): Document result kind.
+	(COMPLEX): Add documentation.
+
+2007-05-04  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31760
+	* intrinsic.c (add_functions): Replaced calls to gfc_check_g77_math1
+	by gfc_check_fn_r to avoid checks for scalarity.
+	* check.c (gfc_check_besn): Removed check for scalarity.
+	(gfc_check_g77_math1): Removed.
+	* intrinsic.h (gfc_check_g77_math1): Removed.
+
+2007-05-04  Daniel Franke  <franke.daniel@gmail.com>
+
+	* check.c (gfc_check_fseek_sub): Fixed typo.
+
+2007-05-04  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/22359
+	* intrinsic.c (add_subroutines): Added FSEEK.
+	* intrinsic.h (gfc_resolve_fseek_sub, gfc_check_fseek_sub): New.
+	* iresolve.c (gfc_resolve_fseek_sub): New.
+	* check.c (gfc_check_fseek_sub): New.
+	* intrinsic.texi (FSEEK): Updated.
+
+2007-05-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/31803
+	* expr.c (gfc_check_pointer_assign): Check for NULL pointer.
+
+2007-05-04  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/31251
+	* simplify.c (gfc_simplify_len): Only simplify integer lengths.
+
+2007-05-04  Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31781
+	* simplify.c (gfc_simplify_repeat): Don't put function call with
+	side effect in a gcc_assert().
+
+2007-05-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/25071
+	* interface.c (compare_actual_formal): Check character length.
+
+2007-05-01  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/31732
+	* dependency.c (gfc_full_array_ref_p):  If the reference is
+	to a single element, check that the array has a single
+	element and that the correct element is referenced.
+
+2007-05-01  Daniel Franke  <franke.daniel@gmail.com>
+
+	* intrinsic.c (add_functions): Fixed ELEMENTAL specifications.
+	(add_subroutines): Replaced magic numbers in function calls by
+	ELEMENTAL and NOT_ELEMENTAL respectively.
+	* intrinsic.texi (MVBITS): Changed class to elemental subroutine.
+	(RANDOM_NUMBER): Changed class to subroutine.
+	(HUGE, TINY): Changed class to inquiry function.
+
+2007-04-30  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* trans-const.c (gfc_conv_mpz_to_tree): Use mpz_get_double_int.
+	(gfc_conv_tree_to_mpz): New function.
+	(gfc_conv_mpfr_to_tree): Use real_from_mpfr.
+	(gfc_conv_tree_to_mpfr): New function.
+	* trans-const.h: (gfc_conv_tree_to_mpz): New prototype.
+	(gfc_conv_tree_to_mpfr): New prototype.
+
+2007-04-30  Daniel Franke  <franke.daniel@gmail.com>
+
+	* intrinsic.texi (IERRNO): Changed class to non-elemental function.
+	(LOG10): Removed COMPLEX as accepted argument type.
+	(NEW_LINE): Changed class from elemental to inquiry function.
+	(SIGN): Removed requirement of scalar arguments.
+	(SNGL): Changed class to elemental function.
+
+2007-04-29  Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31591
+	* simplify.c (simplify_bound_dim): New function.
+	(simplify_bound): Use the above. Perform simplification of LBOUND
+	and UBOUND when DIM argument is not present.
+
+2007-04-29  Daniel Franke  <franke.daniel@gmail.com>
+
+	* gfortran.texi: Cleaned up keyword index.
+	* invoke.texi: Likewise.
+	* intrinsic.texi: Likewise.
+			
+2007-04-29  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31645
+	* scanner.c (load_file): Discard the byte order mark if one is
+	found on the first non-preprocessor line of a file.
+
+2007-04-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31711
+	* trans-array.c (gfc_conv_resolve_dependencies): Create a temp
+	whenever a dependency is found.
+
+2007-04-28  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* options.c (gfc_handle_option): Ensure requested free form line
+	length is not too small.
+
+2007-04-27  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi (Transfer): Improve documentation.
+
+2007-04-27  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* gfortran.texi (Option Index): Add @samp as needed.
+
+2007-04-27  Daniel Franke  <franke.daniel@gmail.com>
+
+	* gfortran.texi: Added node and menu entry for an option index.
+	* invoke.texi: Moved command line option related entries of the concept 
+	index to the option index.
+
+2007-04-27  Daniel Franke  <franke.daniel@gmail.com>
+
+	* intrinsic.texi (AND, FPUT, FPUTC, MODULO, OR, SET_EXPONENT,
+	XOR): Fixed examples.
+
+2007-04-27  Daniel Franke  <franke.daniel@gmail.com>
+
+	* intrinsic.texi (PRODUCT, RESHAPE, SPACING, SPREAD, SUM, 
+	SYSTEM_CLOCK, TRANSFER, UNPACK): New.
+	(DATE_AND_TIME, CPU_TIME, RRSPACING): Added cross references.
+
+2007-04-26  Daniel Franke  <franke.daniel@gmail.com>
+
+	* intrinsic.texi (NULL, PACK, PRESENT, REPEAT, SCAN, SHAPE, 
+	SIZE, TRANSPOSE, TRIM, VERIFY): New.
+	(ADJUSTL, ADJUSTR, INDEX): Added cross references.
+	(INT, INT2, INT8, LONG): Enabled section header.
+
+2007-04-25  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	* module.c (module_char): Replace fgetc() with
+	getc(). 
+	(write_char): Replace fputc() with putc().
+	* scanner.c (load_line): Replace fgetc() with getc().
+	(gfc_read_orig_filename): Likewise.
+
+2007-04-25  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/31668
+	* error.c (error_print): Fix %% support.
+	* intrinsic.c (sort_actual): Improve error message.
+	* resolve.c (resolve_actual_arglist): Allow %VAL for
+	interfaces defined in the module declaration part.
+
+2007-04-25  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR libfortran/31299
+	* intrinsic.texi (GETLOG): Update documentation to reflect
+	library changes.
+
+2007-04-24  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31587
+	* module.c (write_char): Add character to the MD5 buffer.
+	(read_md5_from_module_file): New function.
+	(gfc_dump_module): Compute MD5 for new module file. Call
+	read_md5_from_module_file. Only overwrite old module file
+	if the new MD5 is different.
+
+2007-04-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31630
+	* resolve.c (resolve_symbol): Allow resolution of formal
+	namespaces nested within formal namespaces coming from modules.
+
+	PR fortran/31620
+	* trans-expr.c (gfc_trans_assignment): Make the call to
+	gfc_trans_zero_assign conditional on the lhs array ref being
+	the only reference.
+
+2007-04-23  Tobias Burnus  <burnus@net-b.de>
+
+	* primary.c (match_integer_constant): Mention -fno-range-check
+	in the error message.
+
+2007-04-21  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/31495
+	* scanner.c (load_line):  Remove check for comment after ampersand and
+	adjust tracking of ampersand.
+
+2007-04-21  Andrew Pinski  <andrew_pinski@playstation.sony.com>
+
+	* f95-lang.c (lang_tree_node): Use GENERIC_NEXT
+	instead of checking GIMPLE_STMT_P in chain_next.
+
+2007-04-17  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* trans-types.h (gfc_packed): New enum.
+	(gfc_get_nodesc_array_type): Change prototype to use new enum.
+	* trans-types.c (gfc_get_nodesc_array): Use gfc_packed for
+	argument packed.  Adapt all references to values accordingly.
+	(gfc_sym_type): Use enum values in call to gfc_get_nodesc_array.
+	(gfc_get_derived_type): Likewise.
+	* trans-array.c (gfc_build_constant_array_constructor): Likewise.
+	* trans-expr.c (gfc_get_interface_mapping_charlen): Changed packed
+	argument to type gfc_packed.
+	(gfc_add_interface_mapping): Use enum values in call to
+	gfc_get_interface_mapping.
+	* trans-decl.c (gfc_build_dummy_array_decl): Adapt to use enum
+	values when determining packing.
+
+	* trans-decl.c (gfc_finish_decl): Remove unused second argument
+	'init'.  Simplify code accordingly.  Remove calls to
+	gfc_fatal_error in favor of gcc_assert.
+	(create_function_arglist): Remove second argument from calls to
+	gfc_finish-decl.
+	(gfc_trans_dummy_character): Likewise.
+
+	* arith.h: Update copyright years.
+	* dependency.h: Likewise.
+	* gfortran.h: Likewise.
+	* lang-specs.h: Likewise.
+	* parse.h: Likewise.
+	* symbol.c: Likewise.
+	* trans.h: Likewise.
+	* trans.c: Likewise.
+	* trans-array.c: Likewise.
+	* trans-common.c: Likewise.
+	* trans-const.h: Likewise.
+	* trans-const.c: Likewise.
+	* trans-decl.c: Likewise.
+	* trans-expr.c: Likewise.
+	* trans-io.c: Likewise.
+	* trans-openmp.c: Likewise.
+	* trans-types.h: Likewise.
+	* types.def: Likewise.
+
+2007-04-17  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/31144
+	* decl.c (gfc_sym_mangled_identifier): Use capital letters in name
+	mangling.
+	(gfc_sym_mangled_function_id): Likewise.
+
+2007-04-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31204
+	* primary.c (check_for_implicit_index): New function to check
+	that a host associated variable is not an undeclared implied
+	do loop index.
+	(gfc_match_rvalue, match_variable): Use it and reset the
+	implied_index attribute.
+	* gfortran.h : Add the implied_index field to symbol_attribute.
+	* match.c (gfc_match_iterator): Mark the iterator variable
+	with the new attribute.
+	* decl.c (build_sym): Reset the new attribute.
+
+2007-04-15  Kazu Hirata  <kazu@codesourcery.com>
+
+	* gfc-internals.texi: Fix typos.
+	* simplify.c: Fix a comment typo.
+
+2007-04-14  Bernhard Fischer  <aldot@gcc.gnu.org>
+
+	* primary.c: Commentary typo fix; Add question about redundant (?)
+	set.
+
+2007-04-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/29507
+	PR fortran/31404
+	* expr.c (scalarize_intrinsic_call): New function to
+	scalarize elemental intrinsic functions in initialization
+	expressions.
+	(check_init_expr): Detect elemental intrinsic functions
+	in initalization expressions and call previous.
+
+2007-04-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/31559
+	* primary.c (match_variable): External functions
+	are no variables.
+
+2007-04-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31550
+	* trans-types.c (copy_dt_decls_ifequal): Do not get pointer
+	derived type components.
+
+2007-04-13  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/18937
+	* resolve.c: Include obstack.h and bitmap.h.  New variable
+	labels_obstack.
+	(code_stack): Add tail and reachable_labels fields.
+	(reachable_labels): New function.
+	(resolve_branch): Rework to use new fields in code_stack.
+	(resolve_code): Call reachable_labels.
+	(resolve_codes): Allocate and free labels_obstack.
+
+2007-04-12  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/31250
+	* decl.c (match_char_spec): Move check for negative CHARACTER
+	length ...
+	* resolve.c (resolve_charlen): ... here.
+	(resolve_types): Resolve CHARACTER lengths earlier.
+
+2007-04-12  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31234
+	* intrinsic.texi (RANDOM_SEED, RANDOM_NUMBER): New.
+
+2007-04-12  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/31266
+	* primary.c (gfc_variable_attr): Don't copy string length if it
+	doesn't make sense.
+	* resolve.c (resolve_code): Clarify error message.
+
+	PR fortran/31471
+	* decl.c (gfc_match_end): Also check for construct name in END
+	FORALL and END WERE statements.
+	* match.c (match_case_eos): Use uppercase for statement name in
+	error message.
+	(match_elsewhere): Construct name may appear iff construct has a
+	name.
+
+	* trans-types.c: Update copyright years.  Reformat long comment
+	explaining array descriptor format.  Remove obsolete mention of
+	TYPE_SET.
+
+	* arith.c (gfc_arith_uplus): Rename to ...
+	(gfc_arith_identity): ... this.
+	(gfc_parentheses): New function.
+	(gfc_uplus): Adapt to renamed function.
+	* arith.h (gfc_parentheses): Add prototype.
+	* expr.c (gfc_copy_expr): Deal with INTRINSIC_PARENTHESES.
+	(simplifiy_intrinsic_op): Treat INTRINSIC_UPLUS separately from
+	INTRINSIC_PARENTHESES.
+
+2007-04-12  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/31472
+	* decl.c (match_attr_spec): Allow PRIVATE/PUBLIC
+	attribute in type definitions.
+	(gfc_match_private): Allow PRIVATE statement only
+	in specification part of modules.
+	(gfc_match_public): Ditto for PUBLIC.
+	(gfc_match_derived_decl): Allow PRIVATE/PUBLIC attribute only in
+	specificification part of modules.
+
+2007-04-07  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31257
+	* intrinsic.c (add_functions): Add ref. to gfc_resolve_achar.
+	* intrinsic.h : Add prototype for gfc_resolve_achar.
+	* iresolve.c (gfc_resolve_achar): New function.
+
+2007-04-07  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30880
+	* resolve.c (resolve_fl_variable): Set flag to 2 for automatic
+	arrays.  Make condition for automatic array error explicit.
+	If a dummy, no error on an INTENT(OUT) derived type.
+
+2007-04-07  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30872
+	* expr.c (find_array_element): Correct arithmetic for rank > 1.
+
+2007-04-07  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31222
+	* check.c (numeric_check): If an expresson has not got a type,
+	see if it is a symbol for which a default type applies.
+
+2007-04-07  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31214
+	* trans-decl.c (gfc_get_symbol_decl): Allow unreferenced use
+	associated symbols.
+
+2007-04-07  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31293
+	* symbol.c (gfc_check_function_type): New function.
+	* gfortran.h : Add prototype for previous.
+	* parse.c (parse_progunit): Call it after parsing specification
+	statements.
+
+2007-04-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31483
+	* trans-expr.c (gfc_conv_function_call): Give a dummy
+	procedure the correct type if it has alternate returns.
+
+2007-04-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31292
+	* decl.c (gfc_match_modproc): Go up to the top of the namespace
+	tree to find the module namespace for gfc_get_symbol.
+
+2007-04-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31304
+	* fortran/gfortran.h (gfc_charlen_int_kind): New prototype.
+	* fortran/trans-types.c (gfc_charlen_int_kind): New variable.
+	(gfc_init_types): Define gfc_charlen_int_kind. 
+	* fortran/trans.h (gfor_fndecl_string_repeat): Remove prototype.
+	* fortran/trans-decl.c (gfor_fndecl_string_repeat): Delete.
+	(gfc_build_intrinsic_function_decls): Don't set
+	gfor_fndecl_string_repeat.
+	* fortran/trans-intrinsic.c (gfc_conv_intrinsic_repeat): Rewrite
+	so that we don't have to call a library function.
+	* fortran/simplify.c (gfc_simplify_repeat): Perform the necessary
+	checks on the NCOPIES argument, and work with arbitrary size
+	arguments.
+
+2007-03-31  Tobias Burnus  <burnus@net-b.de>
+
+	* intrinsic.c (add_functions): Fix name of dummy argument
+	  for new_line and exit intrinsic.
+
+2007-03-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31160
+	* gfortran.texi: Add a section for the %VAL, %REF and %LOC
+	extensions.
+
+2007-03-30  Rafael Ávila de Espíndola  <espindola@google.com>
+
+	* trans-types.c (gfc_signed_or_unsigned_type): Remove.
+	(gfc_unsigned_type): Use get_signed_or_unsigned_type instead of
+	gfc_signed_or_unsigned_type.
+	(gfc_signed_type): Ditto.
+	* trans-types.h (gfc_signed_or_unsigned_type): Remove.
+	* f95-lang.c (LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE): Remove.
+
+2007-03-30  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* symbol.c (gfc_find_gsymbol): Simplify, don't unconditionally
+	descend into all branches.
+
+2007-03-29  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* intrinsic.c (conv_name): Let gfc_get_string handle the format.
+	(find_conv): Compare pointers instead of calling strcmp.
+	(find_sym): Likewise, but ensure that the compared pointer is in
+	the global string table.
+
+2007-03-28  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* gfc-internals.texi: Fix output filename.  Merge type index into
+	concept index.  Start documentation of gfc_code structure.
+
+2007-03-26  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* gfc-internals.texi: New file,
+	* Make-lang.in: Add rules to convert it to dvi, pdf, and info.
+
+2007-03-26  Brooks Moses  <brooks.moses@codesourcery.com>
+ 
+	* error.c (show_locus): Remove always-false test.
+
+2007-03-26  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* lang.opt: Minor edits to descriptions.
+
+2007-03-25  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/30877
+	* fortran/interface.c (check_operator_interface): Implement
+	the standard checks on user operators extending intrinsic operators.
+	* fortran/resolve.c (resolve_operator): If the ranks of operators
+	don't match, don't error out but try the user-defined ones first.
+
+2007-03-24  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/30655
+	* expr.c (check_dimension): Fix logic of comparisons.
+
+2007-03-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31215
+	* trans-expr.c (gfc_apply_interface_mapping_to_expr): Return
+	int result that is non-zero if the expression is the function
+	result.  Only the characteristics of the result expression
+	can be used in a procedure interface, so simplify LEN in situ
+	using its character length.
+
+	PR fortran/31209
+	PR fortran/31200
+	* trans-expr.c (gfc_conv_function_call): Do not use
+	gfc_conv_expr_reference for actual pointer function with formal
+	target because a temporary is created that does not transfer
+	the reference correctly.  Do not indirect formal pointer
+	functions since it is the function reference that is needed.
+
+2007-03-24  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* gfortran.h: Edit comments on GFC_STD_*.
+
+2007-03-23  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* invoke.texi: Misc. small typo fixes.
+	(-Wcharacter-truncation): Add.
+	(-Wnonstd-intrinsics): Correct spelling.
+	(-std=): Edit.
+	(-fintrinsic-modules-path): Add.
+
+2007-03-23  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/30834
+	* arith.c (complex_pow): Rewrite to handle large power.
+	(gfc_arith_power): Handle large power in the real and integer
+	cases.
+
+2007-03-22  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/31262
+	* trans-const.c (gfc_conv_mpz_to_tree): Allow integer constants
+	larger than twice the width of a HOST_WIDE_INT.
+
+2007-03-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31193
+	* trans-intrinsic.c (gfc_size_in_bytes): Remove function.
+	(gfc_conv_intrinsic_array_transfer): Remove calls to previous.
+	Explicitly extract TREE_TYPEs for source and mold.  Use these
+	to calculate length of source and mold, except for characters,
+	where the se string_length is used.  For mold, the TREE_TYPE is
+	recalculated using gfc_get_character_type_len so that the
+	result is correctly cast for character literals and substrings.
+	Do not use gfc_typenode_for_spec for the final cast.
+
+2007-03-22  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/20897
+	* decl.c (gfc_match_derived_decl): Reliably reject
+	'doubleprecision' and 'doublecomplex' as type names.
+
+2007-03-19  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/31203
+	* trans-expr.c (gfc_trans_init_string_length): Length should
+	never be negative.
+	(gfc_conv_function_call): Likewise.
+
+2007-03-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30531
+	PR fortran/31086
+	* symbo.c : Add gfc_derived_types.
+	(gfc_free_dt_list): Free derived type list gfc_derived_types.
+	(gfc_free_namespace): Remove call to gfc_free_dt_list.
+	(gfc_symbol_done_2): Call  gfc_free_dt_list.
+	* gfortran.h : Declare gfc_derived_types to be external. Remove
+	derived types field from gfc_namespace.
+	* resolve.c (resolve_fl_derived): Refer to gfc_derived types
+	rather than namespace derived_types.
+	(resolve_fntype): Remove special treatment for module
+	derived type functions.
+	* trans-types.c (gfc_get_derived_type): Remove search for like
+	derived types.  Finish by copying back end declaration to like
+	derived types in the derived type list gfc_derived_types.
+
+	2007-03-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/31120
+	* trans-expr.c (gfc_conv_powi): Make n argument unsigned hwi.
+	(gfc_conv_cst_int_power): Handle integer exponent with care,
+	since it might be too large for us.
+
+2007-03-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/31184
+	* invoke.texi: Fix typo.
+
+2007-03-16  Tobias Burnus  <burnus@net-b.de>
+
+	* trans-decl.c (gfc_generate_function_code): Use all arguments of
+	  set_std.
+
+2007-03-15  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* gfortran.h (gfc_option_t): Add flag_backtrace field.
+	* lang.opt: Add -fbacktrace option.
+	* invoke.texi: Document the new option.
+	* trans-decl.c (gfc_build_builtin_function_decls): Add new
+	option to the call to set_std.
+	* options.c (gfc_init_options, gfc_handle_option): Handle the
+	new option.
+
+2007-03-15  Tobias Burnus  <burnus@gcc.gnu.org>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30922
+	* decl.c (gfc_match_import): If the parent of the current name-
+	space is null, try looking for an imported symbol in the parent
+	of the proc_name interface.
+	* resolve.c (resolve_fl_variable): Do not check for blocking of
+	host association by a same symbol, if the symbol is in an
+	interface body.
+
+2007-03-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30879
+	* decl.c (match_data_constant): Before going on to try to match
+	a name, try to match a structure component.
+
+
+	PR fortran/30870
+	* resolve.c (resolve_actual_arglist): Do not reject a generic
+	actual argument if it has a same name specific interface.
+
+	PR fortran/31163
+	* trans-array.c (parse_interface): Do not nullify allocatable
+	components if the symbol has the saved attribute.
+
+2007-03-14  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* trans-array.c (gfc_trans_auto_array_allocation): Replace
+	fold(convert()) by fold_convert().
+	(gfc_duplicate_allocatable): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_dot_product): Use
+	build_int_cst instead of converting an integer_zero_node
+	to the final type.
+
+2007-03-14  Jakub Jelinek  <jakub@redhat.com>
+
+	* module.c (mio_typespec): Don't look at ts->cl if not BT_CHARACTER.
+
+2007-03-13  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	PR fortran/30933
+	PR fortran/30948
+	PR fortran/30953
+	* intrinsics.texi (CHDIR): Fix argument names, note
+	that STATUS must be a default integer.
+	(CTIME): Fix argument names, note that RESULT must
+	be a default integer.
+	(EXIT): Note that STATUS must be a default integer.
+
+2007-03-13  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	PR fortran/28068
+	* intrinsic.texi: General whitespace cleanup, remove
+	comment about missing intrinsics.
+	(menu): Add lines for new entries listed below.
+	(ACOSH): Mention specific function DACOSH, correct
+	description phrasing.
+	(ASINH): Mention specific function DASINH, correct
+	description phrasing.
+	(ATANH): Mention specific function DATANH, correct
+	description phrasing.
+	(COS): Add index entry for CCOS.
+	(CPU_TIME): Correct "REAL" to "REAL(*)".
+	(EXP): Add index entry for CEXP.
+	(INT): Correct argument name to "A".
+	(INT2): New entry.
+	(INT8): New entry.
+	(LONG): New entry.
+	(MAX): Add index entries for specific variants.
+	(MCLOCK): New entry.
+	(MCLOCK8): New entry.
+	(SECNDS): Adjust to a more standard form.
+	(SECOND): New entry.
+	(TIME): Add cross-reference to MCLOCK.
+	(TIME8): Add cross-reference to MCLOCK8.
+
+2007-03-11  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30883
+	* parse.c (parse_interface): Use the default types from the
+	formal namespace if a function or its result do not have a type
+	after parsing the specification statements.
+
+2007-03-08  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi: (ICHAR) Improve internal I/O note.
+	(ACHAR): Reference it.
+	(CHAR): Reference it.
+	(IACHAR): Reference it.
+
+2007-03-08  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi: (LINK) Document function form.
+	(RENAME): Likewise.
+	(SYMLNK): Likewise.
+	(SYSTEM): Likewise.
+	(UNLINK): Likewise.
+
+2007-03-08  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi: minor typo fixes, removed prologue.
+	(FSEEK): moved to correct place in alphabetical order.
+
+2007-03-08  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/30947
+	* check.c (gfc_check_alarm_sub): Added check for default integer 
+	kind of status argument.
+	* iresolve.c (gfc_resolve_alarm_sub): Removed conversion of 
+	status argument.
+	* intrinsic.texi (ALARM): Extended documentation.
+
+2007-03-08  Daniel Franke  <franke.daniel@gmail.com>
+
+	* intrinsic.texi (GERROR, ISATTY, TTYNAM): New.
+	(ABORT, FLUSH, FNUM, IRAND, MALLOC, SIGNAL, SRAND): Fixed typo.
+	* intrinsic.c (add_subroutines): Adjusted dummy argument names 
+	of GERROR and TTYNAM.
+
+2007-07-08  Tobias Burnus  <burnus@net-b.de>
+
+	* module.c (gfc_match_use): Support renaming of operators
+	in USE statements.
+	* gfortran.texi (Fortran 2003 Status): Document support of
+	renaming of operators.
+
+2007-07-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/30973
+	* module.c (read_module): Always import module name as symbol.
+	(gfc_match_use): Disallow module name in the only clause of
+	a use statement.
+
+2007-03-08  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31011
+	* expr.c (find_array_section): Correct arithmetic for section
+	size.
+
+2007-03-07  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* iresolve.c (gfc_resolve_ishftc): Correct s_kind value.
+
+2007-03-06  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR documentation/30950
+	* intrinsic.texi (AND, CPU_TIME): Fix dummy argument names.
+	(FREE): Fix call syntax.
+
+2007-03-06  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi: Limit column widths to a total of .85.
+
+2007-03-05  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* gfortran.texi (GFortran and G77): Rewrite completely.
+
+2007-03-05  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* match.c (gfc_match_name): Expanded comment.
+
+2007-03-05  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* gfortran.texi (Old-style kind specifications): Document
+	special handling of old-style kind specifiers for COMPLEX.
+	* decl.c (gfc_match_old_kind_spec): Document kind/bytesize
+	assumptions for COMPLEX in comment.
+
+2007-03-05  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	PR 31050
+	* gfortranspec.c (lang_specific_driver): Update program
+	name and copyright date.
+
+2007-03-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30882
+	* check.c (dim_rank_check): The shape of subsections of
+	assumed-size arrays is known.
+
+2007-03-02  Paul Thomas  <pault@gcc.gnu.org>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/30873
+	* decl.c (gfc_match_entry): Remove erroneous entry result check.
+
+2007-03-01  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* Make-lang.in: Add install-pdf target as copied from
+	automake v1.10 rules.
+
+2007-03-01  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/30865
+	* trans-intrinsic.c (gfc_conv_intrinsic_size): Compare pointers.
+
+2007-02-28  Tobias Burnus  <burnus@net-b.de>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30888
+	PR fortran/30887
+	* resolve.c (resolve_actual_arglist): Allow by-value
+	arguments and non-default-kind for %VAL().
+	* trans-expr.c (conv_arglist_function): Allow
+	non-default-kind for %VAL().
+
+2007-02-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/30968
+	* primary.c (next_string_char): Correct reading a character
+	after the delimiter.
+	(match_string_constant): Print warning message only once.
+
+2007-02-27  Richard Guenther  <rguenther@suse.de>
+
+	* trans-array.c (structure_alloc_comps): Use correct type
+	for null pointer constant.
+
+2007-02-26  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* gfortran.texi: Standardize title page, remove version number
+	from copyright page.
+
+2007-02-26  Thomas Koenig  <Thomas.Koenig@online.de>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30865
+	* trans-intrinsic.c (gfc_conv_intrinsic_size):
+	If dim is an optional argument, check for its
+	presence and call size0 or size1, respectively.
+
+2007-02-23  Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/30660
+	* resolve.c (has_default_initializer): New function.
+	(resolve_fl_variable): Call has_default_initializer to determine if
+	the derived type has a default initializer to its ultimate
+	components.
+
+
+2007-02-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	* options.c (set_default_std_flags): New function to consolidate
+	setting the flags.
+	(gfc_init_options): Use new function.
+	(gfc_handle_option): Use new function.
+
+2007-02-22  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* gfortran.texi (Old-style kind specifications): Document
+	special handling of old-style kind specifiers for COMPLEX.
+	* decl.c (gfc_match_old_kind_spec): Documented kind/bytesize
+	assumptions in comment.
+
+2007-02-21  Bernhard Fischer  <aldot@gcc.gnu.org>
+
+	* parse.c (next_free): Gooble spaces after OpenMP sentinel.
+
+2007-02-20  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR fortran/30869
+	* match.c (gfc_match_iterator): Remove conflict between
+	loop variable and pointer.
+
+2007-02-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/30522
+	* symbol.c (gfc_add_volatile): Allow to set VOLATILE
+	  attribute for host-associated variables.
+	* gfortran.h (symbol_attribute): Save namespace
+	  where VOLATILE has been set.
+	* trans-decl.c (gfc_finish_var_decl): Move variable
+	  declaration to the top.
+
+2007-02-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/30783
+	* resolve.c (resolve_symbol): Add character dummy VALUE check.
+
+2007-02-19  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR libfortran/30533
+	* fortran/iresolve.c (gfc_resolve_maxloc): Remove coercion of
+	argument to default integer.
+	(gfc_resolve_minloc): Likewise.
+
+2007-02-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/30681
+	* options.c (gfc_init_options): Relax warning level for obsolescent.
+	* match.c (match_arithmetic_if): Change to obsolescent from deleted.
+	(gfc_match_if): Same.
+
+2007-02-18  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-array.c (gfc_build_constant_array_constructor): When the
+	shape of the constructor is known, use that to construct the
+	gfc_array_spec.
+	(gfc_trans_constant_array_constructor): Initialize the "info"
+	information for all of the dimensions of the array constructor.
+	(constant_array_constructor_loop_size): New function.
+	(gfc_trans_array_constructor): Use it to determine whether a
+	loop is suitable for "constant array constructor" optimization.
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_anyall): Use fold_build2
+	instead of build2, to avoid conditions like "(a != b) != 0".
+
+2007-02-18  Roger Sayle  <roger@eyesopen.com>
+	    Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/30400
+	* match.c (match_forall_iterator): Use gfc_match_expr instead
+	of gfc_match_variable to match the iterator variable.  Return
+	MATCH_NO if not a variable.  Remove the reset of the symbol's
+	flavor in cleanup.
+
+2007-02-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/30793
+	* trans-decl.c (gfc_generate_function_code): Do not initialize
+	pointers to derived components.
+
+2007-02-15  Sandra Loosemore  <sandra@codesourcery.com>
+	    Brooks Moses  <brooks.moses@codesourcery.com>
+	    Lee Millward  <lee.millward@codesourcery.com>
+
+	* trans-expr.c (gfc_conv_power_op): Use build_call_expr.
+	(gfc_conv_string_tmp): Likewise.
+	(gfc_conv_concat_op): Likewise.
+	(gfc_build_compare_string): Likewise.
+	(gfc_conv_function_call): Use build_call_list instead of build3.
+
+	* trans-array.c (gfc_trans_allocate_array_storage): Use
+	build_call_expr.
+	(gfc_grow_array): Likewise.
+	(gfc_trans_array_ctor_element): Likewise.
+	(gfc_trans_array_constructor_value): Likewise.
+	(gfc_array_allocate): Likewise.
+	(gfc_array_deallocate): Likewise.
+	(gfc_trans_auto_array_allocation): Likewise.
+	(gfc_trans_dummy_array_bias): Likewise.
+	(gfc_conv_array_parameter): Likewise.
+	(gfc_trans_dealloc_allocated): Likewise.
+	(gfc_duplicate_allocatable): Likewise.
+
+	* trans-openmp.c (gfc_trans_omp_barrier): Use build_call_expr.
+	(gfc_trans_omp_flush): Likewise.
+
+	* trans-stmt.c (gfc_conv_elementel_dependencies): Use build_call_expr.
+	(gfc_trans_pause): Likewise.
+	(gfc_trans_stop): Likewise.
+	(gfc_trans_character_select): Likewise.
+	(gfc_do_allocate): Likewise.
+	(gfc_trans_assign_need_temp): Likewise.
+	(gfc_trans_pointer_assign_need_temp): Likewise.
+	(gfc_trans_forall_1): Likewise.
+	(gfc_trans_where_2): Likewise.
+	(gfc_trans_allocate): Likewise.
+	(gfc_trans_deallocate): Likewise.
+
+	* trans.c (gfc_trans_runtime_check): Use build_call_expr.
+
+	* trans-io.c (gfc_trans_open): Use build_call_expr.
+	(gfc_trans_close): Likewise.
+	(build_filepos): Likewise.
+	(gfc_trans_inquire): Likewise.
+	(NML_FIRST_ARG): Delete.
+	(NML_ADD_ARG): Delete.
+	(transfer_namelist_element): Use build_call_expr.
+	(build_dt): Likewise.
+	(gfc_trans_dt_end): Likewise.
+	(transfer_expr): Likewise.
+	(transfer_array-desc): Likewise.
+
+	* trans-decl.c (gfc_generate_function_code): Use build_call_expr.
+	(gfc_generate_constructors): Likewise.
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_ctime): Use build_call_expr.
+	(gfc_conv_intrinsic_fdate): Likewise.
+	(gfc_conv_intrinsic_ttynam): Likewise.
+	(gfc_conv_intrinsic_array_transfer): Likewise.
+	(gfc_conv_associated): Likewise.
+	(gfc_conv_intrinsic_si_kind): Likewise.
+	(gfc_conv_intrinsic_trim): Likewise.
+	(gfc_conv_intrinsic_repeat: Likewise.
+	(gfc_conv_intrinsic_iargc): Likewise.
+
+2007-02-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/30779
+	* scanner.c (gfc_next_char_literal): Add check for end of file after
+	call to advance_line.
+
+2007-02-14  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/30799
+	* primary.c (match_logical_constant): Return MATCH_ERROR on invalid
+	kind.
+
+2007-02-14  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* misc.c (gfc_typename): Fix potential buffer overflow.
+
+2007-02-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30554
+	* module.c (read_module): Set pointer_info to referenced if the
+	symbol has no namespace.
+
+2007-02-12  Nick Clifton  <nickc@redhat.com>
+
+	* lang.opt: Add Warning attribute to warning options.
+
+2007-02-11  Daniel Franke  <franke.daniel@gmail.com>
+
+	* intrinsic.texi (HOSTNM): Fix typographical error in syntax.
+	(SLEEP): Added section and documentation.
+
+2007-02-11  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/30478
+	* decl.c (add_init_expr_to_sym): Remove ENUM specific code.
+	(variable_decl): Likewise.  Rewrap comment.
+	(match_attr_spec): Remove ENUM specific code.
+	(gfc_match_enum): Fix typo in error message.
+	(enumerator_decl): New function.
+	(gfc_match_enumerator_def): Use enumerator_decl instead of
+	variable_decl.  Adapt code accordingly.
+
+2007-02-11  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30554
+	* module.c (find_symtree_for_symbol): New function to return
+	a symtree that is not a "unique symtree" given a symbol.
+	(read_module): Do not automatically set pointer_info to
+	referenced because this inhibits the generation of a unique
+	symtree.  Recycle the existing symtree if possible by calling
+	find_symtree_for_symbol.
+
+	PR fortran/30319
+	* decl.c (add_init_expr_to_sym): Make new charlen for an array
+	constructor initializer.
+
+2007-02-10  Richard Henderson  <rth@redhat.com>, Jakub Jelinek  <jakub@redhat.com>
+
+	* f95-lang.c (gfc_init_builtin_functions): Add __emutls_get_address
+	and __emutls_register_common.
+	* openmp.c (gfc_match_omp_threadprivate): Don't error if !have_tls.
+	* trans-common.c (build_common_decl): Don't check have_tls.
+	* trans-decl.c (gfc_finish_var_decl): Likewise.
+	* types.def (BT_WORD, BT_FN_PTR_PTR): New.
+	(BT_FN_VOID_PTR_WORD_WORD_PTR): New.
+
+2007-02-09  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/30512
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc,
+	  gfc_conv_intrinsic_minmaxval): Use HUGE-1 for most negative integer.
+
+2007-02-09  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/30720
+	* trans-array.c (gfc_trans_create_temp_array): Remove use of the
+	function argument. Always generate code for negative extent.
+	Simplify said code.
+	* trans-array.h (gfc_trans_create_temp_array): Change prototype.
+	* trans-expr.c (gfc_conv_function_call): Remove use of last argument
+	of gfc_trans_create_temp_array.
+	* trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Likewise.
+	* trans-stmt.c (gfc_conv_elemental_dependencies): Likewise.
+
+2007-02-08  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-stmt.c (gfc_trans_forall_1): Optimize the cases where the
+	mask expression is a compile-time constant (".true." or ".false.").
+
+2007-02-04  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/30611
+	* trans-intrinsic.c (gfc_conv_intrinsic_repeat): Evaluate
+	arguments only once. Generate check that NCOPIES argument is not
+	negative.
+
+2007-02-04  Steven G. Kargl <kargl@gcc.gnu.org>
+
+	PR fortran/30605
+	* fortran/invoke.texi: Update documentation.
+	* fortran/options.c (gfc_post_options): Deal with tabs with -std=f2003
+	and -pedantic.
+
+2007-02-03  Kazu Hirata  <kazu@codesourcery.com>
+
+	* trans-array.c: Fix a comment typo.
+
+2007-02-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30514
+	* array.c (match_array_element_spec): If the length of an array is
+	negative, adjust the upper limit to make it zero length.
+
+	PR fortran/30660
+	* resolve.c (pure_function, resolve_function): Initialize name to
+	null to clear up build warnings.
+	(resolve_fl_variable): Look at components explicitly to check for
+	default initializer, rather than using gfc_default_initializer.
+
+2007-02-02  Steven G. Kargl <kargl@gcc.gnu.org>
+
+	PR fortran/30683
+	* resolve.c (resolve_generic_f): Check for non-NULL sym.
+
+2007-02-02  Roger Sayle  <roger@eyesopen.com>
+
+	* trans.c (gfc_build_array_ref): Use STRIP_TYPE_NOPS to eliminate
+	NON_LVALUE_EXPR nodes and useless type conversions.
+
+2007-02-02  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30284
+	PR fortran/30626
+	* trans-expr.c (gfc_conv_aliased_arg): Remove static attribute
+	from function and make sure that substring lengths are
+	translated.
+	(is_aliased_array): Remove static attribute.
+	* trans.c : Add prototypes for gfc_conv_aliased_arg and
+	is_aliased_array.
+	* trans-io.c (set_internal_unit): Add the post block to the
+	arguments of the function.  Use is_aliased_array to check if
+	temporary is needed; if so call gfc_conv_aliased_arg.
+	(build_dt): Pass the post block to set_internal_unit and
+	add to the block after all io activiy is done.
+
+2007-02-01  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-array.c (gfc_conv_expr_descriptor): We don't need to use
+	a temporary array to pass a constant non-character array constructor.
+	Generalize the descriptor generation code to handle scalarizer
+	"info" without an array reference.
+
+2007-02-01  Roger Sayle  <roger@eyesopen.com>
+
+	* dependency.c (gfc_check_dependency) <EXPR_ARRAY>: Implement
+	dependency checking for array constructors.
+
+2007-02-01  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-stmt.c (compute_overall_iter_number): Document function
+	arguments.  Generalize "unconditional forall nest with constant
+	bounds" optimization to eliminate unconditional inner loops with
+	constant bounds.
+
+2007-01-31  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/30520
+	* interface.c (compare_actual_formal): Check conformance between
+	  actual and VOLATILE dummy arguments.
+	* symbol.c (gfc_add_volatile): Allow setting of VOLATILE
+	  multiple times in different scopes.
+	* decl.c (gfc_match_volatile): Search symbol in host association.
+
+2007-01-31  Kazu Hirata  <kazu@codesourcery.com>
+
+	* simplify.c, trans-array.c: Fix comment typos.
+
+2007-01-30  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
+
+	* invoke.texi (Code Gen Options): Fix abbreviation typo.
+	* intrinsic.texi (ACCESS, LSHIFT, RSHIFT): Fix typos.
+
+2007-01-30  Steve Ellcey  <sje@cup.hp.com>
+
+	PR fortran/30432
+	* trans-types.c (gfc_get_function_type): Do not add void_type_node
+	to empty arg list.
+	* trans-decl.c (create_function_arglist): Change assert.
+
+2007-01-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30554
+	* module.c (read_module): If a symbol is excluded by an ONLY
+	clause, check to see if there is a symtree already loaded. If
+	so, attach the symtree to the pointer_info.
+
+2007-01-28  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR libfortran/30389
+	* gfortran.h: Remove gfc_simplify_init_1.
+	* arith.h: Remove third argument from gfc_compare_string.
+	* arith.c (gfc_compare_expression): Remove third argument
+	from call to gfc_compare_string.
+	(gfc_compare_string): Remove third argument xcoll_table.
+	Remove use of xcoll_table.
+	* misc.c (gfc_init_1): Remove call to gfc_simplify_init_1.
+	* simplify.c (ascii_table): Remove.
+	(xascii_table): Likewise.
+	(gfc_simplify_achar): ICE if extract_int fails.  Remove use of
+	ascii_table.  Warn if -Wsurprising and value < 0 or > 127.
+	(gfc_simplify_char): ICE if extract_int fails. Error if
+	value < 0 or value > 255.
+	(gfc_simplify_iachar): Remove use of xascii_table.
+	Char values outside of 0..255 are an ICE.
+	(gfc_simplify_lge): Remove use of xascii_table.
+	(gfc_simplify_lgt): Likewise.
+	(gfc_simplify_lle): Likewise.
+	(gfc_simplify_llt): Likewise.
+	(invert_table): Remove.
+	(gfc_simplify_init_1): Remove.
+
+2007-01-27  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-stmt.c (forall_info): Replace the next_nest and outer
+	fields that previously implemented a doubly-linked list with a
+	single prev_nest field (singly-linked list).
+	(gfc_trans_nested_forall_loop): The nested_forall_info argument
+	now denotes the innermost FORALL in the loop nest.
+	(compute_overall_iter_number): Use prev_nest instead of next_nest.
+	(gfc_trans_forall_1): Link/cons the new "info" to the head of the
+	nested_forall_info linked list.  Free the current "info" when done.
+
+2007-01-27  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30407
+	* trans-expr.c (gfc_conv_operator_assign): New function.
+	* trans.h : Add prototype for gfc_conv_operator_assign.
+	* trans-stmt.c (gfc_trans_where_assign): Add a gfc_symbol for
+	a potential operator assignment subroutine.  If it is non-NULL
+	call gfc_conv_operator_assign instead of the first assignment.
+	( gfc_trans_where_2): In the case of an operator assignment,
+	extract the argument expressions from the code for the
+	subroutine call and pass the symbol to gfc_trans_where_assign.
+	resolve.c (resolve_where, gfc_resolve_where_code_in_forall,
+	gfc_resolve_forall_body): Resolve the subroutine call for
+	operator assignments.
+
+2007-01-26  Steven Bosscher  <stevenb.gcc@gmail.com>
+	    Steven G. Kargl <kargl@gcc.gnu.org>
+
+	PR fortran/30278
+	* fortran/io.c (next_char): Deal with backslash escaped characters.
+	Issue warnings in non -std=gnu cases.
+	* fortran/primary.c (next_string_char): Issue warnings in non
+
+2007-01-26  Tobias Burnus  <burnus@net-b.de>
+
+	* lang-specs.h: Add support for .f03 and .F03 extensions.
+	* gfortran.texi: Document .f03 extension.
+	* options.c (form_from_filename): Recognize .f03.
+
+2007-01-25  Manuel Lopez-Ibanez  <manu@gcc.gnu.org>
+
+	PR fortran/30437
+	* lang.opt (Wall): Remove RejectNegative.
+	* options.c (gfc_handle_option): Wall can be disabled.
+	(set_Wall): Add a parameter for disabling Wall.
+	
+2007-01-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/30532
+	* scanner.c (load_line): Remove check fot ctrl-z and don't gobble.
+	
+2007-01-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30481
+	* match.c (gfc_match_namelist): Add check for assumed size character
+	in namelist and provide error if found.
+
+2007-01-21  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi (ACHAR): Added cross-references.
+	(CHAR): Put cross-references in alphabetical order.
+	(IACHAR): Added cross-references.
+	(ICHAR): Added cross-references.
+
+2007-01-20  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi: Edited all "Syntax" examples to a consistent form.
+	(MAXVAL): Corrected description of result characteristics.
+	(MINVAL): Same.
+	(UMASK): Added documentation.
+
+2007-01-20  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* openmp.c, matchexp.c, module.c, scanner.c, resolve.c, st.c,
+	parse.c, primary.c, options.c, misc.c, simplify.c: Next installment
+	in the massive whitespace patch.
+
+2007-01-20  Roger Sayle  <roger@eyesopen.com>
+
+	* module.c (mio_array_ref): The dimen_type fields of an array ref
+	are an enumerated type and can't be read/written directly with a
+	call to mio_integer.  Instead loop over and cast each element.
+
+2007-01-20  Roger Sayle  <roger@eyesopen.com>
+
+	* dependency.c (gfc_full_array_ref_p): Check that ref->next is NULL,
+	i.e. that the ARRAY_REF doesn't mention components.
+	* trans-array.c (gfc_constant_array_constructor_p): Export external
+	function renamed from constant_array_constructor_p.
+	(gfc_build_constant_array_constructor): Export.
+	(gfc_trans_array_constructor): Update call to the renamed function
+	constant_array_constructor_p.
+	* trans-array.h (gfc_constant_array_constructor_p): Prototype here.
+	(gfc_build_constant_array_constructor): Likewise.
+	* trans-expr.c (gfc_build_memcpy_call): New helper function split
+	out from gfc_trans_array_copy.
+	(gfc_trans_array_copy): Use gfc_build_memcpy_call.
+	(gfc_trans_array_constructor_copy): New function to optimize
+	assigning an entire array from a constant array constructor.
+	(gfc_trans_assignment): Call gfc_trans_array_constructor_copy
+	when appropriate.
+
+2007-01-20  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_sign): New branchless
+	implementation for the SIGN intrinsic with integral operands.
+	(gfc_conv_intrinsic_minmax): Fix whitespace.
+
+2007-01-20  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* gfortran.h (gfc_options_t): Add flag_allow_leading_underscore.
+	* lang.opt: Add -fallow-leading-underscore.
+	* match.c (gfc_match_name): Allow leading underscore in symbol
+	name if -fallow-leading-underscore is used.
+	* symbol.c (gfc_get_default_type): Add special case for symbol
+	names beginning with an underscore.
+	* trans-decl.c (gfc_get_extern_function_decl,
+	gfc_build_intrinsic_function_decls): Add _gfortran prefix to
+	library symbols selected_int_kind, selected_real_kind and 
+	all specifics.
+	* options.c (gfc_init_options, gfc_handle_option): Handle the
+	new -fallow-leading-underscore option.
+
+2007-01-20  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/30446
+	* options.c (gfc_handle_module_path_options): Path used in -J
+	option is now added to the module search path.
+
+2007-01-20  Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/30223
+	* f95-lang.c (gfc_init_builtin_functions): Provide cbrt and
+	cexpi builtins if we have TARGET_C99_FUNCTIONS.  Provide
+	sincos builtins if the target has sincos.
+
+2007-01-19  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi (MATMUL): Corrected a typo.
+	(MAX): Separated @var arguments.
+	(MIN): Separated @var arguments.
+
+2007-01-19  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi: general whitespace cleanup.
+	(menu): Added TIME8, removed UNMASK.
+	(AINT): Clarified argument requirement.
+	(ANINT): Clarified argument requirement.
+	(CEILING): Clarified argument requirement.
+	(CHAR): Clarified argument requirement.
+	(CMPLX): Clarified argument requirement.
+	(DCMPLX): Clarified argument requirement.
+	(FGET): Line rewrapping.
+	(FLOOR): Clarified argument requirement.
+	(GMTIME): Added documentation.
+	(IAND): Added cross-reference.
+	(IBCLR): Added cross-reference.
+	(IBSET): Added cross-reference.
+	(IEOR): Added cross-reference.
+	(INT): Collapsed examples, clarified argument requirement.
+	(IOR): Added cross-references.
+	(LEN_TRIM): Corrected result kind.
+	(LINK): Added cross-reference.
+	(LLT): Removed "documentation pending".
+	(LOGICAL): Added documentation.
+	(LSHIFT): Added documentation.
+	(LTIME): Added documentation.
+	(MATMUL): Added documentation.
+	(MAX): Added documentation.
+	(MAXLOC): Added documentation.
+	(MAXVAL): Added documentation.
+	(MERGE): Added documentation.
+	(MIN): Added documentation.
+	(MINLOC): Added documentation.
+	(MINVAL): Added documentation.
+	(MVBITS): Moved to correct place, added documentation.
+	(NOT): Added documentation.
+	(PERROR): Added documentation.
+	(RAN): Moved to correct place, added documentation.
+	(REAL): Clarified argument requirement.
+	(RENAME): Added documentation.
+	(RSHIFT): Clarified argument requirement.
+	(SIGN): Corrected table specification.
+	(SYMLNK): Added documentation.
+	(SYSTEM): Added documentation.
+	(TIME): Added documentation.
+	(TIME8): Added section and documentation.
+	(UNMASK): Removed erroneous section.
+
+2007-01-18  H.J. Lu  <hongjiu.lu@intel.com>
+
+	* trans-stmt.c (compute_overall_iter_number): Fix a typo.
+
+2007-01-18  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-expr.c (copyable_array_p): Consider user derived types without
+	allocatable components to be copyable.
+
+2007-01-18  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-stmt.c (compute_overall_iter_number): Enhance to precompute
+	the number of interations in unconditional FORALL nests with constant
+	bounds.
+
+2007-01-18  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR libfortran/29649
+	* gfortran.h (gfc_option_t): Add flag_dump_core.
+	* lang.opt: Add -fdump-core option.
+	* invoke.texi: Document the new options.
+	* trans-decl.c (gfc_build_builtin_function_decls): Add new
+	  options to the call to set_std.
+	* options.c (gfc_init_options, gfc_handle_option): Set the
+	  new options.
+
+2007-01-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30476
+	* module.c (load_generic_interfaces): Make the marking of the
+	symbol as ambiguous conditional on the module names being
+	different.
+	(write_generic): Ensure that the generic interface has a
+	non-NULL module field.
+
+2007-01-16  Roger Sayle  <roger@eyesopen.com>
+
+	PR fortran/30404
+	* trans-stmt.c (forall_info): Remove pmask field.
+	(gfc_trans_forall_loop): Remove NVAR argument, instead assume that
+	NVAR covers all the interation variables in the current forall_info.
+	Add an extra OUTER parameter, which specified the loop header in
+	which to place mask index initializations.
+	(gfc_trans_nested_forall_loop): Remove NEST_FLAG argument.
+	Change the semantics of MASK_FLAG to only control the mask in the
+	innermost loop.
+	(compute_overall_iter_number): Optimize the trivial case of a
+	top-level loop having a constant number of iterations.  Update
+	call to gfc_trans_nested_forall_loop.  Calculate the number of
+	times the inner loop will be executed, not to size of the 
+	iteration space.
+	(allocate_temp_for_forall_nest_1): Reuse SIZE as BYTESIZE when
+	sizeof(type) == 1.  Tidy up.
+	(gfc_trans_assign_need_temp): Remove NEST_FLAG argument from calls
+	to gfc_trans_nested_forall_loop.
+	(gfc_trans_pointer_assign_need_temp): Likewise.
+	(gfc_trans_forall_1): Remove unused BYTESIZE, TMPVAR, SIZEVAR and
+	LENVAR local variables.  Split mask allocation into a separate
+	hunk/pass from mask population.  Use allocate_temp_for_forall_nest
+	to allocate the FORALL mask with the correct size.  Update calls
+	to gfc_trans_nested_forall_loop.
+	(gfc_evaluate_where_mask): Update call to
+	gfc_trans_nested_forall_loop.
+	(gfc_trans_where_2): Likewise.
+
+2007-01-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28172
+	* trans-stmt.c (gfc_trans_call): If it does not have one, get
+	a backend_decl for an alternate return.
+
+	PR fortran/29389
+	* resolve.c (pure_function): Statement functions are pure. Note
+	that this will have to recurse to comply fully with F95.
+
+	PR fortran/29712
+	* resolve.c (resolve_function): Only a reference to the final
+	dimension of an assumed size array is an error in an inquiry
+	function.
+
+	PR fortran/30283
+	* resolve.c (resolve_function): Make sure that the function
+	expression has a type.
+
+2007-01-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30410
+	* trans-decl.c (gfc_sym_mangled_function_id): Module, external
+	symbols must not have the module name prepended.
+
+2007-01-11  Thomas Koenig  <Thomas.Koenig@online.de>
+
+	PR libfortran/30415
+	* iresolve.c (gfc_resolve_maxloc): If the rank
+	of the return array is nonzero and we process an
+	integer array smaller than default kind, coerce
+	the array to default integer.
+	* iresolve.c (gfc_resolve_minloc): Likewise.
+
+2007-01-11  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* simplify.c: Update copyright to 2007.
+	* scanner.c: Same.
+
+2007-01-11  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/30430
+	* scanner.c (gfc_release_include_path): Free gfc_option.module_dir
+	only once!
+
+2007-01-09  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* simplify.c (gfc_simplify_ibclr): Fix POS comparison.
+	(gfc_simplify_ibset): Same.
+
+2007-01-09  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	PR 30381
+	PR 30420
+	* simplify.c (convert_mpz_to_unsigned): New function.
+	(convert_mpz_to_signed): New function, largely based on
+	twos_complement().
+	(twos_complement): Removed.
+	(gfc_simplify_ibclr): Add conversions to and from an
+	unsigned representation before bit-twiddling.
+	(gfc_simplify_ibset): Same.
+	(gfc_simplify_ishftc): Add checks for overly large
+	constant arguments, only check the third argument if
+	it's present, carry over high bits into	the result as
+	appropriate, and perform the final conversion back to
+	a signed representation using the correct sign bit.
+	(gfc_simplify_not): Removed unnecessary masking.
+
+2007-01-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/30408
+	* resolve.c (resolve_code): Use the code->expr character length
+	directly to set length of llen.
+
+2007-01-09  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/30408
+	* lang.opt: Add Wcharacter_truncation option.
+	* options.c (gfc_init_options): Initialize
+	gfc_option.warn_character_truncation to zero.
+	(gfc_handle_option): Add case for OPT_Wcharacter_truncation.
+
+2007-01-08  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* interface.c, intrinsic.c, gfortranspec.c, io.c, f95-lang.c,
+	iresolve.c, match.c: Update Copyright years.  Whitespace.
+
+2007-01-08  Richard Guenther  <rguenther@suse.de>
+
+	* trans-io.c (transfer_array_desc): Use build_int_cst instead
+	of build_int_cstu.
+
+2007-01-08  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-array.c (constant_array_constructor_p): New function to
+	determine whether an array constructor consists only of constant
+	elements, and if so return it's size.
+	(gfc_build_constant_array_constructor): Construct a statically
+	initialized gfortran array for a given EXPR_ARRAY.
+	(gfc_trans_constant_array_constructor): Efficiently scalarize
+	a constant array constructor.
+	(gfc_trans_array_constructor): Tidy up use of CONST_STRING.
+	Special case scalarization of constant array constructors, all of
+	whose elements are specified, using constant_array_constructor_p 
+	and gfc_trans_constant_array_constructor.
+	(gfc_conv_scalarized_array_ref): Check whetger info->offset is zero
+	before adding it to index, to avoid creating a NON_LVALUE_EXPR.
+
+2007-01-08  Kazu Hirata  <kazu@codesourcery.com>
+
+	gfortran.texi: Fix typos.
+
+2007-01-07  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* decl.c, dump-parse-tree.c, error.c, data.c, expr.c, dependency.c,
+	convert.c: Update Copyright dates.  Fix whitespace.
+
+2007-01-07  Bernhard Fischer  <aldot@gcc.gnu.org>
+
+	* data.c (gfc_assign_data_value): Fix whitespace.
+
+2007-01-07  Bernhard Fischer  <aldot@gcc.gnu.org>
+
+	* trans-array.c (gfc_trans_create_temp_array, gfc_array_init_size):
+	Commentary typo fix.
+
+2007-01-07  Bernhard Fischer  <aldot@gcc.gnu.org>
+
+	PR fortran/27698
+	* match.c (gfc_match_name): Print diagnostics for invalid
+	character in names.
+
+2007-01-06  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* array.c: Fix whitespace in comment table.
+
+2007-01-06  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* array.c, bbt.c, check.c: Update copyright years.  Whitespace.
+
+2007-01-06  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* arith.c: Update copyright years.  Whitespace.
+
+2007-01-05  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-expr.c (gfc_trans_assignment_1): New subroutine to scalarize
+	array assignments split out from gfc_trans_assignment.
+	(gfc_trans_array_copy): New function to implement array to array
+	copies via calls to __builtin_memcpy.
+	(copyable_array_p): New helper function to identify an array of
+	simple/POD types, that may be copied/assigned using memcpy.
+	(gfc_trans_assignment): Use gfc_trans_array_copy to handle simple
+	whole array assignments considered suitable by copyable_array_p.
+	Invoke gfc_trans_assignment_1 to perform the fallback scalarization.
+
+2007-01-05  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-array.c (gfc_trans_array_constructor_value): Make the
+	static const "data" array as TREE_READONLY.
+	* trans-stmt.c (gfc_trans_character_select): Likewise.
+
+2007-01-05  Roger Sayle  <roger@eyesopen.com>
+
+	* trans-array.c (gfc_conv_loop_setup): Test whether the loop
+	stride is one, to avoid fold_build2 introducing a useless
+	NON_LVALUE_EXPR node.
+
+2007-01-05  Tobias Burnus  <burnus@net-b.de>
+
+	* symbol.c (check_conflict): Fix error message.
+
+2007-01-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/23232
+	* decl.c (gfc_in_match_data, gfc_set_in_match_data): New
+	functions to signal that a DATA statement is being matched.
+	(gfc_match_data): Call gfc_set_in_match_data on entry and on
+	exit.
+	* gfortran.h : Add prototypes for above.
+	* expr.c (check_init_expr): Avoid check on parameter or
+	variable if gfc_in_match_data is true.
+	(gfc_match_init_expr): Do not call error on non-reduction of
+	expression if gfc_in_match_data is true.
+
+	PR fortran/27996
+	PR fortran/27998
+	* decl.c (gfc_set_constant_character_len): Add boolean arg to
+	flag array constructor resolution.  Warn if string is being
+	truncated.  Standard dependent error if string is padded. Set
+	new arg to false for all three calls to
+	gfc_set_constant_character_len.
+	* match.h : Add boolean arg to prototype for
+	gfc_set_constant_character_len.
+	* gfortran.h : Add warn_character_truncation to gfc_options.
+	* options.c (set_Wall): Set warn_character_truncation if -Wall
+	is set.
+	* resolve.c (resolve_code): Warn if rhs string in character
+	assignment has to be truncated.
+	* array.c (gfc_resolve_character_array_constructor): Set new
+	argument to true for call to gfc_set_constant_character_len.
+
+2007-01-05  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/29624
+	* interface.c (compare_parameter_intent): New function.
+	  (check_intents): Support pointer intents.
+	* symbol.c (check_conflict): Support pointer intents,
+	  better conflict_std message.
+	* expr.c (gfc_check_assign,gfc_check_pointer_assign):
+	  Support pointer intents.
+	* resolve.c (resolve_deallocate_expr,resolve_allocate_expr):
+	  Support pointer intents.
+
+2007-01-03  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	PR 30371
+	* check.c (gfc_check_kill_sub): Add checks for non-scalar
+	arguments.
+
+2007-01-04  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi: Minor cleanup, reflowing overlong
+	paragraphs, and correcting whitespace.
+
+2007-01-04  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi (LBOUND): Add documentation.
+	(LGE): Add documentation.
+	(LGT): Add documentation.
+	(LINK): Add documentation.
+	(LLE): Add documentation.
+	(LLT): Add documentation.
+	(LNBLNK): Add documentation.
+	(UBOUND): Add documentation.
+	(UNLINK): Add documentation.
+
+2007-01-04  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi (IAND): Clarify argument specifications.
+	(IBCLR): Add documentation.
+	(IBITS): Add documentation.
+	(IBSET): Add documentation.
+	(IEOR): Add documentation.
+	(IERRNO): Add documentation.
+	(INDEX): Add documentation.
+	(IOR): Add documentation.
+	(ISHFT): Add documentation.
+	(ISHFTC): Add documentation.
+	(KILL): Add documentation.
+	(LEN_TRIM): Add documentation.
+
+2007-01-04  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	PR 30235
+	* interface.c (compare_actual_formal): check for
+	alternate returns when iterating over non-present
+	arguments.
+
+2007-01-04  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* invoke.texi: Update manpage copyright to include 2007.
+
+2007-01-04  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* gfortran.texi: Update copyright to include 2007.
+	* intrinsic.texi: Update copyright to include 2007.
+	* invoke.texi: Update copyright to include 2007.
+
+2007-01-02  Tobias Burnus  <burnus@net-b.de>
+	    Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/30276
+	* scanner.c (open_included_file): Revert patch.
+	  (gfc_open_included_file): Support absolute pathnames.
+	  (gfc_open_intrinsic_module): Support absolute pathnames.
+
+2007-01-03  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* gfortran.texi (GNU Fortran and GCC): Rewrite
+
+2007-01-03  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* gfortran.texi (Introduction): Lower "Part I:
+	Introduction" to a chapter, renumber Parts II and III to
+	Parts I and II.
+	* intrinsic.texi (Introduction): Rename to "Introduction
+	to Intrinsics" to avoid conflict with the new chapter.
+
+2007-01-03  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi (Introduction): Rewrite first paragraph.
+
+2007-01-03  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* invoke.texi (OpenMP): Added index entry.
+	* gfortran.texi (title page): Removed erroneous '*'.
+
+2007-01-03  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* gfortran.texi (GFORTRAN_DEFAULT_RECL): Added units
+	to description.
+	(Extensions): Miscellaneous minor rewriting and copyediting.
+	(BOZ-literal constants): Renamed from Hexadecimal constants.
+	(Hollerith constants support): Added explanation and 
+	suggestions for standard-conforming modern equivalents.
+
+2007-01-03  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi: Improvements to index entries; change
+	@findex entries to @cindex entries.
+	* invoke.texi: Standardize and improve index entries.
+	* gfortran.texi: Fix @code in one index entry.
+
+2007-01-03  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* invoke.texi: Change @code-type macros to appropriate
+	variants (@command, @option, etc.)
+	* gfortran.texi: Same.
+
+2007-01-03  Brooks Moses  <brooks.moses@codesourcery.com>
+
+	* intrinsic.texi: Various minor cleanups.
+
+2007-01-02  Steven G. Kargl  <kargls@comcast.net>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_ibits): Fix call to
+	build_int_cst.
+
+2007-01-02  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/30276
+	* scanner.c (open_included_file): Support full-path filenames.
+
+2007-01-02  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/20896
+	* interface.c (check_sym_interfaces): Remove call to
+	resolve_global_procedure.
+	gfortran.h : Remove prototype for resolve_global_procedure.
+	resolve.c (resolve_global_procedure): Add static attribute
+	to function declaration.
+
+2007-01-01  Steven G. Kargl  <kargls@comcast.net>
+
+	* ChangeLog: Copy to ...
+	* ChangeLog-2006: here.
+
+
+Copyright (C) 2007 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved.
diff --git a/gcc/fortran/ChangeLog-2008 b/gcc/fortran/ChangeLog-2008
new file mode 100644
index 000000000..7f536aa44
--- /dev/null
+++ b/gcc/fortran/ChangeLog-2008
@@ -0,0 +1,4142 @@
+2008-12-31  Daniel Franke  <franke.daniel@gmail.com>
+
+	* check.c (dim_rank_check): Fixed checking of dimension argument
+	if array is of type EXPR_ARRAY.
+
+2008-12-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38602
+	* trans-decl.c (init_intent_out_dt): Allow for optional args.
+
+2008-12-21  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/38398
+	* io.c: Add error checks for g0 formatting and provide adjustment of
+	error loci for improved error messages.
+
+2008-12-21  Arjen Markus  <arjen.markus@wldelft.nl>
+	    Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37605
+	* gfortran.texi: Fixed some typos and some minor style improvements.
+	* intrinsic.texi: Some clarifications and typo-fixes.
+	* invoke.texi: Better documenation of the behaviour of the
+	-fdefault-*-8 options and some other fixes.
+
+2008-12-18  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/31822
+	* gfortran.h (gfc_check_same_strlen): Made public.
+	* trans.h (gfc_trans_same_strlen_check): Made public.
+	* check.c (gfc_check_same_strlen): Made public and adapted error
+	message output to be useful not only for intrinsics.
+	(gfc_check_merge): Adapt to gfc_check_same_strlen change.
+	* expr.c (gfc_check_pointer_assign): Use gfc_check_same_strlen for
+	string length compile-time check.
+	* trans-expr.c (gfc_trans_pointer_assignment): Add runtime-check for
+	equal string lengths using gfc_trans_same_strlen_check.
+	* trans-intrinsic.c (gfc_trans_same_strlen_check): Renamed and made
+	public from conv_same_strlen_check.
+	(gfc_conv_intrinsic_merge): Adapted accordingly.
+
+2008-12-17  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/38137
+	* trans-intrinsic.c (conv_same_strlen_check): New method.
+	(gfc_conv_intrinsic_merge): Call it here to actually do the check.
+
+2008-12-15  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/38487
+	* dependency.c (gfc_is_data_pointer): New function.
+	(gfc_check_argument_var_dependency): Disable the warning
+	in the pointer case.
+	(gfc_check_dependency): Use gfc_is_data_pointer.
+
+2008-12-15  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/38113
+	* error.c (show_locus): Start counting columns at 0.
+	* primary.c (match_actual_arg): Eat spaces
+	before copying the current locus.
+	(match_variable): Copy the locus before matching.
+
+2008-12-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35937
+	* trans-expr.c (gfc_finish_interface_mapping): Fold convert the
+	character length to gfc_charlen_type_node.
+
+2008-12-12  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/36355
+	* check.c (gfc_check_matmul): Fixed error message for invalid
+	types to correctly identify the offending argument, added check
+	for mismatching types.
+
+2008-12-11  Richard Guenther  <rguenther@suse.de>
+
+	* Make-lang.in (install-finclude-dir): Use correct mode argument
+	for mkinstalldirs.
+
+2008-12-09  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/36376
+	PR fortran/37468
+	* lang-specs.h: Pass on -i* options to f951 to (probably) report
+	them as unknown. Duplicate gcc.c (cpp_options), but omit
+	-fpch-preprocess on -save-temps.
+
+2008-12-09  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/36457
+	* lang.opt: Added option idirafter.
+	* cpp.h (gfc_cpp_add_include_path_after): New prototype.
+	* cpp.c (gfc_cpp_handle_option): Recognize and handle OPT_dirafter.
+	(gfc_cpp_add_include_path_after): New, adds user-defined search path
+	after any other paths.
+	* invoke.texi (idirafter): New.
+	(no-range-check): Fixed entry in option-index.
+
+2008-12-09  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/37469
+	* expr.c (find_array_element): Simplify array bounds.
+	Assert that both bounds are constant expressions.
+
+2008-12-09  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/35983
+	* trans-expr.c (gfc_trans_subcomponent_assign):
+	Add se's pre and post blocks to current block.
+	(gfc_trans_structure_assign): Remove specific handling
+	of C_NULL_PTR and C_NULL_FUNPTR.
+
+2008-12-06  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/38425
+	* io.c (check_io_constraints): Check constraints on REC=, POS=, and
+	internal unit with POS=. Fix punctuation on a few error messages.
+
+2008-12-06  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/38415
+	* expr.c (gfc_check_pointer_assign): Added a check for abstract
+	interfaces in procedure pointer assignments, removed check involving
+	gfc_compare_interfaces until PR38290 is fixed completely.
+
+2008-12-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/38291
+	* io.c (match_dt_element): Use dt->pos in matcher.
+	(gfc_free_dt): Free dt->pos after use.
+	(gfc_resolve_dt): Use dt->pos in resolution of stream position tag.
+
+2008-12-05  Sebastian Pop  <sebastian.pop@amd.com>
+
+	PR bootstrap/38262
+	* Make-lang.in (f951): Add BACKENDLIBS, remove GMPLIBS.
+
+2008-12-02  Jakub Jelinek  <jakub@redhat.com>
+	    Diego Novillo  <dnovillo@google.com>
+
+	* Make-lang.in (install-finclude-dir): Use mkinstalldirs
+	and don't remove the finclude directory beforehand.
+
+2008-12-02  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36704
+	PR fortran/38290
+	* decl.c (match_result): Result may be a standard variable or a
+	procedure pointer.
+	* expr.c (gfc_check_pointer_assign): Additional checks for procedure
+	pointer assignments.
+	* primary.c (gfc_match_rvalue): Bugfix for procedure pointer
+	assignments.
+	* resolve.c (resolve_function): Check for attr.subroutine.
+	* symbol.c (check_conflict): Addtional checks for RESULT statements.
+	* trans-types.c (gfc_sym_type,gfc_get_function_type): Support procedure
+	pointers as function result.
+
+2008-12-01  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/38252
+	* parse.c (parse_spec): Skip statement order check in case
+	of a CONTAINS statement.
+
+2008-11-30  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37779
+	* gfortran.h (struct gfc_entry_list): Fixed typo in comment.
+	* resolve.c (is_illegal_recursion): New method.
+	(resolve_procedure_expression): Use new is_illegal_recursion instead of
+	direct check and handle function symbols correctly.
+	(resolve_actual_arglist): Removed useless recursion check.
+	(resolve_function): Use is_illegal_recursion instead of direct check.
+	(resolve_call): Ditto.
+
+2008-11-29  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* trans-array.c (gfc_conv_array_parameter): Guard union access.
+
+2008-11-29  Janus Weil  <janus@gcc.gnu.org>
+	    Mikael Morin <mikael@gcc.gnu.org>
+
+	PR fortran/38289
+	PR fortran/38290
+	* decl.c (match_procedure_decl): Handle whitespaces.
+	* resolve.c (resolve_specific_s0): Bugfix in check for intrinsic
+	interface.
+
+2008-11-25  H.J. Lu  <hongjiu.lu@intel.com>
+
+	* module.c (gfc_dump_module): Report error on unlink only if
+	errno != ENOENT.
+
+2008-11-25  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/36463
+	* expr.c (replace_symbol): Don't replace the symtree
+	if the expresion is an intrinsic function. Don't create
+	non-existent symtrees.  Use symbol's name instead of symtree's,
+	different in case of module procedure dummy arguments.
+
+2008-11-25  Jan Kratochvil  <jan.kratochvil@redhat.com>
+
+	PR fortran/38248
+	* module.c (gfc_dump_module): Check rename/unlink syscalls errors.
+
+2008-11-25  Eric Botcazou  <ebotcazou@adacore.com>
+
+	PR fortran/37319
+	* parse.c (match_deferred_characteristics): Make sure 'name' is
+	initialized before reading it.
+
+2008-11-24  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/37803
+	* arith.c (gfc_check_real_range): Add mpfr_check_range.
+	* simplify.c (gfc_simplify_nearest): Add mpfr_check_range.
+
+2008-11-24  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/38184
+	* simplify.c (is_constant_array_expr): Return true instead of false
+	if the array constructor is empty.
+
+2008-11-24  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37779
+	* resolve.c (resolve_procedure_expression): New method.
+	(resolve_variable): Call it.
+	(resolve_actual_arglist): Call gfc_resolve_expr for procedure arguments.
+
+2008-11-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34820
+	* trans-expr.c (gfc_conv_function_call): Remove all code to
+	deallocate intent out derived types with allocatable
+	components.
+	(gfc_trans_assignment_1): An assignment from a scalar to an
+	array of derived types with allocatable components, requires
+	a deep copy to each array element and deallocation of the
+	converted rhs expression afterwards.
+	* trans-array.c : Minor whitespace.
+	* trans-decl.c (init_intent_out_dt): Add code to deallocate
+	allocatable components of derived types with intent out.
+	(generate_local_decl): If these types are unused, set them
+	referenced anyway but allow the uninitialized warning.
+
+	PR fortran/34143
+	* trans-expr.c (gfc_trans_subcomponent_assign): If a conversion
+	expression has a null data pointer argument, nullify the
+	allocatable component.
+
+	PR fortran/32795
+	* trans-expr.c (gfc_trans_subcomponent_assign): Only nullify
+	the data pointer if the source is not a variable.
+
+2008-11-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37735
+	* trans-array.c (structure_alloc_comps): Do not duplicate the
+	descriptor if this is a descriptorless array!
+
+2008-11-12  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/38160
+	* trans-types.c (gfc_validate_c_kind): Remove function.
+	* decl.c (gfc_match_kind_spec): Add C kind parameter check.
+	(verify_bind_c_derived_type): Remove gfc_validate_c_kind call.
+	(verify_c_interop_param): Update call.
+	* gfortran.h (verify_bind_c_derived_type): Update prototype.
+	(gfc_validate_c_kind): Remove.
+	* symbol.c (verify_bind_c_derived_type): Update verify_c_interop call.
+	* resolve.c (gfc_iso_c_func_interface): Ditto.
+
+2008-11-22  Jakub Jelinek  <jakub@redhat.com>
+
+	PR libfortran/37839
+	* trans-io.c (gfc_build_io_library_fndecls): Decrease pad size back
+	to 16 pointers plus 32 integers.  Don't use max integer kind
+	alignment, only gfc_intio_kind's alignment.
+	(gfc_trans_inquire): Only set flags2 if mask2 is non-zero.
+	* ioparm.def: Fix order, bitmasks and types of inquire round, sign
+	and pending fields.  Move u in dt before id.
+	* io.c (gfc_free_inquire): Free decimal and size exprs.
+	(match_inquire_element): Match size instead of matching blank twice.
+	(gfc_resolve_inquire): Resolve size.
+
+2008-11-20  Jakub Jelinek  <jakub@redhat.com>
+
+	PR middle-end/29215
+	* trans-array.c (trans_array_constructor_value,
+	gfc_build_constant_array_constructor): Fill in TREE_PURPOSE.
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Use
+	gfc_index_one_node.
+	(gfc_conv_intrinsic_size): Use gfc_index_{zero,one}_node.
+
+	PR fortran/38181
+	* trans-intrinsic.c (gfc_conv_intrinsic_size): Inline 2 argument
+	size if the second argument is not optional and one argument size
+	for rank 1 arrays.
+
+2008-11-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38171
+	* module.c (load_equiv): Regression fix; check that equivalence
+	members come from the same module only.
+
+2008-11-16  Mikael Morin <mikael.morin@tele2.fr>
+
+	PR fortran/35681
+	* dependency.c (gfc_check_argument_var_dependency): Add
+	elemental check flag. Issue a warning if we find a dependency
+	but don't generate a temporary. Add the case of an elemental
+	function call as actual argument to an elemental procedure.
+	Add the case of an operator expression as actual argument
+	to an elemental procedure.
+	(gfc_check_argument_dependency): Add elemental check flag.
+	Update calls to gfc_check_argument_var_dependency.
+	(gfc_check_fncall_dependency): Add elemental check flag.
+	Update call to gfc_check_argument_dependency.
+	* trans-stmt.c (gfc_trans_call): Make call to
+	gfc_conv_elemental_dependencies unconditional, but with a flag
+	whether we should check dependencies between variables.
+	(gfc_conv_elemental_dependencies): Add elemental check flag.
+	Update call to gfc_check_fncall_dependency.
+	* trans-expr.c (gfc_trans_arrayfunc_assign): Update call to
+	gfc_check_fncall_dependency.
+	* resolve.c (find_noncopying_intrinsics): Update call to
+	gfc_check_fncall_dependency.
+	* dependency.h (enum gfc_dep_check): New enum.
+	(gfc_check_fncall_dependency): Update prototype.
+
+2008-11-16  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/37992
+	* gfortran.h (gfc_namespace): Added member old_cl_list, 
+	backup of cl_list.
+	(gfc_free_charlen): Added prototype.
+	* symbol.c (gfc_free_charlen): New function.
+	(gfc_free_namespace): Use gfc_free_charlen.
+	* parse.c (next_statement): Backup gfc_current_ns->cl_list.
+	(reject_statement): Restore gfc_current_ns->cl_list.
+	Free cl_list's elements before dropping them.
+
+2008-11-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/38095
+	* trans-expr.c (gfc_map_intrinsic_function): Fix pointer access.
+
+2008-11-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38119
+	* trans-array.c (gfc_trans_create_temp_array): Set the
+	loop->from to zero and the renormalisation of loop->to for all
+	dimensions.
+
+2008-11-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37926
+	* trans-expr.c (gfc_free_interface_mapping): Null sym->formal
+	(gfc_add_interface_mapping): Copy the pointer to the formal
+	arglist, rather than using copy_formal_args - fixes regression.
+
+2008-11-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37926
+	* trans-expr.c (gfc_add_interface_mapping): Transfer the formal
+	arglist and the always_explicit attribute if the dummy arg is a
+	procedure.
+
+2008-11-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/37988
+	* io.c (enum format_token): For readability replace FMT_POS with FMT_T,
+	FMT_TL, and FMT_TR.  (format_lex): Use new enumerators. (check_format):
+	Add check for missing positive integer.
+
+2008-10-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38033
+	* trans-array.c (gfc_trans_create_temp_array): Stabilize the
+	'to' expression.
+	(gfc_conv_loop_setup): Use the end expression for the loop 'to'
+	if it is available.
+
+2008-11-12  Jakub Jelinek  <jakub@redhat.com>
+
+	PR target/35366
+	PR fortran/33759
+	* trans-const.c (gfc_conv_constant_to_tree): Warn when
+	converting an integer outside of LOGICAL's range to
+	LOGICAL.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function,
+	gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_transfer):
+	Use INTEGER_TYPE instead of BOOLEAN_TYPE for TRANSFER as
+	argument of another TRANSFER.
+
+2008-11-12  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/38065
+	* resolve.c (resolve_fntype): Fix private derived type checking.
+
+2008-11-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37836
+	* intrinsic.c (add_functions): Reference gfc_simplify._minval
+	and gfc_simplify_maxval.
+	* intrinsic.h : Add prototypes for gfc_simplify._minval and
+	gfc_simplify_maxval.
+	* simplify.c (min_max_choose): New function extracted from
+	simplify_min_max.
+	(simplify_min_max): Call it.
+	(simplify_minval_maxval, gfc_simplify_minval,
+	gfc_simplify_maxval): New functions.
+
+2008-11-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37597
+	* parse.c (gfc_fixup_sibling_symbols ): Fixup contained, even
+	when symbol not found.
+
+2008-11-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/37821
+	* cpp.c (gfc_cpp_add_include_path): Use BRACKET.
+	* scanner.c (add_path_to_list): Argument to add at head.
+	(gfc_add_include_path): Add new argument.
+	(gfc_add_intrinsic_modules_path) Update call.
+	(load_file): Print filename/line in the error message.
+	* gfortran.h (gfc_add_include_path): Update prototype.
+	* options.c (gfc_post_options,gfc_handle_module_path_options,
+	gfc_handle_option): Update call.
+	* lang-spec.h (F951_OPTIONS): Don't insert include path twice.
+
+	* arith.c (arith_error): Add -fno-range-error to the message.
+
+2008-11-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37445
+	* resolve.c (resolve_actual_arglist ): Correct comparison of
+	FL_VARIABLE with e->expr_type.
+	(resolve_call): Check that host association is correct.
+	(resolve_actual_arglist ): Remove return is old_sym is use
+	associated.  Only reparse expression if old and new symbols
+	have different types.
+
+	PR fortran/PR35769
+	* resolve.c (gfc_resolve_assign_in_forall): Change error to a
+	warning.
+
+2008-11-01  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36426
+	* expr.c (replace_symbol): Replace all symbols which lie in the
+	formal namespace of the interface and copy their attributes.
+	* resolve.c (resolve_symbol): Add charlen to namespace.
+
+2008-11-01  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/19925
+	* trans-array.c (gfc_trans_array_constructor_value): Fix comment.
+	(gfc_conv_array_initializer): Convert internal_error() to gfc_error_now.
+	* array.c: Remove GFC_MAX_AC_EXPAND macro.
+	(gfc_expand_constructor): Use gfc_option.flag_max_array_constructor.
+	* gfortran.h (gfc_option): Add flag_max_array_constructor member.
+	* lang.opt: Add -fmax-array-constructor option.
+	* expr.c (gfc_match_init_expr): Fix error message to mention new option.
+	* invoke.texi: Document new option.
+	* options.c (gfc_init_options): Set default value for new option.
+	(gfc_handle_option): Deal with commandline.
+
+2008-11-01  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/35681
+	* gfortran.h (struct gfc_code): New field `resolved_isym'.
+	* trans.h (gfc_build_memcpy_call): Made public.
+	* trans-array.h (gfc_trans_create_temp_array): New argument `initial'.
+	* intrinsic.c (gfc_intrinsic_sub_interface): Set resolved_isym.
+	* iresolve.c (create_formal_for_intents): New helper method.
+	(gfc_resolve_mvbits): Put dummy formal arglist on resolved_sym.
+	* resolve.c (resolve_call): Initialize resolved_isym to NULL.
+	* trans-array.c (gfc_trans_allocate_array_storage): New argument
+	`initial' to allow initializing the allocated storage to some initial
+	value copied from another array.
+	(gfc_trans_create_temp_array): Allow initialization of the temporary
+	with a copy of some other array by using the new extension.
+	(gfc_trans_array_constructor): Pass NULL_TREE for initial argument.
+	(gfc_conv_loop_setup): Ditto.
+	* trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Ditto.
+	* trans-expr.c (gfc_conv_function_call): Ditto.
+	(gfc_build_memcpy_call): Made public.
+	* trans-stmt.c (gfc_conv_elemental_dependencies): Initialize created
+	temporary for INTENT(INOUT) arguments to the value of the mirrored
+	array and clean up the temporary as very last intructions in the created
+	block.
+	* trans.c (gfc_trans_code): For EXEC_CALL, see if we have a MVBITS call
+	and enable elemental dependency checking if we have.
+
+2008-11-01  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36322
+	PR fortran/36463
+	* gfortran.h: New function gfc_expr_replace_symbols.
+	* decl.c (match_procedure_decl): Increase reference count for interface.
+	* expr.c: New functions replace_symbol and gfc_expr_replace_symbols.
+	* resolve.c (resolve_symbol): Correctly copy array spec and char len
+	of PROCEDURE declarations from their interface.
+	* symbol.c (gfc_get_default_type): Enhanced error message.
+	(copy_formal_args): Call copy_formal_args recursively for arguments.
+	* trans-expr.c (gfc_conv_function_call): Bugfix.
+
+2008-11-01  Dennis Wassel  <dennis.wassel@gmail.com>
+
+	PR fortran/37159
+	* fortran/check.c (gfc_check_random_seed): Check PUT size
+	at compile time.
+
+2008-10-31  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/35840
+	* expr.c (gfc_reduce_init_expr): New function, containing checking code
+	from gfc_match_init_expr, so that checking can be deferred. 
+	(gfc_match_init_expr): Use gfc_reduce_init_expr.
+	* io.c (check_io_constraints): Use gfc_reduce_init_expr instead of 
+	checking that the expression is a constant. 
+	* match.h (gfc_reduce_init_expr): Prototype added. 
+
+2008-10-31  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/35820
+	* resolve.c (gfc_count_forall_iterators): New function.
+	(gfc_resolve_forall): Use gfc_count_forall_iterators to evaluate 
+	the needed memory amount to allocate. Don't forget to free allocated 
+	memory.  Add an assertion to check for memory leaks. 
+
+2008-10-30  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/37930
+	* fortran/arith.c (gfc_mpfr_to_mpz):  Test for NaN and Inf values.
+	Remove stale comment and kludge code for MPFR 2.0.1 and older.
+	(gfc_real2int): Error on conversion of NaN or Inf.
+	(gfc_complex2int): Ditto.
+	* fortran/arith.h: Update mpfr_to_mpz prototype.
+	* fortran/simplify.c (gfc_simplify_ceiling, gfc_simplify_floor,
+	gfc_simplify_ifix, gfc_simplify_idint, simplify_nint): Update function
+	calls to include locus.
+
+2008-10-30  Mikael Morin  <mikael.morin@tele2.fr>
+
+        PR fortran/37903
+        * trans-array.c (gfc_trans_create_temp_array): If n is less
+	than the temporary dimension, assert that loop->from is
+	zero (reverts to earlier versions). If there is at least one
+	null loop->to[n], it is a callee allocated array so set the
+	size to NULL and break.
+	(gfc_trans_constant_array_constructor): Set the offset to zero.
+	(gfc_trans_array_constructor): Remove loop shifting around the
+	temporary creation.
+	(gfc_conv_loop_setup): Prefer zero-based descriptors if
+	possible.  Calculate the translation from loop variables to
+	array indices if an array constructor.
+
+2008-10-30  Mikael Morin  <mikael.morin@tele2.fr>
+
+        PR fortran/37749
+        * trans-array.c (gfc_trans_create_temp_array): If size is NULL
+	use the array bounds for loop->to.
+
+2008-10-28  Tobias Burnus  <burnus@net-b.de>
+
+	* intrinsic.texi: Update OpenMP section for OMPv3.
+
+2008-10-24  Jakub Jelinek  <jakub@redhat.com>
+
+	* Make-lang.in (check-f95-subtargets, check-fortran-subtargets): New
+	aliases for check-gfortran-subtargets.
+	(lang_checks_parallelized): Add check-gfortran.
+	(check_gfortran_parallelize): New variable.
+
+2008-10-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37723
+	* dependency.c (gfc_dep_resolver ): If we find equal array
+	element references, go on to the next reference.
+
+2008-10-16  Daniel Kraft  <d@domob.eu>
+
+	* resolve.c (resolve_elemental_actual): Handle calls to intrinsic
+	subroutines correctly.
+
+2008-10-13  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* simplify.c: Remove MPFR_VERSION_NUM(2,3,0) conditionals.
+
+2008-10-12  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37688
+	* expr.c (gfc_expr_check_typed): Extend permission of untyped
+	expressions to both top-level variable and basic arithmetic expressions.
+
+2008-10-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37787
+	* dependency.c (gfc_are_equivalenced_arrays): Look in symbol
+	namespace rather than current namespace, if it is available.
+
+2008-10-12  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/37792
+	* fortran/resolve.c (resolve_fl_variable): Simplify the
+	initializer if there is one.
+
+2008-10-11  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37794
+	* module.c (check_for_ambiguous): Remove redundant code.
+
+2008-10-09  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/35723
+	* gfortran.h (gfc_suppress_error): Removed from header.
+	(gfc_push_suppress_errors), (gfc_pop_suppress_errors): New methods.
+	* array.c (gfc_array_size): Use new gfc_push/pop_suppress_errors
+	instead of directly changing gfc_suppress_error.
+	* intrinsic.c (gfc_intrinsic_func_interface): Ditto.
+	(gfc_intrinsic_sub_interface): Ditto.
+	* error.c (suppress_errors): Made static from `gfc_suppress_error'.
+	(gfc_push_suppress_errors), (gfc_pop_suppress_errors): New methods.
+	(gfc_notify_std), (gfc_error): Use new static name of global.
+	* expr.c (check_arglist), (check_references): New methods.
+	(check_restricted): Check arglists and references of EXPR_FUNCTIONs
+	and EXPR_VARAIBALEs, respectively.  Allow PARAMETER symbols.
+
+2008-10-07  Jakub Jelinek  <jakub@redhat.com>
+
+	* f95-lang.c (poplevel): Don't clear BLOCK_VARS if functionbody.
+	* trans-decl.c (gfc_build_qualified_array): Build accurate debug type
+	even if nest.
+	(build_entry_thunks, gfc_generate_function_code,
+	gfc_generate_constructors): Ensure DECL_SAVED_TREE is a BIND_EXPR
+	with DECL_INITIAL as its BLOCK.
+
+2008-10-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35680
+	* gfortran.h : Add 'error' bit field to gfc_expr structure.
+	* expr.c (check_inquiry): When checking a restricted expression
+	check that arguments are either variables or restricted.
+	(check_restricted): Do not emit error if the expression has
+	'error' set.  Clean up detection of host-associated variable.
+
+2008-10-05  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37638
+	* gfortran.h (struct gfc_typebound_proc): New flag `error'.
+	* resolve.c (update_arglist_pass): Added assertion.
+	(update_compcall_arglist): Fail early for erraneous procedures to avoid
+	confusion later.
+	(resolve_typebound_generic_call): Ignore erraneous specific targets
+	and added assertions.
+	(resolve_typebound_procedure): Set new `error' flag.
+
+2008-10-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37706
+	* module.c (load_equiv): Check the module before negating the
+	unused flag.
+
+2008-10-02  Steven Bosscher  <steven@gcc.gnu.org>
+
+	PR fortran/37635
+	* intrinsic.c (add_functions): Add LEADZ and TRAILZ as generics.
+	* intrinsic.h (gfc_simplify_leadz, gfc_simplify_trailz): New protos.
+	* gfortran.h <enum gfc_isym_id>: (GFC_ISYM_LEADZ, GFC_ISYM_TRAILZ): New.
+	* f95-lang (gfc_init_builtin_functions): Add BUILT_IN_CLZ,
+	BUILT_IN_CLZL, BUILT_IN_CLZLL, BUILT_IN_CTZ, BUILT_IN_CTZL, and
+	BUILT_IN_CTZLL.
+	* trans-intrinsic.c (gfc_conv_intrinsic_leadz,
+	gfc_conv_intrinsic_trails): New code-generation functions for LEADZ
+	and TRAILZ intrinsics.
+	(gfc_conv_intrinsic_function): Use them
+	* intrinsic.texi: Add documentation for LEADZ and TRAILZ.
+	* simplify.c (gfc_simplify_leadz, gfc_simplify_trailz): New functions.
+
+2008-09-30  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36592
+	* symbol.c (check_conflict): If a symbol in a COMMON block is a
+	procedure, it must be a procedure pointer.
+	(gfc_add_in_common): Symbols in COMMON blocks may be variables or
+	procedure pointers.
+	* trans-types.c (gfc_sym_type): Make procedure pointers in COMMON
+	blocks work.
+
+2008-09-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org
+
+	PR fortran/37498
+	* trans-io.c (build_dt): Revert previous patch..
+	* ioparm.def: Delete IOPARM_dt_f2003.
+
+2008-09-25  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/37504
+	* expr.c (gfc_check_pointer_assign): Allow assignment of
+	protected pointers.
+	* match.c (gfc_match_assignment,gfc_match_pointer_assignment):
+	Remove unreachable code.
+
+2008-09-24  Tobias Burnus  <burnus@net-b.de>
+
+	* options.c (set_default_std_flags,gfc_init_options):
+	Add comment: keep in sync with libgfortran.
+
+2008-09-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/37626
+	* trans-array.c (gfc_trans_deferred_array): Don't auto-deallocate
+	result variables.
+
+2008-09-23  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37588
+	* gfortran.h (gfc_compare_actual_formal): Removed, made private.
+	(gfc_arglist_matches_symbol): New method.
+	* interface.c (compare_actual_formal): Made static.
+	(gfc_procedure_use): Use new name of compare_actual_formal.
+	(gfc_arglist_matches_symbol): New method.
+	(gfc_search_interface): Moved code partially to new
+	gfc_arglist_matches_symbol.
+	* resolve.c (resolve_typebound_generic_call): Resolve actual arglist
+	before checking against formal and use new gfc_arglist_matches_symbol
+	for checking.
+	(resolve_compcall): Set type-spec of generated expression.
+
+2008-09-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/37580
+	* expr.c (gfc_check_pointer_assign): Add checks for pointer
+	remapping.
+
+2008-09-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org
+
+	PR fortran/37498
+	* trans-io.c (gfc_build_io_library_fndecls): Bump pad size.
+	(build_dt): Set mask bit for IOPARM_dt_f2003.
+	* ioparm.def: Add IOPARM_dt_f2003.
+
+2008-09-22  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/37486
+	* gfortran.h (gfc_option_t): New members flag_align_commons and
+	warn_align_commons. 
+	* lang.opt: New options falign-commons and Walign-commons.
+	* invoke.texi: Documentation for new options.
+	* options.c (gfc_init_options): Initialize new options.
+	(gfc_handle_options): Handle new options.
+	* trans-common.c (translate_common): Implement new options.
+	(gfc_trans_common): Set correct locus.
+
+2008-09-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37583
+	* decl.c (scalarize_intrinsic_call): Both subroutines and
+	functions can give a true for get_proc_mame's last argument so
+	remove the &&gfc_current_ns->proc_name->attr.function.
+	resolve.c (resolve_actual_arglist): Add check for recursion by
+	reference to procedure as actual argument.
+
+2008-09-21  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/35846
+	* trans.h (gfc_conv_string_length): New argument `expr'.
+	* trans-expr.c (flatten_array_ctors_without_strlen): New method.
+	(gfc_conv_string_length): New argument `expr' that is used in a new
+	special case handling if cl->length is NULL.
+	(gfc_conv_subref_array_arg): Pass expr to gfc_conv_string_length.
+	* trans-array.c (gfc_conv_expr_descriptor): Ditto.
+	(gfc_trans_auto_array_allocation): Pass NULL as new expr.
+	(gfc_trans_g77_array), (gfc_trans_dummy_array_bias): Ditto.
+	(gfc_trans_deferred_array): Ditto.
+	(gfc_trans_array_constructor): Save and restore old values of globals
+	used for bounds checking.
+	* trans-decl.c (gfc_trans_dummy_character): Ditto.
+	(gfc_trans_auto_character_variable): Ditto.
+
+2008-09-21  Daniel Kraft  <d@domob.eu>
+
+	* decl.c (match_procedure_in_type): Changed misleading error message
+	for not yet implemented PROCEDURE(interface) syntax.
+
+2008-09-18  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/35945
+       * resolve.c (resolve_fl_variable_derived):  Remove derived type
+       comparison for use associated derived types.  Host association
+       of a derived type will not arise if there is a local derived type
+       whose use name is the same.
+
+       PR fortran/36700
+       * match.c (gfc_match_call):  Use the existing symbol even if
+       it is a function.
+
+2008-09-18  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37507
+	* trans.h (gfc_trans_runtime_error): New method.
+	(gfc_trans_runtime_error_vararg): New method.
+	(gfc_allocate_array_with_status): New argument `expr' for locus/varname.
+	(gfc_deallocate_array_with_status): Ditto.
+	* trans-array.h (gfc_array_deallocate): Ditto.
+	* trans.c (gfc_trans_runtime_error): New method.
+	(gfc_trans_runtime_error_vararg): New method, moved parts of the code
+	from gfc_trans_runtime_check here.
+	(gfc_trans_runtime_error_check): Moved code partly to new method.
+	(gfc_call_malloc): Fix tab-indentation.
+	(gfc_allocate_array_with_status): New argument `expr' and call
+	gfc_trans_runtime_error for error reporting to include locus.
+	(gfc_deallocate_with_status): Ditto.
+	* trans-stmt.c (gfc_trans_deallocate): Pass expr as new argument.
+	* trans-array.c (gfc_array_allocate): Ditto.
+	(gfc_array_deallocate): New argument `expr', passed on.
+	(gfc_trans_dealloc_allocated): Pass NULL for expr.
+	* trans-openmp.c (gfc_omp_clause_default): Ditto.
+
+2008-09-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37274
+	PR fortran/36374
+	* module.c (check_for_ambiguous): New function to test loaded
+	symbol for ambiguity with fixup symbol.
+	(read_module): Call check_for_ambiguous.
+	(write_symtree): Do not write the symtree for symbols coming
+	from an interface body.
+
+	PR fortran/36374
+	* resolve.c (count_specific_procs ): New function to count the
+	number of specific procedures with the same name as the generic
+	and emit appropriate errors for and actual argument reference.
+	(resolve_assumed_size_actual): Add new argument no_formal_args.
+	Correct logic around passing generic procedures as arguments.
+	Call count_specific_procs from two locations.
+	(resolve_function): Evaluate and pass no_formal_args.
+	(resolve call): The same and clean up a bit by using csym more
+	widely.
+
+	PR fortran/36454
+	* symbol.c (gfc_add_access): Access can be updated if use
+	associated and not private.
+
+2008-09-17  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/37536
+	* trans-stmt.c (gfc_trans_do): Optimize integer type non-simple
+	do loop initialization.
+
+2008-09-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+	    Tobias Burnus  <burnus@net.b.de>
+
+	PR fortran/35840
+	* io.c (match_vtag): Add tag name to error message.
+	(match_out_tag): Cleanup whitespace.
+	(gfc_resolve_dt): Resolve id and async tags. 
+
+2008-09-13  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/35770
+	* primary.c (gfc_match_varspec): Added missing type-spec clearing
+	after wrong implicit character typing.
+
+2008-09-12  Richard Guenther  <rguenther@suse.de>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Use
+	build_fold_addr_expr to properly mark the argument
+	addressable.
+
+2008-09-11  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/36214
+	* simplify.c (simplify_cmplx): Added linebreak to long line.
+	* target-memory.c (gfc_convert_boz): Fix indentation.
+	(gfc_interpret_float): Set mpfr precision to right value before
+	calling mpfr_init.
+
+2008-09-10  H.J. Lu  <hongjiu.lu@intel.com>
+
+	* expr.c (find_array_element): Reformat comment.
+
+2008-09-10  H.J. Lu  <hongjiu.lu@intel.com>
+
+	* expr.c (find_array_element): Reformat.
+
+2008-09-10  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/37420
+	* trans-decl.c (get_proc_pointer_decl): Fix -Wunused-variable.
+
+2008-09-09  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37429
+	* resolve.c (expression_rank): Added assertion to guard against
+	EXPR_COMPCALL expressions.
+	(resolve_compcall): Set expression's rank from the target procedure's.
+
+2008-09-09  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37411
+	* trans-array.c (gfc_conv_array_parameter): Added assertion that the
+	symbol has an array spec.
+
+2008-09-08  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37199
+	* trans-expr.c (gfc_add_interface_mapping): Set new_sym->as.
+	(gfc_map_intrinsic_function): Added checks against NULL bounds in
+	array specs.
+
+2008-09-08  Tobias Burnus  <burnus@net.b.de>
+
+	PR fortran/37400
+	* symbol.c (gfc_set_default_type): Copy char len.
+
+2008-09-06  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/36153
+	* fortran/resolve.c (resolve_function): Shortcircuit for SIZE and
+	UBOUND if 2nd argument is KIND.
+
+2008-09-06  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/33229
+	* resolve.c (resolve_function): An intrinsic subroutine should not be
+	called as a function.
+
+2008-09-05  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/35837
+	* resolve.c (resolve_types): Restore gfc_current_ns on exit.
+	* symbol.c (gfc_save_all): Removed blank line.
+
+2008-09-05  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/36746
+	* primary.c (gfc_match_rvalue): Removed logic to handle implicit
+	typing to a derived-type if a component reference is found.
+	(gfc_match_varspec): Moved it here.
+
+2008-09-04  Richard Guenther  <rguenther@suse.de>
+
+	* trans-array.c (gfc_conv_array_parameter): Use correct types
+	in building COND_EXPRs.
+	* trans-expr.c (gfc_conv_missing_dummy): Likewise.
+	* trans-intrinsics.c (gfc_conv_intrinsic_merge): Likewise.
+
+2008-09-04  Daniel Kraft  <d@domob.eu>
+
+	* PR fortran/37099
+	* expr.c (simplify_const_ref): Update expression's character length
+	when pulling out a substring reference.
+
+2008-09-04  Ian Lance Taylor  <iant@google.com>
+
+	* symbol.c (generate_isocbinding_symbol): Compare
+	gfc_notification_std with ERROR rather than FAILURE.
+	* resolve.c (check_assumed_size_reference): Compare array type
+	with AR_FULL rather than DIMEN_ELEMENT.
+	(resolve_actual_arglist): Compare with EXPR_VARIABLE rather than
+	FL_VARIABLE.
+
+2008-09-01  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/37228
+	* io.c (check_format): Allow specifying precision with g0 format.
+
+2008-09-02  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.h (struct gfc_namespace): New member `implicit_loc'.
+	(gfc_add_abstract): New method.
+	* decl.c (gfc_get_type_attr_spec): Match ABSTRACT attribute.
+	(gfc_match_derived_decl): Copy abstract attribute in derived symbol.
+	* dump-parse-tree.c (show_attr): Show ABSTRACT attribute as `ABSTRACT'
+	only to allow for ABSTRACT types.
+	* parse.c (parse_interface): Use new gfc_add_abstract.
+	* primary.c (gfc_match_structure_constructor): Check that no ABSTRACT
+	type is constructed.
+	* resolve.c (resolve_typespec_used): New method.
+	(resolve_fl_derived): Check type in respect to ABSTRACT attribute and
+	check that no component is of an ABSTRACT type.
+	(resolve_symbol): Check that no symbol is of an ABSTRACT type.
+	(resolve_types): Check IMPLICIT declarations for ABSTRACT types.
+	* symbol.c (gfc_merge_new_implicit): Remember loci of IMPLICIT's.
+	(gfc_add_abstract): New method.
+
+2008-09-01  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37193
+	* module.c (read_module): Initialize use_only flag on used symbols.
+
+2008-09-01  Daniel Kraft  <d@domob.eu>
+
+	* gfc-internals.texi (F2003 OOP), (Type-bound Procedures): New chapter
+	and section to document the internals of type-bound procedures.
+	(gfc_expr): Document EXPR_COMPCALL.
+	* gfortran.h (struct gfc_expr): Remove unused `derived' from compcall.
+	* dump-parse-tree.c (show_compcall): New method.
+	(show_expr): Call it for EXPR_COMPCALL.
+	(show_typebound), (show_f2k_derived): New methods.
+	(show_symbol): Call show_f2k_derived.
+	(show_code_node): Handle EXEC_COMPCALL.
+	* primary.c (gfc_match_varspec): Don't initialize removed `derived' in
+	primary->value.compcall.
+
+2008-08-31  Richard Guenther  <rguenther@suse.de>
+
+	* trans-expr.c (gfc_trans_string_copy): Use the correct types
+	to compute slen and dlen.
+
+2008-08-31  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.h (enum gfc_statement): New entry `ST_GENERIC'.
+	(struct gfc_tbp_generic): New type.
+	(struct gfc_typebound_proc): Removed `target' and added union with
+	`specific' and `generic' members; new members `overridden',
+	`subroutine', `function' and `is_generic'.
+	(struct gfc_expr): New members `derived' and `name' in compcall union
+	member and changed type of `tbp' to gfc_typebound_proc.
+	(gfc_compare_interfaces), (gfc_compare_actual_formal): Made public.
+	* match.h (gfc_typebound_default_access): New global.
+	(gfc_match_generic): New method.
+	* decl.c (gfc_match_generic): New method.
+	(match_binding_attributes): New argument `generic' and handle it.
+	(match_procedure_in_type): Mark matched binding as non-generic.
+	* interface.c (gfc_compare_interfaces): Made public.
+	(gfc_compare_actual_formal): Ditto.
+	(check_interface_1), (compare_parameter): Use new public names.
+	(gfc_procedure_use), (gfc_search_interface): Ditto.
+	* match.c (match_typebound_call): Set base-symbol referenced.
+	* module.c (binding_generic): New global array.
+	(current_f2k_derived): New global.
+	(mio_typebound_proc): Handle IO of GENERIC bindings.
+	(mio_f2k_derived): Record current f2k-namespace in current_f2k_derived.
+	* parse.c (decode_statement): Handle GENERIC statement.
+	(gfc_ascii_statement): Ditto.
+	(typebound_default_access), (set_typebound_default_access): Removed.
+	(gfc_typebound_default_access): New global.
+	(parse_derived_contains): New default-access implementation and handle
+	GENERIC statements encountered.
+	* primary.c (gfc_match_varspec): Adapted to new gfc_typebound_proc
+	structure and removed check for SUBROUTINE/FUNCTION from here.
+	* resolve.c (extract_compcall_passed_object): New method.
+	(update_compcall_arglist): Use it.
+	(resolve_typebound_static): Adapted to new gfc_typebound_proc structure.
+	(resolve_typebound_generic_call): New method.
+	(resolve_typebound_call): Check target is a SUBROUTINE and handle calls
+	to GENERIC bindings.
+	(resolve_compcall): Ditto (check for target being FUNCTION).
+	(check_typebound_override): Handle GENERIC bindings.
+	(check_generic_tbp_ambiguity), (resolve_typebound_generic): New methods.
+	(resolve_typebound_procedure): Handle GENERIC bindings and set new
+	attributes subroutine, function and overridden in gfc_typebound_proc.
+	(resolve_fl_derived): Ensure extended type is resolved before the
+	extending one is.
+	* st.c (gfc_free_statement): Fix bug with free'ing EXEC_COMPCALL's.
+	* symbol.c (gfc_find_typebound_proc): Adapt for GENERIC changes.
+
+2008-08-29  Jan Hubicka  <jh@suse.cz>
+	
+	* parse.c (parse_interface): Silence uninitialized var warning.
+
+2008-08-29  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans.h (struct lang_type): Add span.
+	(GFC_TYPE_ARRAY_SPAN): Define.
+	* trans-decl.c (gfc_get_symbol_decl): For subref array pointers,
+	copy TREE_STATIC from decl to span instead of setting it
+	unconditionally, set DECL_ARTIFICIAL, fix type of initializer
+	and set GFC_TYPE_ARRAY_SPAN on decl's type.
+	* trans-types.c (gfc_get_array_descr_info): If
+	GFC_TYPE_ARRAY_SPAN is non-NULL, use it as element size.
+
+	* trans-decl.c (check_constant_initializer,
+	gfc_emit_parameter_debug_info): New functions.
+	(gfc_generate_module_vars, gfc_generate_function_code): Emit
+	PARAMETERs and unreferenced variables with initializers into
+	debug info.
+
+	* gfortran.h (gfc_use_list): Add where field.
+	* module.c (use_locus): New static variable.
+	(gfc_match_use): Set it.
+	(gfc_use_module): Copy it to gfc_use_list's where field.
+	* trans-decl.c (gfc_generate_module_vars): Call gfc_trans_use_stmts.
+	(gfc_trans_use_stmts): Set backend locus before calling the debug
+	hook.  Allow non-VAR_DECLs to be created even for non-external
+	module.  Don't emit anything so far for renames from different
+	modules.
+
+	PR fortran/24790
+	* trans-decl.c (create_function_arglist): Set DECL_BY_REFERENCE on
+	PARM_DECLs with pointer or reference type.
+
+	* trans-decl.c (gfc_build_qualified_array): Build non-flat
+	array type for debug info purposes.
+
+	PR fortran/29635
+	PR fortran/23057
+	* f95-lang.c (gfc_init_ts): New function.
+	(LANG_HOOKS_INIT_TS): Define.
+	* gfortran.h (gfc_use_rename): New type, moved from module.c.
+	(gfc_get_use_rename): New macro, moved from module.c.
+	(gfc_use_list): New type.
+	(gfc_get_use_list): New macro.
+	(gfc_namespace): Add use_stmts field.
+	(gfc_free_use_stmts): New prototype.
+	* Make-lang.in (fortran/trans-decl.o): Depend on debug.h.
+	* module.c (gfc_use_rename, gfc_get_use_rename): Moved to
+	gfortran.h.
+	(gfc_use_module): Chain the USE statement info to
+	ns->use_stmts.
+	(gfc_free_use_stmts): New function.
+	* symbol.c (gfc_free_namespace): Call gfc_free_use_stmts.
+	* trans.h (struct module_htab_entry): New type.
+	(gfc_find_module, gfc_module_add_decl): New functions.
+	* trans.c (gfc_generate_module_code): Create NAMESPACE_DECL for
+	the module, adjust DECL_CONTEXTs of module procedures and
+	call gfc_module_add_decl for them.
+	* trans-common.c (build_common_decl): Set DECL_IGNORED_P
+	on the common variable.
+	(create_common): Set DECL_IGNORED_P for use associated vars.
+	* trans-decl.c: Include debug.h.
+	(gfc_get_symbol_decl): Set DECL_IGNORED_P on use_assoc vars from
+	modules.
+	(build_function_decl): Allow current_function_decl's context
+	to be a NAMESPACE_DECL.
+	(module_htab, cur_module): New variables.
+	(module_htab_do_hash, module_htab_eq, module_htab_decls_hash,
+	module_htab_decls_eq, gfc_find_module, gfc_module_add_decl): New
+	functions.
+	(gfc_create_module_variable): Adjust DECL_CONTEXTs of module
+	variables and types and call gfc_module_add_decl for them.
+	(gfc_generate_module_vars): Temporarily set cur_module.
+	(gfc_trans_use_stmts): New function.
+	(gfc_generate_function_code): Call it.
+	(gfc_generate_block_data): Set DECL_IGNORED_P on decl.
+	* trans-types.c (gfc_get_derived_type): Adjust DECL_CONTEXT
+	and TYPE_CONTEXT of module derived types.
+
+2008-08-28  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.h (enum expr_t): New value `EXPR_COMPCALL'.
+	(gfc_get_typebound_proc): New macro.
+	(struct gfc_expr): New union-member `compcall' for EXPR_COMPCALL.
+	(enum gfc_exec_op): New value `EXEC_COMPCALL'.
+	(gfc_find_typebound_proc): New argument.
+	(gfc_copy_ref), (gfc_match_varspec): Made public.
+	* decl.c (match_procedure_in_type): Use gfc_get_typebound_proc.
+	* expr.c (free_expr0), (gfc_copy_expr): Handle EXPR_COMPCALL.
+	(gfc_copy_ref): Made public and use new name.
+	(simplify_const_ref): Use new name of gfc_copy_ref.
+	(simplify_parameter_variable): Ditto.
+	(gfc_simplify_expr): gcc_unreachable for EXPR_COMPCALL.
+	* match.c (match_typebound_call): New method.
+	(gfc_match_call): Allow for CALL's to typebound procedures.
+	* module.c (binding_passing), (binding_overriding): New variables.
+	(expr_types): Add EXPR_COMPCALL.
+	(mio_expr): gcc_unreachable for EXPR_COMPCALL.
+	(mio_typebound_proc), (mio_typebound_symtree): New methods.
+	(mio_f2k_derived): Handle type-bound procedures.
+	* primary.c (gfc_match_varspec): Made public and parse trailing
+	references to type-bound procedures; new argument `sub_flag'.
+	(gfc_match_rvalue): New name and argument of gfc_match_varspec.
+	(match_variable): Ditto.
+	* resolve.c (update_arglist_pass): New method.
+	(update_compcall_arglist), (resolve_typebound_static): New methods.
+	(resolve_typebound_call), (resolve_compcall): New methods.
+	(gfc_resolve_expr): Handle EXPR_COMPCALL.
+	(resolve_code): Handle EXEC_COMPCALL.
+	(resolve_fl_derived): New argument to gfc_find_typebound_proc.
+	(resolve_typebound_procedure): Ditto and removed not-implemented error.
+	* st.c (gfc_free_statement): Handle EXEC_COMPCALL.
+	* symbol.c (gfc_find_typebound_proc): New argument `noaccess' and
+	implement access-checking.
+	* trans-expr.c (gfc_apply_interface_mapping_to_expr): gcc_unreachable
+	on EXPR_COMPCALL.
+	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Add missing break.
+	* trans-openmp.c (gfc_trans_omp_array_reduction): Add missing
+	intialization of ref->type.
+
+2008-08-28  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/37253
+	* module.c (ab_attribute,attr_bits,mio_symbol_attribute): Take care of
+	saving attr.procedure and attr.proc_ptr to the module file.
+
+2008-08-25  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.h (gfc_find_component): Add new arguments.
+	* parse.c (parse_derived_contains): Check if the derived-type containing
+	the CONTAINS section is SEQUENCE/BIND(C).
+	* resolve.c (resolve_typebound_procedure): Check for name collision with
+	components.
+	(resolve_fl_derived): Check for name collision with inherited
+	type-bound procedures.
+	* symbol.c (gfc_find_component): New arguments `noaccess' and `silent'.
+	(gfc_add_component): Adapt for new arguments.
+	* primary.c (match_varspec), (gfc_match_structure_constructor): Ditto.
+
+2008-08-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/37201
+	* decl.c (verify_bind_c_sym): Reject array/string returning
+	functions.
+
+2008-08-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/37201
+	* trans-expr.c (gfc_conv_function_call): Add string_length
+	for character-returning bind(C) functions.
+
+2008-08-24  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.h (gfc_typebound_proc):  New struct.
+	(gfc_symtree):  New member typebound.
+	(gfc_find_typebound_proc):  Prototype for new method.
+	(gfc_get_derived_super_type):  Prototype for new method.
+	* parse.h (gfc_compile_state):  New state COMP_DERIVED_CONTAINS.
+	* decl.c (gfc_match_procedure):  Handle PROCEDURE inside derived-type
+	CONTAINS section.
+	(gfc_match_end):  Handle new context COMP_DERIVED_CONTAINS.
+	(gfc_match_private):  Ditto.
+	(match_binding_attributes), (match_procedure_in_type):  New methods.
+	(gfc_match_final_decl):  Rewrote to make use of new
+	COMP_DERIVED_CONTAINS parser state.
+	* parse.c (typebound_default_access):  New global helper variable.
+	(set_typebound_default_access):  New callback method.
+	(parse_derived_contains):  New method.
+	(parse_derived):  Extracted handling of CONTAINS to new parser state
+	and parse_derived_contains.
+	* resolve.c (resolve_bindings_derived), (resolve_bindings_result):  New.
+	(check_typebound_override), (resolve_typebound_procedure):  New methods.
+	(resolve_typebound_procedures):  New method.
+	(resolve_fl_derived):  Call new resolving method for typebound procs.
+	* symbol.c (gfc_new_symtree):  Initialize new member typebound to NULL.
+	(gfc_find_typebound_proc):  New method.
+	(gfc_get_derived_super_type):  New method.
+
+2008-08-23  Janus Weil  <janus@gcc.gnu.org>
+
+	* gfortran.h (gfc_component): Add field "symbol_attribute attr", remove
+	fields "pointer", "allocatable", "dimension", "access".
+	Remove functions "gfc_set_component_attr" and "gfc_get_component_attr".
+	* interface.c (gfc_compare_derived_types): Ditto.
+	* trans-array.c (gfc_array_allocate,structure_alloc_comps): Ditto.
+	* trans-expr.c (gfc_conv_component_ref,gfc_trans_subcomponent_assign,
+	gfc_conv_structure): Ditto.
+	* symbol.c (gfc_find_component,free_components,gfc_set_component_attr,
+	gfc_get_component_attr,verify_bind_c_derived_type,
+	generate_isocbinding_symbol): Ditto.
+	* decl.c (build_struct): Ditto.
+	* dump-parse-tree.c (show_components): Ditto.
+	* trans-stmt.c (gfc_trans_deallocate): Ditto.
+	* expr.c (gfc_check_assign,gfc_check_pointer_assign,
+	gfc_default_initializer): Ditto.
+	* module.c (mio_component): Ditto.
+	* trans-types.c (copy_dt_decls_ifequal,gfc_get_derived_type): Ditto.
+	* resolve.c (has_default_initializer,resolve_structure_cons,
+	gfc_iso_c_func_interface,find_array_spec,resolve_ref,
+	resolve_deallocate_expr,resolve_allocate_expr,resolve_fl_derived,
+	resolve_equivalence_derived): Ditto.
+	* trans-io.c (transfer_expr): Ditto.
+	* parse.c (parse_derived): Ditto.
+	* dependency.c (gfc_check_dependency): Ditto.
+	* primary.c (gfc_variable_attr): Ditto.
+
+2008-08-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/37076
+	* arith.c (gfc_arith_concat): Fix concat of kind=4 strings.
+
+2008-08-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/37025
+	* target-memory.c (gfc_interpret_character): Support
+	kind=4 characters.
+
+2008-08-22  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/30239
+	* symbol.c (gfc_add_type): Warn on -Wsurprising if a function-result
+	type is re-declared but neither -pedantic nor -std=f* is given and so
+	this is no error.
+	* invoke.texi (-Wsurprising): Document this new behaviour.
+
+2008-08-22  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.h (in_prefix): Removed from this header.
+	* match.h (gfc_matching_prefix): Moved and renamed from `in_prefix'.
+	* decl.c (in_prefix): Removed from here.
+	(gfc_match_prefix): Use new name of `gfc_matching_prefix'.
+	* symbol.c (gfc_check_symbol_typed): Ditto.
+	* expr.c (check_typed_ns): New helper variable.
+	(expr_check_typed_help): New helper method.
+	(gfc_expr_check_typed): Rewrote to use gfc_traverse_expr to do the
+	work, fixing a minor problem.
+	* match.c (gfc_matching_prefix): New variable.
+
+2008-08-22  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/32095
+	PR fortran/34228
+	* gfortran.h (in_prefix): New global.
+	(gfc_check_symbol_typed), (gfc_check_expr_typed): New methods.
+	* array.c (match_array_element_spec): Check that bounds-expressions
+	don't have symbols not-yet-typed in them.
+	* decl.c (var_element): Check that variable used is already typed.
+	(char_len_param_value): Check that expression does not contain
+	not-yet-typed symbols.
+	(in_prefix): New global.
+	(gfc_match_prefix): Record using `in_prefix' if we're at the moment
+	parsing a prefix or not.
+	* expr.c (gfc_expr_check_typed): New method.
+	* parse.c (verify_st_order): New argument to disable error output.
+	(check_function_result_typed): New helper method.
+	(parse_spec): Check that the function-result declaration, if given in
+	a prefix, contains no not-yet-typed symbols when the IMPLICIT rules are
+	parsed.
+	* symbol.c (gfc_check_symbol_typed): Check that a symbol already has
+	a type associated to it, otherwise use the IMPLICIT rules or signal
+	an error.
+
+2008-08-21  Manuel Lopez-Ibanez  <manu@gcc.gnu.org>
+
+	* f95-lang.c: Update all calls to pedwarn.
+
+2008-08-18  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/37032
+	* gfortran.texi: Document decision on include file handling in
+	preprocessed files.
+
+2008-08-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/36825
+	* libgfortran.h: Reduce GFC_MAX_DIMENSIONS to 7.
+
+2008-08-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35863
+	* io.c (gfc_match_open): Enable UTF-8 in checks.
+	* simplify.c (gfc_simplify_selected_char_kind): Enable iso_10646.
+
+2008-08-14  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36705
+	* symbol.c (check_conflict): Move conflict checks for (procedure,save)
+	and (procedure,intent) to resolve_fl_procedure.
+	* resolve.c (resolve_fl_procedure): Ditto.
+
+2008-08-09  Manuel Lopez-Ibanez  <manu@gcc.gnu.org>
+
+	PR 36901
+	* f95-lang.c (gfc_mark_addressable): Use "pedwarn (0," instead of
+	'pedwarn0'.
+
+2008-08-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37011
+	* symbol.c (gfc_add_extension): New function.
+	* decl.c (gfc_get_type_attr_spec): Call it.
+	(gfc_match_derived_decl): Set symbol extension attribute from
+	attr.extension.
+	* gfortran.h : Add prototype for gfc_add_extension.
+
+2008-08-08  Manuel Lopez-Ibanez  <manu@gcc.gnu.org>
+
+	PR 28875
+	* options.c (set_Wall): Replace set_Wunused by warn_unused.
+
+2008-08-08  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.h (gfc_finalizer):  Replaced member `procedure' by two
+	new members `proc_sym' and `proc_tree' to store the symtree after
+	resolution.
+	(gfc_find_sym_in_symtree):  Made public.
+	* decl.c (gfc_match_final_decl):  Adapted for new member name.
+	* interface.c (gfc_find_sym_in_symtree):  Made public.
+	(gfc_extend_expr), (gfc_extend_assign):  Changed call accordingly.
+	* module.c (mio_finalizer), (mio_f2k_derived), (mio_full_f2k_derived):
+	New methods for module-file IO of f2k_derived.
+	(mio_symbol):  Do IO of f2k_derived namespace.
+	* resolve.c (gfc_resolve_finalizers):  Adapted for new member name and
+	finding the symtree for the symbol here.
+	* symbol.c (gfc_free_finalizer):  Adapted for new members.
+
+2008-07-30  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
+
+	* gfc-internals.texi: Update to GFDL 1.2.  Do not list GPL as
+	Invariant Section.
+	* gfortran.texi: Likewise.
+	* intrinsic.texi: Do not list GPL as Invariant Section.
+	* invoke.texi: Likewise.  Update copyright years.
+
+2008-07-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	* trans-expr.c (conv_parent_component_references): New function
+	to build missing parent references.
+	(gfc_conv_variable): Call it
+	* symbol.c (gfc_add_component): Check that component name in a
+	derived type extension does not appear in parent.
+	(gfc_find_component): For a derived type extension, check if
+	the component appears in the parent derived type by calling
+	self. Separate errors for private components and private types.
+	* decl.c (match_data_constant): Add extra arg to call to
+	gfc_match_structure_constructor.
+	(check_extended_derived_type): New function to check that a
+	parent derived type exists and that it is OK for exension.
+	(gfc_get_type_attr_spec): Add extra argument 'name' and return
+	it if extends is specified.
+	(gfc_match_derived_decl): Match derived type extension and
+	build a first component of the parent derived type if OK. Add
+	the f2k namespace if not present.
+	* gfortran.h : Add the extension attribute.
+	* module.c : Handle attribute 'extension'.
+	* match.h : Modify prototypes for gfc_get_type_attr_spec and
+	gfc_match_structure_constructor.
+	* primary.c (build_actual_constructor): New function extracted
+	from gfc_match_structure_constructor and modified to call self
+	iteratively to build derived type extensions, when f2k named
+	components are used.
+	(gfc_match_structure_constructor): Do not throw error for too
+	many components if a parent type is being handled. Use
+	gfc_find_component to generate errors for non-existent or
+	private components.  Iteratively call self for derived type
+	extensions so that parent constructor is built.  If extension
+	and components left over, throw error.
+	(gfc_match_rvalue): Add extra arg to call to
+	gfc_match_structure_constructor.
+
+	* trans-array.c (gfc_conv_resolve_dependencies): If lhs and rhs
+	are the same symbol, aliassing does not matter.
+
+2008-07-29  Jan Hubicka  <jh@suse.cz>
+
+	* options.c (gfc_post_options): Do not set flag_no_inline.
+
+2008-07-29  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/36403
+	* trans-intrinsic.c (conv_generic_with_optional_char_arg):  New method
+	to append a string-length even if the string argument is missing, e.g.
+	for EOSHIFT.
+	(gfc_conv_intrinsic_function):  Call the new method for EOSHIFT, PACK
+	and RESHAPE.
+
+2008-07-28  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* gfortran.h (try): Remove macro.  Replace try with gfc_try
+	throughout.
+	* array.c: Likewise.
+	* check.c: Likewise.
+	* cpp.c: Likewise.
+	* cpp.h: Likewise.
+	* data.c: Likewise.
+	* data.h: Likewise.
+	* decl.c: Likewise.
+	* error.c: Likewise.
+	* expr.c: Likewise.
+	* interface.c: Likewise.
+	* intrinsic.c: Likewise.
+	* intrinsic.h: Likewise.
+	* io.c: Likewise.
+	* match.h: Likewise.
+	* parse.c: Likewise.
+	* parse.h: Likewise.
+	* resolve.c: Likewise.
+	* scanner.c: Likewise.
+	* simplify.c: Likewise.
+	* symbol.c: Likewise.
+	* trans-openmp.c: Likewise.
+	* trans-types.c: Likewise.
+
+2008-07-28  Tobias Burnus  <burnus@net-b.de>
+
+	* Make-lang.in: Remove -Wno-* from fortran-warn.
+
+2008-07-28  Richard Guenther  <rguenther@suse.de>
+
+	Merge from gimple-tuples-branch.
+
+	2008-07-18  Aldy Hernandez  <aldyh@redhat.com>
+
+	* trans-expr.c: Include gimple.h instead of tree-gimple.h.
+	* trans-array.c: Same.
+	* trans-openmp.c: Same.
+	* trans-stmt.c: Same.
+	* f95-lang.c: Same.
+	* trans-io.c: Same.
+	* trans-decl.c: Same.
+	* trans-intrinsic.c: Same.
+	* trans.c: Same.  Include tree-iterator.h.
+	* Make-lang.in (trans.o): Depend on tree-iterator.h
+
+	2008-07-14  Aldy Hernandez  <aldyh@redhat.com>
+
+	* trans-array.h (gfc_conv_descriptor_data_set_internal):
+	Rename to gfc_conv_descriptor_data_set.
+	(gfc_conv_descriptor_data_set_tuples): Remove.
+	* trans-array.c (gfc_conv_descriptor_data_get): Rename
+	from gfc_conv_descriptor_data_set_internal.
+	Remove last argument to gfc_add_modify.
+	(gfc_trans_allocate_array_storage): Rename gfc_add_modify_expr to
+	gfc_add_modify.
+	(gfc_trans_create_temp_array): Same.
+	(gfc_conv_array_transpose): Same.
+	(gfc_grow_array): Same.
+	(gfc_put_offset_into_var): Same.
+	(gfc_trans_array_ctor_element): Same.
+	(gfc_trans_array_constructor_subarray): Same.
+	(gfc_trans_array_constructor_value): Same.
+	(gfc_trans_scalarized_loop_end): Same.
+	(gfc_array_init_size): Same.
+	(gfc_array_allocate): Same.
+	(gfc_trans_array_bounds): Same.
+	(gfc_trans_auto_array_allocation): Same.
+	(gfc_trans_g77_array): Same.
+	(gfc_trans_dummy_array_bias): Same.
+	(gfc_conv_expr_descriptor): Same.
+	(structure_alloc_comps): Same.
+	* trans-expr.c: Same.
+	* trans-openmp.c (gfc_omp_clause_default_ctor): Same.
+	Rename gfc_conv_descriptor_data_set_tuples to
+	gfc_conv_descriptor_data_set.
+	(gfc_omp_clause_copy_ctor): Change build_gimple_modify_stmt to
+	build2_v.
+	(gfc_omp_clause_assign_op): Same.
+	(gfc_trans_omp_array_reduction): Rename gfc_add_modify_expr to
+	gfc_add_modify.
+	(gfc_trans_omp_atomic): Same.
+	(gfc_trans_omp_do): Same.  Change GIMPLE_MODIFY_STMT to MODIFY_EXPR.
+	Rename gfc_add_modify_stmt to gfc_add_modify.
+	* trans-stmt.c: Rename gfc_add_modify_expr to
+	gfc_add_modify.
+	* trans.c: Rename gfc_add_modify_expr to
+	gfc_add_modify.
+	(gfc_add_modify): Remove last argument.
+	Rename GIMPLE_MODIFY_STMT to MODIFY_EXPR.
+	* trans.h: Remove gfc_add_modify_expr, gfc_add_modify_stmt.
+	Add prototype for gfc_add_modify.
+	* f95-lang.c (union lang_tree_node): Rename GENERIC_NEXT to TREE_CHAIN.
+	* trans-decl.c: Rename gfc_add_modify_stmt to gfc_add_modify.
+	* trans-io.c: Same.
+	* trans-intrinsic.c: Same.
+
+	2008-02-25  Aldy Hernandez  <aldyh@redhat.com>
+
+	* Make-lang.in (fortran-warn): Add -Wno-format.
+
+	2008-02-19  Diego Novillo  <dnovillo@google.com>
+
+	http://gcc.gnu.org/ml/gcc-patches/2008-02/msg00804.html
+
+	* fortran/Make-lang.in (fortran-warn): Remove.
+
+	2007-11-22  Aldy Hernandez  <aldyh@redhat.com>
+
+	* trans-expr.c (gfc_trans_string_copy): Use "void *" when building a
+	memset.
+
+	2007-11-10  Aldy Hernandez  <aldyh@redhat.com>
+
+	* Make-lang.in (fortran-warn): Set to -Wno-format.
+	* trans.c (gfc_trans_code): Update comment to say GENERIC.
+	Call tree_annotate_all_with_locus instead of annotate_all_with_locus.
+
+2008-07-27  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/36132
+	PR fortran/29952
+	PR fortran/36909
+	* trans.c (gfc_trans_runtime_check): Allow run-time warning besides
+	run-time error.
+	* trans.h (gfc_trans_runtime_check): Update declaration.
+	* trans-array.c (gfc_trans_array_ctor_element,gfc_trans_array_bound_check,
+	gfc_conv_array_ref,gfc_conv_ss_startstride,gfc_trans_dummy_array_bias):
+	Updated gfc_trans_runtime_check calls.
+	(gfc_conv_array_parameter): Implement flag_check_array_temporaries,
+	fix packing/unpacking for nonpresent optional actuals to optional
+	formals.
+	* trans-array.h (gfc_conv_array_parameter): Update declaration.
+	* trans-expr.c (gfc_conv_substring,gfc_trans_arrayfunc_assign,
+	gfc_conv_function_call): Updated gfc_trans_runtime_check calls.
+	(gfc_conv_function_call): Update gfc_conv_array_parameter calls.
+	* trans-expr.c (gfc_trans_goto): Updated gfc_trans_runtime_check
+	calls.
+	* trans-io.c (set_string,gfc_conv_intrinsic_repeat): Ditto.
+	(gfc_conv_intrinsic_transfer,gfc_conv_intrinsic_loc): Same for
+	gfc_conv_array_parameter.
+	* trans-intrinsics.c (gfc_conv_intrinsic_bound): Ditto.
+	* trans-decl.c (gfc_build_builtin_function_decls): Add
+	gfor_fndecl_runtime_warning_at.
+	* lang.opt: New option fcheck-array-temporaries.
+	* gfortran.h (gfc_options): New flag_check_array_temporaries.
+	* options.c (gfc_init_options, gfc_handle_option): Handle flag.
+	* invoke.texi: New option fcheck-array-temporaries.
+
+2008-07-24  Jan Hubicka  <jh@suse.cz>
+
+	* fortran/options.c (gfc_post_options): Remove flag_unline_trees code.
+
+2008-07-24  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/33141
+	* lang.opt (Wnonstd-intrinsics):  Removed option.
+	(Wintrinsics-std), (Wintrinsic-shadow):  New options.
+	* invoke.texi (Option Summary):  Removed -Wnonstd-intrinsics
+	from the list and added -Wintrinsics-std and -Wintrinsic-shadow.
+	(Error and Warning Options):  Documented the new options and removed
+	the documentation for -Wnonstd-intrinsics.
+	* gfortran.h (gfc_option_t):  New members warn_intrinsic_shadow and
+	warn_intrinsics_std, removed warn_nonstd_intrinsics.
+	(gfc_is_intrinsic):  Renamed from gfc_intrinsic_name.
+	(gfc_warn_intrinsic_shadow), (gfc_check_intrinsic_standard):  New.
+	* decl.c (match_procedure_decl):  Replaced gfc_intrinsic_name by
+	the new name gfc_is_intrinsic.
+	(warn_intrinsic_shadow):  New helper method.
+	(gfc_match_function_decl), (gfc_match_subroutine):  Call the new method
+	warn_intrinsic_shadow to check the just-parsed procedure.
+	* expr.c (check_init_expr):  Call new gfc_is_intrinsic to check whether
+	the function called is really an intrinsic in the selected standard.
+	* intrinsic.c (gfc_is_intrinsic):  Renamed from gfc_intrinsic_name and
+	extended to take into account the selected standard settings when trying
+	to find out whether a symbol is an intrinsic or not.
+	(gfc_check_intrinsic_standard):  Made public and extended.
+	(gfc_intrinsic_func_interface), (gfc_intrinsic_sub_interface):  Removed
+	the calls to check_intrinsic_standard, this check now happens inside
+	gfc_is_intrinsic.
+	(gfc_warn_intrinsic_shadow):  New method defined.
+	* options.c (gfc_init_options):  Initialize new warning flags to false
+	and removed intialization of Wnonstd-intrinsics flag.
+	(gfc_post_options):  Removed logic for Wnonstd-intrinsics flag.
+	(set_Wall):  Set new warning flags and removed Wnonstd-intrinsics flag.
+	(gfc_handle_option):  Handle the new flags and removed handling of the
+	old Wnonstd-intrinsics flag.
+	* primary.c (gfc_match_rvalue):  Replaced call to gfc_intrinsic_name by
+	the new name gfc_is_intrinsic.
+	* resolve.c (resolve_actual_arglist):  Ditto.
+	(resolve_generic_f), (resolve_unknown_f):  Ditto.
+	(is_external_proc):  Ditto.
+	(resolve_generic_s), (resolve_unknown_s):  Ditto.
+	(resolve_symbol):  Ditto and ensure for symbols declared INTRINSIC that
+	they are really available in the selected standard setting.
+
+2008-07-24  Daniel Kraft  <d@domob.eu>
+
+	* match.c (gfc_match):  Add assertion to catch wrong calls trying to
+	match upper-case characters.
+
+2008-07-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/29952
+	* gfortran.h:  Add "warn_array_temp" to gfc_option_t.
+	* lang.opt:  Add -Warray-temporaries.
+	* invoke.texi:  Document -Warray-temporaries
+	* trans-array.h (gfc_trans_create_temp_array):  Add argument of
+	type *locus.
+	(gfc_conv_loop_setup):  Likewise.
+	* trans-array.c (gfc_trans_create_temp_array):  If
+	-Warray-temporaries is given and locus is present, warn about
+	creation of array temporaries.
+	(gfc_trans_array_constructor_subarray):  Add locus to call
+	of gfc_conv_loop_setup.
+	(gfc_trans_array_constructor):  Add where argument.  Pass where
+	argument to call of gfc_trans_create_temp_array.
+	(gfc_add_loop_ss_code):  Add where argument.  Pass where argument
+	to recursive call of gfc_add_loop_ss_code and to call of
+	gfc_trans_array_constructor.
+	(gfc_conv_loop_setup):  Add where argument.  Pass where argument
+	to calls to gfc_add_loop_ss_code and to gfc_trans_create_temp_array.
+	(gfc_conv_expr_descriptor):  Pass location to call of
+	gfc_conv_loop_setup.
+	(gfc_conv_array_parameter):  If -Warray-temporaries is given,
+	warn about creation of temporary arrays.
+	* trans-expr.c (gfc_conv_subref_array_arg):  Add where argument
+	to call to gfc_conv_loop_setup.
+	(gfc_conv_function_call):  Add where argument to call to
+	gfc_trans_creat_temp_array.
+	(gfc_trans_subarray_assign):  Likewise.
+	(gfc_trans_assignment_1):  Add where argument to call to
+	gfc_conv_loop_setup.
+	* trans-stmt.c (gfc_conv_elemental_dependencies):  Add where
+	argument to call to gfc_trans_create_temp_array.
+	(gfc_trans_call):  Add where argument to call to gfc_conv_loop_setup.
+	(generate_loop_for_temp_to_lhs):  Likewise.
+	(generate_loop_for_rhs_to_temp):  Likewise.
+	(compute_inner_temp_size):  Likewise.
+	(gfc_trans-pointer_assign_need_temp):  Likewise.
+	(gfc_evaluate_where_mask):  Likewise.
+	(gfc_trans_where_assign):  Likewise.
+	(gfc_trans_where_3):  Likewise.
+	* trans-io.c (transfer_srray_component):  Add where argument
+	to function. Add where argument to call to gfc_conv_loop_setup.
+	(transfer_expr):  Add where argument to call to
+	transfer_array_component.
+	(gfc_trans_transfer):  Add where expression to call to
+	gfc_conv_loop_setup.
+	* trans-intrinsic.c (gfc_conv_intrinsic_anyall):  Add
+	where argument to call to gfc_conv_loop_setup.
+	(gfc_conv_intrinsic_count):  Likewise.
+	(gfc_conv_intrinsic_arith):  Likewise.
+	(gfc_conv_intrinsic_dot_product):  Likewise.
+	(gfc_conv_intrinsic_minmaxloc):  Likewise.
+	(gfc_conv_intrinsic_minmaxval):  Likewise.
+	(gfc_conv_intrinsic_array_transfer):  Warn about
+	creation of temporary array.
+	Add where argument to call to gfc_trans_create_temp_array.
+	* options.c (gfc_init_options):  Initialize gfc_option.warn_array_temp.
+	(gfc_handle_option):  Set gfc_option.warn_array_temp.
+
+2008-07-23  Manuel Lopez-Ibanez  <manu@gcc.gnu.org>
+
+	PR 35058
+	* f95-lang.c (gfc_mark_addressable): All calls to pedwarn changed.
+
+2008-07-22  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/29835
+	* io.c (error_element), (format_locus):  New static globals.
+	(unexpected_element):  Spelled out this message fully.
+	(next_char):  Keep track of locus when not MODE_STRING.
+	(next_char_not_space):  Remember last parsed element in error_element.
+	(format_lex):  Fix two indentation errors.
+	(check_format):  Use format_locus and possibly error_element for a
+	slightly better error message on invalid format.
+	(check_format_string):  Set format_locus to start of the string
+	expression used as format.
+
+2008-07-21  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
+
+	* expr.c (gfc_check_pointer_assign): Fix typo in string.
+	* io.c (check_format): Fix typo in string.  Fix comment typos.
+	* parse.c (gfc_global_used): Likewise.
+	* resolve.c (resolve_allocate_expr): Likewise.
+	* symbol.c (gfc_set_default_type): Likewise.
+	* arith.c: Fix typos in comments.
+	* array.c: Likewise.
+	* data.c: Likewise.
+	* decl.c: Likewise.
+	* dependency.c: Likewise.
+	* f95-lang.c: Likewise.
+	* gfortran.h: Likewise.
+	* matchexp.c: Likewise.
+	* module.c: Likewise.
+	* primary.c: Likewise.
+	* scanner.c: Likewise.
+	* trans-array.c: Likewise.
+	* trans-common.c: Likewise.
+	* trans-decl.c: Likewise.
+	* trans-expr.c: Likewise.
+	* trans-intrinsic.c: Likewise.
+	* trans-types.c: Likewise.
+	* trans.c: Likewise.
+	* trans.h: Likewise.
+
+2008-07-19  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/36795
+	* matchexp.c (gfc_get_parentheses): Remove obsolete workaround,
+	which caused the generation of wrong code.
+
+2008-07-19  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/36342
+	* scanner.c (load_file): Add argument to destinguish between
+	true filename and displayed filename.
+	(include_line,gfc_new_file): Adapt accordingly.
+
+2008-07-19  Tobias Burnus  <burnus@net-b.de>
+
+	* check.c (gfc_check_cshift,gfc_check_eoshift,gfc_check_unpack): Add rank
+	checks for cshift's shift and eoshift's shift and boundary args.
+	(gfc_check_unpack): Add rank and shape tests for unpack.
+
+2008-07-19  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* gfortran.h (new): Remove macro.
+	* array.c (gfc_append_constructor, match_array_list,
+	gfc_match_array_constructor): Likewise.
+	* bbt.c (insert, gfc_insert_bbt): Likewise.
+	* decl.c (var_element, top_var_list, top_val_list, gfc_match_data,
+	get_proc_name): Likewise.
+	* expr.c (gfc_copy_actual_arglist): Likewise.
+	* interface.c (compare_actual_formal, check_new_interface,
+	gfc_add_interface): Likewise.
+	* intrinsic.c gfc_convert_type_warn, gfc_convert_chartype):
+	Likewise.
+	* io.c (match_io_iterator, match_io_list): Likewise.
+	* match.c (match_forall_header): Likewise.
+	* matchexp.c (build_node): Likewise.
+	* module.c (gfc_match_use): Likewise.
+	* scanner.c (load_file): Likewise.
+	* st.c (gfc_append_code): Likewise.
+	* symbol.c (save_symbol_data, gfc_get_sym_tree, gfc_undo_symbols,
+	gfc_commit_symbols): Likewise.
+	* trans-common.c (build_field): Likewise.
+	* trans-decl.c (gfc_finish_var_decl): Likewise.
+	* trans-expr.c (gfc_free_interface_mapping,
+	gfc_get_interface_mapping_charlen, gfc_add_interface_mapping,
+	gfc_finish_interface_mapping,
+	gfc_apply_interface_mapping_to_expr): Likewise.
+	* trans.h (gfc_interface_sym_mapping): Likewise.
+
+2008-07-19  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* gfortran.h (operator): Remove macro.
+	(gfc_namespace, gfc_expr): Avoid C++ keywords.
+	* arith.c (eval_intrinsic, eval_intrinsic_f2, eval_intrinsic_f3):
+	Likewise.
+	* decl.c (access_attr_decl): Likewise.
+	* dependency.c (gfc_dep_compare_expr): Likewise.
+	* dump-parse-tree.c (show_expr, show_uop, show_namespace):
+	Likewise.
+	* expr.c (gfc_copy_expr, gfc_type_convert_binary,
+	simplify_intrinsic_op, check_intrinsic_op): Likewise.
+	* interface.c (fold_unary, gfc_match_generic_spec,
+	gfc_match_interface, gfc_match_end_interface,
+	check_operator_interface, check_uop_interfaces,
+	gfc_check_interfaces, gfc_extend_expr, gfc_extend_assign,
+	gfc_add_interface, gfc_current_interface_head,
+	gfc_set_current_interface_head): Likewise.
+	* iresolve.c (gfc_resolve_dot_product, gfc_resolve_matmul):
+	Likewise.
+	* matchexp.c (gfc_get_parentheses, build_node): Likewise.
+	* module.c (gfc_use_rename, gfc_match_use, find_use_name_n,
+	number_use_names, mio_expr, load_operator_interfaces, read_module,
+	write_operator, write_module): Likewise.
+	* openmp.c (resolve_omp_atomic): Likewise.
+	* resolve.c (resolve_operator, gfc_resolve_character_operator,
+	gfc_resolve_uops): Likewise.
+	* symbol.c (free_uop_tree, gfc_free_namespace): Likewise.
+	* trans-expr.c (gfc_conv_expr_op): Likewise.
+	* trans-openmp.c (gfc_trans_omp_atomic): Likewise.
+
+2008-07-19  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* gfortran.h (protected): Remove macro.
+	* dump-parse-tree.c (show_attr): Avoid C++ keywords.
+	* expr.c (gfc_check_pointer_assign): Likewise.
+	* interface.c (compare_parameter_protected): Likewise.
+	* intrinsic.c (enum class, add_sym, add_sym_0, add_sym_1,
+	add_sym_1s, add_sym_1m, add_sym_2, add_sym_2s, add_sym_3,
+	add_sym_3ml, add_sym_3red, add_sym_3s, add_sym_4, add_sym_4s,
+	add_sym_5s): Likewise.
+	* match.c (gfc_match_assignment, gfc_match_pointer_assignment):
+	Likewise.
+	* module.c (mio_symbol_attribute): Likewise.
+	* primary.c (match_variable): Likewise.
+	* resolve.c (resolve_equivalence): Likewise.
+	* symbol.c (check_conflict, gfc_add_protected, gfc_copy_attr):
+	Likewise.
+	* trans-types.c (gfc_get_array_type_bounds): Likewise.
+
+2008-07-18  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* arith.c (eval_type_intrinsic0): Avoid C++ keywords.
+	* gfortran.h (try, protected, operator, new): Likewise.
+
+2008-07-17  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/36825
+	PR fortran/36824
+	* array.c (gfc_match_array_spec): Fix array-rank check.
+	* resolve.c (resolve_fl_derived): Fix constentness check
+	for the array dimensions.
+
+2008-07-14  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
+
+	* Make-lang.in (gfortranspec.o): Fix dependencies.
+
+2008-07-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/36725
+	* io.c: Add error check for g0 edit descriptor followed by '.'.
+
+2008-07-12  Daniel Kraft  <d@domob.eu>
+
+	* resolve.c (resolve_fl_derived):  Allow pointer components to empty
+	derived types fixing a missing part of PR fortran/33221.
+
+2008-07-10  Daniel Kraft  <d@domob.eu>
+
+	* gfc-internals.texi (section gfc_expr):  Created documentation about
+	the gfc_expr internal data structure.
+
+2008-07-07  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/36670
+	* iresolve.c (gfc_resolve_product):  Set shape of return
+	value from array.
+	(gfc_resolve_sum):  Likewise.
+
+2008-07-07  Jakub Jelinek  <jakub@redhat.com>
+
+	PR middle-end/36726
+	* f95-lang.c (poplevel): Don't ever add subblocks to
+	global_binding_level.
+
+2008-07-02  Janus Weil  <janus@gcc.gnu.org>
+	    Tobias Burnus  <burnus@net-b.de>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32580
+	* gfortran.h (struct gfc_symbol): New member "proc_pointer".
+	* check.c (gfc_check_associated,gfc_check_null): Implement
+	procedure pointers.
+	* decl.c (match_procedure_decl): Ditto.
+	* expr.c (gfc_check_pointer_assign,gfc_check_assign_symbol): Ditto.
+	* interface.c (compare_actual_formal): Ditto.
+	* match.h: Ditto.
+	* match.c (gfc_match_pointer_assignment): Ditto.
+	* parse.c (parse_interface): Ditto.
+	* primary.c (gfc_match_rvalue,match_variable): Ditto.
+	* resolve.c (resolve_fl_procedure): Ditto.
+	* symbol.c (check_conflict,gfc_add_external,gfc_add_pointer,
+	gfc_copy_attr,gen_fptr_param,build_formal_args): Ditto.
+	* trans-decl.c (get_proc_pointer_decl,gfc_get_extern_function_decl,
+	create_function_arglist): Ditto.
+	* trans-expr.c (gfc_conv_variable,gfc_conv_function_val,
+	gfc_conv_function_call,gfc_trans_pointer_assignment): Ditto.
+
+2008-07-02  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/36590
+	PR fortran/36681
+	* iresolve.c (resolve_mask_arg):  Don't convert mask to
+	kind=1 logical if it is of that type already.
+
+2008-06-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/36341
+	* iresolve.c (gfc_resolve_matmul): Copy shapes
+	from arguments.
+
+2008-06-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	* invoke.texi: Add documentation for runtime behavior of
+	-fno-range-check.
+
+2008-06-28  Daniel Kraft  <d@domob.eu>
+
+	* gfc-internals.texi (section gfc_code):  Extended documentation about
+	gfc_code in the internal datastructures chapter including details about
+	how IF, DO and SELECT blocks look like and an example for how the
+	block-chaining works.
+
+2008-06-25  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/36526
+	* interface.c (check_intents):  Correct error where the actual
+	arg was checked for a pointer argument, rather than the formal.
+
+2008-06-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34371
+	* expr.c (gfc_check_assign):  Change message and locus for
+	error when conform == 0.
+
+2008-06-23  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/36597
+	* cpp.c (cpp_define_builtins): Change _OPENMP value to 200805.
+
+2008-06-20  Laurynas Biveinis  <laurynas.biveinis@gmail.com>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34908
+	PR fortran/36276
+	* scanner.c (preprocessor_line): do not call gfc_free for
+	current_file->filename if it differs from filename.
+
+2008-06-20  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* arith.c (hollerith2representation): Fix for -Wc++-compat.
+	* array.c (gfc_get_constructor): Likewise.
+	* decl.c (gfc_get_data_variable, gfc_get_data_value, gfc_get_data,
+	create_enum_history, gfc_match_final_decl): Likewise.
+	* error.c (error_char): Likewise.
+	* expr.c (gfc_get_expr, gfc_copy_expr): Likewise.
+	* gfortran.h (gfc_get_charlen, gfc_get_array_spec,
+	gfc_get_component, gfc_get_formal_arglist, gfc_get_actual_arglist,
+	gfc_get_namelist, gfc_get_omp_clauses, gfc_get_interface,
+	gfc_get_common_head, gfc_get_dt_list, gfc_get_array_ref,
+	gfc_get_ref, gfc_get_equiv, gfc_get_case, gfc_get_iterator,
+	gfc_get_alloc, gfc_get_wide_string): Likewise.
+	* interface.c (count_types_test): Likewise.
+	* intrinsic.c (add_char_conversions, gfc_intrinsic_init_1):
+	Likewise.
+	* io.c (gfc_match_open, gfc_match_close, match_filepos, match_io,
+	gfc_match_inquire, gfc_match_wait): Likewise.
+	* match.c (gfc_match, match_forall_iterator): Likewise.
+	* module.c (gfc_get_pointer_info, gfc_get_use_rename, add_fixup,
+	add_true_name, parse_string, write_atom, quote_string,
+	mio_symtree_ref, mio_gmp_real, write_common_0): Likewise.
+	* options.c (gfc_post_options): Likewise.
+	* primary.c (match_integer_constant, match_hollerith_constant,
+	match_boz_constant, match_real_constant,
+	gfc_get_structure_ctor_component, gfc_match_structure_constructor): Likewise.
+	* scanner.c (gfc_widechar_to_char, add_path_to_list,
+	add_file_change, load_line, get_file, preprocessor_line,
+	load_file, unescape_filename, gfc_read_orig_filename): Likewise.
+	* simplify.c (gfc_simplify_ibits, gfc_simplify_ishft,
+	gfc_simplify_ishftc): Likewise.
+	* symbol.c (gfc_get_st_label, gfc_get_namespace, gfc_new_symtree,
+	gfc_get_uop, gfc_new_symbol, save_symbol_data, gfc_get_gsymbol):
+	Likewise.
+	* target-memory.c (gfc_target_interpret_expr): Likewise.
+	* trans-const.c (gfc_build_wide_string_const): Likewise.
+	* trans-expr.c (gfc_add_interface_mapping): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_conversion,
+	gfc_conv_intrinsic_int, gfc_conv_intrinsic_lib_function,
+	gfc_conv_intrinsic_cmplx, gfc_conv_intrinsic_ctime,
+	gfc_conv_intrinsic_fdate, gfc_conv_intrinsic_ttynam,
+	gfc_conv_intrinsic_minmax, gfc_conv_intrinsic_minmax_char,
+	gfc_conv_intrinsic_ishftc, gfc_conv_intrinsic_index_scan_verify,
+	gfc_conv_intrinsic_merge, gfc_conv_intrinsic_trim): Likewise.
+	* trans.c (gfc_get_backend_locus): Likewise.
+	* trans.h (gfc_get_ss): Likewise.
+
+2008-06-18  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/36517, fortran/36492
+	* array.c (gfc_resolve_character_array_constructor):  Call
+	gfc_set_constant_character_len with changed length-chec argument.
+	* decl.c (gfc_set_constant_character_len):  Changed array argument to
+	be a generic length-checking argument that can be used for correct
+	checking with typespec and in special cases where the should-be length
+	is different from the target length.
+	(build_struct):  Call gfc_set_constant_character_len with changed length
+	checking argument and introduced additional checks for exceptional
+	conditions on invalid code.
+	(add_init_expr_to_sym), (do_parm):  Call gfc_set_constant_character_len
+	with changed argument.
+	* match.h (gfc_set_constant_character_len):  Changed third argument to
+	int for the should-be length rather than bool.
+
+2008-06-17  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/36112
+	* array.c (gfc_resolve_character_array_constructor):  Check that all
+	elements with constant character length have the same one rather than
+	fixing it if no typespec is given, emit an error if they don't.  Changed
+	return type to "try" and return FAILURE for the case above.
+	(gfc_resolve_array_constructor):  Removed unneeded call to
+	gfc_resolve_character_array_constructor in this function.
+	* gfortran.h (gfc_resolve_character_array_constructor):  Returns try.
+	* trans-array.c (get_array_ctor_strlen):  Return length of first element
+	rather than last element.
+	* resolve.c (gfc_resolve_expr):  Handle FAILURE return from
+	gfc_resolve_character_array_constructor.
+
+2008-06-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34396
+	* resolve.c (add_dt_to_dt_list):  New function.
+	(resolve_fl_derived): Call new function for pointer components
+	and when derived type resolved.
+
+2008-06-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/36515
+	* trans-decl.c (gfc_generate_function_code): Add range_check to options
+	array.
+
+2008-06-15  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
+
+	* gfc-internals.texi: Expand TABs, drop indentation outside examples.
+	* gfortran.texi: Likewise.
+	* intrinsic.texi: Likewise.
+	* invoke.texi: Likewise.
+
+2008-06-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35863
+	* trans-io.c (gfc_build_io_library_fndecls): Build declaration for
+	transfer_character_wide which includes passing in the character kind to
+	support wide character IO. (transfer_expr): If the kind == 4, create the
+	argument and build the call.
+	* gfortran.texi: Fix typo.
+
+2008-06-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/36476
+	* decl.c (do_parm): Handle init expression for len=*.
+
+2008-06-12  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/36462
+	* trans-intrinsic.c (gfc_conv_intrinsic_index_scan_verify):
+	Fix passing of the BACK= argument.
+
+2008-06-10  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	* cpp.c: Add copyright notice.
+	* cpp.h: Add copyright notice.
+
+2008-06-08  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36459
+	* decl.c (match_procedure_decl): Correctly recognize if the interface
+	is an intrinsic procedure.
+
+2008-06-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/35830
+	* resolve.c (resolve_symbol): Copy more attributes for
+	PROCEDUREs with interfaces.
+
+2008-06-07  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/36420
+	PR fortran/36422
+	* io.c (check_format): Add new error message for zero width.
+	Use new	error message for FMT_A and with READ, FMT_G.  Allow
+	FMT_G with WRITE except when -std=F95 and -std=F2003.
+
+2008-06-07  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/36437
+	* intrinsic.c (add_functions): Implement c_sizeof.
+	* trans-intrinsic.c (gfc_conv_intrinsic_sizeof): Do not
+	create unneeded variable in the scalar case.
+	* intrinsic.texi: Add C_SIZEOF documentation.
+
+2008-06-06  Tobias Burnus  <burnus@net-b.de>
+
+	* intrinsic.texi (BESSEL_J1): Fix BES(S)EL_J1 typo.
+
+2008-06-06  Jakub Jelinek  <jakub@redhat.com>
+
+	* scanner.c (skip_free_comments, skip_fixed_comments): Handle tabs.
+	* parse.c (next_free): Allow tab after !$omp.
+	(decode_omp_directive): Handle !$omp task, !$omp taskwait
+	and !$omp end task.
+	(case_executable): Add ST_OMP_TASKWAIT.
+	(case_exec_markers): Add ST_OMP_TASK.
+	(gfc_ascii_statement): Handle ST_OMP_TASK, ST_OMP_END_TASK and
+	ST_OMP_TASKWAIT.
+	(parse_omp_structured_block, parse_executable): Handle ST_OMP_TASK.
+	* gfortran.h (gfc_find_sym_in_expr): New prototype.
+	(gfc_statement): Add ST_OMP_TASK, ST_OMP_END_TASK and ST_OMP_TASKWAIT.
+	(gfc_omp_clauses): Add OMP_SCHED_AUTO to sched_kind,
+	OMP_DEFAULT_FIRSTPRIVATE to default_sharing.  Add collapse and
+	untied fields.
+	(gfc_exec_op): Add EXEC_OMP_TASK and EXEC_OMP_TASKWAIT.
+	* f95-lang.c (LANG_HOOKS_OMP_CLAUSE_COPY_CTOR,
+	LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP, LANG_HOOKS_OMP_CLAUSE_DTOR,
+	LANG_HOOKS_OMP_PRIVATE_OUTER_REF): Define.
+	* trans.h (gfc_omp_clause_default_ctor): Add another argument.
+	(gfc_omp_clause_copy_ctor, gfc_omp_clause_assign_op,
+	gfc_omp_clause_dtor, gfc_omp_private_outer_ref): New prototypes.
+	* types.def (BT_ULONGLONG, BT_PTR_ULONGLONG,
+	BT_FN_BOOL_ULONGLONGPTR_ULONGLONGPTR,
+	BT_FN_BOOL_BOOL_ULL_ULL_ULL_ULLPTR_ULLPTR,
+	BT_FN_BOOL_BOOL_ULL_ULL_ULL_ULL_ULLPTR_ULLPTR,
+	BT_FN_VOID_PTR_PTR, BT_PTR_FN_VOID_PTR_PTR,
+	BT_FN_VOID_OMPFN_PTR_OMPCPYFN_LONG_LONG_BOOL_UINT): New.
+	(BT_BOOL): Use integer type with BOOL_TYPE_SIZE rather
+	than boolean_type_node.
+	* dump-parse-tree.c (gfc_show_omp_node): Handle EXEC_OMP_TASK,
+	EXEC_OMP_TASKWAIT, OMP_SCHED_AUTO, OMP_DEFAULT_FIRSTPRIVATE,
+	untied and collapse clauses.
+	(gfc_show_code_node): Handle EXEC_OMP_TASK and EXEC_OMP_TASKWAIT.
+	* trans.c (gfc_trans_code): Handle EXEC_OMP_TASK and
+	EXEC_OMP_TASKWAIT.
+	* st.c (gfc_free_statement): Likewise.
+	* resolve.c (gfc_resolve_blocks, resolve_code): Likewise.
+	(find_sym_in_expr): Rename to...
+	(gfc_find_sym_in_expr): ... this.  No longer static.
+	(resolve_allocate_expr, resolve_ordinary_assign): Adjust caller.
+	* match.h (gfc_match_omp_task, gfc_match_omp_taskwait): New
+	prototypes.
+	* openmp.c (resolve_omp_clauses): Allow allocatable arrays in
+	firstprivate, lastprivate, reduction, copyprivate and copyin
+	clauses.
+	(omp_current_do_code): Made static.
+	(omp_current_do_collapse): New variable.
+	(gfc_resolve_omp_do_blocks): Compute omp_current_do_collapse,
+	clear omp_current_do_code and omp_current_do_collapse on return.
+	(gfc_resolve_do_iterator): Handle collapsed do loops.
+	(resolve_omp_do): Likewise, diagnose errorneous collapsed do loops.
+	(OMP_CLAUSE_COLLAPSE, OMP_CLAUSE_UNTIED): Define.
+	(gfc_match_omp_clauses): Handle default (firstprivate),
+	schedule (auto), untied and collapse (n) clauses.
+	(OMP_DO_CLAUSES): Add OMP_CLAUSE_COLLAPSE.
+	(OMP_TASK_CLAUSES): Define.
+	(gfc_match_omp_task, gfc_match_omp_taskwait): New functions.
+	* trans-openmp.c (gfc_omp_private_outer_ref): New function.
+	(gfc_omp_clause_default_ctor): Add outer argument.  For allocatable
+	arrays allocate them with the bounds of the outer var if outer
+	var is allocated.
+	(gfc_omp_clause_copy_ctor, gfc_omp_clause_assign_op,
+	gfc_omp_clause_dtor): New functions.
+	(gfc_trans_omp_array_reduction): If decl is allocatable array,
+	allocate it with outer var's bounds in OMP_CLAUSE_REDUCTION_INIT
+	and deallocate it in OMP_CLAUSE_REDUCTION_MERGE.
+	(gfc_omp_predetermined_sharing): Return OMP_CLAUSE_DEFAULT_SHARED
+	for assumed-size arrays.
+	(gfc_trans_omp_do): Add par_clauses argument.  If dovar is
+	present in lastprivate clause and do loop isn't simple,
+	set OMP_CLAUSE_LASTPRIVATE_STMT.  If dovar is present in
+	parallel's lastprivate clause, change it to shared and add
+	lastprivate clause to OMP_FOR_CLAUSES.  Handle collapsed do loops.
+	(gfc_trans_omp_directive): Adjust gfc_trans_omp_do callers.
+	(gfc_trans_omp_parallel_do): Likewise.  Move collapse clause to
+	OMP_FOR from OMP_PARALLEL.
+	(gfc_trans_omp_clauses): Handle OMP_SCHED_AUTO,
+	OMP_DEFAULT_FIRSTPRIVATE, untied and collapse clauses.
+	(gfc_trans_omp_task, gfc_trans_omp_taskwait): New functions.
+	(gfc_trans_omp_directive): Handle EXEC_OMP_TASK and
+	EXEC_OMP_TASKWAIT.
+
+2008-06-04  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36322
+	PR fortran/36275
+	* resolve.c (resolve_symbol): Correctly copy the interface for a
+	PROCEDURE declaration.
+
+2008-06-02  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36361
+	* symbol.c (gfc_add_allocatable,gfc_add_dimension,
+	gfc_add_explicit_interface): Added checks.
+	* decl.c (attr_decl1): Added missing "var_locus".
+	* parse.c (parse_interface): Checking for errors.
+
+2008-06-02  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.h:  New statement-type ST_FINAL for FINAL declarations.
+	(struct gfc_symbol):  New member f2k_derived.
+	(struct gfc_namespace):  New member finalizers, for use in the above
+	mentioned f2k_derived namespace.
+	(struct gfc_finalizer):  New type defined for finalizers linked list.
+	* match.h (gfc_match_final_decl):  New function header.
+	* decl.c (gfc_match_derived_decl):  Create f2k_derived namespace on
+	constructed symbol node.
+	(gfc_match_final_decl):  New function to match a FINAL declaration line.
+	* parse.c (decode_statement):  match-call for keyword FINAL.
+	(parse_derived):  Parse CONTAINS section and accept FINAL statements.
+	* resolve.c (gfc_resolve_finalizers):  New function to resolve (that is
+	in this case, check) a list of finalizer procedures.
+	(resolve_fl_derived):  Call gfc_resolve_finalizers here.
+	* symbol.c (gfc_get_namespace):  Initialize new finalizers to NULL.
+	(gfc_free_namespace):  Free finalizers list.
+	(gfc_new_symbol):  Initialize new f2k_derived to NULL.
+	(gfc_free_symbol):  Free f2k_derived namespace.
+	(gfc_free_finalizer):  New function to free a single gfc_finalizer node.
+	(gfc_free_finalizer_list):  New function to free a linked list of
+	gfc_finalizer nodes.
+
+2008-06-02  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/36375
+	PR fortran/36377
+	* cpp.c (gfc_cpp_init): Do not initialize builtins if
+	processing already preprocessed input.
+	(gfc_cpp_preprocess): Finalize output with newline.
+
+2008-05-31  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	* intrinsic.texi: Revert wrong commit.
+
+2008-05-31  Steven G. Kargl  <kargls@comcast.net>
+
+	* arith.c (gfc_arith_init_1): Remove now unused r and c variables.
+	Cleanup numerical inquiry function initialization.
+	(gfc_arith_done_1): Replace multiple mpfr_clear() invocations with
+	a single mpfr_clears().
+	(gfc_check_real_range): Re-arrange logic to eliminate multiple
+	unnecessary branching and assignments.
+	(gfc_arith_times): Use mpfr_clears() in preference to multiple
+	mpfr_clear().
+	(gfc_arith_divide): Ditto.
+	(complex_reciprocal): Eliminate now unused variables a, re, im.
+	Cleanup the mpfr abuse.  Use mpfr_clears() in preference to
+	multiple mpfr_clear().
+	(complex_pow): Fix comment whitespace.  Use mpfr_clears() in
+	preference to multiple mpfr_clear().
+	* simplify.c (gfc_simplify_and): Remove blank line.
+	(gfc_simplify_atan2): Move error checking earlier to eliminate
+	a now unnecessay gfc_free_expr().
+	(gfc_simplify_bessel_j0): Remove unnecessary gfc_set_model_kind().
+	(gfc_simplify_bessel_j1): Ditto.
+	(gfc_simplify_bessel_jn): Ditto.
+ 	(gfc_simplify_bessel_y0): Ditto.
+	(gfc_simplify_bessel_y1): Ditto.
+	(gfc_simplify_bessel_yn): Ditto. 
+	(only_convert_cmplx_boz): Eliminate unnecessary duplicate code, and
+	combine nested if statement rational expressions.
+	(gfc_simplify_cos): Use mpfr_clears() in preference to multiple
+	mpfr_clear().
+	(gfc_simplify_exp): Ditto.
+	(gfc_simplify_fraction): Move gfc_set_model_kind() to after the
+	special case of 0.  Use mpfr_clears() in preference to multiple
+	mpfr_clear().
+	(gfc_simplify_gamma): Eliminate unnecessary gfc_set_model_kind().
+ 	(gfc_simplify_lgamma): Ditto.
+	(gfc_simplify_log10): Ditto.
+	(gfc_simplify_log): Move gfc_set_model_kind () inside switch
+	statement. Use mpfr_clears() in preference to multiple mpfr_clear().
+	(gfc_simplify_mod):  Eliminate now unused variables quot, iquot,
+	and term.  Simplify the mpfr magic.
+	(gfc_simplify_modulo): Ditto.
+	(gfc_simplify_nearest): Eliminate unnecessary gfc_set_model_kind().
+	(gfc_simplify_scale): Use mpfr_clears() in preference to multiple
+	mpfr_clear().
+	(gfc_simplify_sin): Ditto
+	(gfc_simplify_sqrt): Ditto
+	(gfc_simplify_set_exponent):  Move gfc_set_model_kind() to after the
+	special case of 0.  Use mpfr_clears() in preference to multiple
+	mpfr_clear().
+
+2008-05-29  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR target/36348
+	* Make-lang.in (F95_OBJS): Added dependency on FORTRAN_TARGET_OBJS.
+
+2008-05-29  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* scanner.c (load_line): Add first_char argument. Don't call ungetc.
+	(gfc_read_orig_filename): Adjust call to load_line. Don't call
+	ungetc.
+	(load_file): Adjust call to load_line.
+
+2008-05-28  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36325
+	PR fortran/35830
+	* interface.c (gfc_procedure_use): Enable argument checking for
+	external procedures with explicit interface.
+	* symbol.c (check_conflict): Fix conflict checking for externals.
+	(copy_formal_args): Fix handling of arrays.
+	* resolve.c (resolve_specific_f0, resolve_specific_s0): Fix handling
+	of intrinsics.
+	* parse.c (parse_interface): Non-abstract INTERFACE statement implies
+	EXTERNAL attribute.
+
+2008-05-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36319
+	* intrinsic.c (gfc_convert_chartype): Don't mark conversion
+	function as pure.
+	* trans-array.c (gfc_trans_array_ctor_element): Divide element
+	size by the size of one character to obtain length.
+	* iresolve.c (gfc_resolve_cshift): Call the _char4 variant when
+	appropriate.
+	(gfc_resolve_eoshift): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_ctime): Minor beautification.
+	(gfc_conv_intrinsic_fdate): Minor beautification.
+	(gfc_conv_intrinsic_ttynam): Minor beautification.
+	(gfc_conv_intrinsic_minmax_char): Allow all character kinds.
+	(size_of_string_in_bytes): New function.
+	(gfc_conv_intrinsic_size): Call size_of_string_in_bytes for
+	character expressions.
+	(gfc_conv_intrinsic_sizeof): Likewise.
+	(gfc_conv_intrinsic_array_transfer): Likewise.
+	(gfc_conv_intrinsic_trim): Allow all character kinds. Minor
+	beautification.
+	(gfc_conv_intrinsic_repeat): Fix comment typo.
+	* simplify.c (gfc_convert_char_constant): Take care of conversion
+	of array constructors.
+
+2008-05-27  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/36316
+	* trans-array.c (gfc_set_loop_bounds_from_array_spec):
+	Add missing fold_convert.
+
+2008-05-26  Daniel Franke  <franke.daniel@gmail.com>
+
+	* fortran/cpp.c (cpp_define_builtins): Remove usage of TARGET_* macros,
+	added FIXME instead.
+
+2008-05-26  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/18428
+	* lang.opt (A, C, CC, D, E, H, P, U, cpp, d, fworking-directory,
+	imultilib, iprefix, iquote, isysroot, isystem, nocpp, nostdinc,
+	o, undef, v): New options.
+	* options.c (gfc_init_options): Also initialize preprocessor
+	options.
+	(gfc_post_options): Also handle post-initialization of preprocessor
+	options.
+	(gfc_handle_option): Check if option is a preprocessor option.
+	If yes, let gfc_cpp_handle_option() handle the option.
+	* lang-specs.h: Reorganized to handle new options.
+	* scanner.c (gfc_new_file): Read temporary file instead of
+	input source if preprocessing is enabled.
+	* f95-lang.c (gfc_init): Initialize preprocessor.
+	(gfc_finish): Clean up preprocessor.
+	* cpp.c: New.
+	* cpp.h: New.
+	* Make-lang.in: Added new objects and dependencies.
+	* gfortran.texi: Updated section "Preprocessing and
+	conditional compilation".
+	* invoke.texi: Added new section "Preprocessing Options",
+	listed and documented the preprocessing options handled
+	by gfortran.
+
+2008-05-25  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32600
+	* trans-expr.c (gfc_conv_function_call): Remove library
+	call for c_f_pointer with scalar Fortran pointers and for
+	c_f_procpointer.
+
+2008-05-21  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36257
+	* iresolve.c (check_charlen_present): Don't force the rank to 1.
+
+2008-05-19  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36265
+	* trans-expr.c (gfc_conv_string_tmp): Pick the correct type for
+	the temporary variable.
+
+2008-05-19  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* simplify.c (gfc_simplify_dble, gfc_simplify_real): Initialize
+	result variable to avoid warnings.
+
+2008-05-18  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* intrinsic.c (char_conversions, ncharconv): New static variables.
+	(find_char_conv): New function.
+	(add_functions): Add simplification functions for ADJUSTL and
+	ADJUSTR. Don't check the kind of their argument. Add checking for
+	LGE, LLE, LGT and LLT.
+	(add_subroutines): Fix argument type for SLEEP. Fix argument name
+	for SYSTEM.
+	(add_char_conversions): New function.
+	(gfc_intrinsic_init_1): Call add_char_conversions.
+	(gfc_intrinsic_done_1): Free char_conversions.
+	(check_arglist): Use kind == 0 as a signal that we don't want
+	the kind value to be checked.
+	(do_simplify): Also simplify character functions.
+	(gfc_convert_chartype): New function
+	* trans-array.c (gfc_trans_array_ctor_element): Don't force the
+	use of default character type.
+	(gfc_trans_array_constructor_value): Likewise.
+	(get_array_ctor_var_strlen): Use integer kind to build an integer
+	instead of a character kind!
+	(gfc_build_constant_array_constructor): Don't force the use of
+	default character type.
+	(gfc_conv_loop_setup): Likewise.
+	* trans-expr.c (gfc_conv_string_tmp): Don't force the use of
+	default character type. Allocate enough memory for wide strings.
+	(gfc_conv_concat_op): Make sure operand kind are the same.
+	(string_to_single_character): Remove gfc_ prefix. Reindent.
+	Don't force the use of default character type.
+	(gfc_conv_scalar_char_value): Likewise.
+	(gfc_build_compare_string): Call string_to_single_character.
+	(fill_with_spaces): New function
+	(gfc_trans_string_copy): Add kind arguments. Use them to deal
+	with wide character kinds.
+	(gfc_conv_statement_function): Whitespace fix. Call
+	gfc_trans_string_copy with new kind arguments.
+	(gfc_conv_substring_expr): Call gfc_build_wide_string_const
+	instead of using gfc_widechar_to_char.
+	(gfc_conv_string_parameter): Don't force the use of default
+	character type.
+	(gfc_trans_scalar_assign): Pass kind args to gfc_trans_string_copy.
+	* intrinsic.h (gfc_check_lge_lgt_lle_llt, gfc_convert_char_constant,
+	gfc_resolve_adjustl, gfc_resolve_adjustr): New prototypes.
+	* decl.c (gfc_set_constant_character_len): Don't assert the
+	existence of a single character kind.
+	* trans-array.h (gfc_trans_string_copy): New prototype.
+	* gfortran.h (gfc_check_character_range, gfc_convert_chartype):
+	New prototypes.
+	* error.c (print_wide_char_into_buffer): New function lifting
+	code from gfc_print_wide_char. Fix order to output '\x??' instead
+	of 'x\??'.
+	(gfc_print_wide_char): Call print_wide_char_into_buffer.
+	(show_locus): Call print_wide_char_into_buffer with buffer local
+	to this function.
+	* trans-const.c (gfc_build_wide_string_const): New function.
+	(gfc_conv_string_init): Deal with wide characters strings
+	constructors.
+	(gfc_conv_constant_to_tree): Call gfc_build_wide_string_const.
+	* trans-stmt.c (gfc_trans_label_assign): Likewise.
+	(gfc_trans_character_select): Deal with wide strings.
+	* expr.c (gfc_check_assign): Allow conversion between character
+	kinds on assignment.
+	* trans-const.h (gfc_build_wide_string_const): New prototype.
+	* trans-types.c (gfc_get_character_type_len_for_eltype,
+	gfc_get_character_type_len): Create too variants of the old
+	gfc_get_character_type_len, one getting kind argument and the
+	other one directly taking a type tree.
+	* trans.h (gfor_fndecl_select_string_char4,
+	gfor_fndecl_convert_char1_to_char4,
+	gfor_fndecl_convert_char4_to_char1): New prototypes.
+	* trans-types.h (gfc_get_character_type_len_for_eltype): New
+	prototype.
+	* resolve.c (resolve_operator): Exit early when kind mismatches
+	are detected, because that makes us issue an error message later.
+	(validate_case_label_expr): Fix wording of error message.
+	* iresolve.c (gfc_resolve_adjustl, gfc_resolve_adjustr): New
+	functions.
+	(gfc_resolve_pack): Call _char4 variants of library function
+	when dealing with wide characters.
+	(gfc_resolve_reshape): Likewise.
+	(gfc_resolve_spread): Likewise.
+	(gfc_resolve_transpose): Likewise.
+	(gfc_resolve_unpack): Likewise.
+	* target-memory.c (size_character): Take character kind bit size
+	correctly into account (not that it changes anything for now, but
+	it's more generic).
+	(gfc_encode_character): Added gfc_ prefix. Encoding each
+	character of a string by calling native_encode_expr for the
+	corresponding unsigned integer.
+	(gfc_target_encode_expr): Add gfc_ prefix to encode_character.
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Build
+	gfor_fndecl_select_string_char4, gfor_fndecl_convert_char1_to_char4
+	and gfor_fndecl_convert_char4_to_char1.
+	* target-memory.h (gfc_encode_character): New prototype.
+	* arith.c (gfc_check_character_range): New function.
+	(eval_intrinsic): Allow non-default character kinds.
+	* check.c (gfc_check_access_func): Only allow default
+	character kind arguments.
+	(gfc_check_chdir): Likewise.
+	(gfc_check_chdir_sub): Likewise.
+	(gfc_check_chmod): Likewise.
+	(gfc_check_chmod_sub): Likewise.
+	(gfc_check_lge_lgt_lle_llt): New function.
+	(gfc_check_link): Likewise.
+	(gfc_check_link_sub): Likewise.
+	(gfc_check_symlnk): Likewise.
+	(gfc_check_symlnk_sub): Likewise.
+	(gfc_check_rename): Likewise.
+	(gfc_check_rename_sub): Likewise.
+	(gfc_check_fgetputc_sub): Likewise.
+	(gfc_check_fgetput_sub): Likewise.
+	(gfc_check_stat): Likewise.
+	(gfc_check_stat_sub): Likewise.
+	(gfc_check_date_and_time): Likewise.
+	(gfc_check_ctime_sub): Likewise.
+	(gfc_check_fdate_sub): Likewise.
+	(gfc_check_gerror): Likewise.
+	(gfc_check_getcwd_sub): Likewise.
+	(gfc_check_getarg): Likewise.
+	(gfc_check_getlog): Likewise.
+	(gfc_check_hostnm): Likewise.
+	(gfc_check_hostnm_sub): Likewise.
+	(gfc_check_ttynam_sub): Likewise.
+	(gfc_check_perror): Likewise.
+	(gfc_check_unlink): Likewise.
+	(gfc_check_unlink_sub): Likewise.
+	(gfc_check_system_sub): Likewise.
+	* primary.c (got_delim): Perform correct character range checking
+	for all kinds.
+	* trans-intrinsic.c (gfc_conv_intrinsic_conversion): Generate
+	calls to library functions convert_char4_to_char1 and
+	convert_char1_to_char4 for character conversions.
+	(gfc_conv_intrinsic_char): Allow all character kings.
+	(gfc_conv_intrinsic_strcmp): Fix whitespace.
+	(gfc_conv_intrinsic_repeat): Take care of all character kinds.
+	* intrinsic.texi: For all GNU intrinsics accepting character
+	arguments, mention that they're restricted to the default kind.
+	* simplify.c (simplify_achar_char): New function.
+	(gfc_simplify_achar, gfc_simplify_char): Call simplify_achar_char.
+	gfc_simplify_ichar): Don't error out for wide characters.
+	(gfc_convert_char_constant): New function.
+
+2008-05-18  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/36251
+	* symbol.c (check_conflict): Issue errors for abuse of PUBLIC, PRIVATE,
+	and BIND(C).
+	* resolve.c (gfc_verify_binding_labels): Fix NULL pointer dereference.
+
+2008-05-17  Tobias Burnus  <burnus@net-b.de>
+
+	* intrinsic.texi: Correct description of GET_COMMAND_ARGUMENT
+	and GET_ENVIRONMENT_VARIABLE; fix keyword= name for GETENV,
+	GETLOG, GMTIME, HOSTNM, IRAND, ITIME, KILL.
+	Move LOG_GAMMA after LOG10.
+
+2008-05-17  Tobias Burnus  <burnus@net-b.de>
+
+	* intrinsic.c (add_functions): Change FLUSH(C) to FLUSH(UNIT).
+	* intrinsic.texi: Change INTEGER(*) to INTEGER; fix keyword= name for
+	ABS, ADJUSTL, AINT, ALLOCATED, ANINT, ASSOCIATED, C_ASSOCIATED,
+	CEILING, DBLE, DFLOAT, DOT_PRODUCT, DREAL, FLOAT, FLOOR, GET_COMMAND.
+
+2008-05-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35756
+	PR fortran/35759
+	* trans-stmt.c (gfc_trans_where): Tighten up the dependency
+	check for calling gfc_trans_where_3.
+
+	PR fortran/35743
+	* trans-stmt.c (gfc_trans_where_2): Set the mask size to zero
+	if it is calculated to be negative.
+
+	PR fortran/35745
+	* trans-stmt.c (gfc_trans_where_3, gfc_trans_where_assign): Set
+	ss->where for scalar right hand sides.
+	* trans-array.c (gfc_add_loop_ss_code): If ss->where is set do
+	not evaluate scalars outside the loop.  Clean up whitespace.
+	* trans.h : Add a bitfield 'where' to gfc_ss.
+
+2008-05-16  Tobias Burnus  <burnus@net-b.de>
+
+	* libgfortran.h: Increase GFC_MAX_DIMENSIONS to 15.
+	* array.c (gfc_match_array_spec): Error with -std=f2003 if rank > 7.
+
+2008-04-16  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/27997
+	* gfortran.h:  Added field "length_from_typespec" to gfc_charlength.
+	* aray.c (gfc_match_array_constructor):  Added code to parse typespec.
+	(check_element_type, check_constructor_type, gfc_check_constructor_type):
+	Extended to support explicit typespec on constructor.
+	(gfc_resolve_character_array_constructor):  Pad strings correctly for
+	explicit, constant character length.
+	* trans-array.c:  New static global variable "typespec_chararray_ctor"
+	(gfc_trans_array_constructor):  New code to support explicit but dynamic
+	character lengths.
+
+2008-05-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/34325
+	* decl.c (match_attr_spec): Check for matching pairs of parenthesis.
+	* expr.c (gfc_specification_expr): Supplement the error message with the
+	type that was found.
+	* resolve.c (gfc_resolve_index): Likewise.
+	* match.c (gfc_match_parens): Clarify error message with "at or before".
+	(gfc_match_do): Check for matching pairs of parenthesis.
+
+2008-05-16  Tobias Burnus  <burnus@net-b.de
+
+	* intrinsic.texi: Write Fortran 77/90/95 instead of F77/90/95;
+	add missing KIND argument to ACHAR and NINT; and state that
+	the KIND argument is a F2003 extension for ACHAR, COUNT, IACHAR,
+	ICHAR, INDEX, LBOUND, LEN, LEN_TRIM, SCAN, SIZE, UBOUND, VERIFY.
+
+2008-05-16  Daniel Kraft  <d@domob.eu>
+
+	* primary.c:  New private structure "gfc_structure_ctor_component".
+	(gfc_free_structure_ctor_component):  New helper function.
+	(gfc_match_structure_constructor):  Extended largely to support named
+	arguments and default initialization for structure constructors.
+
+2008-05-15  Steven G. Kargl  <kargls@comcast.net>
+
+	* simplify.c (gfc_simplify_dble, gfc_simplify_float,
+	simplify_bound, gfc_simplify_nearest, gfc_simplify_real): Plug
+	possible memory leaks.
+	(gfc_simplify_reshape): Plug possible memory leaks and dereferencing
+	of NULL pointers.
+
+2008-05-15  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/36239
+	* simplify.c (gfc_simplify_int, gfc_simplify_intconv): Replaced hand
+	rolled integer conversion with gfc_int2int, gfc_real2int, and
+	gfc_complex2int.
+	(gfc_simplify_intconv): Renamed to simplify_intconv.
+	
+2008-05-15  Steven G. Kargl,   <kargl@comcast.net>
+	* gfortran.dg/and_or_xor.f90: New test
+
+	* fortran/simplify.c (gfc_simplify_and, gfc_simplify_or,
+	gfc_simplify_xor): Don't range check logical results.
+
+2008-05-15  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans-expr.c (gfc_conv_concat_op): Take care of nondefault
+	character kinds.
+	(gfc_build_compare_string): Add kind argument and use it.
+	(gfc_conv_statement_function): Fix indentation.
+	* gfortran.h (gfc_character_info): New structure.
+	(gfc_character_kinds): New array.
+	* trans-types.c (gfc_character_kinds, gfc_character_types,
+	gfc_pcharacter_types): New array.
+	(gfc_init_kinds): Fill character kinds array.
+	(validate_character): Take care of nondefault character kinds.
+	(gfc_build_uint_type): New function.
+	(gfc_init_types): Take care of nondefault character kinds.
+	(gfc_get_char_type, gfc_get_pchar_type): New functions.
+	(gfc_get_character_type_len): Use gfc_get_char_type.
+	* trans.h (gfc_build_compare_string): Adjust prototype.
+	(gfor_fndecl_compare_string_char4, gfor_fndecl_concat_string_char4,
+	gfor_fndecl_string_len_trim_char4, gfor_fndecl_string_index_char4,
+	gfor_fndecl_string_scan_char4, gfor_fndecl_string_verify_char4,
+	gfor_fndecl_string_trim_char4, gfor_fndecl_string_minmax_char4,
+	gfor_fndecl_adjustl_char4, gfor_fndecl_adjustr_char4): New
+	prototypes.
+	* trans-types.h (gfc_get_char_type, gfc_get_pchar_type): New
+	prototypes.
+	* trans-decl.c (gfor_fndecl_compare_string_char4,
+	gfor_fndecl_string_len_trim_char4, gfor_fndecl_string_index_char4,
+	gfor_fndecl_string_scan_char4, gfor_fndecl_string_verify_char4,
+	gfor_fndecl_string_trim_char4, gfor_fndecl_string_minmax_char4,
+	gfor_fndecl_adjustl_char4, gfor_fndecl_adjustr_char4,
+	gfor_fndecl_concat_string_char4): New function decls.
+	(gfc_build_intrinsic_function_decls): Define new *_char4 function
+	decls.
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmax_char,
+	gfc_conv_intrinsic_len_trim, gfc_conv_intrinsic_ichar,
+	gfc_conv_intrinsic_strcmp, gfc_conv_intrinsic_trim,
+	gfc_conv_intrinsic_function): Deal with nondefault character kinds.
+
+2008-05-15  Sa Liu  <saliu@de.ibm.com>
+
+	* iso-c-binding.def: Add standard parameter to macro NAMED_INTCST.
+	All existing NAMED_INTCST definitions has standard GFC_STD_F2003,
+	c_int128_t, c_int_least128_t and c_int_fast128_t are added as
+	GNU extensions.
+	* iso-fortran-evn.def: Add standard parameter GFC_STD_F2003
+	to macro NAMED_INTCST.
+	* symbol.c (std_for_isocbinding_symbol): New helper function to 
+	return the standard that supports this isocbinding symbol.
+	(generate_isocbinding_symbol): Do not generate GNU extension symbols
+	if std=f2003. Add new parameter to NAMED_INTCST.
+	* module.c (use_iso_fortran_env_module): Add new parameter to
+	NAMED_INTCST and new field standard to struct intmod_sym.
+	* gfortran.h: Add new parameter to NAMED_INTCST.
+	* trans-types.c (init_c_interop_kinds): Add new parameter to 
+	NAMED_INTCST.
+	* intrinsic.texi: Documented new types C_INT128_T, C_INT_LEASE128_T
+	and C_INT_FAST128_T.
+
+2008-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36059
+	* trans-decl.c (gfc_build_dummy_array_decl): Don't repack
+	arrays that have the TARGET attribute.
+
+2008-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36186
+	* simplify.c (only_convert_cmplx_boz): New function.
+	(gfc_simplify_cmplx, gfc_simplify_complex, gfc_simplify_dcmplx):
+	Call only_convert_cmplx_boz.
+
+2008-05-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/36233
+	* interface.c (compare_actual_formal): Do not check sizes if the
+	actual is BT_PROCEDURE.
+
+2008-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/35682
+	* trans-array.c (gfc_conv_ss_startstride): Any negative size is
+	the same as zero size.
+	(gfc_conv_loop_setup): Fix size calculation.
+
+2008-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/35685
+	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Correctly
+	handle zero-size sections.
+
+2008-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36215
+	* scanner.c (preprocessor_line): Allocate enough memory for a
+	wide string.
+
+2008-05-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36176
+	* target-memory.c (gfc_target_expr_size): Correctly treat
+	substrings.
+	(gfc_target_encode_expr): Likewise.
+	(gfc_interpret_complex): Whitespace change.
+
+2008-05-11  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/35719
+	* trans.c (gfc_call_malloc): If size equals zero, allocate one
+	byte; don't return a null pointer.
+
+2008-05-10  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36197
+	* module.c (quote_string): Fix sprintf format.
+
+2008-05-09  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36162
+	* module.c (quote_string, unquote_string,
+	mio_allocated_wide_string): New functions.
+	(mio_expr): Call mio_allocated_wide_string where needed.
+
+2008-05-07 Kenneth Zadeck <zadeck@naturalbridge.com>
+
+	 * trans-decl.c (gfc_get_extern_function_decl, build_function_decl):
+	 Rename DECL_IS_PURE to DECL_PURE_P.
+
+2008-05-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* arith.c: (gfc_arith_concat, gfc_compare_string,
+	gfc_compare_with_Cstring, hollerith2representation,
+	gfc_hollerith2int, gfc_hollerith2real, gfc_hollerith2complex,
+	gfc_hollerith2character, gfc_hollerith2logical): Use wide
+	characters for character constants.
+	* data.c (create_character_intializer): Likewise.
+	* decl.c (gfc_set_constant_character_len): Likewise.
+	* dump-parse-tree.c (show_char_const): Correctly dump wide
+	character strings.
+	error.c (print_wide_char): Rename into gfc_print_wide_char.
+	(show_locus): Adapt to new prototype of gfc_print_wide_char.
+	expr.c (free_expr0): Representation is now disjunct from
+	character string value, so we always free it.
+	(gfc_copy_expr, find_substring_ref, gfc_simplify_expr): Adapt
+	to wide character strings.
+	* gfortran.h (gfc_expr): Make value.character.string a wide string.
+	(gfc_wide_toupper, gfc_wide_strncasecmp, gfc_wide_memset,
+	gfc_widechar_to_char, gfc_char_to_widechar): New prototypes.
+	(gfc_get_wide_string): New macro.
+	(gfc_print_wide_char): New prototype.
+	* io.c (format_string): Make a wide string.
+	(next_char, gfc_match_format, compare_to_allowed_values, 
+	gfc_match_open): Deal with wide strings.
+	* module.c (mio_expr): Convert between wide strings and ASCII ones.
+	* primary.c (match_hollerith_constant, match_charkind_name): 
+	Handle wide strings.
+	* resolve.c (build_default_init_expr): Likewise.
+	* scanner.c (gfc_wide_toupper, gfc_wide_memset,
+	gfc_char_to_widechar): New functions.
+	(wide_strchr, gfc_widechar_to_char, gfc_wide_strncasecmp):
+	Changes in prototypes.
+	(gfc_define_undef_line, load_line, preprocessor_line,
+	include_line, load_file, gfc_read_orig_filename): Handle wide
+	strings.
+	* simplify.c (gfc_simplify_achar, gfc_simplify_adjustl,
+	gfc_simplify_adjustr, gfc_simplify_char, gfc_simplify_iachar,
+	gfc_simplify_ichar, simplify_min_max, gfc_simplify_new_line,
+	gfc_simplify_repeat): Handle wide strings.
+	(wide_strspn, wide_strcspn): New helper functions.
+	(gfc_simplify_scan, gfc_simplify_trim, gfc_simplify_verify):
+	Handle wide strings.
+	* symbol.c (generate_isocbinding_symbol): Likewise.
+	* target-memory.c (size_character, gfc_target_expr_size,
+	encode_character, gfc_target_encode_expr, gfc_interpret_character,
+	gfc_target_interpret_expr): Handle wide strings.
+	* trans-const.c (gfc_conv_string_init): Lower wide strings to
+	narrow ones.
+	(gfc_conv_constant_to_tree): Likewise.
+	* trans-expr.c (gfc_conv_substring_expr): Handle wide strings.
+	* trans-io.c (gfc_new_nml_name_expr): Likewise.
+	* trans-stmt.c (gfc_trans_label_assign): Likewise.
+
+2008-05-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* simplify.c (gfc_simplify_bessel_j0,gfc_simplify_bessel_j1,
+	gfc_simplify_bessel_jn,gfc_simplify_bessel_y0,
+	gfc_simplify_bessel_y1,gfc_simplify_bessel_yn): Mark arguments
+	with ATTRIBUTE_UNUSED.
+
+2008-05-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* check.c (gfc_check_sizeof): Switch to ATTRIBUTE_UNUSED.
+	* simplify.c (gfc_simplify_lgamma): Likewise.
+
+2008-05-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* openmp.c (gfc_match_omp_eos): Use gfc_next_ascii_char and
+	gfc_peek_ascii_char.
+	* decl.c (gfc_match_kind_spec, gfc_match_type_spec,
+	gfc_match_implicit_none, match_implicit_range, gfc_match_implicit,
+	match_string_p, match_attr_spec, gfc_match_suffix,
+	match_procedure_decl, gfc_match_entry, gfc_match_subroutine):
+	Likewise.
+	* gfortran.h (gfc_char_t): New type.
+	(gfc_linebuf): Make line member a gfc_char_t.
+	(locus): Make nextc member a gfc_char_t.
+	(gfc_wide_is_printable, gfc_wide_is_digit, gfc_wide_fits_in_byte,
+	gfc_wide_tolower, gfc_wide_strlen, gfc_next_ascii_char,
+	gfc_peek_ascii_char, gfc_check_digit): New prototypes.
+	* error.c (print_wide_char): New function.
+	(show_locus): Use print_wide_char and gfc_wide_strlen.
+	* io.c (next_char): Use gfc_char_t type.
+	(match_io): Use gfc_peek_ascii_char and gfc_next_ascii_char.
+	* match.c (gfc_match_parens, gfc_match_eos,
+	gfc_match_small_literal_int, gfc_match_name, gfc_match_name_C,
+	gfc_match_intrinsic_op, gfc_match_char,  gfc_match_return,
+	gfc_match_common): Likewise.
+	* match.h (gfc_match_special_char): Change prototype.
+	* parse.c (decode_specification_statement, decode_statement,
+	decode_omp_directive, next_free, next_fixed): Use
+	gfc_peek_ascii_char and gfc_next_ascii_char.
+	* primary.c (gfc_check_digit): Change name.
+	(match_digits, match_hollerith_constant, match_boz_constant,
+	match_real_constant, next_string_char, match_charkind_name,
+	match_string_constant, match_logical_constant_string,
+	match_complex_constant, match_actual_arg, match_varspec,
+	gfc_match_rvalue, match_variable): Use gfc_peek_ascii_char and
+	gfc_next_ascii_char.
+	* scanner.c (gfc_wide_fits_in_byte, wide_is_ascii,
+	gfc_wide_is_printable, gfc_wide_tolower, gfc_wide_is_digit,
+	gfc_wide_is_digit, wide_atoi, gfc_wide_strlen, wide_strcpy,
+	wide_strchr, widechar_to_char, wide_strncmp, wide_strncasecmp,
+	gfc_next_ascii_char, gfc_peek_ascii_char):
+	New functions.
+	(next_char, gfc_define_undef_line, skip_free_comments,
+	gfc_next_char_literal, gfc_next_char, gfc_peek_char,
+	gfc_error_recovery, load_line, preprocessor_line, include_line,
+	load_file, gfc_read_orig_filename): Use gfc_char_t for source
+	characters and the {gfc_,}wide_* functions to manipulate wide
+	strings.
+
+2008-05-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/36117
+	* intrinsic.c (add_functions): Call gfc_simplify_bessel_*.
+	* intrinsic.h: Add prototypes for gfc_simplify_bessel_*.
+	* simplify.c (gfc_simplify_bessel_j0,gfc_simplify_bessel_j1,
+	gfc_simplify_bessel_jn,gfc_simplify_bessel_y0,
+	gfc_simplify_bessel_y1,gfc_simplify_bessel_yn): New.
+
+2008-05-03  Janus Weil  <jaydub66@gmail.com>
+
+	* misc.c (gfc_clear_ts): Set interface to NULL.
+
+2008-05-03  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/33268
+	* gfortran.h: Add extra_comma pointer to gfc_dt structure. Add iokind to
+	gfc_expr value union. Add io_kind enum to here from io.c.
+	* io.c (gfc_free_dt): Free extra_comma.
+	(gfc_resolve_dt): If an extra comma was encountered and io_unit is type
+	BT_CHARACTER, resolve to format_expr and set default unit.  Error if
+	io_kind is M_WRITE. (match_io):  Match the extra comma and set new
+	pointer, extra_comma.
+
+2008-05-01  Bud Davis  <bdavis9659@sbcglobal.net>
+
+	PR35940/Fortran
+	* simplify.c (gfc_simplify_index): Check for direction argument 
+	being a constant.
+
+2008-05-01  Janus Weil  <jaydub66@gmail.com>
+
+	* gfortran.h (struct gfc_symbol): Moving "interface" member to
+	gfc_typespec (plus fixing a small docu error).
+	* interface.c (gfc_procedure_use): Ditto.
+	* decl.c (match_procedure_decl): Ditto.
+	* resolve.c (resolve_specific_f0,
+	resolve_specific_f0, resolve_symbol): Ditto.
+
+2008-04-30  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* intrinsic.c (add_functions): Add SELECTED_CHAR_KIND intrinsic.
+	* intrinsic.h (gfc_check_selected_char_kind,
+	gfc_simplify_selected_char_kind): New prototypes.
+	* gfortran.h (gfc_isym_id): Add GFC_ISYM_SC_KIND.
+	* trans.h (gfor_fndecl_sc_kind): New function decl.
+	* trans-decl.c (gfor_fndecl_sc_kind): Build new decl.
+	* arith.c (gfc_compare_with_Cstring): New function.
+	* arith.h (gfc_compare_with_Cstring): New prototype.
+	* check.c (gfc_check_selected_char_kind): New function.
+	* primary.c (match_string_constant, match_kind_param): Mark
+	symbols used as literal constant kind param as referenced.
+	* trans-intrinsic.c (gfc_conv_intrinsic_sc_kind): New function.
+	(gfc_conv_intrinsic_function): Call gfc_conv_intrinsic_sc_kind.
+	* intrinsic.texi (SELECTED_CHAR_KIND): Document new intrinsic.
+	* simplify.c (gfc_simplify_selected_char_kind): New function.
+
+2008-04-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35997
+	* module.c (find_symbol): Do not return a result for a symbol
+	that has been renamed in another module.
+
+2008-04-26  George Helffrich <george@gcc.gnu.org>
+
+	PR fortran/35892
+	PR fortran/35154
+	* trans-common.c (create_common):  Add decl to function
+	chain (if inside one) to preserve identifier scope in debug output.
+
+2008-04-25  Jan Hubicka  <jh@suse.cz>
+
+	* trans-decl.c (trans_function_start): Update.
+
+2008-04-25  Tobias Burnus  <burnus@net-b.de>
+	    Daniel Franke <franke.daniel@gmail.com>
+
+	PR fortran/35156
+	* gfortranspec.c (lang_specific_driver): Deprecate
+	-M option; fix ICE when "-M" is last argument and
+	make "-M<dir>" work.
+	* options.c (gfc_handle_module_path_options): 
+	Use -J instead of -M in error messages.
+	* invoke.texi: Mark -M as depecated.
+
+2008-04-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+	    Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/35994
+	* trans-instrinsic.c (gfc_conv_intrinsic_minmaxloc): Correctly adjust
+	loop counter offset.
+
+2008-04-23  Paolo Bonzini  <bonzini@gnu.org>
+
+	* trans-expr.c (gfc_conv_structure): Don't set TREE_INVARIANT.
+	* trans-array.c (gfc_build_null_descriptor): Don't set TREE_INVARIANT.
+	(gfc_trans_array_constructor_value): Don't set TREE_INVARIANT.
+	(gfc_build_constant_array_constructor): Don't set TREE_INVARIANT.
+	(gfc_conv_array_initializer): Don't set TREE_INVARIANT.
+	* trans-common.c (get_init_field): Don't set TREE_INVARIANT.
+	(create_common): Don't set TREE_INVARIANT.
+	* trans-stmt.c (gfc_trans_character_select): Don't set TREE_INVARIANT.
+	* trans-decl.c (gfc_generate_function_code): Don't set TREE_INVARIANT.
+
+2008-04-21  Steve Ellcey  <sje@cup.hp.com>
+
+	* f95-lang.c (gfc_init_decl_processing): use ptr_mode instead of Pmode.
+
+2008-04-21  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/35019
+	* gfortranspec.c (lookup_option): Properly handle separated arguments
+	in -J option, print missing argument message when necessary.
+
+2008-04-20  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35882
+	* scanner.c (skip_fixed_comments): Update continue_line when comment is
+	detected. (gfc_next_char_literal): Likewise.
+
+2008-04-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35944
+	PR fortran/35946
+	PR fortran/35947
+	* trans_array.c (gfc_trans_array_constructor): Temporarily
+	realign loop, if loop->from is not zero, before creating
+	the temporary array and provide an offset.
+
+	PR fortran/35959
+	* trans-decl.c (gfc_init_default_dt): Add gfc_ prefix to name
+	and allow for NULL body.  Change all references from
+	init_default_dt to gfc_init_default_dt.
+	* trans.h : Add prototype for gfc_init_default_dt.
+	* trans-array.c (gfc_trans_deferred_vars): After nullification
+	call gfc_init_default_dt for derived types with allocatable
+	components.
+
+2008-04-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35892
+	* trans-common.c (create_common): Revert patch causing regression.
+
+2008-04-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35724
+	* iresolve.c (gfc_resolve_eoshift): Check for NULL symtree in test for
+	optional argument attribute.
+	
+2008-04-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35932
+	* trans-intrinsic.c (gfc_conv_intrinsic_char): Even though KIND
+	is not used, the argument must be converted.
+
+2008-04-16  Jakub Jelinek  <jakub@redhat.com>
+
+	PR target/35662
+	* f95-lang.c (gfc_init_builtin_functions): Make sure
+	BUILT_IN_SINCOS{,F,L} types aren't varargs.
+
+2008-04-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35864
+	* expr.c (scalarize_intrinsic_call): Reorder identification of
+	array argument so that if one is not found a segfault does not
+	occur.  Return FAILURE if all scalar arguments.
+
+2008-04-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/35882
+	* options.c (gfc_init_options): Set the default maximum continuation
+	lines to 255 for both free and fixed form source for warnings.
+	(gfc_handle_option): Set -std=f95 fixed form max continuations to 19 and
+	the -std=f95 free form max continuations to 39 for warnings.
+	* scanner.c (gfc_next_char_literal): Adjust the current_line number only
+	if it is less than the current locus.
+
+2008-04-07  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/25829 28655
+	* io.c (io_tag): Add new tags for decimal, encoding, asynchronous,
+	round, sign, and id. (match_open_element): Match new tags.
+	(gfc_resolve_open): Resolve new tags. (gfc_match_open): Enable encoding
+	for DEFAULT only. Update error messages. (match_dt_element): Fix match
+	tag for asynchronous. Update error messages. (gfc_free_inquire): Free
+	new expressions. (match_inquire_element): Match new tags.
+	(gfc_match_inquire): Add constraint for ID and PENDING.
+	(gfc_resolve_inquire): Resolve new tags.
+	* trans-io.c (gfc_trans_inquire): Clean up whitespace and fix setting of
+	mask for ID parameter.
+	* ioparm.def: Fix order of parameters for pending, round, and sign.
+	NOTE: These must line up with the definitions in libgfortran/io/io.h. or
+	things don't work.
+
+2008-04-06  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35780
+	* expr.c (scalarize_intrinsic_call): Identify which argument is
+	an array and use that as the template.
+	(check_init_expr): Remove tests that first argument is an array
+	in the call to scalarize_intrinsic_call.
+
+2008-04-06  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/35832
+	* io.c (io_tag): Add field 'value'.  Split 'spec' field in
+	existing io_tags.
+	(match_etag, match_vtag, match_ltag): Split parsing in two steps
+	to give better error messages.
+
+2008-04-06  Tobias Burnus  <burnus@net-b.de>
+
+	* io.c (check_io_constraints): Add constrains. ID= requires
+	asynchronous= and asynchronous= must be init expression.
+
+2008-04-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* f95-lang.c: Set LANG_HOOKS_NAME to "GNU Fortran".
+
+2008-04-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* dump-parse-tree.c: Use fprintf, fputs and fputc instead of
+	gfc_status and gfc_status_char. Remove gfc_ prefix of the gfc_show_*
+	functions and make them static. Add new gfc_dump_parse_tree
+	function.
+	* gfortran.h (gfc_option_t): Rename verbose into dump_parse_tree.
+	(gfc_status, gfc_status_char): Delete prototypes.
+	* error.c (gfc_status, gfc_status_char): Remove functions.
+	* scanner.c (gfc_new_file): Use printf instead of gfc_status.
+	* options.c (gfc_init_options): Rename verbose into dump_parse_tree.
+	(gfc_handle_module_path_options): Use gfc_fatal_error instead of
+	gfc_status and exit.
+	(gfc_handle_option): Rename verbose into dump_parse_tree.
+	* parse.c (gfc_parse_file): Use gfc_dump_parse_tree.
+
+2008-04-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+	    Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/25829 28655
+	* dump-parse-tree.c (gfc_show_code_node): Show new I/O parameters.
+	* gfortran.h (gfc_statement): Add ST_WAIT enumerator.
+	(gfc_open): Add pointers for decimal, encoding, round, sign,
+	asynchronous. (gfc_inquire): Add pointers for asynchronous, decimal,
+	encoding, pending, round, sign, size, id.
+	(gfc_wait): New typedef struct. (gfc_dt): Add pointers for id, pos,
+	asynchronous, blank, decimal, delim, pad, round, sign.
+	(gfc_exec_op): Add EXEC_WAIT enumerator. (gfc_code): Add pointer for
+	wait. (gfc_free_wait), (gfc_resolve_wait): New function prototypes.
+	* trans-stmt.h (gfc_trans_wait): New function prototype.
+	* trans.c (gfc_trans_code): Add case for EXEC_WAIT.
+	* io.c (io_tag): Add new tags for DECIMAL, ENCODING, ROUND, SIGN,
+	ASYCHRONOUS, ID. (match_open_element): Add matchers for new tags.
+	(gfc_free_open): Free new pointers. (gfc_resolve_open): Resolve new
+	tags. (gfc_resolve_open): Remove comment around check for allowed
+	values and ASYNCHRONOUS, update it.  Likewise for DECIMAL, ENCODING,
+	ROUND, and SIGN. (match_dt_element): Add matching for new tags.
+	(gfc_free_wait): New function. (gfc_resolve_wait): New function.
+	(match_wait_element): New function. (gfc_match_wait): New function.
+	* resolve.c (gfc_resolve_blocks): Add case for EXEC_WAIT.
+	(resolve_code): Add case for EXEC_WAIT. 
+	* st.c (gfc_free_statement): Add case for EXEC_WAIT.
+	* trans-io.c (ioparam_type): Add IOPARM_ptype_wait. (gfc_st_parameter):
+	Add "wait" entry. (iocall): Add IOCALL_WAIT enumerator.
+	(gfc_build_io_library_fndecls): Add function declaration for st_wait.
+	(gfc_trans_open): Add mask bits for new I/O tags.
+	(gfc_trans_inquire): Add mask bits for new I/O tags.
+	(gfc_trans_wait): New translation function.
+	(build_dt): Add mask bits for new I/O tags.
+	* match.c (gfc_match_if) Add matcher for "wait".
+	* match.h (gfc_match_wait): Prototype for new function.
+	* ioparm.def: Add new I/O parameter definitions.
+	* parse.c (decode_statement): Add match for "wait" statement.
+	(next_statement): Add case for ST_WAIT. (gfc_ascii_statement): Same.
+
+2008-04-03  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/35786
+	* openmp.c (resolve_omp_clauses): Diagnose if a clause symbol
+	isn't a variable.
+
+2008-04-03  Tom Tromey  <tromey@redhat.com>
+
+	* Make-lang.in (fortran_OBJS): New variable.
+
+2008-04-03  Paolo Bonzini  <bonzini@gnu.org>
+
+	* f95-lang.c (insert_block): Kill.
+
+2008-04-01  George Helffrich <george@gcc.gnu.org>
+
+	PR fortran/35154, fortran/23057
+	* trans-common.c (create_common):  Add decl to function
+	chain to preserve identifier scope in debug output.
+
+2008-04-01  Joseph Myers  <joseph@codesourcery.com>
+
+	* gfortran.texi: Include gpl_v3.texi instead of gpl.texi
+	* Make-lang.in (GFORTRAN_TEXI): Include gpl_v3.texi instead of
+	gpl.texi.
+
+2008-03-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35740
+	* resolve.c (resolve_function, resolve_call): If the procedure
+	is elemental do not look for noncopying intrinsics.
+
+2008-03-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35698
+	* trans-array.c (gfc_array_init_size): Set 'size' zero if
+	negative in one dimension.
+
+	PR fortran/35702
+	* trans-expr.c (gfc_trans_string_copy): Only assign a char
+	directly if the lhs and rhs types are the same.
+
+2008-03-28  Daniel Franke  <franke.daniel@gmail.com>
+	    Paul Richard Thomas <paul.richard.thomas@gmail.com>
+
+	PR fortran/34714
+	* primary.c (match_variable): Improved matching of function 
+	result variables.
+	* resolve.c (resolve_allocate_deallocate): Removed checks if
+	the actual argument for STAT is a variable.
+
+2008-03-28  Tobias Burnus  <burnus@net-b.de>
+
+	* symbol.c (gfc_get_default_type): Fix error message; option
+	-fallow_leading_underscore should be -fallow-leading-underscore
+
+2008-03-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35724
+	* iresolve.c (gfc_resolve_cshift): Check for NULL symtree in test for
+	optional argument attribute.
+
+2008-03-27  Tom Tromey  <tromey@redhat.com>
+
+	* Make-lang.in: Revert automatic dependency patch.
+
+2008-03-25  Tom Tromey  <tromey@redhat.com>
+
+	* Make-lang.in: Remove .o targets.
+	(fortran_OBJS): New variable.
+	(fortran/gfortranspec.o): Move to fortran/.  Reduce to variable
+	setting.
+	(GFORTRAN_D_OBJS): Update.
+	(GFORTRAN_TRANS_DEPS): Remove.
+
+2008-03-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34813
+	* resolve.c (resolve_structure_cons): It is an error to assign
+	NULL to anything other than a pointer or allocatable component.
+
+	PR fortran/33295
+	* resolve.c (resolve_symbol): If the symbol is a derived type,
+	resolve the derived type.  If the symbol is a derived type
+	function, ensure that the derived type is visible in the same
+	namespace as the function.
+
+2008-03-23  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* trans.h: Use fold_build in build1_v, build2_v and build3_v
+	macros.
+	* trans-openmp.c (gfc_trans_omp_critical, gfc_trans_omp_single):
+	Don't use build2_v macro.
+
+2008-03-19  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/35152
+	* interface.c (gfc_procedure_use): Check for keyworded arguments in
+	procedures without explicit interfaces.
+
+2008-03-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35470
+	* resolve.c (check_assumed_size_reference):  Only visit the
+	first reference and look directly at the highest dimension.
+
+2008-03-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35184
+	* trans-array.c (gfc_conv_array_index_offset): Remove unnecessary
+	assert.
+
+2008-03-15  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/35584
+	* resolve.c (resolve_branch): Less strict and pessimistic warning
+	message.
+
+2008-03-11  Paolo Bonzini  <bonzini@gnu.org>
+
+	* f95-lang.c (LANG_HOOKS_CLEAR_BINDING_STACK): Delete.
+	(gfc_be_parse_file): Call clear_binding_stack from here.
+	(gfc_clear_binding_stack): Rename to clear_binding_stack.
+		
+2008-03-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/35474
+	* module.c (mio_symtree_ref): After providing a symbol for a
+	missing equivalence member, resolve and NULL the fixups.
+
+2008-03-09  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
+
+	* invoke.texi (Error and Warning Options): Document
+	-Wline-truncation.
+
+2008-03-08  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/34956
+	* trans-array.c (gfc_conv_ss_startstride): Fix the logic to avoid
+	checking bounds of absent optional arguments.
+
+2008-03-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33197
+	* intrinsic.c (add_functions): Add simplification routines for
+	ERF, DERF, ERFC and DERFC.
+	* decl.c (gfc_match_suffix, gfc_match_subroutine): Change GNU
+	extensions into Fortran 2008 features.
+	* intrinsic.h (gfc_simplify_erf, gfc_simplify_erfc): New
+	prototypes.
+	* simplify.c (gfc_simplify_erf, gfc_simplify_erfc): New functions.
+
+2008-03-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33197
+	* intrinsic.c (add_functions): Modify intrinsics ACOSH, ASINH,
+	ATANH, ERF, ERFC and GAMMA. Add intrinsics BESSEL_{J,Y}{0,1,N},
+	ERFC_SCALED, LOG_GAMMA and HYPOT.
+	* intrinsic.h (gfc_check_hypot, gfc_simplify_hypot,
+	gfc_resolve_hypot): New prototypes.
+	* mathbuiltins.def: Add HYPOT builtin. Make complex versions of
+	ACOSH, ASINH and ATANH available.
+	* gfortran.h (GFC_ISYM_ERFC_SCALED, GFC_ISYM_HYPOT): New values.
+	* lang.opt: Add -std=f2008 option.
+	* libgfortran.h: Define GFC_STD_F2008.
+	* lang-specs.h: Add .f08 and .F08 file suffixes.
+	* iresolve.c (gfc_resolve_hypot): New function.
+	* parse.c (parse_contained): Allow empty CONTAINS for Fortran 2008.
+	* check.c (gfc_check_hypot): New function.
+	* trans-intrinsic.c (gfc_intrinsic_map): Define ERFC_SCALE builtin.
+	* options.c (set_default_std_flags): Allow Fortran 2008 by default.
+	(form_from_filename): Add .f08 suffix.
+	(gfc_handle_option): Handle -std=f2008 option.
+	* simplify.c (gfc_simplify_hypot): New function.
+	* gfortran.texi: Document Fortran 2008 status and file extensions.
+	* intrinsic.texi: Document new BESSEL_{J,Y}{0,1,N} intrinsics,
+	as well as HYPOT and ERFC_SCALED. Update documentation of ERF,
+	ERFC, GAMMA, LGAMMA, ASINH, ACOSH and ATANH.
+	* invoke.texi: Document the new -std=f2008 option.
+
+2008-03-02  Jakub Jelinek  <jakub@redhat.com>
+
+	* gfortranspec.c (lang_specific_driver): Update copyright notice
+	dates.
+
+2008-02-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35059
+	* expr.c (find_array_element): Modify traversing the constructor to
+	avoid trying to access NULL memory pointed to by next for the
+	last element. (find_array_section): Exit while loop if cons->next is
+	NULL.
+	* trans-expr.c (gfc_conv_scalar_char_value): Initialize gfc_typespec.
+	(gfc_conv_function_call): Same.
+	* decl.c (gfc_match_implicit): Same.
+	* trans-intrinsic.c (gfc_conv_intrinsic_sr_kind): Same.
+
+2008-02-28  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31463
+	PR fortran/33950
+	PR fortran/34296
+	* lang.opt: Added -Wreturn-type.
+	* options.c (gfc_handle_option): Recognize -Wreturn-type.
+	* trans-decl.c (gfc_trans_deferred_vars): Emit warnings for funtions
+	where the result value is not set.
+	(gfc_generate_function_code): Likewise.
+	(generate_local_decl): Emit warnings for funtions whose RESULT
+	variable is not set.
+
+2008-02-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/34868
+	* trans-expr.c (gfc_conv_variable): Don't build indirect
+	references when explicit interface is mandated.
+	* resolve.c (resolve_formal_arglist): Set attr.always_explicit
+	on the result symbol as well as the procedure symbol.
+
+2008-02-27  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33387
+	* trans.h: Remove prototypes for gfor_fndecl_math_exponent4,
+	gfor_fndecl_math_exponent8, gfor_fndecl_math_exponent10 and
+	gfor_fndecl_math_exponent16.
+	* f95-lang.c (build_builtin_fntypes): Add new function types.
+	(gfc_init_builtin_functions): Add new builtins for nextafter,
+	frexp, ldexp, fabs, scalbn and inf.
+	* iresolve.c (gfc_resolve_rrspacing): Don't add hidden arguments.
+	(gfc_resolve_scale): Don't convert type of second argument.
+	(gfc_resolve_set_exponent): Likewise.
+	(gfc_resolve_size): Don't add hidden arguments.
+	* trans-decl.c: Remove gfor_fndecl_math_exponent4,
+	gfor_fndecl_math_exponent8, gfor_fndecl_math_exponent10 and
+	gfor_fndecl_math_exponent16.
+	* trans-intrinsic.c (gfc_intrinsic_map): Remove intrinsics
+	for scalbn, fraction, nearest, rrspacing, set_exponent and
+	spacing.
+	(gfc_conv_intrinsic_exponent): Directly call frexp.
+	(gfc_conv_intrinsic_fraction, gfc_conv_intrinsic_nearest,
+	gfc_conv_intrinsic_spacing, gfc_conv_intrinsic_rrspacing,
+	gfc_conv_intrinsic_scale, gfc_conv_intrinsic_set_exponent): New
+	functions.
+	(gfc_conv_intrinsic_function): Use the new functions above.
+
+2008-02-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/35033
+	* interface.c (check_operator_interface): Show better line for error
+	messages; fix constrains for user-defined assignment operators.
+	(gfc_extend_assign): Fix constrains for user-defined assignment
+	operators.
+
+2008-02-26  Tom Tromey  <tromey@redhat.com>
+
+	* trans-io.c (set_error_locus): Remove old location code.
+	* trans-decl.c (gfc_set_decl_location): Remove old location code.
+	* f95-lang.c (gfc_init): Remove test of USE_MAPPED_LOCATION.
+	* scanner.c (gfc_gobble_whitespace): Remove old location code.
+	(get_file): Likewise.
+	(preprocessor_line): Likewise.
+	(load_file): Likewise.
+	(gfc_new_file): Likewise.
+	* trans.c (gfc_trans_runtime_check): Remove old location code.
+	(gfc_get_backend_locus): Likewise.
+	(gfc_set_backend_locus): Likewise.
+	* data.c (gfc_assign_data_value): Remove old location code.
+	* error.c (show_locus): Remove old location code.
+	* gfortran.h (gfc_linebuf): Remove old location code.
+	(gfc_linebuf_linenum): Remove old-location variant.
+
+2008-02-25  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/34729
+	* trans-const.c (gfc_build_string_const): Don't call gettext.
+	(gfc_build_localized_string_const): New function.
+	* trans-const.h (gfc_build_localized_string_const): New prototype.
+	* trans.c (gfc_trans_runtime_check): Use
+	gfc_build_localized_string_const instead of gfc_build_string_const.
+	(gfc_call_malloc): Likewise.
+	(gfc_allocate_with_status): Likewise.
+	(gfc_allocate_array_with_status): Likewise.
+	(gfc_deallocate_with_status): Likewise.
+	(gfc_call_realloc): Likewise.
+	* trans-io.c (gfc_trans_io_runtime_check): Likewise.
+
+2008-02-24  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* arith.c: Update copyright years.
+	* arith.h: Likewise.
+	* array.c: Likewise.
+	* bbt.c: Likewise.
+	* check.c: Likewise.
+	* data.c: Likewise.
+	* data.h: Likewise.
+	* decl.c: Likewise.
+	* dependency.c: Likewise.
+	* dependency.h: Likewise.
+	* dump-parse-tree.c: Likewise.
+	* error.c: Likewise.
+	* expr.c: Likewise.
+	* gfc-internals.texi: Likewise.
+	* gfortran.h: Likewise.
+	* gfortran.texi: Likewise.
+	* gfortranspec.c: Likewise.
+	* interface.c: Likewise.
+	* intrinsic.c: Likewise.
+	* intrinsic.h: Likewise.
+	* intrinsic.texi: Likewise.
+	* invoke.texi: Likewise.
+	* io.c: Likewise.
+	* iresolve.c: Likewise.
+	* iso-c-binding.def: Likewise.
+	* iso-fortran-env.def: Likewise.
+	* lang-specs.h: Likewise.
+	* lang.opt: Likewise.
+	* libgfortran.h: Likewise.
+	* match.c: Likewise.
+	* match.h: Likewise.
+	* matchexp.c: Likewise.
+	* misc.c: Likewise.
+	* module.c: Likewise.
+	* openmp.c: Likewise.
+	* options.c: Likewise.
+	* parse.c: Likewise.
+	* parse.h: Likewise.
+	* primary.c: Likewise.
+	* resolve.c: Likewise.
+	* scanner.c: Likewise.
+	* simplify.c: Likewise.
+	* st.c: Likewise.
+	* symbol.c: Likewise.
+	* target-memory.c: Likewise.
+	* target-memory.h: Likewise.
+	* trans-array.h: Likewise.
+	* trans-const.h: Likewise.
+	* trans-stmt.h: Likewise.
+	* trans-types.c: Likewise.
+	* trans-types.h: Likewise.
+	* types.def: Likewise.
+
+2008-02-24  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35223
+	* simplify.c (gfc_simplify_ibclr), (gfc_simplify_ibits),
+	(gfc_simplify_ibset): Remove call to range_check.
+	(simplify_cmplx), (gfc_simplify_dble), (gfc_simplify_float)
+	(gfc_simplify_real): Add call gfc_clear_ts to initialize the
+	temporary gfc_typspec variable.
+
+2008-02-24  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* trans-array.c (gfc_conv_descriptor_data_get,
+	gfc_conv_descriptor_data_set_internal,
+	gfc_conv_descriptor_data_addr, gfc_conv_descriptor_offset,
+	gfc_conv_descriptor_dtype, gfc_conv_descriptor_dimension,
+	gfc_conv_descriptor_stride, gfc_conv_descriptor_lbound,
+	gfc_conv_descriptor_ubound, gfc_trans_create_temp_array,
+	gfc_conv_array_transpose, gfc_grow_array,
+	gfc_trans_array_constructor_subarray,
+	gfc_trans_array_constructor_value, gfc_trans_scalarized_loop_end,
+	gfc_array_init_size, gfc_array_allocate, gfc_array_deallocate,
+	gfc_conv_array_initializer, gfc_trans_array_bounds,
+	gfc_trans_auto_array_allocation, gfc_trans_dummy_array_bias,
+	gfc_get_dataptr_offset, gfc_conv_array_parameter,
+	gfc_trans_dealloc_allocated, get_full_array_size,
+	gfc_duplicate_allocatable, structure_alloc_comps): Use fold_buildN
+	instead of buildN.
+	* trans-expr.c (gfc_conv_expr_present, gfc_conv_missing_dummy,
+	gfc_conv_component_ref, gfc_conv_cst_int_power,
+	gfc_conv_function_call, gfc_trans_structur_assign): Likewise.
+	* trans-common.c (create_common): Likewise.
+	* trans-openmp.c (gfc_trans_omp_atomic, gfc_trans_omp_do):
+	Likewise.
+	* trans-const.c (gfc_conv_constant_to_tree): Likewise.
+	* trans-stmt.c (gfc_trans_goto, gfc_trans_return, gfc_trans_do,
+	gfc_trans_integer_select, gfc_trans_character_select,
+	gfc_trans_forall_loop, compute_overall_iter_number,
+	gfc_trans_forall_1, gfc_evaluate_where_mask, gfc_trans_allocate,
+	gfc_trans_deallocate): Likewise.
+	* trans.c (gfc_build_addr_expr, gfc_trans_runtime_check,
+	gfc_allocate_with_status, gfc_allocate_array_with_status,
+	gfc_deallocate_with_status): Likewise.
+	* f95-lang.c (gfc_truthvalue_conversion): Likewise.
+	* trans-io.c (set_parameter_const, set_parameter_value,
+	set_parameter_ref, set_string, set_internal_unit, io_result,
+	set_error_locus, nml_get_addr_expr, transfer_expr): Likewise.
+	* trans-decl.c (gfc_build_qualified_array, build_entry_thunks,
+	gfc_get_fake_result_decl, gfc_trans_auto_character_variable,
+	gfc_generate_function_code): Likewise.
+	* convert.c (convert): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_conversion,
+	build_fixbound_expr, build_fix_expr, gfc_conv_intrinsic_aint,
+	gfc_conv_intrinsic_int, gfc_conv_intrinsic_imagpart,
+	gfc_conv_intrinsic_conjg, gfc_conv_intrinsic_abs,
+	gfc_conv_intrinsic_cmplx, gfc_conv_intrinsic_mod,
+	gfc_conv_intrinsic_dim, gfc_conv_intrinsic_dprod,
+	gfc_conv_intrinsic_ctime, gfc_conv_intrinsic_fdate,
+	gfc_conv_intrinsic_ttynam, gfc_conv_intrinsic_minmax,
+	gfc_conv_intrinsic_minmax_char, gfc_conv_intrinsic_count,
+	gfc_conv_intrinsic_arith, gfc_conv_intrinsic_dot_product,
+	gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_minmaxval,
+	gfc_conv_intrinsic_btest, gfc_conv_intrinsic_not,
+	gfc_conv_intrinsic_ibits, gfc_conv_intrinsic_ishft,
+	gfc_conv_intrinsic_ichar, gfc_conv_intrinsic_size,
+	gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_transfer,
+	gfc_conv_allocated, gfc_conv_associated, gfc_conv_intrinsic_trim,
+	gfc_conv_intrinsic_repeat): Likewise.
+
+2008-02-23  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR target/25477
+	* trans-expr.c (gfc_conv_power_op): Use BUILT_IN_CPOW{F,,L}.
+	* f95-lang.c (gfc_init_builtin_functions): Define BUILT_IN_CPOW{F,,L}.
+	* trans.h (gfor_fndecl_math_cpow, gfor_fndecl_math_cpowf,
+	gfor_fndecl_math_cpowl10, gfor_fndecl_math_cpowl16): Remove.
+	* trans-decl.c: Likewise.
+
+2008-02-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35059
+	* expr.c (find_array_element): Modify traversing the constructor to
+	avoid trying to access NULL memory pointed to by next for the
+	last element. (find_array_section): Exit while loop if cons->next is
+	NULL.
+
+2008-02-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/34907
+	* iresolve.c (resolve_mask_arg): Add gfc_clear_ts to initialize
+	structure.
+	(gfc_resolve_aint): Likewise.
+	(gfc_resolve_anint): Likewise.
+	(gfc_resolve_besn): Likewise.
+	(gfc_resolve_cshift): Likewise.
+	(gfc_resolve_ctime): Likewise.
+	(gfc_resolve_eoshift): Likewise.
+	(gfc_resolve_index_func): Likewise.
+	(gfc_resolve_isatty): Likewise.
+	(gfc_resolve_malloc): Likewise.
+	(gfc_resolve_rrspacing): Likewise.
+	(gfc_resolve_scale): Likewise.
+	(gfc_resolve_set_exponent): Likewise.
+	(gfc_resolve_spacing): Likewise.
+	(gfc_resolve_spacing): Likewise.
+	(gfc_resolve_fgetc): Likewise.
+	(gfc_resolve_fputc): Likewise.
+	(gfc_resolve_ftell): Likewise.
+	(gfc_resolve_ttynam): Likewise.
+	(gfc_resolve_alarm_sub): Likewise.
+	(gfc_resolve_mvbits): Likewise.
+	(gfc_resolve_getarg): Likewise.
+	(gfc_resolve_signal_sub): Likewise.
+	(gfc_resolve_exit): Likewise.
+	(gfc_resolve_flush): Likewise.
+	(gfc_resolve_free): Likewise.
+	(gfc_resolve_ctime_sub): Likewise.
+	(gfc_resolve_fgetc_sub): Likewise.
+	(gfc_resolve_fputc_sub): Likewise.
+	(gfc_resolve_fseek_sub): Likewise.
+	(gfc_resolve_ftell_sub): Likewise.
+	(gfc_resolve_ttynam_sub): Likewise.
+
+2008-02-22  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
+
+	* gfc-internals.texi: Fix typos and markup nits.
+	* gfortran.texi: Likewise.
+	* intrinsic.texi: Likewise.
+
+2008-02-21  Richard Guenther  <rguenther@suse.de>
+
+	* trans-expr.c (gfc_conv_expr_op): Expand INTRINSIC_PARENTHESES
+	as unary PAREN_EXPR for real and complex typed expressions.
+	(gfc_conv_unary_op): Fold the built tree.
+
+2008-02-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34997
+	* match.c (gfc_match_name): Improve error message for '$'.
+
+2008-02-19  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/35030
+	* expr.c (gfc_check_pointer_assign): Add type and kind information
+	to type-mismatch message.
+	(gfc_check_assign): Unify error messages.
+
+2008-02-16  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/34952
+	* gfortran.texi: Create new section for unimplemented extensions.
+	Add "STRUCTURE and RECORD" and "ENCODE and DECODE statements".
+	Remove "smaller projects" list. Fix a few typos.
+
+2008-02-15  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* intrinsic.texi: Rename INDEX node to avoid clashing with
+	index.html on case-insensitive systems.
+
+2008-02-15  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/35150
+	* trans-expr.c (gfc_conv_function_call): Force evaluation of
+	se->expr.
+
+2008-02-10  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/35019
+	* lang.opt: Allow '-J<dir>' next to '-J <dir>', 
+	likewise '-I <dir>' and '-I<dir>'.
+
+2008-02-06  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	PR other/35107
+	* Make-lang.in (f951): Add $(GMPLIBS).
+
+2008-02-05  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/35037
+	* trans-common.c (build_field): Mark fields as volatile when needed.
+
+2008-02-05  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/35093
+	* data.c (gfc_assign_data_value): Only free "size" if
+	it has not already been freed.
+
+2008-02-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34945
+	* array.c (match_array_element_spec): Remove check for negative
+	array size.
+	(gfc_resolve_array_spec): Add check for negative size.
+
+2008-02-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32315
+	* data.c (gfc_assign_data_value): Add bounds check for array
+	references.
+
+2008-02-04  Daniel Franke  <franke.daniel@gmail.com>
+
+	* resolve.c (resolve_where): Fix typo.
+	(gfc_resolve_where_code_in_forall): Likewise.
+
+2008-02-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32760
+	* resolve.c (resolve_allocate_deallocate): New function.
+	(resolve_code): Call it for allocate and deallocate.
+	* match.c (gfc_match_allocate, gfc_match_deallocate) : Remove
+	the checking of the STAT tag and put in above new function.
+	* primary,c (match_variable): Do not fix flavor of host
+	associated symbols yet if the type is not known.
+
+2008-01-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34910
+	* expr.c (gfc_check_assign): It is an error to assign
+	to a sibling procedure.
+
+2008-01-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34975
+	* symbol.c (gfc_delete_symtree, gfc_undo_symbols): Rename
+	delete_symtree to gfc_delete_symtree.
+	* gfortran.h : Add prototype for gfc_delete_symtree.
+	* module.c (load_generic_interfaces): Transfer symbol to a
+	unique symtree and delete old symtree, instead of renaming.
+	(read_module): The rsym and the found symbol are the same, so
+	the found symtree can be deleted.
+
+	PR fortran/34429
+	* decl.c (match_char_spec): Remove the constraint on deferred
+	matching of functions and free the length expression.
+	delete_symtree to gfc_delete_symtree.
+	(gfc_match_type_spec): Whitespace.
+	(gfc_match_function_decl): Defer characteristic association for
+	all types except BT_UNKNOWN.
+	* parse.c (decode_specification_statement): Only derived type
+	function matching is delayed to the end of specification.
+
+2008-01-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR libfortran/34980
+	* simplify.c (gfc_simplify_shape): Simplify rank zero arrays.
+
+2008-01-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/34990
+	* array.c (gfc_check_constructor_type): Revert clearing the expression.
+
+2008-01-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34848
+	* trans-expr.c (gfc_conv_function_call): Don't call
+	gfc_add_interface_mapping if the expression is NULL.
+
+2008-01-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/31610
+	* trans-array.c (gfc_trans_create_temp_array): Remove call to
+	gcc_assert (integer_zerop (loop->from[n])).
+
+2008-01-25  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/34661
+	* resolve.c (resolve_where): Added check if user-defined assignment 
+	operator is an elemental subroutine.
+	(gfc_resolve_where_code_in_forall): Likewise.
+
+2008-01-24  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/33375
+	PR fortran/34858
+	* gfortran.h: Revert changes from 2008-01-17.
+	* match.c: Likewise.
+	* symbol.c: Likewise.
+	(gfc_undo_symbols): Undo namespace changes related to common blocks.
+
+2008-01-24  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/34202
+	* data.c (formalize_structure_cons): Skip formalization on
+	empty structures.
+
+2008-01-24  Daniel Franke  <franke.daniel@gmail.com>
+
+	* gfortran.texi (OpenMP): Extended existing documentation.
+	(contributors): Added major contributors of 2008 that were
+	not listed yet.
+	(proposed extensions): Removed implemented items.
+
+2008-01-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34872
+	* parse.c (next_statement) : If ST_GET_FCN_CHARACTERISTICS  is
+	seen, check for a statement label and, if present, delete it
+	and set the locus to the start of the statement.
+
+2008-01-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34875
+	* trans-io.c (gfc_trans_transfer): If the array reference in a
+	read has a vector subscript, use gfc_conv_subref_array_arg to
+	copy back the temporary.
+
+2008-01-22  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34848
+	* interface.c (compare_actual_formal): Fix adding type
+	to missing_arg_type for absent optional arguments.
+
+2008-01-22  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34907
+	* parse.c (parse_spec): Change = into ==.
+
+2008-01-22  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/34915
+	* expr.c (check_elemental): Fix check for valid data types.
+
+2008-01-22  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34899
+	* scanner.c (load_line): Support <tab><digit> continuation lines.
+	* invoke.texi (-Wtabs): Document this.
+
+2008-01-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34896
+	* module.c (read_module): Set use_rename attribute.
+
+2008-01-21  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34901
+	* interface.c (compare_parameter): Improved error message
+	for arguments of same type and mismatched kinds.
+
+2008-01-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34861
+	* resolve.c (resolve_entries): Do not do an array bounds check
+	if the result symbols are the same.
+
+	PR fortran/34854
+	* module.c (read_module) : Hide the symtree of the previous
+	version of the symbol if this symbol is renamed.
+
+2008-01-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34784
+	* array.c (gfc_check_constructor_type): Clear the expression ts
+	so that the checking starts from the deepest level of array
+	constructor.
+	* primary.c (match_varspec): If an unknown type is changed to
+	default character and the attempt to match a substring fails,
+	change it back to unknown.
+
+	PR fortran/34785
+	* trans-array.c (gfc_add_loop_ss_code) : If ss->string_length is
+	NULL for an array constructor, use the cl.length expression to
+	build it.
+	(gfc_conv_array_parameter): Change call to gfc_evaluate_now to
+	a tree assignment.
+
+2008-01-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/34817
+	PR fortran/34838
+	* iresolve.c (gfc_resolve_all):  Remove conversion of mask
+	argument to kind=1 by removing call to resolve_mask_arg().
+	(gfc_resolve_any):  Likewise.
+
+2008-01-19  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34760
+	* primary.c (match_variable): Handle FL_UNKNOWN without
+	uneducated guessing.
+	(match_variable): Improve error message.
+
+2008-01-18  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32616
+	* interface.c (get_expr_storage_size): Return storage size
+	for array element designators.
+	(compare_actual_formal): Reject unequal string sizes for
+	assumed-shape dummy arguments. And fix error message for
+	array-sections with vector subscripts.
+
+2008-01-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/34556
+	* simplify.c (is_constant_array_expr): New static function that returns
+	true if the given expression is an array and is constant.
+	(gfc_simplify_reshape): Use new function.
+
+2008-01-17  H.J. Lu  <hongjiu.lu@intel.com>
+
+	PR fortran/33375
+	* symbol.c (free_common_tree): Renamed to ...
+	(gfc_free_common_tree): This.  Remove static.
+	(gfc_free_namespace): Updated.
+
+	* gfortran.h (gfc_free_common_tree): New.
+
+	* match.c (gfc_match_common): Call gfc_free_common_tree () with
+	gfc_current_ns->common_root and set gfc_current_ns->common_root
+	to NULL on syntax error.
+
+2008-01-18  Richard Sandiford  <rsandifo@nildram.co.uk>
+
+	PR fortran/34686
+	* trans-expr.c (gfc_conv_function_call): Use proper
+	type for returned character pointers.
+
+2008-01-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34429
+	PR fortran/34431
+	PR fortran/34471
+	* decl.c : Remove gfc_function_kind_locus and
+	gfc_function_type_locus. Add gfc_matching_function.
+	(match_char_length): If matching a function and the length
+	does not match, return MATCH_YES and try again later.
+	(gfc_match_kind_spec): The same.
+	(match_char_kind): The same.
+	(gfc_match_type_spec): The same for numeric and derived types.
+	(match_prefix): Rename as gfc_match_prefix.
+	(gfc_match_function_decl): Except for function valued character
+	lengths, defer applying kind, type and charlen info until the
+	end of specification block.
+	gfortran.h (gfc_statement): Add ST_GET_FCN_CHARACTERISTICS.
+	parse.c (decode_specification_statement): New function.
+	(decode_statement): Call it when a function has kind = -1. Set
+	and reset gfc_matching function, as function statement is being
+	matched.
+	(match_deferred_characteristics): Simplify with a single call
+	to gfc_match_prefix. Do appropriate error handling. In any
+	case, make sure that kind = -1 is reset or corrected.
+	(parse_spec): Call above on seeing ST_GET_FCN_CHARACTERISTICS.
+	Throw an error if kind = -1 after last specification statement.
+	parse.h : Prototype for gfc_match_prefix.
+
+2008-01-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34796
+	* interface.c (compare_parameter): Allow AS_DEFERRED array
+	elements and reject attr.pointer array elemenents.
+	(get_expr_storage_size): Return storage size of elements of
+	assumed-shape and pointer arrays.
+
+2008-01-15  Sebastian Pop  <sebastian.pop@amd.com>
+
+	* f95-lang.c (gfc_init_builtin_functions): Initialize GOMP builtins
+	for flag_tree_parallelize_loops.
+
+2008-01-15  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR libfortran/34671
+	* iresolve.c (gfc_resolve_all):  Call resolve_mask_arg.
+	(gfc_resolve_any):  Likewise.
+	(gfc_resolve_count):  Likewise.  Don't append kind of
+	argument to function name.
+
+2008-01-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34665
+	* resolve.c (resolve_actual_arglist): For expressions,
+	also check for assume-sized arrays.
+	* interface.c (compare_parameter): Move F2003 character checks
+	here, print error messages here, reject elements of
+	assumed-shape array as argument to dummy arrays.
+	(compare_actual_formal): Update for the changes above.
+
+2008-01-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34763
+	* decl.c (contained_procedure): Only check directly preceeding state.
+
+2008-01-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34759
+	* check.c (gfc_check_shape): Accept array ranges of
+	assumed-size arrays.
+
+2008-01-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/34432
+	* match.c (gfc_match_name): Don't error if leading character is a '(',
+	just return MATCH_NO.
+
+2008-01-11  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/34722
+	* trans-io.c (create_dummy_iostat): Commit the symbol.
+
+2008-01-11  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34537
+	* simplify.c (gfc_simplify_transfer): Return NULL if the size
+	of the element is unavailable and only assign character length
+	to the result, if 'mold' is constant.
+
+2008-01-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34396
+	* trans-array.c (gfc_trans_array_ctor_element):  Use gfc_trans_string_copy
+	to assign strings and perform bounds checks on the string length.
+	(get_array_ctor_strlen): Remove bounds checking.
+	(gfc_trans_array_constructor): Initialize string length checking.
+	* trans-array.h : Add prototype for gfc_trans_string_copy.
+
+2008-01-08  Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/34706
+	PR tree-optimization/34683
+	* trans-types.c (gfc_get_array_type_bounds): Use an array type
+	with known size for accesses if that is known.
+
+2008-01-08  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34476
+	* expr.c (find_array_element): Check that the array bounds are
+	constant before using them.  Use lower, as well as upper bound.
+	(check_restricted): Allow implied index variable.
+
+2008-01-08  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34681
+	* trans_array.c (gfc_trans_deferred_array): Do not null the
+	data pointer on entering scope, nor deallocate it on leaving
+	scope, if the symbol has the 'save' attribute.
+
+	PR fortran/34704
+	* trans_decl.c (gfc_finish_var_decl): Derived types with
+	allocatable components and an initializer must be TREE_STATIC.
+
+2008-01-07  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34672
+	* module.c (write_generic): Rewrite completely.
+	(write_module): Change call to write_generic.
+
+2008-01-06  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/34659
+	* scanner.c (load_line): Do not count ' ' as printable when checking for
+	continuations.
+
+2008-01-06  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34545
+	* module.c (load_needed): If the namespace has no proc_name
+	give it the module symbol.
+
+2008-01-06  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/34387
+	* trans-expr.c (gfc_conv_missing_dummy): Use a temporary to type convert
+	the dummy variable expression, test for NULL, and pass the variable
+	address to the called function.
+
+2008-01-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34658
+	* match.c (gfc_match_common): Remove blank common in
+	DATA BLOCK warning.
+	* resolve.c (resolve_common_vars): New function.
+	(resolve_common_blocks): Move checks to resolve_common_vars
+	and invoke that function.
+	(resolve_types): Call resolve_common_vars for blank commons.
+
+2008-01-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34655
+	* resolve.c (resolve_equivalence_derived): Reject derived types with
+	default initialization if equivalenced with COMMON variable.
+
+2008-01-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34654
+	* io.c (check_io_constraints): Disallow unformatted I/O for
+	internal units.
+
+2008-01-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34660
+	* resolve.c (resolve_formal_arglist): Reject dummy procedure in
+	ELEMENTAL functions.
+
+2008-01-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34662
+	* interface.c (compare_actual_formal): Reject parameter
+	actual to intent(out) dummy.
+
+2008-01-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34557
+	* primary.c (match_varspec): Gobble whitespace before
+	checking for '('.
+
+
+Copyright (C) 2008 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved.
diff --git a/gcc/fortran/ChangeLog-2009 b/gcc/fortran/ChangeLog-2009
new file mode 100644
index 000000000..43d206a14
--- /dev/null
+++ b/gcc/fortran/ChangeLog-2009
@@ -0,0 +1,3710 @@
+2009-12-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42517
+	* invoke.texi: Document the interference of
+	-fcheck=recursion and -fopenmp.
+	* trans-decl.c (gfc_generate_function_code): Disable -fcheck=recursion
+	when used with -fopenmp.
+
+2009-12-28  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42353
+	* symbol.c (gfc_find_derived_vtab): Make vtabs and vtypes private.
+
+2009-12-27  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+	    Daniel Kraft  <d@domob.eu>
+
+	PR fortran/22552
+	* lang.opt (Wimplicit-procedure): New option.
+	* gfortran.h (struct gfc_option_t): New member `warn_implicit_procedure'
+	* options.c (gfc_handle_option): Handle -Wimplicit-procedure.
+	* interface.c (gfc_procedure_use): Warn about procedure never
+	explicitly declared if requested by the new flag.
+	* invoke.texi: Document new flag -Wimplicit-procedure.
+
+2009-12-17  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42144
+	* trans-expr.c (select_class_proc): Skip abstract base types.
+
+2009-12-16  Kazu Hirata  <kazu@codesourcery.com>
+
+	* gfc-internals.texi, gfortran.texi, invoke.texi: Fix typos.
+	Follow spelling conventions.
+
+2009-12-15  Tobias Burnus  <burnus@net-b.de>
+	    Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/41235
+	* resolve.c (resolve_global_procedure): Add check for
+	presence of an explicit interface for nonconstant,
+	nonassumed character-length functions.
+	(resolve_fl_procedure): Remove check for nonconstant
+	character-length functions.
+
+2009-12-14  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/42354
+	* expr.c (check_init_expr): Do not check for specification functions.
+
+2009-12-11  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42257
+	* module.c (write_dt_extensions): Check for accessibility.
+
+2009-12-11  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/40290
+	* expr.c (gfc_type_convert_binary): Added warn-on-conversion flag,
+	passed on to gfc_convert_type_warn() instead of gfc_convert_type();
+	enabled warnings on all callers but ...
+	* arith.c (eval_intrinsic): Disabled warnings on implicit type
+	conversion.
+	* gfortran.h gfc_type_convert_binary): Adjusted prototype.
+
+2009-12-11  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42335
+	* symbol.c (select_type_insert_tmp): Add an extra check for
+	error recovery.
+
+2009-12-10  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/40287
+	* iresolve.c (resolve_mask_arg): Disabled warning on conversion
+	to LOGICAL(1).
+
+2009-12-10  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/41369
+	* parse.c (match_deferred_characteristics): Removed check for empty
+	types in function return values.
+
+2009-12-10  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/34402
+	* expr.c (check_alloc_comp_init): New.
+	(check_init_expr): Verify that allocatable components
+	are not data-initalized.
+
+2008-12-08  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/41177
+	* gfortran.h (struct symbol_attribute): New flag `class_pointer'.
+	* symbol.c (gfc_build_class_symbol): Set the new flag.
+	* resolve.c (update_compcall_arglist): Remove wrong check for
+	non-scalar base-object.
+	(check_typebound_baseobject): Add the correct version here as well
+	as some 'not implemented' message check in the old case.
+	(resolve_typebound_procedure): Check that the passed-object dummy
+	argument is scalar, non-pointer and non-allocatable as it should be.
+
+2009-12-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40961
+	PR fortran/40377
+	* gfortran.texi (Non-Fortran Main Program): Add
+	_gfortran_set_fpe documentation.
+	(Interoperability with C): Mention array storage order.
+
+2009-12-07  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/41940
+	* match.c (gfc_match_allocate): Improved error message for
+	allocatable scalars that are allocated with a shape.
+
+2009-12-07  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	PR other/40302
+	* arith.c: Remove HAVE_mpc* checks throughout.
+	* expr.c: Likewise.
+	* gfortran.h: Likewise.
+	* resolve.c: Likewise.
+	* simplify.c: Likewise.
+	* target-memory.c: Likewise.
+	* target-memory.h: Likewise.
+
+2009-12-06  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/40904
+	* intrinsics.texi: Fixed description of COUNT.
+
+2009-12-01  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/42131
+	* trans-stmt.c (gfc_trans_do): Sign test using ternary operator.
+
+2009-11-30  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42053
+	* resolve.c (resolve_select_type): Check for duplicate CLASS IS blocks.
+
+2009-11-30  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41631
+	* decl.c (gfc_match_derived_decl): Set extension level.
+	* gfortran.h (symbol_attribute): Expand 'extension' bit field to 8 bit.
+	* iresolve.c (gfc_resolve_extends_type_of): Return value of
+	'is_extension_of' has kind=4.
+	* match.c (select_type_set_tmp,gfc_match_class_is): Create temporary
+	for CLASS IS blocks.
+	* module.c (MOD_VERSION): Bump module version.
+	(ab_attribute,attr_bits): Remove AB_EXTENSION.
+	(mio_symbol_attribute): Handle expanded 'extension' field.
+	* resolve.c (resolve_select_type): Implement CLASS IS blocks.
+	(resolve_fl_variable_derived): Show correct type name.
+	* symbol.c (gfc_build_class_symbol): Set extension level.
+
+2009-11-30  Janus Weil  <janus@gcc.gnu.org>
+
+	* intrinsic.h (gfc_resolve_extends_type_of): Add prototype.
+	* intrinsic.c (add_functions): Use 'gfc_resolve_extends_type_of'.
+	* iresolve.c (gfc_resolve_extends_type_of): New function, which
+	replaces the call to EXTENDS_TYPE_OF by the library function
+	'is_extension_of' and modifies the arguments.
+	* trans-intrinsic.c (gfc_conv_extends_type_of): Removed.
+	(gfc_conv_intrinsic_function): FOR EXTENDS_TYPE_OF, don't call
+	gfc_conv_extends_type_of but gfc_conv_intrinsic_funcall.
+
+2009-11-30  Paul Thomas  <pault@gcc.gnu.org>
+	    Janus Weil  <janus@gcc.gnu.org>
+
+	* decl.c (encapsulate_class_symbol): Replaced by
+	'gfc_build_class_symbol'.
+	(build_sym,build_struct): Call 'gfc_build_class_symbol'.
+	(gfc_match_derived_decl): Replace vindex by hash_value.
+	* dump-parse-tree.c (show_symbol): Replace vindex by hash_value.
+	* gfortran.h (symbol_attribute): Add field 'vtab'.
+	(gfc_symbol): Replace vindex by hash_value.
+	(gfc_class_esym_list): Ditto.
+	(gfc_get_derived_type,gfc_build_class_symbol,gfc_find_derived_vtab):
+	New prototypes.
+	* module.c (mio_symbol): Replace vindex by hash_value.
+	* resolve.c (vindex_expr): Rename to 'hash_value_expr'.
+	(resolve_class_compcall,resolve_class_typebound_call): Renamed
+	'vindex_expr'.
+	(resolve_select_type): Replace $vindex by $vptr->$hash.
+	* symbol.c (gfc_add_save): Handle vtab symbols.
+	(gfc_type_compatible): Rewrite.
+	(gfc_build_class_symbol): New function which replaces
+	'encapsulate_class_symbol'.
+	(gfc_find_derived_vtab): New function to set up a vtab symbol for a
+	derived type.
+	* trans-decl.c (gfc_create_module_variable): Handle vtab symbols.
+	* trans-expr.c (select_class_proc): Replace vindex by hash_value.
+	(gfc_conv_derived_to_class): New function to construct a temporary
+	CLASS variable from a derived type expression.
+	(gfc_conv_procedure_call): Call 'gfc_conv_derived_to_class'.
+	(gfc_conv_structure): Initialize the $extends and $size fields of
+	vtab symbols.
+	(gfc_trans_class_assign): Replace $vindex by $vptr. Remove the $size
+	assignment.
+	* trans-intrinsic.c (gfc_conv_same_type_as): Replace $vindex by
+	$vptr->$hash, and replace vindex by hash_value.
+	* trans-stmt.c (gfc_trans_allocate): Insert $vptr references, replace
+	$vindex by $vptr. Remove the $size assignment.
+	* trans-types.c (gfc_get_derived_type): Make it non-static.
+
+2009-11-30  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/42131
+	* trans-stmt.c (gfc_trans_do):  Calculate loop count
+	without if statements.
+
+2009-11-28  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-common.c (create_common): Remove unused offset variable.
+	* io.c (gfc_match_wait): Remove unused loc variable.
+	* trans-openmp.c (gfc_trans_omp_clauses): Remove unused old_clauses
+	variable.
+	(gfc_trans_omp_do): Remove unused outermost variable.
+	* iresolve.c (gfc_resolve_alarm_sub, gfc_resolve_fseek_sub): Remove
+	unused status variable.
+	* module.c (number_use_names): Remove unused c variable.
+	(load_derived_extensions): Remove unused nuse variable.
+	* trans-expr.c (gfc_conv_substring): Remove unused var variable.
+	* trans-types.c (gfc_get_array_descr_info): Remove unused offset_off
+	variable.
+	* matchexp.c (match_primary): Remove unused where variable.
+	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Remove unused cond2
+	variable.
+	(gfc_conv_intrinsic_sizeof): Remove unused source variable.
+	(gfc_conv_intrinsic_transfer): Remove unused stride variable.
+	(gfc_conv_intrinsic_function): Remove unused isym variable.
+	* arith.c (gfc_hollerith2real, gfc_hollerith2complex,
+	gfc_hollerith2logical): Remove unused len variable.
+	* parse.c (parse_derived): Remove unused derived_sym variable.
+	* decl.c (variable_decl): Remove unused old_locus variable.
+	* resolve.c (check_class_members): Remove unused tbp_sym variable.
+	(resolve_ordinary_assign): Remove unused assign_proc variable.
+	(resolve_equivalence): Remove unused value_name variable.
+	* data.c (get_array_index): Remove unused re variable.
+	* trans-array.c (gfc_conv_array_transpose): Remove unused src_info
+	variable.
+	(gfc_conv_resolve_dependencies): Remove unused aref and temp_dim
+	variables.
+	(gfc_conv_loop_setup): Remove unused dim and len variables.
+	(gfc_walk_variable_expr): Remove unused head variable.
+	* match.c (match_typebound_call): Remove unused var variable.
+	* intrinsic.c (gfc_convert_chartype): Remove unused from_ts variable.
+
+2009-11-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/41807
+	* trans-const.c (gfc_conv_const): Set se->expr to a constant on error.
+
+2009-11-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/41278
+	* trans-array.c (gfc_conv_array_transpose): Delete unnecessary assert.
+
+2009-11-26  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42048
+	PR fortran/42167
+	* gfortran.h (gfc_is_function_return_value): New prototype.
+	* match.c (gfc_match_call): Use new function
+	'gfc_is_function_return_value'.
+	* primary.c (gfc_is_function_return_value): New function to check if a
+	symbol is the return value of an encompassing function.
+	(match_actual_arg,gfc_match_rvalue,match_variable): Use new function
+	'gfc_is_function_return_value'.
+	* resolve.c (resolve_common_blocks,resolve_actual_arglist): Ditto.
+
+2009-11-25  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/42162
+	* trans-openmp.c (gfc_trans_omp_do): When dovar isn't a VAR_DECL,
+	don't use simple loop and handle clauses properly.
+
+2009-11-24  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/42008
+	* decl.c (variable_decl): Do not error on initialization within a
+	derived type specification of a pure procedure.
+
+2009-11-24  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42045
+	* resolve.c (resolve_actual_arglist): Make sure procedure pointer
+	actual arguments are resolved correctly.
+	(resolve_function): An EXPR_FUNCTION which is a procedure pointer
+	component, has already been resolved.
+	(resolve_fl_derived): Procedure pointer components should not be
+	implicitly typed.
+
+2009-11-21  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/41807
+	* trans-const.c (gfc_conv_const): Fix typo in comment. Replace assert
+	with error message if not constant.
+	* resolve.c (next_data_value): Delete check for constant.
+
+2009-11-20  Janus Weil  <janus@gcc.gnu.org>
+
+	* intrinsic.texi (C_F_PROCPOINTER): Remove obsolete comment.
+
+2009-11-20  Paul Thomas  <pault@gcc.gnu.org>
+	    Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42104
+	* trans-expr.c (gfc_conv_procedure_call): If procedure pointer
+	component call, use the component's 'always_explicit' attr
+	for array arguments.
+
+2009-11-19  Janus Weil  <janus@gcc.gnu.org>
+
+	* trans-expr.c (conv_isocbinding_procedure): New function.
+	(gfc_conv_procedure_call): Move ISO_C_BINDING stuff to
+	separate function.
+
+2009-11-19  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi (Interoperable Subroutines and Functions): Fix
+	example.
+
+2009-11-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42072
+	* trans-expr.c (gfc_conv_procedure_call): Handle procedure pointer
+	dummies which are passed to C_F_PROCPOINTER.
+
+2009-11-18  Alexandre Oliva  <aoliva@redhat.com>
+
+	* module.c (mio_f2k_derived): Initialize op.
+
+2009-11-15  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42048
+	* match.c (gfc_match_call): If we're inside a function with derived
+	type return value, allow calling a TBP of the result variable.
+
+2009-11-12  Tobias Burnus  <burnus@net-b.de>
+
+	* intrinsic.texi (XOR): Refer also to .NEQV.
+	(ISO_FORTRAN_ENV): State which parameters are F2008.
+
+2009-11-11  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41978
+	* resolve.c (resolve_ref): Take care of procedure pointer component
+	references.
+
+2009-11-06  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/41909
+	* resolve.c (is_illegal_recursion): Return false if sym is program.
+
+2009-11-06  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* resolve.c (check_typebound_override): Remove duplicate "in" in error
+	message.
+
+2009-11-05  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/41918
+	* fortran/trans-decl.c: Silence intent(out) warning for derived type
+	dummy arguments with default initialization.
+
+2009-11-05  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41556
+	* interface.c (matching_typebound_op,gfc_extend_assign): Handle CLASS
+	variables.
+
+2009-11-05  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41556
+	PR fortran/41873
+	* resolve.c (resolve_function,resolve_call): Prevent abstract interfaces
+	from being called, but allow deferred type-bound procedures with
+	abstract interface.
+
+2009-11-04  Tobias Burnus <burnus@gcc.gnu.org>
+	    Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41556
+	PR fortran/41937
+	* interface.c (gfc_check_operator_interface): Handle CLASS arguments.
+	* resolve.c (resolve_allocate_expr): Handle allocatable components of
+	CLASS variables.
+
+2009-11-04  Richard Guenther  <rguenther@suse.de>
+
+	* options.c (gfc_post_options): Rely on common code processing
+	LTO options.  Only enable -fwhole-file here.
+
+2009-11-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41907
+	* trans-expr.c (gfc_conv_procedure_call): Fix presence check
+	for optional arguments.
+
+2009-11-01  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41872
+	* trans-decl.c (gfc_trans_deferred_vars): Do not nullify
+	autodeallocated allocatable scalars at the end of scope.
+	(gfc_generate_function_code): Fix indention.
+	* trans-expr.c (gfc_conv_procedure_call): For allocatable
+	scalars, fix calling by reference and autodeallocating
+	of intent out variables.
+
+2009-11-01  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41850
+	* trans-expr.c (gfc_conv_procedure_call): Deallocate intent-out
+	variables only when present. Remove unneccessary present check.
+
+2009-10-29  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41777
+	* trans-expr.c (gfc_conv_procedure_call,gfc_conv_expr_reference):
+	Use for generic EXPR_FUNCTION the attributes of the specific
+	function.
+
+2009-10-29  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/41860
+	* resolve.c (apply_default_init_local): Treat -fno-automatic as if
+	var was saved.
+
+2009-10-28  Rafael Avila de Espindola  <espindola@google.com>
+
+	* trans-common.c (create_common): Set TREE_PUBLIC to false on
+	fake variables.
+
+2009-10-26  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41714
+	* trans.c (gfc_trans_code): Remove call to
+	'tree_annotate_all_with_location'. Location should already be set.
+	* trans-openmp.c (gfc_trans_omp_workshare): Ditto.
+	* trans-stmt.c (gfc_trans_allocate): Do correct data initialization for
+	CLASS variables with SOURCE tag, plus some cleanup.
+
+2009-10-24  Janus Weil  <janus@gcc.gnu.org>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41784
+	* module.c (load_derived_extensions): Skip symbols which are not being
+	loaded.
+
+2009-10-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41772
+	* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Stop'extent'
+	from going negative.
+
+2009-10-23  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41800
+	* trans-expr.c (gfc_trans_scalar_assign): Handle CLASS variables.
+
+2009-10-23  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41758
+	* match.c (conformable_arrays): Move to resolve.c.
+	(gfc_match_allocate): Don't resolve SOURCE expr yet, and move some
+	checks to resolve_allocate_expr.
+	* resolve.c (conformable_arrays): Moved here from match.c.
+	(resolve_allocate_expr): Moved some checks here from gfc_match_allocate.
+	(resolve_code): Resolve SOURCE tag for ALLOCATE expressions.
+
+2009-10-22  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41781
+	* resolve.c (resolve_codes): Don't clear 'cs_base' for BLOCK constructs,
+	to make sure labels are treated correctly.
+	* symbol.c (gfc_get_st_label): Create labels in the right namespace.
+	For BLOCK constructs go into the parent namespace.
+
+2009-10-21  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41706
+	PR fortran/41766
+	* match.c (select_type_set_tmp): Set flavor for temporary.
+	* resolve.c (resolve_class_typebound_call): Correctly resolve actual
+	arguments.
+
+2009-10-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41706
+	* resolve.c (resolve_arg_exprs): New function.
+	(resolve_class_compcall): Call the above.
+	(resolve_class_typebound_call): The same.
+
+2009-10-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41586
+	* parse.c (parse_derived): Correctly set 'alloc_comp' and 'pointer_comp'
+	for CLASS variables.
+	* trans-array.c (structure_alloc_comps): Handle deallocation and
+	nullification of allocatable scalar components.
+	* trans-decl.c (gfc_get_symbol_decl): Remember allocatable scalars for
+	automatic deallocation.
+	(gfc_trans_deferred_vars): Automatically deallocate allocatable scalars.
+
+2009-10-19  Tobias Burnus  <burnus@net-b.de>
+	    Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/41755
+	* symbol.c (gfc_undo_symbols): Add NULL check.
+	* match.c (gfc_match_equivalence): Add check for
+	missing comma.
+
+2009-10-19  Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/41494
+	* trans-expr.c (gfc_trans_scalar_assign): Do not call
+	gfc_evaluate_now.
+
+2009-10-17  Janus Weil  <janus@gcc.gnu.org>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41608
+	* decl.c (gfc_match_data_decl): Add BT_CLASS for undefined type
+	and empty type errors.
+	* parse.c (gfc_build_block_ns): Only set recursive if parent ns
+	has a proc_name.
+
+	PR fortran/41629
+	PR fortran/41618
+	PR fortran/41587
+	* gfortran.h : Add class_ok bitfield to symbol_attr.
+	* decl.c (build_sym): Set attr.class_ok if dummy, pointer or
+	allocatable.
+	(build_struct): Use gfc_try 't' to carry errors past the call
+	to encapsulate_class_symbol.
+	(attr_decl1): For a CLASS object, apply the new attribute to
+	the data component.
+	* match.c (gfc_match_select_type): Set attr.class_ok for an
+	assigned selector.
+	* resolve.c (resolve_fl_variable_derived): Check a CLASS object
+	is dummy, pointer or allocatable by testing the class_ok and
+	the use_assoc attribute.
+
+2009-10-16  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41719
+	* resolve.c (resolve_ordinary_assign): Reject intrinsic assignments
+	to polymorphic variables.
+
+2009-10-16  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41648
+	PR fortran/41656
+	* trans-expr.c (select_class_proc): Convert the expression for the
+	vindex, carried on the first member of the esym list.
+	* gfortran.h : Add the vindex field to the esym_list structure.
+	and eliminate the class_object field.
+	* resolve.c (check_class_members): Remove the setting of the
+	class_object field.
+	(vindex_expr): New function.
+	(get_class_from_expr): New function.
+	(resolve_class_compcall): Call the above to find the ultimate
+	class or derived component.  If derived, do not generate the
+	esym list.  Add and expression for the vindex to the esym list
+	by calling the above.
+	(resolve_class_typebound_call): The same.
+
+2009-10-15  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/41712
+	* intrinsic.texi: Explicitly state that ETIME and DTIME take
+	REAL(4) arguments.  Fix nearby typographically errors where 
+	/leq was used instead of \leq.
+
+2009-10-13  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41581
+	* decl.c (encapsulate_class_symbol): Add new component '$size'.
+	* resolve.c (resolve_allocate_expr): Move CLASS handling to
+	gfc_trans_allocate.
+	(resolve_class_assign): Replaced by gfc_trans_class_assign.
+	(resolve_code): Remove calls to resolve_class_assign.
+	* trans.c (gfc_trans_code): Use new function gfc_trans_class_assign.
+	* trans-expr.c (get_proc_ptr_comp): Fix a memory leak.
+	(gfc_conv_procedure_call): For CLASS dummies, set the
+	$size component.
+	(gfc_trans_class_assign): New function, replacing resolve_class_assign.
+	* trans-stmt.h (gfc_trans_class_assign): New prototype.
+	* trans-stmt.c (gfc_trans_allocate): Use correct size when allocating
+	CLASS variables. Do proper initialization. Move some code here from
+	resolve_allocate_expr.
+
+2009-10-11 Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/38439
+	* io.c (check_format): Fix locus for error messages and fix a comment.
+
+2009-10-11  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41583
+	* decl.c (hash_value): New function.
+	(gfc_match_derived_decl): Call it.
+
+2009-10-09  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41585
+	* decl.c (build_struct): Bugfix for CLASS components.
+
+2009-10-09  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41582
+	* decl.c (encapsulate_class_symbol): Save attr.abstract.
+	* resolve.c (resolve_allocate_expr): Reject class allocate
+	without typespec or source=.
+	* trans-stmt.c (gfc_trans_allocate): Change gfc_warning
+	into gfc_error for "not yet implemented".
+
+2009-10-09  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41579
+	* gfortran.h (gfc_select_type_stack): New struct, to be used as a stack
+	for SELECT TYPE statements.
+	(select_type_stack): New global variable.
+	(type_selector,select_type_tmp): Removed.
+	* match.c (type_selector,type_selector): Removed.
+	(select_type_stack): New variable, serving as a stack for
+	SELECT TYPE statements.
+	(select_type_push,select_type_set_tmp): New functions.
+	(gfc_match_select_type): Call select_type_push.
+	(gfc_match_type_is): Call select_type_set_tmp.
+	* parse.c (select_type_pop): New function.
+	(parse_select_type_block): Call select_type_pop.
+	* symbol.c (select_type_insert_tmp): New function.
+	(gfc_find_sym_tree): Call select_type_insert_tmp.
+
+2009-10-07  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* arith.c (arith_power): Use mpc_pow_z.
+	* gfortran.h (HAVE_mpc_pow_z): Define.
+
+2009-10-07  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/41615
+	* resolve.c (resolve_contained_fntype): Clarify error message for
+	invalid assumed-length character result on module procedures.
+
+2009-10-07  Janus Weil  <janus@gcc.gnu.org>
+
+	* expr.c (gfc_check_pointer_assign): Do the correct type checking when
+	CLASS variables are involved.
+	* match.c (gfc_match_select_type): Parse associate-name in SELECT TYPE
+	statements, and set up a local namespace for the SELECT TYPE block.
+	* parse.h (gfc_build_block_ns): New prototype.
+	* parse.c (parse_select_type_block): Return from local namespace to its
+	parent after SELECT TYPE block.
+	(gfc_build_block_ns): New function for setting up the local namespace
+	for a BLOCK construct.
+	(parse_block_construct): Use gfc_build_block_ns.
+	* resolve.c (resolve_select_type): Insert assignment for the selector
+	variable, in case an associate-name is given, and put the SELECT TYPE
+	statement inside a BLOCK.
+	(resolve_code): Call resolve_class_assign after checking the assignment.
+	* symbol.c (gfc_find_sym_tree): Moved some code here from
+	gfc_get_ha_sym_tree.
+	(gfc_get_ha_sym_tree): Moved some code to gfc_find_sym_tree.
+
+2009-10-07  Paul Thomas <pault@gcc.gnu.org>
+
+	PR fortran/41613
+	* resolve.c (check_class_members): Reset compcall.assign.
+
+2009-10-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	* trans-expr.c (select_class_proc): New function.
+	(conv_function_val): Deal with class methods and call above.
+	* symbol.c (gfc_type_compatible): Treat case where both ts1 and
+	ts2 are BT_CLASS.
+	gfortran.h : Add structure gfc_class_esym_list and include in
+	the structure gfc_expr.
+	* module.c (load_derived_extensions): New function.
+	(read_module): Call above.
+	(write_dt_extensions): New function.
+	(write_derived_extensions): New function.
+	(write_module): Use the above.
+	* resolve.c (resolve_typebound_call): Add a function expression
+	for class methods.  This carries the chain of symbols for the
+	dynamic dispatch in select_class_proc.
+	(resolve_compcall): Add second, boolean argument to indicate if
+	a function is being handled.
+	(check_members): New function.
+	(check_class_members): New function.
+	(resolve_class_compcall): New function.
+	(resolve_class_typebound_call): New function.
+	(gfc_resolve_expr): Call above for component calls.. 
+
+2009-10-05  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/41403
+	* trans-stmt.c (gfc_trans_goto): Ignore statement list on assigned goto
+	if it is present.
+
+2009-10-03  Richard Guenther  <rguenther@suse.de>
+
+	* options.c (gfc_post_options): Handle -flto and -fwhopr.
+
+2009-10-02  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41479
+	* trans-decl.c (gfc_init_default_dt): Check for presence of
+	the argument only if it is optional or in entry master.
+	(init_intent_out_dt): Ditto; call gfc_init_default_dt
+	for all derived types with initializers.
+
+2009-10-01  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	PR fortran/33197
+	* gfortran.h (HAVE_mpc_arc): Define.
+	* simplify.c (gfc_simplify_acos): Handle complex acos.
+	(gfc_simplify_acosh): Likewise for acosh.
+	(gfc_simplify_asin): Likewise for asin.
+	(gfc_simplify_asinh): Likewise for asinh.
+	(gfc_simplify_atan): Likewise for atan.
+	(gfc_simplify_atanh): Likewise for atanh.
+
+2009-10-01  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41515
+	* decl.c (do_parm): Call add_init_expr_to_sym.
+
+2009-09-30  Dennis Wassel  <dennis.wassel@gmail.com>
+
+	* gcc/fortran/trans-array.c (gfc_trans_array_bound_check): Improved
+	bounds checking error messages. (gfc_conv_array_ref): Likewise.
+	(gfc_conv_ss_startstride): Likewise.
+
+2009-09-30  Janus Weil  <janus@gcc.gnu.org>
+
+	* resolve.c (check_typebound_baseobject): Don't check for
+	abstract types for CLASS.
+	(resolve_class_assign): Adapt for RHS being a CLASS.
+	* trans-intrinsic.c (gfc_conv_associated): Add component ref
+	if expr is a CLASS.
+
+2009-09-30  Janus Weil  <janus@gcc.gnu.org>
+
+	* check.c (gfc_check_same_type_as): New function for checking
+	SAME_TYPE_AS and EXTENDS_TYPE_OF.
+	* decl.c (encapsulate_class_symbol): Set ABSTRACT attribute for class
+	container, if the contained type has it. Add an initializer for the
+	class container.
+	(add_init_expr_to_sym): Handle BT_CLASS.
+	(vindex_counter): New counter for setting vindices.
+	(gfc_match_derived_decl): Set vindex for all derived types, not only
+	those which are being extended.
+	* expr.c (gfc_check_assign_symbol): Handle NULL initialization of class
+	pointers.
+	* gfortran.h (gfc_isym_id): New values GFC_ISYM_SAME_TYPE_AS and
+	GFC_ISYM_EXTENDS_TYPE_OF.
+	(gfc_type_is_extensible): New prototype.
+	* intrinsic.h (gfc_check_same_type_as): New prototype.
+	* intrinsic.c (add_functions): Add SAME_TYPE_AS and EXTENDS_TYPE_OF.
+	* primary.c (gfc_expr_attr): Handle CLASS-valued functions.
+	* resolve.c (resolve_structure_cons): Handle BT_CLASS.
+	(type_is_extensible): Make non-static and rename to
+	'gfc_type_is_extensible.
+	(resolve_select_type): Renamed type_is_extensible.
+	(resolve_class_assign): Handle NULL pointers.
+	(resolve_fl_variable_derived): Renamed type_is_extensible.
+	(resolve_fl_derived): Ditto.
+	* trans-expr.c (gfc_trans_subcomponent_assign): Handle NULL
+	initialization of class pointer components.
+	(gfc_conv_structure): Handle BT_CLASS.
+	* trans-intrinsic.c (gfc_conv_same_type_as,gfc_conv_extends_type_of):
+	New functions.
+	(gfc_conv_intrinsic_function): Handle SAME_TYPE_AS and EXTENDS_TYPE_OF.
+
+2009-09-30  Janus Weil  <janus@gcc.gnu.org>
+
+	* gfortran.h (type_selector, select_type_tmp): New global variables.
+	* match.c (type_selector, select_type_tmp): New global variables,
+	used for SELECT TYPE statements.
+	(gfc_match_select_type): Better error handling. Remember selector.
+	(gfc_match_type_is): Create temporary variable.
+	* module.c (ab_attribute): New value 'AB_IS_CLASS'.
+	(attr_bits): New string.
+	(mio_symbol_attribute): Handle 'is_class'.
+	* resolve.c (resolve_select_type): Insert pointer assignment statement,
+	to assign temporary to selector.
+	* symbol.c (gfc_get_ha_sym_tree): Replace selector by a temporary
+	in SELECT TYPE statements.
+
+2009-09-30  Janus Weil  <janus@gcc.gnu.org>
+
+	* dump-parse-tree.c (show_code_node): Renamed 'alloc_list'.
+	* gfortran.h (gfc_code): Rename 'alloc_list'. Add member 'ts'.
+	(gfc_expr_to_initialize): New prototype.
+	* match.c (alloc_opt_list): Correctly check type compatibility.
+	Renamed 'alloc_list'.
+	(dealloc_opt_list): Renamed 'alloc_list'.
+	* resolve.c (expr_to_initialize): Rename to 'gfc_expr_to_initialize'
+	and make it non-static.
+	(resolve_allocate_expr): Set vindex for CLASS variables correctly.
+	Move initialization code to gfc_trans_allocate. Renamed 'alloc_list'.
+	(resolve_allocate_deallocate): Renamed 'alloc_list'.
+	(check_class_pointer_assign): Rename to 'resolve_class_assign'. Change
+	argument type. Adjust to work with ordinary assignments.
+	(resolve_code): Call 'resolve_class_assign' for ordinary assignments.
+	Renamed 'check_class_pointer_assign'.
+	* st.c (gfc_free_statement): Renamed 'alloc_list'.
+	* trans-stmt.c (gfc_trans_allocate): Renamed 'alloc_list'. Handle
+	size determination and initialization of CLASS variables. Bugfix for
+	ALLOCATE statements with default initialization and SOURCE block.
+	(gfc_trans_deallocate): Renamed 'alloc_list'.
+
+2009-09-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	* trans-expr.c (gfc_conv_procedure_call): Convert a derived
+	type actual to a class object if the formal argument is a
+	class.
+
+2009-09-30  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40996
+	* decl.c (build_struct): Handle allocatable scalar components.
+	* expr.c (gfc_add_component_ref): Correctly set typespec of expression,
+	after inserting component reference.
+	* match.c (gfc_match_type_is,gfc_match_class_is): Make sure that no
+	variables are being used uninitialized.
+	* primary.c (gfc_match_varspec): Handle CLASS array components.
+	* resolve.c (resolve_select_type): Transform EXEC_SELECT_TYPE to
+	EXEC_SELECT.
+	* trans-array.c (structure_alloc_comps,gfc_trans_deferred_array):
+	Handle allocatable scalar components.
+	* trans-expr.c (gfc_conv_component_ref): Ditto.
+	* trans-types.c (gfc_get_derived_type): Ditto.
+
+2009-09-30  Janus Weil  <janus@gcc.gnu.org>
+
+	* decl.c (encapsulate_class_symbol): Modify names of class container
+	components by prefixing with '$'.
+	(gfc_match_end): Handle COMP_SELECT_TYPE.
+	* expr.c (gfc_add_component_ref): Modify names of class container
+	components by prefixing with '$'.
+	* gfortran.h (gfc_statement): Add ST_SELECT_TYPE, ST_TYPE_IS and
+	ST_CLASS_IS.
+	(gfc_case): New field 'ts'.
+	(gfc_exec_op): Add EXEC_SELECT_TYPE.
+	(gfc_type_is_extension_of): New prototype.
+	* match.h (gfc_match_select_type,gfc_match_type_is,gfc_match_class_is):
+	New prototypes.
+	* match.c (match_derived_type_spec): New function.
+	(match_type_spec): Use 'match_derived_type_spec'.
+	(match_case_eos): Modify error message.
+	(gfc_match_select_type): New function.
+	(gfc_match_case): Modify error message.
+	(gfc_match_type_is): New function.
+	(gfc_match_class_is): Ditto.
+	* parse.h (gfc_compile_state): Add COMP_SELECT_TYPE.
+	* parse.c (decode_statement): Handle SELECT TYPE, TYPE IS and CLASS IS
+	statements.
+	(next_statement): Handle ST_SELECT_TYPE.
+	(gfc_ascii_statement): Handle ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS.
+	(parse_select_type_block): New function.
+	(parse_executable): Handle ST_SELECT_TYPE.
+	* resolve.c (resolve_deallocate_expr): Handle BT_CLASS. Modify names of
+	class container components by prefixing with '$'.
+	(resolve_allocate_expr): Ditto.
+	(resolve_select_type): New function.
+	(gfc_resolve_blocks): Handle EXEC_SELECT_TYPE.
+	(check_class_pointer_assign): Modify names of class container
+	components by prefixing with '$'.
+	(resolve_code): Ditto.
+	* st.c (gfc_free_statement): Ditto.
+	* symbol.c (gfc_type_is_extension_of): New function.
+	(gfc_type_compatible): Use 'gfc_type_is_extension_of', plus a bugfix.
+	* trans.c (gfc_trans_code): Handel EXEC_SELECT_TYPE.
+
+2009-09-30  Janus Weil  <janus@gcc.gnu.org>
+	    Paul Thomas <pault@gcc.gnu.org> 
+
+	* check.c (gfc_check_move_alloc): Arguments don't have to be arrays.
+	The second argument needs to be type-compatible with the first (not the
+	other way around, which makes a difference for CLASS entities).
+	* decl.c (encapsulate_class_symbol): New function.
+	(build_sym,build_struct): Handle BT_CLASS, call
+	'encapsulate_class_symbol'.
+	(gfc_match_decl_type_spec): Remove warning, use BT_CLASS.
+	(gfc_match_derived_decl): Set vindex;
+	* expr.c (gfc_add_component_ref): New function.
+	(gfc_copy_expr,gfc_check_pointer_assign,gfc_check_assign_symbol):
+	Handle BT_CLASS.
+	* dump-parse-tree.c (show_symbol): Print vindex.
+	* gfortran.h (bt): New basic type BT_CLASS.
+	(symbol_attribute): New field 'is_class'.
+	(gfc_typespec): Remove field 'is_class'.
+	(gfc_symbol): New field 'vindex'.
+	(gfc_get_ultimate_derived_super_type): New prototype.
+	(gfc_add_component_ref): Ditto.
+	* interface.c (gfc_compare_derived_types): Pointer equality check
+	moved here from gfc_compare_types.
+	(gfc_compare_types): Handle BT_CLASS and use
+	gfc_type_compatible.
+	* match.c (gfc_match_allocate,gfc_match_deallocate,gfc_match_call):
+	Handle BT_CLASS.
+	* misc.c (gfc_clear_ts): Removed is_class.
+	(gfc_basic_typename,gfc_typename): Handle BT_CLASS.
+	* module.c (bt_types,mio_typespec): Handle BT_CLASS.
+	(mio_symbol): Handle vindex.
+	* primary.c (gfc_match_varspec,gfc_variable_attr): Handle BT_CLASS.
+	* resolve.c (find_array_spec,check_typebound_baseobject):
+	Handle BT_CLASS.
+	(resolve_ppc_call,resolve_expr_ppc): Don't call 'gfc_is_proc_ptr_comp'
+	inside 'gcc_assert'.
+	(resolve_deallocate_expr,resolve_allocate_expr): Handle BT_CLASS.
+	(check_class_pointer_assign): New function.
+	(resolve_code): Handle BT_CLASS, call check_class_pointer_assign.
+	(resolve_fl_var_and_proc,type_is_extensible,resolve_fl_variable_derived,
+	resolve_fl_variable): Handle BT_CLASS.
+	(check_generic_tbp_ambiguity): Add special case.
+	(resolve_typebound_procedure,resolve_fl_derived): Handle BT_CLASS.
+	* symbol.c (gfc_get_ultimate_derived_super_type): New function.
+	(gfc_type_compatible): Handle BT_CLASS.
+	* trans-expr.c (conv_parent_component_references): Handle CLASS
+	containers.
+	(gfc_conv_initializer): Handle BT_CLASS.
+	* trans-types.c (gfc_typenode_for_spec,gfc_get_derived_type):
+	Handle BT_CLASS.
+
+2009-09-29  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/39626
+	* gfortran.h (enum gfc_statement): Add ST_BLOCK and ST_END_BLOCK.
+	(struct gfc_namespace): Convert flags to bit-fields and add flag
+	`construct_entities' for use with BLOCK constructs.
+	(enum gfc_exec_code): Add EXEC_BLOCK.
+	(struct gfc_code): Add namespace field to union for EXEC_BLOCK.
+	* match.h (gfc_match_block): New prototype.
+	* parse.h (enum gfc_compile_state): Add COMP_BLOCK.
+	* trans.h (gfc_process_block_locals): New prototype.
+	(gfc_trans_deferred_vars): Made public, new prototype.
+	* trans-stmt.h (gfc_trans_block_construct): New prototype.
+	* decl.c (gfc_match_end): Handle END BLOCK correctly.
+	(gfc_match_intent): Error if inside of BLOCK.
+	(gfc_match_optional), (gfc_match_value): Ditto.
+	* match.c (gfc_match_block): New routine.
+	* parse.c (decode_statement): Handle BLOCK statement.
+	(case_exec_markers): Add ST_BLOCK.
+	(case_end): Add ST_END_BLOCK.
+	(gfc_ascii_statement): Handle ST_BLOCK and ST_END_BLOCK.
+	(parse_spec): Check for statements not allowed inside of BLOCK.
+	(parse_block_construct): New routine.
+	(parse_executable): Parse BLOCKs.
+	(parse_progunit): Disallow CONTAINS in BLOCK constructs.
+	* resolve.c (is_illegal_recursion): Find real container procedure and
+	don't get confused by BLOCK constructs.
+	(resolve_block_construct): New routine.
+	(gfc_resolve_blocks), (resolve_code): Handle EXEC_BLOCK.
+	* st.c (gfc_free_statement): Handle EXEC_BLOCK statements.
+	* trans-decl.c (saved_local_decls): New static variable.
+	(add_decl_as_local): New routine.
+	(gfc_finish_var_decl): Add variable as local if inside BLOCK.
+	(gfc_trans_deferred_vars): Make public.
+	(gfc_process_block_locals): New routine.
+	* trans-stmt.c (gfc_trans_block_construct): New routine.
+	* trans.c (gfc_trans_code): Handle EXEC_BLOCK statements.
+
+2009-09-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35862
+	* io.c (format_token): Add enumerators for rounding format specifiers.
+	(format_lex): Tokenize the rounding format specifiers.
+	(gfc_match_open): Enable rounding modes in OPEN statement.
+
+2009-09-28  Richard Henderson  <rth@redhat.com>
+
+	* f95-lang.c (gfc_init_builtin_functions): Update call to
+	build_common_builtin_nodes.
+
+2009-09-25  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* simplify.c (gfc_simplify_acos, gfc_simplify_acosh,
+	gfc_simplify_asin, gfc_simplify_asinh, gfc_simplify_atan,
+	gfc_simplify_atanh): Fix error message.
+
+2009-09-24  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/41459
+	* error.c(gfc_warning_now): Move warnings_are_errors test to 
+	after actual emitting of the warning.
+	* parse.c (next_free): Improve error locus printing.
+	(next_fixed): Change gfc_warn to gfc_warning_now, and improve
+	locus reporting.
+
+2009-09-16  Michael Matz  <matz@suse.de>
+
+	PR fortran/41212
+	* trans.h (struct lang_type): Remove nontarget_type member.
+	* trans.c (gfc_add_modify): Don't access it.
+	* trans-decl.c (gfc_finish_var_decl): Don't allocate and set it,
+	instead set DECL_RESTRICTED_P on affected decls.
+
+2009-09-14  Richard Henderson  <rth@redhat.com>
+
+	* f95-lang.c (gfc_init_builtin_functions): Update call to
+	build_common_builtin_nodes.
+	(gfc_maybe_initialize_eh): Don't call
+	default_init_unwind_resume_libfunc.
+
+2009-09-13  Richard Guenther  <rguenther@suse.de>
+	Rafael Avila de Espindola  <espindola@google.com>
+
+	* f95-lang.c (gfc_maybe_initialize_eh): Do not init
+	eh_personality_libfunc.
+
+2009-09-11  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41242
+	* resolve.c (resolve_ordinary_assign): Don't call resolve_code,
+	to avoid that subsequent codes are resolved more than once.
+	(resolve_code): Make sure that type-bound assignment operators are
+	resolved correctly.
+
+
+2009-09-10  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/31292
+	* fortran/decl.c(gfc_match_modproc): Check that module procedures
+	from a module can USEd in module procedure statements in other
+	program units.  Update locus for better error message display.
+	Detect intrinsic procedures in module procedure statements.
+
+2009-09-09  Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/41297
+	* trans-expr.c (gfc_trans_scalar_assign): Correct typo that
+	left 'tmp' unused in derived type assignment.
+
+2009-09-07  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/41197
+	* resolve_c (resolve_allocate_deallocate):  Complain
+	if stat or errmsg varaible is an array.
+
+2009-09-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41258
+	* primary.c (gfc_match_varspec): Do not look for typebound
+	procedures unless the derived type has a f2k_derived namespace.
+
+2009-09-03  Diego Novillo  <dnovillo@google.com>
+
+	* f95-lang.c (lang_hooks): Remove const qualifier.
+
+2009-09-01  Richard Guenther  <rguenther@suse.de>
+
+	* f95-lang.c (gfc_mark_addressable): Remove.
+	(LANG_HOOKS_MARK_ADDRESSABLE): Likewise.
+
+2009-08-31  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/39229
+	* scanner.c (next_char): Fix typo in comment.
+	(gfc_get_char_literal): Warn if truncate flag is set for both fixed and
+	free form source, adjusting error locus as needed.
+	* parse.c (next_fixed): Clear the truncate flag.
+	(next_statement): Remove truncate warning.
+
+2009-08-31  Janus Weil  <janus@gcc.gnu.org>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40940
+	* array.c (gfc_match_array_constructor): Rename gfc_match_type_spec.
+	* decl.c (gfc_match_type_spec): Rename to gfc_match_decl_type_spec,
+	and reject CLASS with -std=f95.
+	(gfc_match_implicit, gfc_match_data_decl,gfc_match_prefix,
+	match_procedure_interface): Rename gfc_match_type_spec.
+	* gfortran.h (gfc_type_compatible): Add prototype.
+	* match.h (gfc_match_type_spec): Rename to gfc_match_decl_type_spec.
+	* match.c (match_intrinsic_typespec): Rename to match_type_spec, and
+	add handling of derived types.
+	(gfc_match_allocate): Rename match_intrinsic_typespec and check
+	type compatibility of derived types.
+	* symbol.c (gfc_type_compatible): New function to check if two types
+	are compatible.
+
+2009-08-31  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40996
+	* check.c (gfc_check_allocated): Implement allocatable scalars.
+	* resolve.c (resolve_allocate_expr,resolve_fl_var_and_proc): Ditto.
+	* trans-intrinsic.c (gfc_conv_allocated): Ditto.
+
+2009-08-30  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37425
+	* dump-parse-tree.c (show_typebound_proc): Renamed from `show_typebound'
+	and accept gfc_typebound_proc and name instead of the symtree, needed
+	for intrinsic operator output.
+	(show_typebound_symtree): New method calling `show_typebound_proc'.
+	(show_f2k_derived): Output type-bound operators also.
+	(show_symbol): Moved output of `Procedure bindings:' label to
+	`show_f2k_derived'.
+	* gfortran.texi (Fortran 2003 status): Mention support of
+	array-constructors with explicit type specification, type-bound
+	procedures/operators, type extension, ABSTRACT types and DEFERRED.
+	Link to Fortran 2003 wiki page.
+	(Fortran 2008 status): Fix typo.  Link to Fortran 2008 wiki page.
+	* gfc-internals.texi (Type-bound Procedures): Document the new
+	members/attributes of gfc_expr.value.compcall used for type-bound
+	operators.
+	(Type-bound Operators): New section documenting their internals.
+
+2009-08-27  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40869
+	* expr.c (gfc_check_pointer_assign): Enable interface check for
+	pointer assignments involving procedure pointer components.
+	* gfortran.h (gfc_compare_interfaces): Modified prototype.
+	* interface.c (gfc_compare_interfaces): Add argument 'name2', to be
+	used instead of s2->name. Don't rely on the proc_pointer attribute,
+	but instead on the flags handed to this function.
+	(check_interface1,compare_parameter): Add argument for
+	gfc_compare_interfaces.
+	* resolve.c (check_generic_tbp_ambiguity): Ditto.
+
+2009-08-27  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37425
+	* gfortran.h (gfc_expr): Optionally store base-object in compcall value
+	and add a new flag to distinguish assign-calls generated.
+	(gfc_find_typebound_proc): Add locus argument.
+	(gfc_find_typebound_user_op), (gfc_find_typebound_intrinsic_op): Ditto.
+	(gfc_extend_expr): Return if failure was by a real error.
+	* interface.c (matching_typebound_op): New routine.
+	(build_compcall_for_operator): New routine.
+	(gfc_extend_expr): Handle type-bound operators, some clean-up and
+	return if failure was by a real error or just by not finding an
+	appropriate operator definition.
+	(gfc_extend_assign): Handle type-bound assignments.
+	* module.c (MOD_VERSION): Incremented.
+	(mio_intrinsic_op): New routine.
+	(mio_full_typebound_tree): New routine to make typebound-procedures IO
+	code reusable for type-bound user operators.
+	(mio_f2k_derived): IO of type-bound operators.
+	* primary.c (gfc_match_varspec): Initialize new fields in gfc_expr and
+	pass locus to gfc_find_typebound_proc.
+	* resolve.c (resolve_operator): Only output error about no matching
+	interface if gfc_extend_expr did not already fail with an error.
+	(extract_compcall_passed_object): Use specified base-object if present.
+	(update_compcall_arglist): Handle ignore_pass field.
+	(resolve_ordinary_assign): Update to handle extended code for
+	type-bound assignments, too.
+	(resolve_code): Handle EXEC_ASSIGN_CALL statement code.
+	(resolve_tb_generic_targets): Pass locus to gfc_find_typebound_proc.
+	(resolve_typebound_generic), (resolve_typebound_procedure): Ditto.
+	(resolve_typebound_intrinsic_op), (resolve_typebound_user_op): Ditto.
+	(ensure_not_abstract_walker), (resolve_fl_derived): Ditto.
+	(resolve_typebound_procedures): Remove not-implemented error.
+	(resolve_typebound_call): Handle assign-call flag.
+	* symbol.c (find_typebound_proc_uop): New argument to pass locus for
+	error message about PRIVATE, verify that a found procedure is not marked
+	as erraneous.
+	(gfc_find_typebound_intrinsic_op): Ditto.
+	(gfc_find_typebound_proc), (gfc_find_typebound_user_op): New locus arg.
+
+2009-08-22  Bud Davis <bdavis9659@sbcglobal.net>
+
+	PR fortran/28093
+	* io.c: reverted previous patch.
+
+2009-08-25  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	* gfortran.texi: Fix ENCODE example.
+
+2009-08-25  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41139
+	* primary.c (gfc_match_varspec): Make sure EXPR_PPC is only used for
+	calls to procedure pointer components, other references to procedure
+	pointer components are EXPR_VARIABLE.
+	* resolve.c (resolve_actual_arglist): Bugfix (there can be calls without
+	actual arglist).
+	* trans-expr.c (gfc_get_proc_ptr_comp): Renamed to 'get_proc_ptr_comp',
+	removed argument 'se' and made static. Avoid inserting a temporary
+	variable for calling the PPC.
+	(conv_function_val): Renamed gfc_get_proc_ptr_comp.
+	(gfc_conv_procedure_call): Distinguish functions returning a procedure
+	pointer from calls to a procedure pointer. Distinguish calls to
+	procedure pointer components from procedure pointer components as
+	actual arguments.
+	* trans-stmt.h (gfc_get_proc_ptr_comp): Make it static.
+
+2009-08-24  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/41162
+	* io.c (check_format): Fix to not error on slash after P. Fix some
+	error loci.
+	
+2009-08-24  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/41154
+	* io.c (check_format): Fix to not error on right paren after P.
+
+2009-08-24  Aldy Hernandez  <aldyh@redhat.com>
+
+	PR fortran/40660
+	* trans-io.c (build_dt): Pass UNKNOWN_LOCATION to build_call_expr_loc.
+	(transfer_array_desc): Same.
+
+2009-08-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35754
+	* io.c (check_format): Add checks for comma and the allowed
+	format specifiers after the 'P' specifier. Fix typo in error message
+	and adjust locus.
+
+2009-08-23  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/37446
+	* io.c (enum format_token): Change FMT_EXT to FMT_EN and FMT_ES.
+	(format_lex): Likewise.
+	(token_to_string): New function.
+	(check_format): Use the new tokens and the new function. Add
+	check for positive width.
+
+2009-08-22  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* fortran/decl.c: Disallow procedure pointers with -std=f95.
+
+2009-08-22 Steven K. kargl  <kargl@gcc.gnu.org>
+	   Paul Thomas  <pault@gcc.gnu.org>
+
+	* fortran/decl.c (match_char_spec): Rename to gfc_match_char_spec,
+	and remove static.
+	* fortran/gfortran.h: Add *expr3 entity to gfc_code.  Add prototype
+	for gfc_match_char_spec.
+	* fortran/trans-stmt.c (gfc_trans_allocate): Translate the SOURCE=
+	tag.
+	* fortran/match.c (match_intrinsic_typespec): New function to match
+	F2003 intrinsic-type-spec.
+	(conformable_arrays): New function. Check SOURCE= and
+	allocation-object are conformable.
+	(gfc_match_allocate): Use new functions.  Match SOURCE= tag.
+
+2009-08-22  Bud Davis <bdavis9659@sbcglobal.net>
+
+	PR fortran/28093
+	* io.c : added variable to store original len of fmt
+	* io.c (check_format): Consume H items using next_char
+	in both modes to handle consecutive single quotes.
+	Test for extra characters in fmt, issue warning.
+
+2009-08-21  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41106
+	* primary.c (gfc_variable_attr): Make it work also on EXPR_FUNCTION.
+	(gfc_expr_attr): Use gfc_variable_attr for procedure pointer components.
+	* resolve.c (resolve_fl_derived): Handle CHARACTER-valued procedure
+	pointer components.
+	* trans-expr.c (gfc_conv_component_ref): Ditto.
+	(gfc_conv_variable): Ditto.
+	(gfc_conv_procedure_call): Ditto.
+	(gfc_trans_pointer_assignment): Ditto.
+	* trans-types.c (gfc_get_derived_type): Ditto.
+
+2009-08-20  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	* trans-stmt.c (gfc_trans_do): Add a few missing folds.
+
+2009-08-20  Michael Matz  <matz@suse.de>
+
+	PR fortran/41126
+	* trans-expr.c (gfc_conv_string_tmp): Check type compatibility
+	instead of equality.
+
+2009-08-20  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41121
+	* resolve.c (resolve_symbol): Don't resolve formal_ns of intrinsic
+	procedures.
+
+2009-08-18  Michael Matz  <matz@suse.de>
+
+	* trans-expr.c (gfc_conv_substring): Don't evaluate casted decl early,
+	change order of length calculation to (end - start) + 1.
+	(gfc_get_interface_mapping_array): Adjust call to
+	gfc_get_nodesc_array_type.
+	* trans-array.c (gfc_trans_create_temp_array,
+	gfc_build_constant_array_constructor, gfc_conv_expr_descriptor): Ditto.
+	* trans-stmt.c (gfc_trans_pointer_assign_need_temp): Ditto.
+	* trans.c (gfc_add_modify): Assignment between base type and nontarget
+	type are equal enough.
+	(gfc_call_malloc): Use prvoid_type_node for return value of
+	__builtin_malloc.
+	(gfc_allocate_with_status): Ditto.
+	* trans-types.c (gfc_array_descriptor_base): Double size of this array.
+	(gfc_init_types): Build prvoid_type_node.
+	(gfc_build_array_type): New bool parameter "restricted".
+	(gfc_get_nodesc_array_type): Ditto, build restrict qualified pointers,
+	if it's true.
+	(gfc_get_array_descriptor_base): Ditto.
+	(gfc_get_array_type_bounds): Ditto.
+	(gfc_sym_type): Use symbol attributes to feed calls to above functions.
+	(gfc_get_derived_type): Ditto.
+	* trans.h (struct lang_type): Add nontarget_type member.
+	* trans-types.h (prvoid_type_node): Declare.
+	(gfc_get_array_type_bounds, gfc_get_nodesc_array_type): Declare new
+	parameter.
+	* trans-decl.c (gfc_finish_var_decl): Give scalars that can't be
+	aliased a type with a different alias set than the base type.
+	(gfc_build_dummy_array_decl): Adjust call to gfc_get_nodesc_array_type.
+
+2009-08-18  Janus Weil  <janus@gcc.gnu.org>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40870
+	* trans-types.c (gfc_get_ppc_type): Include formal args in backend_decl
+	using the interface symbol. Character types are returned by reference.
+	(gfc_get_derived_type): Prevent infinite recursion loop
+	if a PPC has a derived-type formal arg.
+
+2008-08-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41062
+	* trans-decl.c (gfc_trans_use_stmts):  Keep going through use
+	list if symbol is not use associated.
+
+2009-08-17  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37425
+	* resolve.c (get_checked_tb_operator_target): New routine to do checks
+	on type-bound operators in common between intrinsic and user operators.
+	(resolve_typebound_intrinsic_op): Call it.
+	(resolve_typebound_user_op): Ditto.
+
+2009-08-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/41075
+	* scanner.c (gfc_next_char_literal): Add comment to improve 
+	readability.
+	* io.c (enum format_token): Add FMT_STAR. (format_lex): Add case
+	for '*'. (check_format): Check for left paren after '*'.  Change
+	format checks to use %L to improve format string error locus.
+
+2009-08-17  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40877
+	* array.c (gfc_resolve_character_array_constructor): Add NULL argument
+	to gfc_new_charlen.
+	* decl.c (add_init_expr_to_sym,variable_decl,match_char_spec,
+	gfc_match_implicit): Ditto.
+	* expr.c (simplify_const_ref): Fix memory leak.
+	(gfc_simplify_expr): Add NULL argument to gfc_new_charlen.
+	* gfortran.h (gfc_new_charlen): Modified prototype.
+	* iresolve.c (check_charlen_present,gfc_resolve_char_achar): Add NULL
+	argument to gfc_new_charlen.
+	* module.c (mio_charlen): Ditto.
+	* resolve.c (gfc_resolve_substring_charlen,
+	gfc_resolve_character_operator,fixup_charlen): Ditto.
+	(resolve_fl_derived,resolve_symbol): Add argument to gfc_charlen.
+	* symbol.c (gfc_new_charlen): Add argument 'old_cl' (to make a copy of
+	an existing charlen).
+	(gfc_set_default_type,generate_isocbinding_symbol): Fix memory leak.
+	(gfc_copy_formal_args_intr): Add NULL argument to gfc_new_charlen.
+	* trans-decl.c (create_function_arglist): Fix memory leak.
+
+2009-08-17  Richard Guenther  <rguenther@suse.de>
+
+	* trans-expr.c (gfc_trans_scalar_assign): Replace hack with
+	more proper hack.
+
+2009-08-15  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41080
+	* gfortranspec.c (lookup_option): Remove gfortran-specific
+	version of -dumpversion.
+
+2009-08-14  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41070
+	* resolve.c (resolve_structure_cons): Make sure that ts.u.derived is
+	only used if type is BT_DERIVED.
+
+2009-08-13  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40941
+	* gfortran.h (gfc_typespec): Put 'derived' and 'cl' into union.
+	* decl.c (build_struct): Make sure 'cl' is only used
+	if type is BT_CHARACTER.
+	* symbol.c (gfc_set_default_type): Ditto.
+	* resolve.c (resolve_symbol, resolve_fl_derived): Ditto.
+	(resolve_equivalence,resolve_equivalence_derived): Make sure 'derived'
+	is only used if type is BT_DERIVED.
+	* trans-io.c (transfer_expr): Make sure 'derived' is only used if type
+	is BT_DERIVED or BT_INTEGER (special case: C_PTR/C_FUNPTR).
+	* array.c: Mechanical replacements to accomodate union in gfc_typespec.
+	* check.c: Ditto.
+	* data.c: Ditto.
+	* decl.c: Ditto.
+	* dump-parse-tree.c: Ditto.
+	* expr.c: Ditto.
+	* interface.c: Ditto.
+	* iresolve.c: Ditto.
+	* match.c: Ditto.
+	* misc.c: Ditto.
+	* module.c: Ditto.
+	* openmp.c: Ditto.
+	* parse.c: Ditto.
+	* primary.c: Ditto.
+	* resolve.c: Ditto.
+	* simplify.c: Ditto.
+	* symbol.c: Ditto.
+	* target-memory.c: Ditto.
+	* trans-array.c: Ditto.
+	* trans-common.c: Ditto.
+	* trans-const.c: Ditto.
+	* trans-decl.c: Ditto.
+	* trans-expr.c: Ditto.
+	* trans-intrinsic.c: Ditto.
+	* trans-io.c: Ditto.
+	* trans-stmt.c: Ditto.
+	* trans-types.c: Ditto.
+
+2009-08-13  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40995
+	* resolve.c (resolve_symbol): Move some checking code to
+	resolve_intrinsic, and call this from here.
+	(resolve_intrinsic): Some checking code moved here from resolve_symbol.
+	Make sure each intrinsic is only resolved once.
+
+2009-08-12  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41034
+	* symbol.c (gfc_copy_attr): Merge bits instead of replace
+	bits in gfc_copy_attr.
+	* gfc_check_pointer_assign (gfc_check_pointer_assign):
+	Initialize ext_attr bits by zero.
+
+2009-08-11  Richard Guenther  <rguenther@suse.de>
+
+	* trans-types.c (gfc_get_derived_type): Do not clear TYPE_CANONICAL.
+
+2009-08-11  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41022
+	* trans-expr.c (gfc_conv_procedure_call): Handle procedure pointer
+	components as actual arguments.
+
+2009-08-10  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37425
+	* gfortran.h (struct gfc_namespace): New fields tb_uop_root and tb_op.
+	(gfc_find_typebound_user_op): New routine.
+	(gfc_find_typebound_intrinsic_op): Ditto.
+	(gfc_check_operator_interface): Now public routine.
+	* decl.c (gfc_match_generic): Match OPERATOR(X) or ASSIGNMENT(=).
+	* interface.c (check_operator_interface): Made public, renamed to
+	`gfc_check_operator_interface' accordingly and hand in the interface
+	as gfc_symbol rather than gfc_interface so it is useful for type-bound
+	operators, too.  Return boolean result.
+	(gfc_check_interfaces): Adapt call to `check_operator_interface'.
+	* symbol.c (gfc_get_namespace): Initialize new field `tb_op'.
+	(gfc_free_namespace): Free `tb_uop_root'-based tree.
+	(find_typebound_proc_uop): New helper function.
+	(gfc_find_typebound_proc): Use it.
+	(gfc_find_typebound_user_op): New method.
+	(gfc_find_typebound_intrinsic_op): Ditto.
+	* resolve.c (resolve_tb_generic_targets): New helper function.
+	(resolve_typebound_generic): Use it.
+	(resolve_typebound_intrinsic_op), (resolve_typebound_user_op): New.
+	(resolve_typebound_procedures): Resolve operators, too.
+	(check_uop_procedure): New, code from gfc_resolve_uops.
+	(gfc_resolve_uops): Moved main code to new `check_uop_procedure'.
+
+2009-08-10  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40940
+	* decl.c (gfc_match_type_spec): Match CLASS statement and warn about
+	missing polymorphism.
+	* gfortran.h (gfc_typespec): Add field 'is_class'.
+	* misc.c (gfc_clear_ts): Initialize 'is_class' to zero.
+	* resolve.c (type_is_extensible): New function to check if a derived
+	type is extensible.
+	(resolve_fl_variable_derived): Add error checks for CLASS variables.
+	(resolve_typebound_procedure): Disallow non-polymorphic passed-object
+	dummy arguments, turning warning into error.
+	(resolve_fl_derived): Use 'type_is_extensible'. Disallow non-polymorphic
+	passed-object dummy arguments for procedure pointer components,
+	turning warning into error. Add error check for CLASS components.
+
+2009-08-05  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40955
+	* gfortran.h (ext_attr_id_t): Add typedef for this enum.
+	(gfc_add_ext_attribute): Use it.
+	* decl.c (gfc_match_gcc_attributes): Ditto.
+	* expr.c (gfc_check_pointer_assign): Ditto.
+	* symbol.c (gfc_add_ext_attribute): Ditto.
+	(gfc_copy_attr): Copy also ext_attr.
+	* resolve.c (resolve_fl_derived,resolve_symbol): Ditto.
+	* module.c (mio_symbol_attribute): Save ext_attr in the mod file.
+
+2009-08-05  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40969
+	Revert:
+	2009-08-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40949
+	* trans-types.c (gfc_get_function_type): Fix typelist of
+	functions without argument.
+
+2009-08-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40847
+	* iresolve.c (gfc_resolve_transfer): Correct error in 'mold'
+	character length for case where length expresson is NULL.
+
+2009-08-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40949
+	* trans-types.c (gfc_get_function_type): Fix typelist of
+	functions without argument.
+
+2009-08-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40875
+	* decl.c (add_init_expr_to_sym): Character symbols can only be
+	initialized with character expressions.
+
+2009-08-02  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40881
+	* decl.c (match_char_length): Warn about old-style character length
+	declarations.
+	* match.c (match_arithmetic_if,gfc_match_if): Modify warning message
+	for arithmetic if.
+	(gfc_match_goto): Warn about computed gotos.
+	(gfc_match_return): Warn about alternate return.
+	(gfc_match_st_function): Warn about statement functions.
+	* resolve.c (resolve_fl_procedure): Modify warning message for
+	assumed-length character functions.
+
+2009-08-01  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40011
+	* error.c : Add static flag 'warnings_not_errors'.
+	(gfc_error): If 'warnings_not_errors' is set, branch to code
+	from gfc_warning.
+	(gfc_clear_error): Reset 'warnings_not_errors'.
+	(gfc_errors_to_warnings): New function.
+	* options.c (gfc_post_options): If pedantic and flag_whole_file
+	change the latter to a value of 2.
+	* parse.c (parse_module): Add module namespace to gsymbol.
+	(resolve_all_program_units): New function.
+	(clean_up_modules): New function.
+	(translate_all_program_units): New function.
+	(gfc_parse_file): If whole_file, do not clean up module right
+	away and add derived types to namespace derived types. In
+	addition, call the three new functions above.
+	* resolve.c (not_in_recursive): New function.
+	(not_entry_self_reference): New function.
+	(resolve_global_procedure): Symbol must not be IFSRC_UNKNOWN,
+	procedure must not be in the course of being resolved and
+	must return false for the two new functions. Pack away the
+	current derived type list before calling gfc_resolve for the
+	gsymbol namespace.  It is unconditionally an error if the ranks
+	of the reference and ther procedure do not match. Convert
+	errors to warnings during call to gfc_procedure_use if not
+	pedantic or legacy.
+	(gfc_resolve): Set namespace resolved flag to -1 during
+	resolution and store current cs_base.
+	* trans-decl.c (gfc_get_symbol_decl): If whole_file compilation
+	substitute a use associated variable, if it is available in a
+	gsymbolnamespace.
+	(gfc_get_extern_function_decl): If the procedure is use assoc,
+	do not attempt to find it in a gsymbol because it could be an
+	interface. If the symbol exists in a module namespace, return
+	its backend_decl.
+	* trans-expr.c (gfc_trans_scalar_assign): If a derived type
+	assignment, set the rhs TYPE_MAIN_VARIANT to that of the rhs.
+	* trans-types.c (copy_dt_decls_ifequal): Add 'from_gsym' as a
+	boolean argument. Copy component backend_decls directly if the
+	components are derived types and from_gsym is true.
+	(gfc_get_derived_type): If whole_file copy the derived type from
+	the module if it is use associated, otherwise, if can be found
+	in another gsymbol namespace, use the existing derived type as
+	the TYPE_CANONICAL and build normally.
+	* gfortran.h : Add derived_types and resolved fields to
+	gfc_namespace. Include prototype for gfc_errors_to_warnings.
+
+2009-07-29  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40898
+	* trans-types.c (gfc_get_function_type): Do not add hidden
+	string-length argument for BIND(C) procedures.
+	* trans-decl.c (create_function_arglist): Skip over nonexisting
+	string-length arguments for BIND(C) procedures.
+
+2009-07-28  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/40878
+	* openmp.c (gfc_match_omp_clauses): Use gfc_error_now instead of
+	gfc_error to diagnose invalid COLLAPSE arguments.
+
+2009-07-28  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40882
+	* trans-types.c (gfc_get_ppc_type): For derived types, directly use the
+	backend_decl, instead of calling gfc_typenode_for_spec, to avoid
+	infinte loop.
+	(gfc_get_derived_type): Correctly handle PPCs returning derived types,
+	avoiding infinite recursion.
+
+2009-07-27  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40848
+	* interface.c (gfc_compare_interfaces): Call 'count_types_test' before
+	'generic_correspondence', and only if checking a generic interface.
+
+2009-07-27  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40851
+	* resolve.c (resolve_symbol): Do not initialize pointer derived-types.
+	* trans-decl.c (init_intent_out_dt): Ditto.
+	(generate_local_decl): No need to set attr.referenced for DT pointers.
+
+2009-07-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33197
+	* intrinsic.c (make_generic): Remove assert as "atan" can be
+	both ISYM_ATAN and ISYM_ATAN2.
+	(add_functions): Add two-argument variant of ATAN.
+	* intrinsic.h (gfc_check_atan_2): Add check for it.
+	* intrinsic.texi (ATAN2): Correct and enhance description.
+	(ATAN): Describe two-argument variant of ATAN.
+
+2009-07-25  Tobias Burnus  <burnus@net-b.de>
+	    Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33197
+	* intrinsic.c (add_functions): Support complex arguments for
+	acos,acosh,asin,asinh,atan,atanh.
+	* invoke.texi (ACOS,ACOSH,ASIN,ASINH,ATAN,ATANH): Support
+	complex arguments.
+	* simplify.c (gfc_simplify_acos,gfc_simplify_acosh,
+	gfc_simplify_asin,gfc_simplify_asinh,gfc_simplify_atan,
+	gfc_simplify_atanh,gfc_simplify_atan,gfc_simplify_asinh,
+	gfc_simplify_acosh,gfc_simplify_atanh): Support
+	complex arguments.
+
+2009-07-25  Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/40005
+	* trans-types.c (gfc_get_array_type_bounds): Use
+	build_distinct_type_copy with a proper TYPE_CANONICAL and
+	re-use the type-decl of the original type.
+	* trans-decl.c (build_entry_thunks): Signal cgraph we may not
+	garbage collect.
+	(create_main_function): Likewise.
+	(gfc_generate_function_code): Likewise.
+	* trans-expr.c (gfc_trans_subcomponent_assign): Do not use
+	fold_convert on record types.
+
+2009-07-25  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/39630
+	* decl.c (match_ppc_decl): Implement the PASS attribute for procedure
+	pointer components.
+	(match_binding_attributes): Ditto.
+	* gfortran.h (gfc_component): Add member 'tb'.
+	(gfc_typebound_proc): Add member 'ppc' and make 'pass_arg' const.
+	* module.c (MOD_VERSION): Bump module version.
+	(binding_ppc): New string constants.
+	(mio_component): Only use formal args if component is a procedure
+	pointer and add 'tb' member.
+	(mio_typebound_proc): Include pass_arg and take care of procedure
+	pointer components.
+	* resolve.c (update_arglist_pass): Add argument 'name' and take care of
+	optional arguments.
+	(extract_ppc_passed_object): New function, analogous to
+	extract_compcall_passed_object, but for procedure pointer components.
+	(update_ppc_arglist): New function, analogous to
+	update_compcall_arglist, but for procedure pointer components.
+	(resolve_typebound_generic_call): Added argument to update_arglist_pass.
+	(resolve_ppc_call, resolve_expr_ppc): Take care of PASS attribute.
+	(resolve_fl_derived): Check the PASS argument for procedure pointer
+	components.
+	* symbol.c (verify_bind_c_derived_type): Reject procedure pointer
+	components in BIND(C) types.
+
+2009-07-24  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40822
+	* array.c (gfc_resolve_character_array_constructor): Use new function
+	gfc_new_charlen.
+	* decl.c (add_init_expr_to_sym,variable_decl,match_char_spec,
+	gfc_match_implicit): Ditto.
+	* expr.c (gfc_simplify_expr): Ditto.
+	* gfortran.h (gfc_new_charlen): New prototype.
+	* iresolve.c (check_charlen_present,gfc_resolve_char_achar): Use new
+	function gfc_new_charlen.
+	* module.c (mio_charlen): Ditto.
+	* resolve.c (gfc_resolve_substring_charlen,
+	gfc_resolve_character_operator,fixup_charlen,resolve_fl_derived,
+	resolve_symbol): Ditto.
+	* symbol.c (gfc_new_charlen): New function to create a new gfc_charlen
+	structure and add it to a namespace.
+	(gfc_copy_formal_args_intr): Make sure ts.cl is present
+	for CHARACTER variables.
+
+2009-07-24  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/40643
+	PR fortran/31067
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc,
+	gfc_conv_intrinsic_minmaxval): Handle Infinities and NaNs properly,
+	optimize.
+	* trans-array.c (gfc_trans_scalarized_loop_end): No longer static.
+	* trans-array.h (gfc_trans_scalarized_loop_end): New prototype.
+
+2009-07-23  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/40839
+	* io.c (gfc_resolve_dt): Add LOC argument.  Fail if
+	dt->io_unit is NULL.  Return FAILURE after issuing error about
+	negative UNIT number.
+	(match_io_element): Don't segfault if current_dt->io_unit is NULL.
+	* gfortran.h (gfc_resolve_dt): Adjust prototype.
+	* resolve.c (resolve_code): Adjust caller.
+
+2009-07-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40796
+	* trans-decl.c (generate_local_decl): Unreferenced result
+	variables with allocatable components should be treated like
+	INTENT_OUT dummy variables.
+
+2009-07-22  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans.h (gfc_set_decl_assembler_name): New prototype.
+	* trans-decl.c (gfc_set_decl_assembler_name): New function.
+	(gfc_get_symbol_decl, gfc_get_extern_function_decl,
+	build_function_decl): Use gfc_set_decl_assembler_name instead of
+	SET_DECL_ASSEMBLER_NAME.
+	* trans-common.c (build_common_decl): Use
+	gfc_set_decl_assembler_name instead of SET_DECL_ASSEMBLER_NAME.
+
+2009-07-21  Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/40726
+	* trans-decl.c (gfc_get_extern_function_decl): Do not set
+	DECL_IS_MALLOC for pointer valued functions.
+	(build_function_decl): The same.
+
+2009-07-19  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/40727
+	* fortran/check.c (gfc_check_cmplx, gfc_check_dcmplx): Add check that
+	the optional second argument isn't of COMPLEX type.
+
+2009-07-17  Richard Guenther  <rguenther@suse.de>
+
+	PR c/40401
+	* f95-lang.c (gfc_be_parse_file): Do not finalize the CU here.
+	* trans-decl.c (gfc_gimplify_function): Remove.
+	(build_entry_thunks): Do not gimplify here.
+	(create_main_function): Likewise.
+	(gfc_generate_function_code): Likewise.
+
+2009-07-17  Aldy Hernandez  <aldyh@redhat.com>
+	    Manuel López-Ibáñez  <manu@gcc.gnu.org>
+
+	PR 40435 
+	* trans-expr.c, trans-array.c, trans-openmp.c, trans-stmt.c,
+	trans.c, trans-io.c, trans-decl.c, trans-intrinsic.c: Add location
+	argument to fold_{unary,binary,ternary}, fold_build[123],
+	build_call_expr, build_size_arg, build_fold_addr_expr,
+	build_call_array, non_lvalue, size_diffop,
+	fold_build1_initializer, fold_build2_initializer,
+	fold_build3_initializer, fold_build_call_array,
+	fold_build_call_array_initializer, fold_single_bit_test,
+	omit_one_operand, omit_two_operands, invert_truthvalue,
+	fold_truth_not_expr, build_fold_indirect_ref, fold_indirect_ref,
+	combine_comparisons, fold_builtin_*, fold_call_expr,
+	build_range_check, maybe_fold_offset_to_address, round_up,
+	round_down.
+
+2009-07-15  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40743
+	* resolve.c (resolve_symbol): Don't resolve the formal namespace of a
+	contained procedure.
+
+2009-07-14  Taras Glek  <tglek@mozilla.com>
+	    Rafael Espindola  <espindola@google.com>
+
+	* Make-lang.in (fortran.install-plugin): New target for
+	installing plugin headers.
+
+2009-07-13  H.J. Lu  <hongjiu.lu@intel.com>
+
+	* module.c (mio_symbol): Remove the unused variable, formal.
+
+2009-07-13  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40646
+	* module.c (mio_symbol): If the symbol has formal arguments,
+	the formal namespace will be present.
+	* resolve.c (resolve_actual_arglist): Correctly handle 'called'
+	procedure pointer components as actual arguments.
+	(resolve_fl_derived,resolve_symbol): Make sure the formal namespace
+	is present.
+	* trans-expr.c (gfc_conv_procedure_call): Correctly handle the formal
+	arguments of procedure pointer components.
+
+2009-07-12  Tobias Burnus  <burnus@net-b.de>
+	    Philippe Marguinaud <philippe.marguinaud@meteo.fr>
+
+	PR fortran/40588
+	* primary.c (match_charkind_name): Fix condition for $ matching.
+
+	PR libfortran/22423
+	* libgfortran.h: Typedef the GFC_DTYPE_* enum.
+
+2009-07-11  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33197
+	* check.c (gfc_check_fn_rc2008): New function.
+	* intrinsic.h (gfc_check_fn_rc2008): New prototype.
+	* intrinsic.c (add_functions): Add complex tan, cosh, sinh,
+	and tanh.
+
+2009-07-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/39334
+	* primary.c (match_kind_param): Return MATCH_NO if the symbol
+	has no value.
+
+2008-07-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40629
+	* resolve.c (check_host_association):  Use the existing
+	accessible symtree and treat function expressions with
+	symbols that have procedure flavor.
+
+2009-07-09  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40646
+	* dump-parse-tree.c (show_expr): Renamed 'is_proc_ptr_comp'.
+	* expr.c (is_proc_ptr_comp): Renamed to 'gfc_is_proc_ptr_comp'.
+	(gfc_check_pointer_assign): Renamed 'is_proc_ptr_comp'.
+	(replace_comp,gfc_expr_replace_comp): New functions, analogous
+	to 'replace_symbol' and 'gfc_expr_replace_symbol', just with components
+	instead of symbols.
+	* gfortran.h (gfc_expr_replace_comp): New prototype.
+	(is_proc_ptr_comp): Renamed to 'gfc_is_proc_ptr_comp'.
+	* interface.c (compare_actual_formal): Renamed 'is_proc_ptr_comp'.
+	* match.c (gfc_match_pointer_assignment): Ditto.
+	* primary.c (gfc_match_varspec): Handle array-valued procedure pointers
+	and procedure pointer components. Renamed 'is_proc_ptr_comp'.
+	* resolve.c (resolve_fl_derived): Correctly handle interfaces with
+	RESULT statement, and handle array-valued procedure pointer components.
+	(resolve_actual_arglist,resolve_ppc_call,resolve_expr_ppc): Renamed
+	'is_proc_ptr_comp'.
+	* trans-array.c (gfc_walk_function_expr): Ditto.
+	* trans-decl.c (gfc_get_symbol_decl): Security check for presence of
+	ns->proc_name.
+	* trans-expr.c (gfc_conv_procedure_call): Handle array-valued procedure
+	pointer components. Renamed 'is_proc_ptr_comp'.
+	(conv_function_val,gfc_trans_arrayfunc_assign): Renamed
+	'is_proc_ptr_comp'.
+	(gfc_get_proc_ptr_comp): Do not modify the argument 'e', but instead
+	make a copy of it.
+	* trans-io.c (gfc_trans_transfer): Handle array-valued procedure
+	pointer components.
+
+2009-07-09  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40604
+	* intrinsic.c (gfc_convert_type_warn): Set sym->result.
+	* trans-expr.c (gfc_conv_procedure_call): Fix -fcheck=pointer
+	for optional arguments.
+
+2009-07-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40675
+	* simplify.c (gfc_simplify_sign): Handle signed zero correctly.
+	* trans-intrinsic.c (gfc_conv_intrinsic_sign): Support
+	-fno-sign-zero.
+	* invoke.texi (-fno-sign-zero): Add text regarding SIGN intrinsic.
+
+2008-07-08  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40591
+	* decl.c (match_procedure_interface):  Correct the association
+	or creation of the interface procedure's symbol.
+
+2009-07-04  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): For integer
+	maxloc initialize limit to -huge-1 rather than just -huge.
+
+2009-07-04  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40593
+	* interface.c (compare_actual_formal): Take care of proc-pointer-valued
+	functions as actual arguments.
+	* trans-expr.c (gfc_conv_procedure_call): Ditto.
+	* resolve.c (resolve_specific_f0): Use the correct ts.
+
+2009-07-02  Michael Matz  <matz@suse.de>
+
+	PR fortran/32131
+	* trans-array.c (gfc_conv_descriptor_stride_get): Return
+	constant one for strides in the first dimension of ALLOCATABLE
+	arrays.
+
+2009-06-30  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40594
+	* trans-types.c (gfc_get_derived_type): Bugfix, reverting one hunk from
+	r147206.
+
+2009-06-29  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40580
+	* trans-expr.c  (gfc_conv_procedure_call): Add -fcheck=pointer check.
+	* libgfortran.h: Add GFC_RTCHECK_POINTER.
+	* invoke.texi (-fcheck): Document new pointer option.
+	* options.c (gfc_handle_runtime_check_option): Handle pointer option.
+
+	* gfortran.texi (C Binding): Improve wording.
+	* iso-c-binding.def: Remove obsolete comment.
+
+2009-06-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40551
+	* dependency.h : Add second bool* argument to prototype of
+	gfc_full_array_ref_p.
+	* dependency.c (gfc_full_array_ref_p): If second argument is
+	present, return true if last dimension of reference is an
+	element or has unity stride.
+	* trans-array.c : Add NULL second argument to references to
+	gfc_full_array_ref_p.
+	* trans-expr.c : The same, except for;
+	(gfc_trans_arrayfunc_assign): Return fail if lhs reference
+	is not a full array or a contiguous section.
+
+2009-06-28  Tobias Burnus  <burnus@net-b.de>
+	    Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/34112
+	* symbol.c (gfc_add_ext_attribute): New function.
+	(gfc_get_sym_tree): New argument allow_subroutine.
+	(gfc_get_symbol,gfc_get_ha_sym_tree,gen_cptr_param,gen_fptr_param
+	gen_shape_param,generate_isocbinding_symbol): Use it.
+	* decl.c (find_special): New argument allow_subroutine.
+	(add_init_expr_to_sym,add_hidden_procptr_result,attr_decl1,
+	match_procedure_in_type,gfc_match_final_decl): Use it.
+	(gfc_match_gcc_attributes): New function.
+	* gfortran.texi (Mixed-Language Programming): New section
+	"GNU Fortran Compiler Directives".
+	* gfortran.h (ext_attr_t): New struct.
+	(symbol_attributes): Use it.
+	(gfc_add_ext_attribute): New prototype.
+	(gfc_get_sym_tree): Update pototype.
+	* expr.c (gfc_check_pointer_assign): Check whether call
+	convention is the same.
+	* module.c (import_iso_c_binding_module, create_int_parameter,
+	use_iso_fortran_env_module): Update gfc_get_sym_tree call.
+	* scanner.c (skip_gcc_attribute): New function.
+	(skip_free_comments,skip_fixed_comments): Use it.
+	(gfc_next_char_literal): Support !GCC$ lines.
+	* resolve.c (check_host_association): Update
+	gfc_get_sym_tree call.
+	* match.c (gfc_match_sym_tree,gfc_match_call): Update
+	gfc_get_sym_tree call.
+	* trans-decl.c (add_attributes_to_decl): New function.
+	(gfc_get_symbol_decl,get_proc_pointer_decl,
+	gfc_get_extern_function_decl,build_function_decl: Use it.
+	* match.h (gfc_match_gcc_attributes): Add prototype.
+	* parse.c (decode_gcc_attribute): New function.
+	(next_free,next_fixed): Support !GCC$ lines.
+	* primary.c (match_actual_arg,check_for_implicit_index,
+	gfc_match_rvalue,gfc_match_rvalue): Update
+	gfc_get_sym_tree call.
+
+2009-06-28  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* gfortran.h: Define HAVE_mpc_pow.
+	* arith.c (complex_reciprocal, complex_pow): If HAVE_mpc_pow,
+	don't define these functions.
+	(arith_power): If HAVE_mpc_pow, use mpc_pow.
+
+2009-06-26  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/39997
+	PR fortran/40541
+	* decl.c (add_hidden_procptr_result): Copy the typespec to the hidden
+	result.
+	* expr.c (gfc_check_pointer_assign): Enable interface check for
+	procedure pointer assignments where the rhs is a function returning a
+	procedure pointer.
+	* resolve.c (resolve_symbol): If an external procedure with unspecified
+	return type can not be implicitly typed, it must be a subroutine.
+
+2009-06-24  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40427
+	* gfortran.h (gfc_component): New member 'formal_ns'.
+	(gfc_copy_formal_args_ppc,void gfc_ppc_use): New.
+	* interface.c (gfc_ppc_use): New function, analogous to
+	gfc_procedure_use, but for procedure pointer components.
+	* module.c (MOD_VERSION): Bump module version.
+	(mio_component): Treat formal arguments.
+	(mio_formal_arglist): Changed argument from gfc_symbol to
+	gfc_formal_arglist.
+	(mio_symbol): Changed argument of mio_formal_arglist.
+	* resolve.c (resolve_ppc_call,resolve_expr_ppc): Call gfc_ppc_use,
+	to check actual arguments and treat formal args correctly.
+	(resolve_fl_derived): Copy formal args of procedure pointer components
+	from their interface.
+	* symbol.c (gfc_copy_formal_args_ppc): New function, analogous to
+	gfc_copy_formal_args, but for procedure pointer components.
+
+2009-06-22  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/37254
+	PR fortran/39850
+	* interface.c (compare_parameter): Set implicit type for function
+	actual arguments with BT_UNKNOWN.
+
+2009-06-22  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40472
+	PR fortran/50520
+	* simplify.c (gfc_simplify_spread): Fix the case that source=
+	is a scalar.
+
+2009-06-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40443
+	* interface.c (gfc_search_interface): Hold back a match to an
+	elementary procedure until all other possibilities are
+	exhausted.
+
+2009-06-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40472
+	* simplify.c (gfc_simplify_spread): Restrict the result size to
+	the limit for an array constructor.
+
+2009-06-21  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/39850
+	* interface.c (gfc_compare_interfaces): Take care of implicit typing
+	when checking the function attribute. Plus another bugfix.
+	(compare_parameter): Set attr.function and attr.subroutine according
+	to the usage of a procedure as actual argument.
+
+2009-06-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40452
+	* trans-decl.c (add_argument_checking): Disable bounds check
+	for allowed argument storage association.
+
+2009-06-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40440
+	* trans-expr.c (gfc_conv_procedure_call): Do not deallocate
+	allocatable components if the argument is a pointer.
+
+2009-06-19  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* gfortran.h (gfc_expr): Use mpc_t to represent complex numbers.
+
+	* arith.c, dump-parse-tree.c, expr.c, module.c, resolve.c,
+	simplify.c, target-memory.c, target-memory.h, trans-const.c,
+	trans-expr.c: Convert to mpc_t throughout.
+
+2009-06-19  Ian Lance Taylor  <iant@google.com>
+
+	* cpp.c (struct gfc_cpp_option_data): Give this struct, used for
+	the global variable gfc_cpp_option, a name.
+
+2009-06-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40450
+	* trans-expr.c (gfc_conv_procedure_call): Only add an extra addr_expr
+	to a procedure pointer actual argument, if it is not itself a
+	dummy arg.
+
+2009-06-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40451
+	* resolve.c (resolve_contained_fntype): Prevent implicit typing for
+	procedures with explicit interface.
+	* symbol.c (gfc_check_function_type): Ditto.
+
+2009-06-16  Ian Lance Taylor  <iant@google.com>
+
+	* decl.c (build_struct): Rewrite loop over constructor elements.
+
+2009-06-16  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36947
+	PR fortran/40039
+	* expr.c (gfc_check_pointer_assign): Call 'gfc_compare_interfaces' with
+	error message.
+	* gfortran.h (gfc_compare_interfaces): Additional argument.
+	* interface.c (operator_correspondence): Removed.
+	(gfc_compare_interfaces): Additional argument to return error message.
+	Directly use the code from 'operator_correspondence' instead of calling
+	the function. Check for OPTIONAL. Some rearrangements.
+	(check_interface1): Call 'gfc_compare_interfaces' without error message.
+	(compare_parameter): Call 'gfc_compare_interfaces' with error message.
+	* resolve.c (check_generic_tbp_ambiguity): Call 'gfc_compare_interfaces'
+	without error message.
+
+2009-06-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40383
+	* trans-decl.c (create_function_arglist): Copy formal charlist to
+	have a proper passed_length for -fcheck=bounds.
+
+2009-06-12  Steven G. Kargl  <kargls@comcast.net>
+
+	* arith.c (gfc_enum_initializer): Move function ...
+	* decl.c: ... here.  Remove gfc_ prefix and make static.
+	(enumerator_decl): Update function call.
+	* gfortran.h:  Remove gfc_enum_initializer prototype.
+
+2009-06-12  Aldy Hernandez  <aldyh@redhat.com>
+
+	* trans-array.c (gfc_trans_allocate_array_storage): Pass
+	location on down.
+	(gfc_trans_array_constructor_value): Same.
+	(gfc_trans_scalarized_loop_end): Same.
+	(gfc_conv_ss_startstride): Same.
+	(gfc_trans_g77_array): Same.
+	(gfc_trans_dummy_array_bias): Same.
+	(gfc_conv_array_parameter): Same.
+	(structure_alloc_comps): Same.
+	* trans-expr.c (gfc_conv_function_call): Same.
+	(fill_with_spaces): Same.
+	(gfc_trans_string_copy): Same.
+	(gfc_trans_scalar_assign): Same.
+	* trans-stmt.c (gfc_trans_goto): Same.
+	(gfc_trans_if_1): Same.
+	(gfc_trans_simple_do): Same.
+	(gfc_trans_do): Same.
+	(gfc_trans_do_while): Same.
+	(gfc_trans_logical_select): Same.
+	(gfc_trans_select): Same.
+	(gfc_trans_forall_loop): Same.
+	(gfc_trans_nested_forall_loop): Same.
+	(generate_loop_for_temp_to_lhs): Same.
+	(generate_loop_for_rhs_to_temp): Same.
+	(gfc_trans_forall_1): Same.
+	(gfc_trans_where_assign): Same.
+	(gfc_trans_where_3): Same.
+	(gfc_trans_allocate): Same.
+	* trans.c (gfc_finish_block): Same.
+	(gfc_trans_runtime_check): Same.
+	(gfc_call_malloc): Same.
+	(gfc_allocate_with_status): Same.
+	(gfc_call_free): Same.
+	(gfc_deallocate_with_status): Same.
+	(gfc_call_realloc): Same.
+	(gfc_trans_code): Same.
+	* trans-decl.c (gfc_init_default_dt): Same.
+	(gfc_generate_constructors): Same.
+	* trans-io.c (gfc_trans_io_runtime_check): Same.
+	* trans-intrinsic.c (gfc_conv_intrinsic_ctime): Same.
+	(gfc_conv_intrinsic_fdate): Same.
+	(gfc_conv_intrinsic_ttynam): Same.
+	(gfc_conv_intrinsic_minmax): Same.
+	(gfc_conv_intrinsic_minmax_char): Same.
+	(gfc_conv_intrinsic_anyall): Same.
+	(gfc_conv_intrinsic_count): Same.
+	(gfc_conv_intrinsic_arith): Same.
+	(gfc_conv_intrinsic_minmaxloc): Same.
+	(gfc_conv_intrinsic_minmaxval): Same.
+	(gfc_conv_intrinsic_rrspacing): Same.
+	(gfc_conv_intrinsic_array_transfer): Same.
+	(gfc_conv_intrinsic_trim): Same.
+	(gfc_conv_intrinsic_repeat): Same.
+	
+2009-06-12  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40176
+	* resolve.c (resolve_symbol): Additional error check, preventing an
+	infinite loop.
+
+2009-06-11  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40402
+	* resolve.c (next_data_value): It is an error if the value is
+	not constant.
+
+2009-06-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/38718
+	* intrinsic.c (add_functions): Add simplifiers for ISNAN,
+	IS_IOSTAT_END and IS_IOSTAT_EOR.
+	* intrinsic.h (gfc_simplify_is_iostat_end, gfc_simplify_is_iostat_eor,
+	gfc_simplify_isnan): New prototypes.
+	* intrinsic.c (gfc_simplify_is_iostat_end, gfc_simplify_is_iostat_eor,
+	gfc_simplify_isnan): New functions.
+
+2009-06-11  Jakub Jelinek  <jakub@redhat.com>
+
+	* interface.c (fold_unary): Rename to...
+	(fold_unary_intrinsic): ... this.
+	(gfc_extend_expr): Adjust caller.
+	(gfc_match_generic_spec): Likewise.  Initialize *op to INTRINSIC_NONE
+	to avoid warnings.
+	* expr.c (gfc_simplify_expr): Initialize start and end before calling
+	gfc_extract_int.
+
+2009-06-10  Dave Korn  <dave.korn.cygwin@gmail.com>
+
+	* trans-decl.c (create_main_function):  Don't build main decl twice.
+
+2009-06-09  Tobias Burnus  <burnus@net-b.de>
+
+	* trans-decl.c (gfc_generate_function_code): Use gfc_option.rtcheck
+	instead of flag_bounds_check.
+	* intrinsic.texi (ISO_FORTRAN_ENV): Document INT{8,16,32,64} and
+	REAL{32,64,128}.
+
+2009-06-08  Paul Thomas  <pault@gcc.gnu.org>
+
+	* trans-array.h : Replace prototypes for
+	gfc_conv_descriptor_offset, gfc_conv_descriptor_stride,
+	gfc_conv_descriptor_lbound, gfc_conv_descriptor_ubound with new
+	prototypes of the same names with _get or _set appended.
+	* trans-array.c : Make the originals of the above static and
+	new functions for the _get and _set functions. Update all the
+	references to these descriptor access functions.
+	* trans-expr.c : Update references to the above descriptor
+	access functions.
+	* trans-intrinsic.c : The same.
+	* trans-openmp.c : The same.
+	* trans-stmt.c : The same.
+
+2009-06-08  Alexandre Oliva  <aoliva@redhat.com>
+
+	* options.c (gfc_post_options): Disable dump_parse_tree
+	during -fcompare-debug-second.
+
+2009-06-07  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/40008
+	* gfortran.h (gfc_open): Add newunit expression to structure.
+	* io.c (io_tag): Add new unit tag and fix whitespace.
+	(match_open_element): Add matching for newunit.
+	(gfc_free_open): Free the newunit expression.
+	(gfc_resolve_open): Add newunit to resolution and check constraints.
+	(gfc_resolve_close): Add check for non-negative unit.
+	(gfc_resolve_filepos): Likewise.
+	(gfc_resolve_dt): Likewise.
+	* trans-io.c (set_parameter_value): Build runtime checks for unit
+	numbers within range of kind=4 integer. (gfc_trans_open) Set the
+	newunit parameter.
+	* ioparm.def (IOPARM): Define the newunit parameter as a pointer
+	to GFC_INTEGER_4, pint4.
+
+2009-06-07  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/25104
+	PR fortran/29962
+	* array.c (gfc_append_constructor): Added NULL-check.
+	* check.c (gfc_check_spread): Check DIM.
+	(gfc_check_unpack): Check that the ARRAY arguments provides enough
+	values for MASK.
+	* intrinsic.h (gfc_simplify_spread): New prototype.
+	(gfc_simplify_unpack): Likewise.
+	* intrinsic.c (add_functions): Added new simplifier callbacks.
+	* simplify.c (gfc_simplify_spread): New.
+	(gfc_simplify_unpack): New.
+	* expr.c (check_transformational): Allow additional transformational
+	intrinsics in initialization expression.
+
+2009-06-07  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/25104
+	PR fortran/29962
+	* check.c (gfc_check_all_any): Check rank of DIM.
+	(gfc_check_count): Likewise.
+	* intrinsic.h (gfc_simplify_all): New prototype.
+	(gfc_simplify_any): Likewise.
+	(gfc_simplify_count): Likewise.
+	(gfc_simplify_sum): Likewise.
+	(gfc_simplify_product): Likewise.
+	* intrinsic.c (add_functions): Added new simplifier callbacks.
+	* simplify.c (transformational_result): New.
+	(simplify_transformation_to_scalar): New.
+	(simplify_transformation_to_array): New.
+	(gfc_count): New.
+	(gfc_simplify_all): New.
+	(gfc_simplify_any): New.
+	(gfc_simplify_count): New.
+	(gfc_simplify_sum): New.
+	(gfc_simplify_product): New.
+	* expr.c (check_transformational): Allow additional transformational
+	intrinsics in initialization expression.
+
+2009-06-07  Daniel Franke  <franke.daniel@gmail.com>
+
+	* check.c (dim_rank_check): Return SUCCESS if DIM=NULL.
+	(gfc_check_lbound): Removed (now) redundant check for DIM=NULL.
+	(gfc_check_minloc_maxloc): Likewise.
+	(check_reduction): Likewise.
+	(gfc_check_size): Likewise.
+	(gfc_check_ubound): Likewise.
+	(gfc_check_cshift): Added missing shape-conformance checks.
+	(gfc_check_eoshift): Likewise.
+	* gfortran.h (gfc_check_conformance): Modified prototype to printf-style.
+	* expr.c (gfc_check_conformance): Accept error-message chunks in 
+	printf-style. Changed all callers.
+
+
+2009-06-07  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/25104
+	PR fortran/29962
+	* intrinsic.h (gfc_simplify_dot_product): New prototype.
+	(gfc_simplify_matmul): Likewise.
+	(gfc_simplify_transpose): Likewise.
+	* intrinsic.c (add_functions): Added new simplifier callbacks.
+	* simplify.c (init_result_expr): New.
+	(compute_dot_product): New.
+	(gfc_simplify_dot_product): New.
+	(gfc_simplify_matmul): New.
+	(gfc_simplify_transpose): New.
+	* expr.c (check_transformational): Allow transformational intrinsics
+	with simplifier in initialization expression.
+
+2009-06-06  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/37203
+	* simplify.c (gfc_simplify_reshape): Fixed reshaping of empty arrays
+	without padding.
+
+2009-06-06  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32890
+	* intrinsic.h (gfc_simplify_pack): New prototype.
+	* intrinsic.c (add_functions): Added
+	simplifier-callback to PACK.
+	* simplify.c (is_constant_array_expr): Moved
+	to beginning of file.
+	(gfc_simplify_pack): New.
+	* check.c (gfc_check_pack): Check that VECTOR has enough elements.
+	Added safeguards for empty arrays.
+
+2009-06-05  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* simplify.c (call_mpc_func): Use mpc_realref/mpc_imagref
+	instead of MPC_RE/MPC_IM.
+
+2009-06-05  Alexandre Oliva  <aoliva@redhat.com>
+
+	* trans-decl.c (gfc_build_qualified_array): Don't skip generation
+	of range types.
+	* trans.h (struct lang_type): Add base_decls.
+	(GFC_TYPE_ARRAY_BASE_DECL): New.
+	* trans-types.c (gfc_get_array_type_bounds): Initialize base decls
+	proactively and excessively.
+	(gfc_get_array_descr_info): Use existing base decls if available.
+
+2009-06-04  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/37203
+	* check.c (gfc_check_reshape): Additional checks for the
+	SHAPE and ORDER arguments.
+	* simplify.c (gfc_simplify_reshape): Converted argument checks
+	to asserts.
+
+2009-06-03  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi: Add mixed-language programming, mention
+	varying string lengths, some clean up of introduction parts.
+	* intrinsic.texi (instrinsic modules): Create @menu for subsections.
+	(ISO_C_BINDING): Support ISOCBINDING_INT_FAST128_T.
+	* libgfortran.h: Comment to rember to keep gfortran.texi in sync.
+	* iso-c-binding.def: Support ISOCBINDING_INT_FAST128_T.
+
+2009-06-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	* iso-c-binding.def: Use INTMAX_TYPE instead of intmax_type_node.
+	* trans-types.c (init_c_interop_kinds): Remove intmax_type_node.
+
+2009-06-03  Alexandre Oliva  <aoliva@redhat.com>
+
+	* module.c (mio_f2k_derived): Initialize cur.
+
+2009-06-01  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40309
+	* trans-decl.c (gfc_sym_identifier): Use "MAIN__" for PROGRAM "main".
+	(create_main_function): Set main_identifier_node.
+
+2009-05-29  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/40019
+	* trans-types.c (gfc_build_uint_type): Make nonstatic.
+	* trans.h (gfor_fndecl_clz128, gfor_fndecl_ctz128): New prototypes.
+	* trans-types.h (gfc_build_uint_type): Add prototype.
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Build
+	gfor_fndecl_clz128 and gfor_fndecl_ctz128.
+	* trans-intrinsic.c (gfc_conv_intrinsic_leadz,
+	gfc_conv_intrinsic_trailz): Call the right builtins or library
+	functions, and cast arguments to unsigned types first.
+	* simplify.c (gfc_simplify_leadz): Deal with negative arguments.
+
+2009-05-27  Ian Lance Taylor  <iant@google.com>
+
+	* Make-lang.in (gfortran$(exeext)): Change $(COMPILER) to
+	$(LINKER).
+	(f951$(exeext)): Likewise.
+
+2009-05-27  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40270
+	* trans-decl.c (create_main_function): Mark MAIN__ and
+	argc/argv as TREE_USED and push/pop function_decl context
+	if needed.
+
+2009-05-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/39178
+	* gfortranspec.c (lang_specific_driver): Stop linking
+	libgfortranbegin.
+	* trans-decl.c (gfc_build_builtin_function_decls): Stop
+	making MAIN__ publicly visible.
+	(gfc_build_builtin_function_decls): Add
+	gfor_fndecl_set_args.
+	(create_main_function) New function.
+	(gfc_generate_function_code): Use it.
+
+2009-05-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40246
+	* match.c (gfc_match_nullify): NULLify freed pointer.
+
+2009-05-26  Ian Lance Taylor  <iant@google.com>
+
+	* Make-lang.in (gfortranspec.o): Use $(COMPILER).
+	(gfortran$(exeext), f951$(exeext), fortran/cpp.o): Likewise.
+
+2009-05-26  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
+
+	* gfortran.h (GFC_MPC_RND_MODE): New.
+	* simplify.c (call_mpc_func): New helper function.
+	(gfc_simplify_cos, gfc_simplify_exp, gfc_simplify_log,
+	gfc_simplify_sin, gfc_simplify_sqrt): Add MPC support.
+
+2009-05-25  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40176
+	* primary.c (gfc_match_varspec): Handle procedure pointer components
+	with array return value.
+	* resolve.c (resolve_expr_ppc): Ditto.
+	(resolve_symbol): Make sure the interface of a procedure pointer has
+	been resolved.
+	* trans-array.c (gfc_walk_function_expr): Handle procedure pointer
+	components with array return value.
+	* trans-expr.c (gfc_conv_component_ref,gfc_conv_procedure_call,
+	gfc_trans_arrayfunc_assign): Ditto.
+	(gfc_trans_pointer_assignment): Handle procedure pointer assignments,
+	where the rhs is a dummy argument.
+	* trans-types.c (gfc_get_ppc_type,gfc_get_derived_type): Handle
+	procedure pointer components with array return value.
+
+2009-05-24  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+	    Dominique Dhumieres
+
+	PR fortran/35732
+	PR fortran/39872
+	* trans-array.c (gfc_conv_ss_startstride): Add one to index.
+
+2009-05-22  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/40195
+	* module.c (read_md5_from_module_file): Close file before returning.
+
+2009-05-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40164
+	* primary.c (gfc_match_rvalue): Handle procedure pointer components in
+	arrays.
+	* resolve.c (resolve_ppc_call,resolve_expr_ppc): Resolve component and
+	array references.
+	(resolve_fl_derived): Procedure pointer components are not required to
+	have constant array bounds in their return value.
+
+2009-05-18  Janus Weil  <janus@gcc.gnu.org>
+
+	* intrinsic.c (add_sym): Fix my last commit (r147655),
+	which broke bootstrap.
+
+2009-05-18  Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/40168
+	* trans-expr.c (gfc_trans_zero_assign): For local array
+	destinations use an assignment from an empty constructor.
+
+2009-05-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36947
+	PR fortran/40039
+	* expr.c (gfc_check_pointer_assign): Check intents when comparing
+	interfaces.
+	* gfortran.h (typedef struct gfc_intrinsic_arg): Add 'intent' member.
+	(gfc_compare_interfaces): Additional argument.
+	* interface.c (operator_correspondence): Add check for equality of
+	intents, and new argument 'intent_check'.
+	(gfc_compare_interfaces): New argument 'intent_check', which is passed
+	on to operator_correspondence.
+	(check_interface1): Don't check intents when comparing interfaces.
+	(compare_parameter): Do check intents when comparing interfaces.
+	* intrinsic.c (add_sym): Add intents for arguments of intrinsic
+	procedures.
+	(add_sym_1,add_sym_1s,add_sym_1m,add_sym_2,add_sym_2s,add_sym_3,
+	add_sym_3ml,add_sym_3red,add_sym_3s,add_sym_4): Use INTENT_IN by
+	default.
+	(add_sym_1_intent,add_sym_1s_intent,add_sym_2s_intent,add_sym_3s_intent)
+	: New functions to add intrinsic symbols, specifying custom intents.
+	(add_sym_4s,add_sym_5s): Add new arguments to specify intents.
+	(add_functions,add_subroutines): Add intents for various intrinsics.
+	* resolve.c (check_generic_tbp_ambiguity): Don't check intents when
+	comparing interfaces.
+	* symbol.c (gfc_copy_formal_args_intr): Copy intent.
+
+2009-05-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* iso-fortran-env.def: Define INT8, INT16, INT32, INT64, REAL32,
+	REAL64 and REAL128.
+	* gfortran.h (gfc_get_int_kind_from_width_isofortranenv,
+	gfc_get_real_kind_from_width_isofortranenv): New prototypes.
+	* iso-c-binding.def: Update definitions for the INT*_T,
+	INT_LEAST*_T and INT_FAST*_T named parameters.
+	* trans-types.c (get_typenode_from_name, get_int_kind_from_name,
+	gfc_get_real_kind_from_width_isofortranenv): New functions.
+
+2009-05-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36260
+	* intrinsic.c (add_functions, add_subroutines): Fix argument
+	names and wrap long lines.
+	* intrinsic.texi: Fix documentation and argument names of
+	LOG_GAMMA, DATAN2, DBESJN, DTIME, ETIME, FSTAT, STAT, LSTAT,
+	GET_COMMAND, IDATE, LTIME, MOVE_ALLOC, NINT, OR, PRODUCT,
+	SUM, RAND, RANDOM_SEED, REAL, SELECTED_INT_KIND,
+	SELECTED_REAL_KIND and XOR.
+
+2009-05-16  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/33197
+	* intrinsic.c (add_functions): Use ERFC_SCALED simplification.
+	* intrinsic.h (gfc_simplify_erfc_scaled): New prototype.
+	* simplify.c (fullprec_erfc_scaled, asympt_erfc_scaled,
+	gfc_simplify_erfc_scaled): New functions.
+
+2009-05-16  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/31243
+	* resolve.c (resolve_substring): Don't allow too large substring
+	indexes.
+	(gfc_resolve_substring_charlen): Fix typo.
+	(gfc_resolve_character_operator): Fix typo.
+	(resolve_charlen): Catch unreasonably large string lengths.
+	* simplify.c (gfc_simplify_len): Don't error out on LEN
+	range checks.
+
+2009-05-16  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36031
+	* decl.c (set_enum_kind): Use global short-enums flag.
+	* gfortran.h (gfc_option_t): Remove short_enums flag.
+	* lang.opt (-fshort-enums): Refer to C documentation.
+	* options.c (gfc_init_options, gfc_handle_option): Use global
+	short-enums flag.
+
+2009-05-15  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/39352
+	* f95-lang.c: Add gfc_maybe_initialize_eh.
+	* gfortran.h: Add gfc_maybe_initialize_eh prototype.
+	* Make-lang.in: Add new .h dendencies for f95-lang.c
+	* openmp.c (resolve_omp_do): Call gfc_maybe_initialize_eh.
+	* misc.c (gfc_free): Avoid #define trickery for free.
+
+2009-05-14  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* dump-parse-tree.c (show_code_node): Add ERRMSG to the dumping
+	of allocate and deallocate statements.
+
+2009-05-14  Ian Lance Taylor  <iant@google.com>
+
+	* decl.c (match_attr_spec): Change d to unsigned int.
+	* dump-parse-tree.c (show_namespace): Change op to int.  Add cast.
+	* interface.c (gfc_check_interfaces): Change i to int.  Add casts.
+	* module.c (read_module): Change i to int.  Add cast.
+	(write_module): Change i to int.
+	* symbol.c (gfc_get_namespace): Change in to int.
+	(gfc_free_namespace): Change i to int.
+	* trans-io.c (gfc_build_io_library_fndecls): Change ptype to
+	unsigned int.  Add cast.
+	* trans-types.c (gfc_init_kinds): Change mode to unsigned int.
+	Add casts.
+
+2009-05-14  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/40045
+	* dump-parse-tree.c (show_typebound): Fix missing adaption to new
+	type-bound procedure storage structure.
+
+2009-05-14  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/39996
+	* decl.c (gfc_match_function_decl): Use gfc_add_type.
+	* symbol.c (gfc_add_type): Better checking for duplicate types in
+	function declarations. And: Always give an error for duplicte types,
+	not just a warning with -std=gnu.
+
+2009-05-14  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/39865
+	* io.c (resolve_tag_format): CHARACTER array in FMT= argument
+	isn't an extension.  Reject non-CHARACTER array element of
+	assumed shape or pointer or assumed size array.
+	* trans-array.c (array_parameter_size): New function.
+	(gfc_conv_array_parameter): Add size argument.  Call
+	array_parameter_size if it is non-NULL.
+	* trans-array.h (gfc_conv_array_parameter): Adjust prototype.
+	* trans-expr.c (gfc_conv_function_call, gfc_trans_arrayfunc_assign):
+	Adjust callers.
+	* trans-intrinsic.c (gfc_conv_intrinsic_loc): Likewise.
+	* trans-io.c (gfc_convert_array_to_string): Rewritten.
+
+2009-05-13  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* gfortran.h (gfc_code): Rename struct member expr to expr1.
+	* openmp.c (resolve_omp_atomic): Update expr to expr1.
+	* interface.c (gfc_extend_assign): Ditto.
+	* trans-expr.c (gfc_conv_expr_reference, gfc_trans_assignment,
+	gfc_trans_init_assign): Ditto.
+	* dump-parse-tree.c (show_code_node): Ditto.
+	* trans-openmp.c (gfc_trans_omp_atomic): Ditto.
+	* trans-stmt.c ( gfc_trans_label_assign, gfc_trans_goto, gfc_trans_call,
+	gfc_trans_return, gfc_trans_pause, gfc_trans_stop, gfc_trans_if_1,
+	gfc_trans_arithmetic_if, gfc_trans_do_while, gfc_trans_integer_select,
+	gfc_trans_logical_select, gfc_trans_character_select
+	forall_make_variable_temp, check_forall_dependencies
+	gfc_trans_forall_1, gfc_trans_where_2, gfc_trans_where_3
+	gfc_trans_where, gfc_trans_allocate, gfc_trans_deallocate): Ditto.
+	* io.c (match_io_element, gfc_match_inquire): Ditto.
+	* resolve.c (resolve_typebound_call, resolve_ppc_call,
+	resolve_allocate_expr, resolve_allocate_deallocate, resolve_select,
+	resolve_transfer, resolve_where, gfc_resolve_assign_in_forall,
+	gfc_resolve_blocks, resolve_code, build_init_assign): Ditto.
+	* st.c (gfc_free_statement): Ditto.
+	* match.c (gfc_match_assignment, gfc_match_pointer_assignment,
+	match_arithmetic_if, gfc_match_if, gfc_match_elseif
+	gfc_match_stopcode, gfc_match_assign, gfc_match_goto,
+	gfc_match_nullify, match_typebound_call, gfc_match_call
+	gfc_match_select, match_simple_where, gfc_match_where
+	gfc_match_elsewhere, match_simple_forall, gfc_match_forall): Ditto.
+	* trans-io.c (gfc_trans_transfer): Ditto.
+	* parse.c (parse_where_block, parse_if_block): Ditto.
+
+2009-05-13  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* gfortran.h (gfc_code): Rename struct member label to label1.
+	* dump-parse-tree.c (show_code_node): Update symbol.
+	* trans-stmt.c (gfc_trans_label_assign, gfc_trans_goto,
+	gfc_trans_arithmetic_if): Ditto.
+	* resolve.c (gfc_resolve_blocks, resolve_code): Ditto.
+	* match.c (match_arithmetic_if, gfc_match_if, gfc_reference_st_label,
+	gfc_match_assign, gfc_match_goto): Ditto.
+	* parse.c (parse_do_block): Ditto.
+
+2009-05-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34153
+	* gfortran.h (gfc_exec_op): Add EXEC_END_PROCEDURE.
+	* dump-parse-tree.c (show_code_node): Use EXEC_END_PROCEDURE.
+	* trans.c (gfc_trans_code): Ditto.
+	* resolve.c (resolve_code): Ditto.
+	* st.c (gfc_free_statement): Ditto.
+	* parse.c (accept_statement): Ditto.
+
+2009-05-12  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40110
+	* decl.c (gfc_match_kind_spec): Turn C kind error into a warning.
+
+2009-05-11  Steve Ellcey  <sje@cup.hp.com>
+
+	* resolve.c (check_host_association): Initialize tail.
+
+2009-05-11  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40089
+	* resolve.c (resolve_fl_derived): Only return FAILURE if
+	gfc_notify_std fails.
+
+2009-05-10  Ian Lance Taylor  <iant@google.com>
+
+	* gfortran.h (enum gfc_omp_sched_kind): New enum, broken out of
+	gfc_omp_clauses.
+	(enum gfc_omp_default_sharing): Likewise.
+	* module.c (enum gfc_rsym_state): New enum, broken out of
+	pointer_info.
+	(enum gfc_wsym_state): Likewise.
+	* parse.c (enum state_order): New enum, broken out of st_state.
+
+2009-05-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40018
+	* trans-array.c (gfc_trans_array_constructor_value): Fold
+	convert numeric constants.
+	(gfc_build_constant_array_constructor): The same.
+
+2009-05-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38863
+	* trans-expr.c (gfc_conv_operator_assign): Remove function.
+	* trans.h : Remove prototype for gfc_conv_operator_assign.
+	* trans-stmt.c (gfc_conv_elemental_dependencies): Initialize
+	derivde types with intent(out).
+	(gfc_trans_call): Add mask, count1 and invert arguments. Add
+	code to use mask for WHERE assignments.
+	(gfc_trans_forall_1): Use new arguments for gfc_trans_call.
+	(gfc_trans_where_assign): The gfc_symbol argument is replaced
+	by the corresponding code. If this has a resolved_sym, then
+	gfc_trans_call is called. The call to gfc_conv_operator_assign
+	is removed.
+	(gfc_trans_where_2): Change the last argument in the call to
+	gfc_trans_where_assign.
+	* trans-stmt.h : Modify prototype for gfc_trans_call.
+	* trans.c (gfc_trans_code): Use new args for gfc_trans_call.
+
+2009-05-08  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/39876
+	* intrinsic.c (gfc_is_intrinsic): Do not add the EXTERNAL attribute if
+	the symbol is a module procedure.
+
+2009-05-08  Tobias Burnus  <burnus@net-b.de>
+
+	* invoke.texi: Add do/recursion to the -fcheck= summary.
+
+2009-05-07  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/38830
+	* gfortran.texi: Document that we don't support variable FORMAT
+	expressions.
+
+2009-05-07  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/39576
+	* error.c (error_print): Add missing break statement.
+
+2009-05-07  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36382
+	* invoke.texi: Document that -fdollar-ok does not allow $ to be
+	used in IMPLICIT statement.
+
+2009-05-06  Janus Weil  <janus@gcc.gnu.org>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/39630
+	* decl.c (match_procedure_interface): New function to match the
+	interface for a PROCEDURE statement.
+	(match_procedure_decl): Call match_procedure_interface.
+	(match_ppc_decl): New function to match the declaration of a
+	procedure pointer component.
+	(gfc_match_procedure):  Call match_ppc_decl.
+	(match_binding_attributes): Add new argument 'ppc' and handle the
+	POINTER attribute for procedure pointer components.
+	(match_procedure_in_type,gfc_match_generic): Added new argument to
+	match_binding_attributes.
+	* dump-parse-tree.c (show_expr,show_components,show_code_node): Handle
+	procedure pointer components.
+	* expr.c (free_expr0,gfc_copy_expr,gfc_simplify_expr): Handle EXPR_PPC.
+	(gfc_check_pointer_assign): Handle procedure pointer components, but no
+	full checking yet.
+	(is_proc_ptr_comp): New function to determine if an expression is a
+	procedure pointer component.
+	* gfortran.h (expr_t): Add EXPR_PPC.
+	(symbol_attribute): Add new member 'proc_pointer_comp'.
+	(gfc_component): Add new member 'formal'.
+	(gfc_exec_op): Add EXEC_CALL_PPC.
+	(gfc_get_default_type): Changed first argument.
+	(is_proc_ptr_comp): Add prototype.
+	(gfc_match_varspec): Add new argument.
+	* interface.c (compare_actual_formal): Handle procedure pointer
+	components.
+	* match.c (gfc_match_pointer_assignment,match_typebound_call): Handle
+	procedure pointer components.
+	* module.c (mio_expr): Handle EXPR_PPC.
+	* parse.c (parse_derived): Handle procedure pointer components.
+	* primary.c (gfc_match_varspec): Add new argument 'ppc_arg' and handle
+	procedure pointer components.
+	(gfc_variable_attr): Handle procedure pointer components.
+	(gfc_match_rvalue): Added new argument to gfc_match_varspec and changed
+	first argument of gfc_get_default_type.
+	(match_variable): Added new argument to gfc_match_varspec.
+	* resolve.c (resolve_entries,set_type,resolve_fl_parameter): Changed
+	first argument of gfc_get_default_type.
+	(resolve_structure_cons,resolve_actual_arglist): Handle procedure
+	pointer components.
+	(resolve_ppc_call): New function to resolve a call to a procedure
+	pointer component (subroutine).
+	(resolve_expr_ppc): New function to resolve a call to a procedure
+	pointer component (function).
+	(gfc_resolve_expr): Handle EXPR_PPC.
+	(resolve_code): Handle EXEC_CALL_PPC.
+	(resolve_fl_derived): Copy the interface for a procedure pointer
+	component.
+	(resolve_symbol): Fix overlong line.
+	* st.c (gfc_free_statement): Handle EXEC_CALL_PPC.
+	* symbol.c (gfc_get_default_type): Changed first argument.
+	(gfc_set_default_type): Changed first argument of gfc_get_default_type.
+	(gfc_add_component): Initialize ts.type to BT_UNKNOWN.
+	* trans.h (gfc_conv_function_call): Renamed.
+	* trans.c (gfc_trans_code): Handle EXEC_CALL_PPC.
+	* trans-expr.c (gfc_conv_component_ref): Ditto.
+	(gfc_conv_function_val): Rename to 'conv_function_val', add new
+	argument 'expr' and handle procedure pointer components.
+	(gfc_conv_operator_assign): Renamed gfc_conv_function_val.
+	(gfc_apply_interface_mapping_to_expr): Handle EXPR_PPC.
+	(gfc_conv_function_call): Rename to 'gfc_conv_procedure_call', add new
+	argument 'expr' and handle procedure pointer components.
+	(gfc_get_proc_ptr_comp): New function to get the backend decl for a
+	procedure pointer component.
+	(gfc_conv_function_expr): Renamed gfc_conv_function_call.
+	(gfc_conv_structure): Handle procedure pointer components.
+	* trans-intrinsic.c (gfc_conv_intrinsic_funcall,
+	conv_generic_with_optional_char_arg): Renamed gfc_conv_function_call.
+	* trans-stmt.h (gfc_get_proc_ptr_comp): Add prototype.
+	* trans-stmt.c (gfc_trans_call): Renamed gfc_conv_function_call.
+	* trans-types.h (gfc_get_ppc_type): Add prototype.
+	* trans-types.c (gfc_get_ppc_type): New function to build a tree node
+	for a procedure pointer component.
+	(gfc_get_derived_type): Handle procedure pointer components.
+
+2009-05-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40041
+	* resolve.c (resolve_symbol): Print no warning for implicitly
+	typed intrinsic functions.
+
+2009-05-05  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/39998
+	* expr.c (gfc_check_pointer_assign): Check for statement functions and
+	internal procedures in procedure pointer assignments.
+
+2009-04-28  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/39946
+	* resolve.c (resolve_symbol): Correctly copy the interface of a
+	PROCEDURE statement if the interface involves a RESULT variable.
+
+2009-04-28  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/39930
+	PR fortran/39931
+	* expr.c (gfc_check_pointer_assign): Correctly detect if the left hand
+	side is a pointer.
+	* parse.c (gfc_fixup_sibling_symbols): Don't check for ambiguity.
+
+2009-04-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/39879
+	* trans_expr.c (gfc_conv_procedure_call): Deep copy a derived
+	type parentheses argument if it is a variable with allocatable
+	components.
+
+2009-04-27  Ian Lance Taylor  <iant@google.com>
+
+	* trans-intrinsic.c (DEFINE_MATH_BUILTIN): Add casts to enum
+	type.
+	* trans-io.c (st_parameter_field): Add casts to enum type.
+
+2009-04-26  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/39893
+	fortran/data.c (gfc_assign_data_value): If the lvalue is an 
+	assumed character length entity in a data statement, then 
+	return FAILURE to prevent segmentation fault.
+
+2009-04-26  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-decl.c: Include pointer-set.h.
+	(nonlocal_dummy_decl_pset, tree nonlocal_dummy_decls): New variables.
+	(gfc_nonlocal_dummy_array_decl): New function.
+	(gfc_get_symbol_decl): Call it for non-local dummy args with saved
+	descriptor.
+	(gfc_get_symbol_decl): Set DECL_BY_REFERENCE when needed.
+	(gfc_generate_function_code): Initialize nonlocal_dummy_decl{s,_pset},
+	chain it to outermost block's vars, destroy it afterwards.
+	* Make-lang.in (trans-decl.o): Depend on pointer-set.h.
+
+2009-04-25  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/39688
+	* decl.c (gfc_match_import): Use 'sym->name' instead of 'name'.
+	They differ if the symbol has been use-renamed.
+
+2009-04-24  Ian Lance Taylor  <iant@google.com>
+
+	* gfortran.h (enum gfc_symbol_type): New named enum type, broken
+	out of struct gfc_symbol.
+	(struct gfc_symbol): Use enum gfc_symbol_type.
+	(enum gfc_array_ref_dimen_type): New named enum type, broken out
+	of struct gfc_array_ref).
+	(struct gfc_array_ref): Use enum gfc_array_ref_dimen_type.
+	(mod_pointee_as): Update declaration.
+	* decl.c (add_global_entry): Change type to enum gfc_symbol_type.
+	(gfc_mod_pointee_as): Change return type to "match".
+	* module.c (mio_array_ref): Add cast to enum type.
+	(mio_symbol): Likewise.
+	* resolve.c (resolve_global_procedure): Change type to enum
+	gfc_symbol_type.
+	* trans-io.c (gfc_build_st_parameter): Change type to unsigned
+	int.
+
+2009-04-24  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.h (gfc_get_typebound_proc): Removed as macro, now a function.
+	(struct gfc_symtree): Moved "typebound" member inside union.
+	(struct gfc_namespace): Add "tb_sym_root" as new symtree to sort out
+	type-bound procedures there.
+	(gfc_get_tbp_symtree): New procedure.
+	* symbol.c (tentative_tbp_list): New global.
+	(gfc_get_namespace): NULL new "tb_sym_root" member.
+	(gfc_new_symtree): Removed initialization of "typebound" member.
+	(gfc_undo_symbols): Process list of tentative tbp's.
+	(gfc_commit_symbols): Ditto.
+	(free_tb_tree): New method.
+	(gfc_free_namespace): Call it.
+	(gfc_get_typebound_proc): New method.
+	(gfc_get_tbp_symtree): New method.
+	(gfc_find_typebound_proc): Adapt to structural changes of gfc_symtree
+	and gfc_namespace with regards to tbp's.
+	* dump-parse-tree.c (show_typebound): Ditto.
+	* primary.c (gfc_match_varspec): Ditto.  Don't reference tbp-symbol
+	as it isn't a symbol any longer.
+	* module.c (mio_typebound_symtree): Adapt to changes.
+	(mio_typebound_proc): Ditto, create symtrees using "gfc_get_tbp_symtree"
+	rather than "gfc_get_sym_tree".
+	(mio_f2k_derived): Ditto.
+	* decl.c (match_procedure_in_type): Ditto.
+	(gfc_match_generic): Ditto.  Don't reference tbp-symbol.
+	* resolve.c (check_typebound_override): Adapt to changes.
+	(resolve_typebound_generic): Ditto.
+	(resolve_typebound_procedures): Ditto.
+	(ensure_not_abstract_walker): Ditto.
+	(ensure_not_abstract): Ditto.
+	(resolve_typebound_procedure): Ditto, ignore erraneous symbols (for
+	instance, through removed tentative ones).
+	* gfc-internals.texi (Type-bound procedures): Document changes.
+
+2009-04-24  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/39861
+	PR fortran/39864
+	* symbol.c (gfc_copy_formal_args_intr): Set attr.flavor and attr.dummy
+	for the formal arguments.
+
+2009-04-21  Taras Glek <tglek@mozilla.com>
+
+	* f95-lang.c: Update GTY annotations to new syntax.
+	* trans-intrinsic.c: Likewise.
+	* trans-io.c: Likewise.
+	* trans.h: Likewise.
+
+2009-04-22  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/39735
+	* decl.c (add_hidden_procptr_result): Bugfix for procptr results.
+	(match_procedure_decl): Set if_source.
+	* expr.c (gfc_check_pointer_assign): Bugfix: Return after error.
+	And: Check interface also for IFSRC_UNKNOWN (return type may be known).
+	* gfortran.h (typedef enum ifsrc): Remove IFSRC_USAGE,
+	add documentation. Rename copy_formal_args and copy_formal_args_intr.
+	* interface.c (gfc_compare_interfaces): Check for return types,
+	handle IFSRC_UNKNOWN.
+	(compare_intr_interfaces,compare_actual_formal_intr): Obsolete, removed.
+	(gfc_procedure_use): Modified handling of intrinsics.
+	* intrinsic.c (add_functions): Bugfix for "dim".
+	* resolve.c (resolve_intrinsic): New function to resolve intrinsics,
+	which copies the interface from isym to sym.
+	(resolve_procedure_expression,resolve_function): Use new function
+	'resolve_intrinsic'.
+	(resolve_symbol): Add function attribute for externals with return type
+	and use new function 'resolve_intrinsic'.
+	* symbol.c (ifsrc_types): Remove string for IFSRC_USAGE.
+	(copy_formal_args): Renamed to gfc_copy_formal_args.
+	(copy_formal_args_intr): Renamed to gfc_copy_formal_args_intr.
+	* trans-const.c (gfc_conv_const_charlen): Handle cl==NULL.
+
+2009-04-21  Joseph Myers  <joseph@codesourcery.com>
+
+	* ChangeLog, ChangeLog-2002, ChangeLog-2003, ChangeLog-2004,
+	ChangeLog-2005, ChangeLog-2006, ChangeLog-2007, ChangeLog-2008,
+	ChangeLog.ptr, config-lang.in, ioparm.def, mathbuiltins.def: Add
+	copyright and license notices.
+	* ChangeLog, ChangeLog-2005, ChangeLog-2006, ChangeLog-2007,
+	ChangeLog-2008: Correct dates.
+
+2009-04-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/39811
+	* scanner.c (load_line): Fix bogus "&" compile-time diagnostic.
+
+2009-04-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/39800
+	* resolve.c (is_sym_host_assoc): New function.
+	(resolve_fl_derived): Call it when checking PRIVATE components
+	of PUBLIC derived types.  Change gfc_error to a gfc_notify_std
+	with std=f2003.
+	(resolve_fl_namelist): Call it twice to check for host
+	association.
+
+2009-04-20  Ian Lance Taylor  <iant@google.com>
+
+	* module.c (import_iso_c_binding_module): Add casts to enum type.
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmax): Change op to enum
+	tree_code.
+	(gfc_conv_intrinsic_anyall): Likewise.
+	(gfc_conv_intrinsic_arith): Likewise.
+	(gfc_conv_intrinsic_minmaxloc): Likewise.
+	(gfc_conv_intrinsic_minmaxval): Likewise.
+	(gfc_conv_intrinsic_bitop): Likewise.
+	(gfc_conv_intrinsic_singlebitop): Likewise.
+	(gfc_conv_intrinsic_strcmp): Likewise.
+
+2009-04-20  Vasilis Liaskovitis  <vliaskov@gmail.com>
+	    Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/35423
+	* trans.h (OMPWS_WORKSHARE_FLAG, OMPWS_CURR_SINGLEUNIT,
+	OMPWS_SCALARIZER_WS, OMPWS_NOWAIT): Define.
+	(ompws_flags): New extern decl.
+	* trans-array.c (gfc_trans_scalarized_loop_end): Build OMP_FOR
+	for the outer dimension if ompws_flags allow it.
+	* trans.c (gfc_generate_code): Clear ompws_flags.
+	* trans-expr.c (gfc_trans_assignment_1): Allow worksharing
+	array assignments inside of !$omp workshare.
+	* trans-stmt.c (gfc_trans_where_3): Similarly for where statements
+	and constructs.
+	* trans-openmp.c (ompws_flags): New variable.
+	(gfc_trans_omp_workshare): Rewritten.
+
+2009-04-11  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37746
+	* gfortran.h (struct gfc_charlen): New field "passed_length" to store
+	the actual passed string length for dummy arguments.
+	* trans-decl.c (gfc_create_string_length): Formatting fixes and added
+	assertion, moved a local variable into the innermost block it is needed.
+	(create_function_arglist): Removed TODO about the check being
+	implemented and initialize cl->passed_length here.
+	(add_argument_checking): New method.
+	(gfc_generate_function_code): Call the argument checking method.
+
+2009-04-11  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/39692
+	* symbol.c (check_conflict): Reject procedure pointers for -std=f95.
+
+2009-04-11  Daniel Franke  <franke.daniel@gmail.com>
+
+	* resolve.c (resolve_global_procedure): Enable whole-file checking for
+	procedures that are declared later in the file.
+	
+2009-04-10  Paolo Bonzini  <bonzini@gnu.org>
+
+	PR middle-end/39701
+	* trans.c (gfc_allocate_with_status): Fix type mismatches
+	on "pstat == 0".
+
+2009-04-10  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/38709
+	* expr.c (find_array_section): Leave early on zero-sized arrays.
+
+2009-04-09  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/36704
+	* decl.c (add_hidden_procptr_result): New function for handling
+	procedure pointer return values by adding a hidden result variable.
+	(variable_decl,match_procedure_decl,gfc_match_function_decl,
+	gfc_match_subroutine,gfc_match_end,attr_decl1): Handle procedure pointer
+	return values.
+	* parse.c (parse_interface): Add EXTERNAL attribute only after
+	FUNCTION/SUBROUTINE declaration is complete.
+	* primary.c (replace_hidden_procptr_result): New function for replacing
+	function symbol by hidden result variable.
+	(gfc_match_rvalue,match_variable): Replace symbol by hidden result
+	variable.
+	* resolve.c (resolve_contained_fntype,resolve_function,resolve_variable,
+	resolve_symbol): Allow for procedure pointer function results.
+	(resolve_fl_procedure): Conflict detection moved here from
+	'check_conflict'.
+	* symbol.c (gfc_check_function_type): Allow for procedure pointer
+	function results.
+	(check_conflict): Move some conflict detection to resolution stage.
+	* trans-types.c (gfc_sym_type,gfc_get_function_type): Handle hidden
+	result variables.
+
+2009-04-08  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-types.c (gfc_init_types): Ensure gfc_integer_types doesn't
+	contain TYPE_STRING_FLAG types.
+
+2009-04-08  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/39670
+	* invoke.texi (fdollar-ok): Fix typo.
+	
+2009-04-08  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/39670
+	* invoke.texi (fdollar-ok): Clarify limitations.
+
+2009-04-08  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38863
+	* trans-array.c (gfc_trans_deferred_array): Return if this
+	is a result variable.
+
+2009-04-07  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/38152
+	* trans-decl.c (gfc_get_symbol_decl): Correctly set decl location for
+	procedure pointer decls.
+
+2009-04-07  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/38290
+	* expr.c (gfc_check_pointer_assign): Enable interface check for
+	procedure pointers.
+	* gfortran.h: Add copy_formal_args_intr.
+	* interface.c (gfc_compare_interfaces): Call gfc_compare_intr_interfaces
+	if second argument is an intrinsic.
+	(compare_intr_interfaces): Correctly set attr.function, attr.subroutine
+	and ts.
+	(compare_parameter): Call gfc_compare_interfaces also for intrinsics.
+	* resolve.c (resolve_specific_f0,resolve_specific_s0): Don't resolve
+	intrinsic interfaces here. Must happen earlier.
+	(resolve_symbol): Resolution of intrinsic interfaces moved here from
+	resolve_specific_..., and formal args are now copied from intrinsic
+	interfaces.
+	* symbol.c (copy_formal_args_intr): New function to copy the formal
+	arguments from an intinsic procedure.
+
+2009-04-06  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38863
+	* dependency.c (ref_same_as_full_array): New function.
+	(gfc_dep_resolver): Call it.
+
+2009-04-06  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/39414
+	* decl.c (match_procedure_decl): Fix double declaration problems with
+	PROCEDURE statements.
+	* symbol.c (gfc_add_type): Ditto.
+
+2009-04-06  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/36091
+	* trans-array.c (gfc_conv_array_ref): If the symbol has the
+	temporary attribute use the array_spec for the bounds.
+	* gfortran.h : Add the temporary field to the structure
+	'symbol_attribute'.
+	* trans-stmt.c (forall_make_variable_temp): Set the symbol's
+	temporary attribute.
+
+2009-04-05  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/29458
+	* trans-array.c (gfc_trans_array_constructor_value): Shadow
+	implied do-loop variable to avoid spurious middle-end warnings.
+
+2009-04-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/39577
+	* trans-decl.c (gfc_generate_function_code): Move recursive
+	check to the right position.
+
+2009-04-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/37614
+	* trans-common.c (translate_common): Do not offset the whole
+	coomon block.
+
+2009-04-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/39594
+	* resolve.c (resolve_common_vars): Add FL_VARIABLE to symbol
+	if it is not a procedure pointer.
+	* primary.c (match_actual_arg): Ditto.
+
+2009-03-31  Joseph Myers  <joseph@codesourcery.com>
+
+	PR preprocessor/15638
+	* cpp.c (cb_cpp_error): Handle CPP_DL_FATAL.
+
+2009-03-30  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/38389
+	* trans-stmt.c(gfc_trans_allocate): Add translation of ERRMSG.
+	(gfc_trans_deallocate): Add translation of ERRMSG.  Remove stale
+	comments.  Minor whitespace cleanup.
+	* resolve.c(is_scalar_expr_ptr): Whitespace cleanup.
+	(resolve_deallocate_expr (gfc_expr *e): Update error message.
+	(resolve_allocate_expr):  Remove dead code.  Update error message.
+	Move error checking to ...
+	(resolve_allocate_deallocate): ... here.  Add additional error
+	checking for STAT, ERRMSG, and allocate-objects.
+	* match.c(gfc_match_allocate,gfc_match_deallocate):  Parse ERRMSG.
+	Check for redundant uses of STAT and ERRMSG.  Reword error message
+	and add checking for pointer, allocatable, and proc_pointer attributes.
+
+2009-03-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/22571
+	PR fortran/26227
+	PR fortran/24886
+	* symbol.c : Add gfc_global_ns_list.
+	* decl.c (add_global_entry): Set the namespace ('ns') field.
+	* gfortran.h : Add the resolved field to gfc_namespace. Add the
+	namespace ('ns') field to gfc_gsymbol.  Add flag_whole_file to
+	gfc_option_t.  Add the prototype for gfc_free_dt_list.
+	* lang.opt : Add the whole-file option.
+	* invoke.texi : Document the whole-file option.
+	* resolve.c (resolve_global_procedure): If the fwhole-file
+	option is set, reorder gsymbols to ensure that translation is
+	in the right order.  Resolve the gsymbol's namespace if that
+	has not occurred and then check interfaces.
+	(resolve_function): Move call to resolve_global_procedure.
+	(resolve_call): The same.
+	(resolve_codes): Store the current labels_obstack.
+	(gfc_resolve) : Return if the namespace is already resolved.
+	trans-decl.c (gfc_get_extern_function_decl): If the whole_file
+	option is selected, use the backend_decl of a gsymbol, if it is
+	available.
+	parse.c (add_global_procedure, add_global_program): If the flag
+	whole-file is set, add the namespace to the gsymbol.
+	(gfc_parse_file): On -fwhole-file, put procedure namespaces on
+	the global namespace list.  Rearrange to do resolution of all
+	the procedures in a file, followed by their translation.
+	* options.c (gfc_init_options): Add -fwhole-file.
+	(gfc_handle_option): The same.
+
+2009-03-30  Ulrich Weigand  <Ulrich.Weigand@de.ibm.com>
+
+	* f95-lang.c (gfc_init_builtin_functions): Define BUILT_IN_HUGE_VAL
+	family of intrinsics instead of BUILT_IN_INF family.
+	* trans-intrinsics.c (gfc_conv_intrinsic_nearest): Use
+	BUILT_IN_HUGE_VAL instead of BUILT_IN_INF.
+
+2009-03-30  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-types.c (gfc_sym_type, gfc_return_by_reference): For
+	sym->attr.result check sym->ns->proc_name->attr.is_bind_c.
+
+2009-03-30  Joseph Myers  <joseph@codesourcery.com>
+
+	PR rtl-optimization/323
+	* options.c (gfc_post_options): Set
+	flag_excess_precision_cmdline.  Give an error for
+	-fexcess-precision=standard for processors where the option is
+	significant.
+
+2009-03-29  Joseph Myers  <joseph@codesourcery.com>
+
+	PR preprocessor/34695
+	* cpp.c (cb_cpp_error): New.
+	(gfc_cpp_post_options): Don't set cpp_option->inhibit_warnings.
+	Don't check cpp_errors (cpp_in).
+	(gfc_cpp_init_0): Set cb->error.
+
+2009-03-29  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/38823
+	* gfortran.h: Add ARITH_PROHIBIT to arith enum.
+	expr.c (gfc_match_init_expr): Add global variable init_flag to
+	flag matching an initialization expression.
+	(check_intrinsic_op): Move no longer reachable error message to ...
+	* arith.c (arith_power): ... here.  Remove gfc_ prefix in
+	gfc_arith_power.  Use init_flag.  Allow constant folding of x**y
+	when y is REAL or COMPLEX.
+	(eval_intrinsic): Remove restriction that y in x**y must be INTEGER
+	for constant folding.
+	* gfc_power: Update gfc_arith_power to arith_power
+
+2009-03-29  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37423
+	* gfortran.h (struct gfc_typebound_proc): Added new flag "deferred" and
+	added a comment explaining DEFERRED binding handling.
+	* decl.c (match_binding_attributes): Really match DEFERRED attribute.
+	(match_procedure_in_type): Really match PROCEDURE(interface) syntax
+	and do some validity checks for DEFERRED and this construct.
+	* module.c (binding_overriding): New string constant for DEFERRED.
+	(mio_typebound_proc): Module-IO DEFERRED flag.
+	* resolve.c (check_typebound_override): Ensure that a non-DEFERRED
+	binding is not overridden by a DEFERRED one.
+	(resolve_typebound_procedure): Allow abstract interfaces as targets
+	for DEFERRED bindings.
+	(ensure_not_abstract_walker), (ensure_not_abstract): New methods.
+	(resolve_fl_derived): Use new "ensure_not_abstract" method for
+	non-ABSTRACT types extending ABSTRACT ones to ensure each DEFERRED
+	binding is overridden.
+	(check_typebound_baseobject): New method.
+	(resolve_compcall), (resolve_typebound_call): Check base-object of
+	the type-bound procedure call.
+	* gfc-internals.texi (Type-bound procedures): Document a little bit
+	about internal handling of DEFERRED bindings.
+
+2009-03-29  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/38507
+	* gfortran.h (gfc_st_label): Fix comment.
+	(gfc_exec_op): Add statement code EXEC_END_BLOCK for end of block.
+	* parse.c (accept_statement): Use EXEC_END_BLOCK for END IF and
+	END SELECT with labels.
+	(check_do_closure): Fix formatting.
+	(parse_do_block): Fix typo in error message.
+	* resolve.c (code_stack): Remove tail member.  Update comment to
+	new use of reachable_labels.
+	(reachable_labels): Rename to ...
+	(find_reachable_labels): ... this.  Overhaul.  Update preceding
+	comment.
+	(resolve_branch): Fix comment preceding function.  Rewrite.
+	(resolve_code): Update call to find_reachable_labels.  Add code to
+	deal with EXEC_END_BLOCK.
+	* st.c (gfc_free_statement): Add code to deal with EXEC_END_BLOCK.
+	Add 2009 to copyright years.
+	* trans.c (gfc_trans_code): Likewise on both counts.
+
+2009-03-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38917
+	* expr.c (gfc_check_assign): Allow pointer components when
+	checking for NULL.
+
+	PR fortran/38918
+	* resolve.c (check_data_variable): Treat pointer arrays with
+	scalars.
+
+2009-03-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38915
+	* trans-expr.c (gfc_trans_assignment_1): Ensure temporaries
+	have a string_length.
+
+2009-03-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/34656
+	* trans-stmt.c (gfc_trans_simple_do, gfc_trans_do):
+	Add GFC_RTCHECK_DO support.
+	* option.c (gfc_handle_runtime_check_option): Enable GFC_RTCHECK_DO.
+	* invoke.texi (-fcheck): Document "do" option.
+
+2009-03-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38538
+	* trans-array.c (get_elemental_fcn_charlen): Remove.
+	(get_array_charlen): New function to replace previous.
+
+2009-03-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38765
+	* parse.c (parse_derived): Do not break on finding pointer,
+	allocatable or private components.
+
+2009-03-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32626
+	* option.c (gfc_handle_runtime_check_option): Enable recursion check.
+	* trans-decl.c (gfc_generate_function_code): Add recursion check.
+	* invoke.texi (-fcheck): Add recursive option.
+
+2009-03-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/38432
+	* resolve.c (gfc_resolve_iterator): Add zero-loop warning.
+
+2009-03-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+	    Paul Thomas  <pault@gcc.gnu.org>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.h (gfc_option_t): Add rtcheck.
+	* lang.opt: New option -fcheck.
+	* libgfortran.h: Add GFC_RTCHECK_* constants.
+	* invoke.texi: Document -fcheck.
+	* options.c (gfc_handle_runtime_check_option): New function.
+	(gfc_init_options,gfc_post_options,gfc_handle_option):
+	Add -fcheck option.
+
+2009-03-27  Richard Guenther  <rguenther@suse.de>
+
+	* trans-array.c (gfc_conv_descriptor_data_addr): Use
+	gfc_build_addr_expr instead of build_fold_addr_expr.
+	(gfc_trans_allocate_array_storage, gfc_trans_array_constructor_value,
+	gfc_trans_constant_array_constructor, gfc_conv_array_data,
+	gfc_conv_expr_descriptor, gfc_conv_array_parameter): Likewise.
+	* trans-expr.c (gfc_conv_missing_dummy, gfc_conv_variable,
+	gfc_conv_function_val, gfc_conv_operator_assign,
+	gfc_conv_subref_array_arg, gfc_conv_function_call,
+	gfc_conv_expr_reference, gfc_trans_scalar_assign): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_exponent,
+	gfc_conv_intrinsic_ctime, gfc_conv_intrinsic_fdate,
+	gfc_conv_intrinsic_ttynam, gfc_conv_intrinsic_minmax_char,
+	gfc_conv_intrinsic_fraction, gfc_conv_intrinsic_spacing,
+	gfc_conv_intrinsic_rrspacing, gfc_conv_intrinsic_set_exponent,
+	gfc_conv_intrinsic_array_transfer, gfc_conv_intrinsic_transfer,
+	gfc_conv_intrinsic_si_kind, gfc_conv_intrinsic_trim): Likewise.
+	* trans-io.c (gfc_trans_io_runtime_check, set_parameter_ref,
+	gfc_convert_array_to_string, gfc_trans_open, gfc_trans_close,
+	build_filepos, gfc_trans_inquire, gfc_trans_wait,
+	nml_get_addr_expr, transfer_namelist_element, build_dt,
+	gfc_trans_dt_end, transfer_array_component, transfer_expr,
+	transfer_array_desc, gfc_trans_transfer): Likewise.
+	* trans-stmt.c (gfc_trans_allocate, gfc_trans_deallocate): Likewise.
+	* trans.c (gfc_build_addr_expr): Mark the base of the address
+	TREE_ADDRESSABLE.
+
+2009-03-27  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.h (enum init_local_real.): Add GFC_INIT_REAL_SNAN.
+	(gfc_expr): Add is_snan.
+	* trans-const.c (gfc_conv_mpfr_to_tree): Support SNaN.
+	(gfc_conv_constant_to_tree): Update call to gfc_conv_mpfr_to_tree.
+	* trans-const.h (gfc_conv_mpfr_to_tree): Update prototype.
+	* resolve.c (build_default_init_expr): Update call.
+	* target-memory.c (encode_float): Ditto.
+	* trans-intrinsic.c (gfc_conv_intrinsic_aint,gfc_conv_intrinsic_mod,
+
+2009-03-18  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
+
+	* lang.opt: Unify help texts for -I, -Wconversion, -d, -fopenmp,
+	and -fpreprocessed.
+
+2009-03-06  Alexandre Oliva <aoliva@redhat.com>
+
+	* simplify.c (gfc_simplify_transfer): Zero-initialize the
+	buffer.
+
+2009-02-27  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/39309
+	* module.c (read_md5_from_module_file): Add missing quote.
+
+2009-02-27  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/39309
+	* module.c (read_md5_from_module_file): Include mod version
+	in had-changed test.
+
+2009-02-26  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/39295
+	* interface.c (compare_type_rank_if): Return 1 if the symbols
+	are the same and deal with external procedures where one is
+	identified to be a function or subroutine by usage but the
+	other is not.
+
+2009-02-26  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/39292
+	* trans-array.c (gfc_conv_array_initializer): Convert all
+	expressions rather than ICEing.
+
+2009-02-21  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/38914
+	* array.c (ref_dimen_size):  Rename to gfc_ref_dimen_size,
+	make global.  Change function name in error messages.
+	(ref_size):  Change ref_dimen_size to gfc_ref_dimen_size.
+	(gfc_array_ref_shape):  Likewise.
+	* gfortran.h:  Add prototype for gfc_ref_dimen_size.
+	* simplify.c (simplify_bound_dim):  Add ref argument.
+	If the reference isn't a full array, return one for
+	the lower bound and the extent for the upper bound.
+	(simplify_bound):  For array sections, take as from the
+	argument.  Add reference to all to simplify_bound_dim.
+
+2009-02-19  Daniel Franke  <franke.daniel@gmail.com>
+
+	* scanner.c (load_line): At end of line, skip '\r' without setting
+	the truncation flag.
+
+2009-02-18  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.texi: New chapter about compiler characteristics.
+	(Compiler Characteristics): Document KIND type parameters here.
+
+2009-02-18  Tobias Burnus  <burnus@net-b.de>
+
+	* intrinsic.texi (MALLOC): Make example more portable.
+
+2009-02-13  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/38259
+	* module.c (gfc_dump_module,gfc_use_module): Add module
+	version number.
+
+2009-02-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/36703
+	PR fortran/36528
+	* trans-expr.c (gfc_conv_function_val): Stabilize Cray-pointer
+	function references to ensure that a valid expression is used.
+	(gfc_conv_function_call): Pass Cray pointers to procedures.
+
+2009-02-03  Jakub Jelinek  <jakub@redhat.com>
+
+	* gfortranspec.c (lang_specific_driver): Update copyright notice
+	dates.
+
+2009-01-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38852
+	PR fortran/39006
+	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Use the array
+	descriptor ubound for UBOUND, when the array lbound == 1.
+
+2009-01-27  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/38883
+	* trans-stmt.c (gfc_conv_elemental_dependencies):  Create temporary
+	for the real type needed to make it work for subcomponent-references.
+
+2009-01-21  Daniel Kraft  <d@domob.eu>
+
+	* trans-stmt.c (gfc_conv_elemental_dependencies):  Cleaned up comment.
+
+2009-01-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38907
+	* resolve.c (check_host_association): Remove the matching to
+	correct an incorrect host association and use manipulation of
+	the expression instead.
+
+2009-01-20  Tobias Burnus  <burnus@net-b.de>
+
+	* invoke.texi (RANGE): RANGE also takes INTEGER arguments.
+
+2009-01-19  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/38859
+	* simplify.c (simplify_bound): Don't use array specification
+	if variable or component has subsequent references.
+
+2009-01-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38657
+	* module.c (write_common_0): Add argument 'this_module' and
+	check that non-use associated common blocks are written first.
+	(write_common): Call write_common_0 twice, once with true and
+	then with false.
+
+2009-01-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34955
+	* trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Has
+	been absorbed into gfc_conv_intrinsic_transfer. All
+	references to it in trans-intrinsic.c have been changed
+	accordingly.  PR fixed by using a temporary for scalar
+	character transfer, when the source is shorter than the
+	destination.
+
+2009-01-17  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38657
+	* module.c (write_common_0): Revert patch of 2009-01-05.
+
+2009-01-16  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/38152
+	* expr.c (gfc_check_pointer_assign): Allow use-associated procedure
+	pointers as lvalue.
+	* trans-decl.c (get_proc_pointer_decl,gfc_create_module_variable):
+	Enable procedure pointers as module variables.
+
+2009-01-14  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* ChangeLog-2007: Clean out svn merge droppings.
+
+2009-01-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38763
+	* target-memory.c (encode_derived): Encode NULL.
+
+2009-01-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38765
+	* resolve.c (check_host_association): Use the symtree name to
+	search for a potential contained procedure, since this is the
+	name by which it would be referenced.
+
+2009-01-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/38220
+	* interface.c (gfc_procedure_use):  Don't warn about functions
+	from ISO_C_BINDING.
+	* symbol.c (generate_isocbinding_symbol):  Mark c_loc and
+	c_funloc as pure.
+
+2009-01-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38657
+	* module.c (write_common_0): Use the name of the symtree rather
+	than the common block, to determine if the common has been
+	written.
+
+2009-01-05  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/37159
+	* check.c (gfc_check_random_seed): Added size check for GET
+	dummy argument, reworded error messages to follow common pattern.
+
+2009-01-05  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/38672
+	* trans-types.c (gfc_get_derived_type):  Check for the
+	presence of derived->ns->proc_name before
+	accessing derived->ns->proc_name->attr.flavor .
+	* resolve.c (resolve_symbol):  Likewise.
+
+2009-01-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38665
+	* gfortran.h : Add bit to gfc_expr 'user_operator'
+	* interface.c (gfc_extend_expr): Set the above if the operator
+	is substituted by a function. 
+	* resolve.c (check_host_association): Return if above is set.
+
+2009-01-04  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/35681
+	* ChangeLog-2008: Fix function name.
+
+	PR fortran/38487
+	* dependency.c (gfc_check_argument_var_dependency):
+	Move the check for pointerness inside the if block
+	so that it doesn't affect the return value.
+
+	PR fortran/38669
+	* trans-stmt.c (gfc_trans_call):
+	Add the dependency code after the loop bounds calculation one.
+
+2009-01-04  Daniel Franke  <franke.daniel@gmail.com>
+
+	* intrinsic.c (do_simplify): Removed already implemented TODO.
+
+2009-01-04  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/38718
+	* simplify.c (gfc_simplify_merge): New.
+	* intrinsic.h (gfc_simplify_merge): New prototype.
+	* intrinsic.c (add_functions): Added simplification for MERGE.
+
+2009-01-04  Mikael Morin  <mikael.morin@tele2.fr>
+
+	PR fortran/38536
+	* gfortran.h (gfc_is_data_pointer): Added prototype
+	* resolve.c (gfc_iso_c_func_interface):
+	Use gfc_is_data_pointer to test for pointer attribute.
+	* dependency.c (gfc_is_data_pointer):
+	Support pointer-returning functions.
+
+2009-01-03  Daniel Franke  <franke.daniel@gmail.com>
+
+	* symbol.c (save_symbol): Don't SAVE function results.
+
+2009-01-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38594
+	* resolve.c (resolve_call): When searching for proper host
+	association, use symtree rather than symbol.  For everything
+	except generic subroutines, substitute the symtree in the call
+	rather than the symbol.
+
+
+Copyright (C) 2009 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved.
diff --git a/gcc/fortran/ChangeLog-2010 b/gcc/fortran/ChangeLog-2010
new file mode 100644
index 000000000..911067069
--- /dev/null
+++ b/gcc/fortran/ChangeLog-2010
@@ -0,0 +1,5556 @@
+2010-12-31  Janus Weil  <janus@gcc.gnu.org>
+
+	* intrinsic.texi (IANY): Correct section title.
+	(IALL, IANY, IPARITY): Fix example codes.
+
+2010-12-31  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/47065
+	* frontend-passes.c (count_arglist):  Static variable to
+	count the nesting of argument lists.
+	(optimize_code):  Set count_arglist to 1 if within a call
+	statement, to 0 otherwise.
+	(optimize_trim):  New function.
+	(optimize_expr):  Adjust count_arglist.  Call optimize_trim.
+
+2010-12-31  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/45338
+	* resolve.c (resolve_operator):  Mark function for user-defined
+	operator as referenced.
+
+2010-12-31  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46971
+	* gfortran.h (gfc_hash_value): Add prototype.
+	* class.c (get_unique_type_string): Check if proc_name is present and
+	make sure string contains an underscore.
+	(get_unique_hashed_string): New function which creates a hashed string
+	if the given unique string is too long.
+	(gfc_hash_value): Moved here from decl.c, renamed and simplified.
+	(gfc_build_class_symbol, gfc_find_derived_vtab): Use hashed strings.
+	* decl.c (hash_value): Moved to class.c.
+	(gfc_match_derived_decl): Renamed 'hash_value'.
+
+2010-12-30  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/47085
+	* match.c (gfc_match_allocate): Check for 'class_ok'.
+	* primary.c (gfc_match_varspec): Ditto.
+
+2010-12-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	* dump_parse_tree.c (show_components):  Show
+	ALLOCATABLE.
+
+2010-12-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46838
+	* expr.c (gfc_default_initializer): Handle allocatable CLASS components.
+
+2010-12-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	* frontend-passes.c (gfc_code_walker): Handle expressions
+	in EXEC_CALL, EXEC_ASSIGN_CALL and EXEC_CALL_PPC.
+	Separate cases in switch statements by blank lines.
+
+2010-12-28  Janus Weil  <janus@gcc.gnu.org>
+	    Daniel Franke  <dfranke@gcc.gnu.org>
+
+	PR fortran/45827
+	* module.c (mio_component_ref): Handle components of CLASS variables.
+
+2010-12-27  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	* dump-parse-tree.c (show_typespec):  Also show character kind.
+
+2010-12-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/31821
+	* check.c (gfc_var_strlen):  New function, also including
+	substring references.
+	(gfc_check_same_strlen):  Use gfc_var_strlen.
+
+2010-12-23  Mikael Morin  <mikael.morin@gcc.gnu.org>
+
+	PR fortran/46978
+	Revert part of revision 164112
+	* trans-array.c (gfc_trans_create_temp_array):
+	Set loop n'th upper bound from (possibly transposed) array's dim bounds.
+
+2010-12-18  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/46974
+	* target-memory.c (gfc_interpret_derived): Handle C_PTR/C_FUNPTR.
+	* trans-expr.c (gfc_trans_structure_assign): Ditto.
+	(gfc_conv_expr): Avoid crashes using non-C_NULL_(FUN)PTR const expr.
+
+2010-12-17  Janus Weil  <janus@gcc.gnu.org>
+	    Tobias Burnus <burnus@gcc.gnu.org>
+
+	PR fortran/46849
+	* resolve.c (resolve_symbol): Remove symbols that wrongly ended up
+	in a local BLOCK namespace.
+
+2010-12-15  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/46945
+	* trans-array.c (gfc_array_init_size): Perform stride overflow
+	checking and multiplication by element_size in size_type_node instead
+	of sizetype, return value with size_type_node type instead of
+	sometimes with sizetype and sometimes with gfc_array_index_type.
+
+2010-12-15  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	* trans.c (gfc_allocate_with_status): Better error message for
+	malloc() failure.
+	(gfc_call_realloc): Likewise.
+	* misc.c (gfc_getmem): Likewise.
+
+2010-12-15  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/28105
+	* trans.c (gfc_call_malloc): Improve comment.
+	(gfc_allocate_with_status): Remove size < 0 check.
+	(gfc_call_realloc): Likewise.
+
+2010-12-14  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/46937
+	* trans-types.c (create_fn_spec): "."-annotate derived types
+	with (proc-)pointer components.
+
+2010-12-14  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/46874
+	* trans-openmp.c (gfc_trans_omp_array_reduction): Handle allocatable
+	dummy variables.
+
+2010-12-13  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46201
+	* trans-expr.c (gfc_conv_procedure_call): Handle procedure pointer
+	components called on a dimensionful base object.
+
+2010-12-13  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46841
+	* trans-expr.c (gfc_trans_subcomponent_assign): Handle array-valued
+	procedure pointer components.
+
+2010-12-13  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/46884
+	* symbol.c (gfc_new_charlen): If old_cl is non-NULL, put it
+	at the ns->old_cl_list spot in the chain rather than at
+	ns->cl_list.
+
+2010-12-12  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	* dump-parse-tree.c (show_expr): Add space for parens.
+
+2010-12-12  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46809
+	* resolve.c (resolve_select_type): Set the location of the first
+	argument when generating the EXTENDS_TYPE_OF call.
+
+2010-12-11  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/46705
+	* gfortran.h: New enum gfc_instring.
+	(gfc_next_char_literal): Update prototype.
+	* scanner.c (gfc_next_char_literal): Use new enum. Only give missing
+	'&' warning for INSTRING_WARN. (gfc_next_char): Use new enum.
+	(gfc_gobble_whitespace): Likewise.
+	* io.c (next_char): Use new enum. (next_char_not_space): Likewise.
+	(format_lex): Likewise.
+	* match.c (gfc_match_parens): Likewise.
+	(gfc_match_special_char): Likewise. (gfc_match_name_C): Likewise.
+	* parse.c (next_fixed): Likewise.
+	* primary.c (match_hollerith_constant): Likewise.
+	(next_string_char): Likewise.
+
+2010-12-11  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/46370
+	* primary.c (gfc_match_varspec): Pass information about codimension
+	to gfc_match_array_ref also for BT_CLASS.
+	* resolve.c (resolve_procedure): Correct check for C612.
+
+2010-12-11  Mikael Morin   <mikael@gcc.gnu.org>
+	    Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/46842
+	* trans-array.c (dim_ok): New helper function.
+	(gfc_conv_expr_descriptor): Use new helper function to check
+	function array is full.
+
+2010-12-10  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/46540
+	* trans-types.c (gfc_init_kinds): Handle
+	--disable-libquadmath-support.
+
+2010-12-09  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* check.c (gfc_check_sngl): Insert missing space in error message.
+
+2010-12-09  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* check.c (gfc_check_float): Insert missing space in error message.
+
+2010-12-07  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/44352
+	* trans-expr.c (gfc_string_to_single_character): Return if not
+	POINTER_TYPE_P.
+	(gfc_trans_string_copy): gfc_build_addr_expr if src or dest is
+	not a pointer.
+	(gfc_trans_string_copy): Make sure the argument string type
+	has a string length, fix indention, and remove not needed
+	gfc_build_addr_expr.
+
+2010-12-04  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/46794
+	* trans-expr.c (gfc_conv_power_op): Handle kind of result expression
+	correctly for integer kind 1 and 2 operands.
+
+2010-12-03  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/44352
+	* dump-parse-tree.c (show_symbol):  Don't show formal namespace
+	for statement functions in order to avoid infinite recursion.
+
+2010-12-03  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/45159
+	* dependency.c (check_section_vs_section):  Pre-calculate
+	the relationship between the strides and the relationship
+	between the start values.  Use an integer constant one for
+	that purpose.
+	Forward dependencies for positive strides apply for where
+	the lhs start <= rhs start and lhs stride <= rhs stride
+	and vice versa for negative stride.  No need to compare
+	end expressions in either case (assume no bounds violation).
+
+2010-12-03  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	* trans-array.c (gfc_could_be_alias):  Handle BT_CLASS
+	as well as BT_DERIVED.
+	(gfc_array_allocate):  Likewise.
+	(gfc_conv_array_parameter):  Likewise.
+	(structure_alloc_comps):  Likewise.
+	(gfc_is_reallocatable_lhs):  Likewise.
+	(gfc_trans_deferred_array):  Likewise.
+
+2010-12-02  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/46753
+	* trans-openmp.c (gfc_trans_omp_do): Use build2_loc instead of
+	fold_build2_loc for OMP_FOR conditions.
+
+2010-11-30  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/28105
+	* trans-array.c (gfc_unlikely): Helper function to mark boolean
+	expr as unlikely.
+	(gfc_array_index_size): Check whether the size overflows.
+	(gfc_array_allocate): Check whether size overflows and generate
+	error.
+
+2010-11-30  Joseph Myers  <joseph@codesourcery.com>
+
+	* trans-common.c: Don't include toplev.h.
+
+2010-11-29  Joseph Myers  <joseph@codesourcery.com>
+
+	* gfortran.h (alloca): Don't include definitions.
+	(NULL): Don't define.
+
+2010-11-28  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46662
+	* resolve.c (update_ppc_arglist): Add check for abstract passed object.
+
+2010-11-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	 PR fortran/35810
+	* trans-array.c (gfc_trans_array_constructor): If the loop->to
+	is a VAR_DECL, assume this is dynamic. In this case, use the
+	counter to obtain the value and set loop->to appropriately.
+	(gfc_conv_ss_descriptor): Always save the offset of a variable
+	in info.saved_offset.
+	(gfc_conv_ss_startstride): Do not attempt bound checking of the
+	lhs of an assignment, if allocatable and f2003 is allowed.
+	(gfc_conv_loop_setup): If possible, do not use an allocatable
+	lhs variable for the loopspec.
+	(gfc_is_reallocatable_lhs): New function.
+	(get_std_lbound): New function.
+	(gfc_alloc_allocatable_for_assignment): New function.
+	* gfortran.h : Add flag_realloc_lhs to the options structure.
+	* lang.opt : Add option f(no-)realloc-lhs.
+	* invoke.texi : Document option f(no-)realloc-lhs.
+	* options.c (gfc_init_options, gfc_post_options,
+	gfc_handle_option): Incorporate f(no-)realloc-lhs with default
+	to frealloc_lhs for -std > f95.
+	* trans-array.h : Add primitive for previous.
+	* trans-expr.c (gfc_conv_string_length): Return if character
+	length is a variable and the expression is NULL.
+	(gfc_conv_procedure_call): If the call is of the kind x = f(...)
+	and the lhs is allocatable and reallocation on assignment OK,
+	call gfc_alloc_allocatable_for_assignment. Do not generate the
+	function call unless direct by reference.
+	(realloc_lhs_loop_for_fcn_call): New function.
+	(realloc_lhs_bounds_for_intrinsic_call): New function.
+	(gfc_trans_arrayfunc_assign): Reallocation assignments need
+	a loopinfo and for the loop bounds to be set.  With intrinsic
+	functions, free the lhs data and let the library allocate the
+	data array. Done by the new functions above.
+	(gfc_trans_assignment_1): If the lhs is allocatable and
+	reallocation on assignment is allowed, mark the lhs and use
+	gfc_alloc_allocatable_for_assignment to make the reallocation.
+	* trans.h : Add is_alloc_lhs bitfield to gfc_ss structure.
+
+2010-11-27  Tobias Burnus  <burnus@net-b.de>
+	    Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/46678
+	trans-decl.c (gfc_trans_auto_character_variable): Use gfc_init_block
+	instead of gfc_start_block.
+
+2010-11-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/46301
+	trans-expr.c (gfc_trans_assignment): Add error message for not
+	implemented assignment to deferred-length character variable.
+
+2010-11-26  Jakub Jelinek  <jakub@redhat.com>
+
+	PR bootstrap/45700
+	* trans.h (build1_stat_loc, build2_stat_loc, build3_stat_loc,
+	build4_stat_loc): Removed.
+	(build1_loc, build2_loc, build3_loc, build4_loc): Removed.
+
+2010-11-25  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46581
+	* trans.h (gfc_process_block_locals): Removed second argument.
+	* trans-decl.c (trans_associate_var): Moved to trans-stmt.c.
+	(gfc_trans_deferred_vars): Skip ASSOCIATE variables.
+	(gfc_process_block_locals): Don't mark associate names to be
+	initialized.
+	* trans-stmt.c (trans_associate_var): Moved here from trans-decl.c.
+	(gfc_trans_block_construct): Call 'trans_associate_var' from here
+	to make sure SELECT TYPE with associate-name is treated correctly.
+
+2010-11-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/46638
+	* target-memory.c (gfc_interpret_derived): Correctly handle
+	component offset.
+
+2010-11-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/46545
+	* gfortran.texi (KIND Type Parameters): Quadmath and F2008 changes.
+
+2010-11-22  Michael Matz  <matz@suse.de>
+
+	* gfortranspec.c (library): New global, moved from ...
+	(lang_specific_driver): ... here.
+	(lang_specific_pre_link): Test it here before including
+	libgfortran.spec.
+
+2010-11-21  Michael Matz  <matz@suse.de>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR driver/46516
+	* gfortranspec.c (lang_specific_driver,
+	lang_specific_pre_link): Load libgfortran.spec in
+	lang_specific_pre_link unless found in the -L path.
+
+2010-11-20  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	* f95-lang.c (gfc_init_decl_processing): Set size_type_node as
+	unsigned int of pointer size and set sizetype based on that.
+	* trans-types.c (gfc_init_types): Don't set size_type_node to an
+	unsigned type.
+
+2010-11-17  Joseph Myers  <joseph@codesourcery.com>
+
+	* f95-lang.c (gfc_be_parse_file): Take no arguments.
+
+2010-11-16  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/32049
+	* gfortranspec.c (find_spec_file): New function.
+	(lang_specific_driver): Try to find .spec file and use it.
+	* trans-io.c (iocall): Define IOCALL_X_REAL128/COMPLEX128(,write).
+	(gfc_build_io_library_fndecls): Build decl for __float128 I/O.
+	(transfer_expr): Call __float128 I/O functions.
+	* trans-types.c (gfc_init_kinds): Allow kind-16 belonging
+	to __float128.
+
+2010-11-15  Tobias Burnus  <burnus@net.b.de>
+
+	PR fortran/46484
+	* check.c (variable_check): Don't treat functions calls as variables;
+	optionally accept function themselves.
+	(gfc_check_all_any, gfc_check_loc, gfc_check_move_alloc,
+	gfc_check_null, gfc_check_present, gfc_check_cpu_time,
+	gfc_check_date_and_time, gfc_check_mvbits, gfc_check_random_number,
+	gfc_check_random_seed, gfc_check_system_clock,
+	gfc_check_dtime_etime, gfc_check_dtime_etime_sub,
+	gfc_check_itime_idate,gfc_check_ltime_gmtime): Update call.
+
+2010-11-13  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45742
+	* trans-common.c (build_field): Add TREE_SIDE_EFFECTS for volatile.
+	* trans-decl.c (gfc_finish_var_decl): Ditto.
+	(create_function_arglist): Handle volatile dummy arguments.
+
+2010-11-12  Joseph Myers  <joseph@codesourcery.com>
+
+	* Make-lang.in (gfortranspec.o): Use $(OPTS_H).
+	* gfortran.h (gfc_handle_option): Take location_t parameter.
+	* options.c (gfc_handle_option): Take location_t parameter.
+
+2010-11-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/45794
+	trans-expr.c (gfc_conv_procedure_call): Avoid NULL array spec.
+	
+2010-11-11  Nathan Froyd  <froydnj@codesourcery.com>
+
+	PR c/44782
+	* options.c (gfc_post_options): Initialize gfc_option.max_errors.
+	(gfc_handle_option) [OPT_fmax_errors_]: Remove.
+	* lang.opt (fmax-errors=): Remove.
+
+2010-11-11  Steven G. Kargl <kargl@gcc.gnu.org>
+
+	* symbol.c (verify_bind_c_derived_type):  Accept BIND(C) on an empty
+	derived type.
+
+2010-11-11  Jan Hubicka  <jh@suse.cz>
+
+	* options.c (gfc_post_options): Remove flag_whopr.
+
+2010-11-11  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/46413
+	* resolve.c (resolve_transfer): Reject I/O transfer of
+	polymorphic type.
+
+	PR fortran/46205
+	* resolve.c (resolve_code): Reject nonscalar FORALL masks.
+
+2010-11-11  Janus Weil  <janus@gcc.gnu.org>
+
+	* resolve.c (resolve_procedure_interface): Copy 'is_bind_c' attribute.
+
+2010-11-10  Joseph Myers  <joseph@codesourcery.com>
+
+	* trans-array.c (gfc_trans_deferred_array): Use "front-end"
+	spelling in diagnostic.
+	* trans.c (gfc_allocate_array_with_status): Add missing space in
+	diagnostic.
+
+2010-11-10  Joseph Myers  <joseph@codesourcery.com>
+
+	* cpp.c (asm_file_name): Don't declare here.
+
+2010-11-10  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/46411
+	* intrinsic.c (gfc_intrinsic_sub_interface): Check for attr.pure
+	and not for attr.elemental.
+	* intrinsic.texi (move_alloc): Document as being pure.
+
+2010-11-10  Tobias Burnus <burnus@net-b.de>
+
+	PR fortran/46244
+	* resolve.c (resolve_fl_derived): Don't allow CLASS in
+	sequence/BIND(C) types.
+
+2010-11-09  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+	    Mikael Morin   <mikael@gcc.gnu.org>
+
+	PR fortran/46331
+	* intrinsic.c: Correctly set the pure attributes for intrinsic
+	functions.
+	* expr.c (check_specification_function): Remove this function and move
+	its code into gfc_is_constant_expr. (gfc_is_constant_expr): Change the
+	order of checks by checking for non-constant arguments first.  Then,
+	check for initialization functions, followed by intrinsics.
+
+2010-11-09  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46313
+	* gfortran.h (gfc_add_data_component,gfc_add_vptr_component,
+	gfc_add_hash_component,gfc_add_size_component,
+	gfc_add_def_init_component): New macros.
+	* class.c (gfc_add_component_ref): Renamed data component.
+	(get_unique_type_string): New function.
+	(gfc_build_class_symbol): Use 'get_unique_type_string' to construct
+	uniques names for the class containers. Rename components.
+	(gfc_find_derived_vtab): Use 'get_unique_type_string' to construct
+	uniques names for the vtab symbols. Rename components.
+	* decl.c (attr_decl1): Renamed class container components.
+	* iresolve.c (gfc_resolve_extends_type_of): Ditto.
+	* match.c (select_type_set_tmp): Renamed temporaries.
+	* module.c (read_module): Renamed vtab and vtype symbols.
+	* resolve.c (resolve_structure_cons,resolve_typebound_function,
+	resolve_typebound_subroutine,resolve_deallocate_expr,
+	resolve_select_type,resolve_fl_derived): Renamed class container and
+	vtab components.
+	* trans-array.c (structure_alloc_comps): Ditto.
+	* trans-decl.c (gfc_trans_deferred_vars): Ditto.
+	* trans-expr.c (gfc_conv_derived_to_class,gfc_conv_structure,
+	gfc_trans_class_init_assign,gfc_trans_class_assign): Ditto.
+	* trans-intrinsic.c (gfc_conv_intrinsic_sizeof,
+	gfc_conv_intrinsic_storage_size,gfc_conv_allocated,gfc_conv_associated,
+	gfc_conv_same_type_as): Ditto.
+	* trans-stmt.c (gfc_trans_allocate): Ditto.
+
+2010-11-08  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/43899
+	* trans-decl.c (generate_local_decl): Do not generate unused warning
+	for variables in namelists.
+
+2010-11-08  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46344
+	* decl.c (build_struct): Build vtab immediately if derived type
+	has already been declared.
+
+2010-11-08  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46344
+	* trans-types.c (gfc_copy_dt_decls_ifequal): Handle CLASS components.
+
+2010-11-06  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46330
+	* trans-expr.c (gfc_trans_class_assign): Find 'vtab' symbol in correct
+	namespace.
+
+2010-11-05  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45451
+	PR fortran/46174
+	* class.c (gfc_find_derived_vtab): Improved search for existing vtab.
+	Add component '$copy' to vtype symbol for polymorphic deep copying.
+	* expr.c (gfc_check_pointer_assign): Make sure the vtab is generated
+	during resolution stage.
+	* resolve.c (resolve_codes): Don't resolve code if namespace is already
+	resolved.
+	* trans-stmt.c (gfc_trans_allocate): Call '$copy' procedure for
+	polymorphic ALLOCATE statements with SOURCE.
+
+2010-11-03  Thomas Koenig  <tkoenig@gcc.gnu.org>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	* dump-parse-tree.c (code_indent):  Take label into acount
+	when calculating indent.
+	(show_typespec):  Also display class.
+	(show_attr):  Add module name to argument.
+	Don't show UNKNOWN for flavor, access and save. Don't show
+	SAVE_NONE.  Don't show INTENT_UNKNOWN.  Show module for use
+	association.  Show intent only for dummy arguments.
+	Set length of shown symbol names to minimum of 12.
+	Show attributes header.
+	(show_symbol):  Adjust show_level.
+	(show_symtree):  Clear up display for ambiguous.  Show if symbol
+	was imported from namespace.
+	(show_code_node):  Clear up indenting.  Traverse symtree and
+	show code directly instead of calling show_namespace.
+
+2010-11-02  Nathan Froyd  <froydnj@codesourcery.com>
+
+	* trans-decl.c (add_argument_checking): Use build_zero_cst instead of
+	fold_convert.
+	* trans-expr.c (gfc_conv_missing_dummy, fill_with_spaces): Likewise.
+	* trans-stmt.c (gfc_trans_do): Likewise.
+
+2010-11-02  Steven G. Kargl  < kargl@gcc.gnu.org>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45170
+	* array.c (gfc_match_array_constructor): Reject deferred type
+	parameter (DTP) in type-spec.
+	* decl.c (char_len_param_value, match_char_length,
+	gfc_match_char_spec, build_sym, variable_decl,
+	enumerator_decl): Support DTP.
+	* expr.c (check_inquiry): Fix check due to support for DTP.
+	* gfortran.h (gfc_typespec): Add Boolean 'deferred'.
+	* misc.c (gfc_clear_ts): Set it to false.
+	* match.c (gfc_match_allocate): Support DTP.
+	* resolve.c (resolve_allocate_expr): Not-implemented error for DTP.
+	(resolve_fl_variable): Add DTP constraint check.
+	* trans-decl.c (gfc_trans_deferred_vars): Add not-implemented
+	error for DTP.
+
+2010-11-01  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/46152
+	* fortran/match.c (match_derived_type_spec): Reoplace gfc_match_symbol
+	with a gfc_find_symbol to prevent namespace pollution.  Remove dead
+	code.
+	(match_type_spec): Remove parsing of '::'.  Collapse character
+	kind checking to one location.
+	(gfc_match_allocate): Use correct locus in error message.
+
+2010-10-30  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	* gfortran.h (gfc_option_t):  Replace dump_parse_tree by
+	dump_fortran_original and add dump_fortran_optimized.
+	* lang.opt: Add fdump-fortran-original and
+	fdump-fortran-optimized.  Document that fdump-parse-tree is
+	deprecated.
+	* gfortran.texi: Add -fdump-fortran-original and
+	-fdump-fortran-optimized.  -fdump-parse-tree is deprecated.
+	* frontend-passes.c (gfc_run_passes):  If optimizing and
+	if gfc_option.dump_fortran_optimized is set, dump the parse tree
+	after optimization.
+	* parse.c:  Rename gfc_option.dump_parse_tree to
+	gfc_option.dump_fortran_original.
+	* options.c (gfc_init_options):  Rename gfc_option.dump_parse_tree
+	to gfc_option.dump_fortran_original and handle
+	gfc_option.dump_fortran_optimize.
+	(gfc_post_options): Rename gfc_option.dump_parse_tree
+	to gfc_option.dump_fortran_original.
+	(gfc_handle_option):  Rename OPT_fdump_parse_tree to
+	OPT_fdump_fortran_original and gfc_option.dump_parse_tree
+	to gfc_option.dump_fortran_original.  Handle
+	OPT_fdump_fortran_optimized.
+
+2010-10-30  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44917
+	PR fortran/44926
+	PR fortran/46196
+	* interface.c (count_types_test): Symmetrize type check.
+	(generic_correspondence): Ditto.
+
+2010-10-27  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46161
+	* interface.c (compare_allocatable): Handle polymorphic allocatables.
+	(compare_parameter): Add two error messages for polymorphic dummies.
+
+2010-10-26  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42647
+	* trans.h (gfc_deallocate_scalar_with_status): New prototype.
+	* trans.c (gfc_deallocate_scalar_with_status): New function for
+	deallocation of allocatable scalars.
+	* trans-array.c (structure_alloc_comps): Call it here ...
+	* trans-decl.c (gfc_trans_deferred_vars): ... here ...
+	* trans-stmt.c (gfc_trans_deallocate): ... and here.
+
+2010-10-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45451
+	* trans-stmt.c (gfc_trans_allocate): Do a deep-copy for SOURCE=.
+
+	PR fortran/43018
+	* trans-array.c (duplicate_allocatable): Use size of type and not
+	the size of the pointer to the type.
+
+2010-10-25  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/46140
+	* fortran/scanner.c (include_line): Check return value of load_file.
+
+2010-10-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/46122
+	* expr.c (gfc_check_vardef_context): Fix PROTECTED check.
+
+2010-10-21  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46060
+	* match.h (gfc_matching_ptr_assignment): New global variable to indicate
+	we're currently matching a (non-proc-)pointer assignment.
+	* decl.c (match_pointer_init): Set it.
+	* match.c (gfc_match_pointer_assignment): Ditto.
+	* primary.c (matching_actual_arglist): New global variable to indicate
+	we're currently matching an actual argument list.
+	(gfc_match_actual_arglist): Set it.
+	(gfc_match_varspec): Reject procedure pointer component calls with
+	missing argument list.
+
+2010-10-21  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/46067
+	* interface.c (gfc_compare_interfaces): Switch arguments of type
+	comparison (important for polymorphic variables).
+
+2010-10-21  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/46100
+	* expr.c (gfc_check_vardef_context): Treat pointer functions
+	as variables.
+
+2010-10-20  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/46079
+	* trans_stmt.c (gfc_trans_stop): Fix whitespace.  Build a call to new
+	F08 numeric stop function.
+	* trans.h: Add declaration for gfor_fndecl_stop_numeric_f08.
+	* trans-decl.c (gfc_build_builtin_function_decls): Build declaration
+	for stop_numeric_f08.
+
+2010-10-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	* gfortran.h: Remove definition of bt enumerator.
+	* libgfortran.h: Add bt enumerator type alighned with defintion.
+	Remove the dtype enumerator, no longer used.
+	previously given in libgfortran/io.h
+	* trans-types.c: Use new bt enumerator.
+	* trans-io.c: Likewise.
+
+2010-10-16  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	* trans-io.c (gfc_build_io_library_fndecls):
+	Array descriptor arguments to transfer_array can be
+	dereferenced recursively.
+
+2010-10-16  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/20165
+	PR fortran/31593
+	PR fortran/43665
+	* trans-io.c (enum iocall): Add IOCALL_X_INTEGER_WRITE,
+	IOCALL_X_LOGICAL_WRITE, IOCALL_X_CHARACTER_WRITE,
+	IOCALL_X_CHARACTER_WIDE_WRIE, IOCALL_X_REAL_WRITE,
+	IOCALL_X_COMPLEX_WRITE and IOCALL_X_ARRAY_WRITE.
+	(gfc_build_io_library_fndecls):  Add corresponding function
+	decls.
+	(transfer_expr):  If the current transfer is a READ, use
+	the iocall with the original version, otherwise the version
+	with _WRITE.
+	(transfer_array_desc):  Likewise.
+
+2010-10-15  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45186
+	* trans.h (gfc_add_modify_loc, gfc_evaluate_now_loc): New prototypes.
+	(gfc_trans_runtime_error_vararg): Remove prototype.
+	* trans.c (gfc_add_modify_loc, gfc_evaluate_now_loc): New functions.
+	(gfc_add_modify, gfc_evaluate_now): Use them.
+	(trans_runtime_error_vararg): Renamed from
+	gfc_trans_runtime_error_vararg, made static and use locus.
+	(gfc_trans_runtime_error): Use it.
+	(gfc_trans_runtime_check): Ditto and make use of locus.
+	* trans-stmt.c (gfc_trans_if_1, gfc_trans_simple_do,
+	gfc_trans_do, gfc_trans_do_while): Improve line number
+	associated with generated expressions.
+
+2010-10-12  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/38936
+	* parse.c (parse_associate): Set typespec of associate-name if that of
+	the target is already available.
+
+2010-10-10  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45961
+	* resolve.c (resolve_typebound_function): Bugfix for type-bound
+	operators.
+
+2010-10-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	* frontend-passes.c:  Include opts.h.
+	(optimize_comparison):  Renamed from optimize_equality.
+	Change second argument to operation to be compared.
+	Use flag_finite_math_only to avoid comparing REAL and
+	COMPLEX only when NANs are honored.  Simplify comparing
+	of string concatenations where left or right operands are
+	equal.  Simplify all comparison operations, based on the result
+	of gfc_dep_compare_expr.
+	* dependency.c:  Include arith.h.
+	(gfc_are_identical_variables):  Volatile variables should not
+	compare equal to themselves.
+	(gfc_dep_compare_expr):  Handle string constants and string
+	concatenations.
+
+2010-10-08  Joseph Myers  <joseph@codesourcery.com>
+
+	* f95-lang.c (LANG_HOOKS_INIT_OPTIONS_STRUCT): Define.
+	* gfortran.h (gfc_init_options_struct): Declare.
+	* options.c (gfc_init_options_struct): New.  Split out from
+	gfc_init_options.
+
+2010-10-07  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45933
+	* resolve.c (resolve_typebound_function): Use correct declared type
+	for type-bound operators.
+
+2010-10-07  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/45916
+	Revert revision 165026:
+	2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* decl.c (match_procedure_in_type): Assertify if conditions.
+
+2010-10-06  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/45889
+	* resolve.c (resolve_transfer): Use expression inside parenthesis to
+	find acutal component to be transgferred.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-stmt.c (gfc_trans_allocate): free lhs expr.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-array.c (gfc_free_ss_chain): Made non-static.
+	* trans-array.h (gfc_free_ss_chain): New prototype.
+	* trans-stmt.c (gfc_trans_where_2): Free ss chains.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_funcall): Also free symbol's
+	subcomponents.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-stmt.c (gfc_trans_forall_1): Free forall struct at the end.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-expr.c (get_proc_ptr_comp): Restore initial expression type
+	before calling gfc_free_expr.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-array.c (gfc_conv_tmp_array_ref): Add factorized call to
+	gfc_advance_se_ss_chain.
+	* trans-expr.c (gfc_conv_subref_array_ref, gfc_conv_procedure_call,
+	gfc_conv_array_constructor_expr, gfc_trans_assignment_1): Remove
+	calls to gfc_advance_se_ss_chain after gfc_conv_tmp_array_ref.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Ditto.
+	* trans-stmt.c (gfc_trans_where_assign, gfc_trans_where_3): Ditto.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans.c (gfc_restore_backend_locus): New function.
+	(gfc_get_backend_locus): Renamed to ...
+	(gfc_save_backend_locus): ... this.
+	* trans.h (gfc_restore_backend_locus, gfc_get_backend_locus,
+	gfc_save_backend_locus): Same.
+	* trans-array.c (gfc_trans_g77_array, gfc_trans_dummy_array_bias,
+	gfc_trans_deferred_array): Rename gfc_get_backend_locus to
+	gfc_save_backend_locus.
+	(gfc_trans_dummy_array_bias): Call gfc_restore_backend_locus at the
+	end.
+	(gfc_trans_g77_array, gfc_trans_deferred_array): Use
+	gfc_restore_backend_locus instead of gfc_set_backend_locus.
+	(gfc_trans_deferred_array): Call gfc_restore_backend_locus on early
+	return.
+	* trans-decl.c (gfc_get_extern_function_decl, build_entry_thunks,
+	gfc_trans_deferred_vars):
+	Rename gfc_get_backend_locus to gfc_save_backend_locus.
+	Use gfc_restore_backend_locus insted of gfc_set_backend_locus.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-array.c (gfc_build_constant_array_constructor): Free array
+	spec when done.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* symbol.c (gfc_copy_formal_args_ppc): Free previous formal arg list
+	before overwriting it.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* array.c (gfc_match_array_spec): Don't re-initialize cleared struct.
+	* symbol.c (gen_shape_param): Ditto.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* symbol.c (free_entry_list): New function.
+	(gfc_free_namespace): Free list of entries.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* symbol.c (free_components): Free list of formal args and formal
+	namespace.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* simplify.c (gfc_simplify_size): Clear temporary mpz int before
+	returning.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* resolve.c (add_dt_to_dt_list): Remove unneeded if.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* resolve.c (check_typebound_baseobject): Free local expr before
+	returning.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* primary.c (gfc_match_structure_constructor): Invert the assert logic.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* primary.c (gfc_free_structure_ctor_component): Also free the
+	component structure itself.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* module.c (gfc_use_module): Free atom_string when done with it.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* module.c (read_module): Remove useless string duplication.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* gfortranspec.c (append_arg): Remove commented code.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* decl.c (match_procedure_in_type): Assertify if conditions.
+
+2010-10-06  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* cpp.c (gfc_cpp_post_options): Don't create a cpp reader if
+	preprocessing is disabled.
+
+2010-10-06  Jakub Jelinek  <jakub@redhat.com>
+
+	PR middle-end/45838
+	* f95-lang.c (ATTR_NOTHROW_LEAF_LIST, ATTR_CONST_NOTHROW_LEAF_LIST,
+	ATTR_NOTHROW_LIST, ATTR_CONST_NOTHROW_LIST): Define.
+	(gfc_define_builtin): Change last argument to int bitmask from bool,
+	control addition of TREE_NOTHROW and leaf attribute as well.
+	(DO_DEFINE_MATH_BUILTIN): Adjust callers.
+	(gfc_init_builtin_functions): Likewise.  Remove
+	ATTR_{,CONST_}NOTHROW_LIST enum.
+
+2010-10-04  Andi Kleen <ak@linux.intel.com>
+
+	* Make-lang.in (gfortran, f951): Add + to build rule.
+
+2010-10-04  Richard Guenther  <rguenther@suse.de>
+
+	* f95-lang.c (current_translation_unit): New global variable.
+	(gfc_create_decls): Build a translation-unit decl.
+	(pushdecl): In the global binding-level use the
+	translation-unit decl as DECL_CONTEXT.
+	* trans-decl.c (gfc_get_symbol_decl): Use DECL_FILE_SCOPE_P.
+	(build_function_decl): Likewise.  Delay setting the assembler
+	name, leave setting of DECL_CONTEXT to pushdecl.
+	(trans_function_start): Use DECL_FILE_SCOPE_P.
+	(gfc_create_module_variable): Likewise.  Remove questionable
+	asserts.
+	* trans.c (gfc_generate_module_code): Likewise.
+
+2010-10-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* cpp.c (cpp_define_builtins): Call functions from cppbuiltin.c
+	instead of duplicating code.
+	* Make-lang.in: Add dependency on cppbuiltin.h. Don't define
+	BASEVER.
+
+2010-10-02  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45748
+	* resolve.c (resolve_formal_arglist): Avoid setting default type for
+	formal arguments of intrinsic procedures.
+
+2010-09-30  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45828
+	* resolve.c (resolve_allocate_expr): Do not use
+	'gfc_has_default_initializer'.
+
+2010-09-30  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.tex (Fortran 2008 status): Update list of
+	implemented features.
+
+2010-09-29  Joseph Myers  <joseph@codesourcery.com>
+
+	* lang.opt: Don't use VarExists.
+
+2010-09-29  Joseph Myers  <joseph@codesourcery.com>
+
+	* cpp.c (cpp_define_builtins): Update names of gfc_option_t
+	members.
+	(gfc_cpp_post_options): Update names of cpp_options members.
+	(cb_cpp_error): Update names of diagnostic_context members.
+	* f95-lang.c (gfc_init_builtin_functions): Update names of
+	gfc_option_t members.
+	* gfortran.h (gfc_option_t): Rename warn_conversion and
+	flag_openmp.
+	* intrinsic.c (gfc_convert_type_warn): Update names of
+	gfc_option_t members.
+	* options.c (gfc_init_options, gfc_post_options, set_Wall,
+	gfc_handle_option): Update names of gfc_option_t members.
+	* parse.c (next_free, next_fixed): Update names of gfc_option_t
+	members.
+	* scanner.c (pedantic): Remove extern declaration.
+	(skip_free_comments, skip_fixed_comments, include_line): Update
+	names of gfc_option_t members.
+	* trans-decl.c (gfc_generate_function_code): Update names of
+	gfc_option_t members.
+
+2010-09-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40569
+	PR fortran/40568
+	* intrinsic.c (add_functions): Make compiler_version and
+	compiler_options CLASS_INQUIRY.
+	* gfortran.h (gfc_get_option_string): New prototype.
+	* intrinsic.texi (COMPILER_VERSION, COMPILER_OPTIONS):
+	Add documentation.
+	(C_SIZEOF): Mark as inquiry function of ISO_C_BINDING.
+	(ISO_FORTRAN_ENV): Refer to COMPILER_VERSION and COMPILER_OPTIONS.
+	(ISO_C_BINDING): Refer to C_SIZEOF.
+	* options.c (gfc_get_option_string): New function.
+	* simplify.c (gfc_simplify_compiler_options): Use it.
+	(gfc_simplify_compiler_version): Include compiler name.
+
+2010-09-28  Jan Hubicka  <jh@suse.cz>
+
+	* f95-lang.c (gfc_define_builtin): Make leaf.
+	(gfc_init_builtin_functions): Handle only ATTR_CONST_NOTHROW_LEAF_LIST
+	and ATTR_NOTHROW_LEAF_LIST.
+	(DEF_SYNC_BUILTIN): Check ATTR_CONST_NOTHROW_LEAF_LIST.
+	(DEF_GOMP_BUILTIN): Likewise.
+
+2010-09-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45756
+	* trans-decl.c (gfc_get_symbol_decl): Use gsym for decl of
+	module parameters.
+
+2010-09-27  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40569
+	PR fortran/40568
+	* intrinsic.h (gfc_simplify_compiler_options,
+	gfc_simplify_compiler_version): New prototypes.
+	* intrinsic.c (gfc_intrinsic_function_by_id,
+	make_from_module): New functions.
+	(gfc_find_function, gfc_find_subroutine, gfc_generic_intrinsic,
+	gfc_specific_intrinsic): Don't return module intrinsics.
+	(add_functions): Add compiler_options, compiler_version.
+	(gfc_intrinsic_func_interface): Also lookup symbol by ISYM ID.
+	* symbol.c (std_for_isocbinding_symbol): Add version check for
+	NAMED_FUNCTIONS.
+	* iso-fortran-env.def: Add compiler_options, compiler_version.
+	* iso-c-binding.def: Add c_sizeof.
+	* gfortran.h (gfc_intrinsic_sym): Add from_module:1.
+	(iso_c_binding_symbol, iso_fortran_env_symbol): Add NAMED_FUNCTIONS.
+	(gfc_intrinsic_function_by_id): New prototype.
+	* module.c (create_intrinsic_function): New function.
+	(import_iso_c_binding_module, use_iso_fortran_env_module): Use it.
+	* trans-types.c (init_c_interop_kinds): Add NAMED_FUNCTIONS.
+	* resolve.c (resolve_intrinsic): Try also to resolve intrinsics
+	by ISYM ID.
+	* simplify.c (gfc_simplify_compiler_options,
+	gfc_simplify_compiler_version): New functions.
+
+2010-09-26  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/45783
+	PR fortran/45795
+	* resolve.c (resolve_select_type): Clarify code.
+	(resolve_assoc_var): Only set typespec if it is currently unknown.
+
+2010-09-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/45793
+	* module.c (create_int_parameter_array): Set the array value shape.
+
+2010-09-25  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi: Re-add accidently removed \input line.
+
+2010-09-25  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/45776
+	* gfortran.h (struct gfc_dt): New member `dt_io_kind'.
+	* io.c (resolve_tag): F2008 check for NEWUNIT and variable
+	definition checks for NEWUNIT, IOSTAT, SIZE and IOMSG.
+	(gfc_free_dt): Correctly handle freeing of `dt_io_kind' and
+	`extra_comma' with changed semantics.
+	(gfc_resolve_dt): Check variable definitions.
+	(match_io_element): Remove INTENT and PURE checks here and
+	initialize code->ext.dt member.
+	(match_io): Set dt->dt_io_kind.
+	(gfc_resolve_inquire): Check variable definition for all tags
+	except UNIT, FILE and ID.
+	* resolve.c (resolve_transfer): Variable definition check.
+
+2010-09-25  Tobias Burnus  <burnus@net-b.de>
+
+	* interface.c (gfc_match_end_interface): Constify char pointer
+	to fix warning.
+
+2010-09-24  Steven G. Kargl  < kargl@gcc.gnu.org>
+
+	* interface.c (gfc_match_end_interface): Deal with user defined
+	operators that overload rational operators and C1202.
+
+2010-09-24  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi: Add second space after end-of-sentence period;
+	change / to /@/ to allow hyphenation of URLs.
+	(Standards): Remove duplicated OpenMP, update wording given that
+	Fortran 2008 now released.
+	(Fortran 2008 status): Update and add list of implemented features.
+
+2010-09-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40571
+	* iso-fortran-env.def: Add NAMED_KINDARRAY with
+	character_kinds, integer_kinds, logical_kinds and
+	real_kinds.
+	* gfortran.h: Add them to iso_fortran_env_symbol.
+	* libgfortran.h: Rename GFC_INQUIRE_INTERNAL_UNIT to
+	LIBERROR_INQUIRE_INTERNAL_UNIT and move it from
+	libgfortran_stat_codes to libgfortran_error_codes.
+	* module.c (create_int_parameter_array): New function.
+	(use_iso_fortran_env_module): Use it for
+	NAMED_KINDARRAY of iso-fortran-env.def.
+	* trans-decl.c (gfc_get_symbol_decl): Parameter
+	arrays of intrinsics modules become local static variables.
+	* intrinsic.texi (ISO_FORTRAN_ENV): Add character_kinds,
+	integer_kinds, logical_kinds and real_kinds.
+
+2010-09-23  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/45744
+	* frontend-passes.c (optimize_binop_array_assignment):
+	Only re-use lhs as intermediate storage if kind and type
+	parameters match.
+
+2010-09-23  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/45745
+	PR fortran/45648
+	* trans-array.c (gfc_conv_expr_descriptor): Handle
+	ss->type == GFC_SS_INTRINSIC (for {l,u}bound intrinsics) case.
+
+2010-09-23  Tobias Burnus  <burnus@net-b.de>
+
+	* intrinsic.texi (OpenMP modules): Add named constants of
+	OMP_LIB.
+
+2010-09-23  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/38936
+	PR fortran/44044
+	PR fortran/45474
+	* gfortran.h (gfc_check_vardef_context): New method.
+	(struct symbol_attribute): New flag `select_type_temporary'.
+	* primary.c (gfc_variable_attr): Clarify initialization of ref.
+	(match_variable): Remove PROTECTED check and assignment check
+	for PARAMETERs (this is now done later).
+	* match.c (gfc_match_iterator): Remove INTENT(IN) check.
+	(gfc_match_associate): Defer initialization of newAssoc->variable.
+	(gfc_match_nullify): Remove PURE definability check.
+	(select_type_set_tmp): Set new `select_type_temporary' flag.
+	* expr.c (gfc_check_assign): Remove INTENT(IN) check here.
+	(gfc_check_pointer_assign): Ditto (and other checks removed).
+	(gfc_check_vardef_context): New method.
+	* interface.c (compare_parameter_protected): Removed.
+	(compare_actual_formal): Use `gfc_check_vardef_context' for checks
+	related to INTENT([IN]OUT) arguments.
+	* intrinsic.c (check_arglist): Check INTENT for intrinsics.
+	* resolve.c (gfc_resolve_iterator): Use `gfc_check_vardef_context'.
+	(remove_last_array_ref): New method.
+	(resolve_deallocate_expr), (resolve_allocate_expr): Ditto.
+	(resolve_allocate_deallocate): Ditto (for STAT and ERRMSG).
+	(resolve_assoc_var): Remove checks for definability here.
+	(resolve_select_type): Handle resolving of code->block here.
+	(resolve_ordinary_assign): Remove PURE check.
+	(resolve_code): Do not resolve code->blocks for SELECT TYPE here.
+	Use `gfc_check_vardef_context' for assignments and pointer-assignments.
+
+2010-08-22  Ralf Wildenhues  <Ralf.Wildenhues@gmx.de>
+
+	* gfortran.texi (Argument list functions): Allow URL to wrap.
+	* intrinsic.texi (GETGID, GETPID, GETUID, IMAGE_INDEX)
+	(IS_IOSTAT_END, IS_IOSTAT_EOR, NUM_IMAGES, THIS_IMAGE)
+	(ISO_FORTRAN_ENV): Fix markup in index entries, and a couple of
+	code markups in the text.
+	* invoke.texi (Fortran Dialect Options)
+	(Error and Warning Options, Directory Options, Code Gen Options):
+	Likewise.  Remove @code inside @smallexample.
+
+2010-09-22  Joseph Myers  <joseph@codesourcery.com>
+
+	* gfortranspec.c (lang_specific_driver): Handle OPT__version and
+	OPT__help instead of OPT_fversion and OPT_fhelp.
+	* lang.opt (-all-warnings, -assert, -assert=, -comments,
+	-comments-in-macros, -define-macro, -define-macro=, -dependencies,
+	-dump, -dump=, -include-barrier, -include-directory,
+	-include-directory=, -include-directory-after,
+	-include-directory-after=, -include-prefix, -include-prefix=,
+	-no-line-commands, -no-standard-includes, -output, -output=,
+	-preprocess, -print-missing-file-dependencies, -trace-includes,
+	-undefine-macro, -undefine-macro=, -user-dependencies, -verbose,
+	-write-dependencies, -write-user-dependencies): New.
+
+2010-09-21  Jason Blevins  <jrblevin@sdf.org>
+
+	* intrinsics.texi (HYPOT, IMAGE_INDEX, BESSEL_JN, BESSEL_YN,
+	execute_command_line, IEOR, IOR, NORM2, NOT, NULL, PARITY):
+	Correct spelling.
+
+2010-09-21  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/45648
+	* trans-array.c (gfc_conv_expr_descriptor): Calculate dim out of n and
+	info->dim.
+
+	PR fortran/45648
+	* trans-array.c (gfc_conv_expr_descriptor): Unset full if we are
+	accessing dimensions in reversed order. 
+
+	PR fortran/45648
+	* trans-array.c (gfc_conv_expr_descriptor): Special case noncopying
+	intrinsic function call. 
+
+	* trans-array.c (gfc_conv_expr_descriptor): Remove ss lookup.
+	Update asserts accordingly.
+
+	PR fortran/45648
+	* trans.h (gfc_se): New field force_tmp. 
+	* trans-expr.c (gfc_conv_procedure_call): Check for argument alias
+	and set parmse.force_tmp if some alias is found. 
+	* trans-array.c (gfc_conv_expr_descriptor): Force a temporary creation
+	if se->force_tmp is set. 
+
+2010-09-20  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45438
+	* trans-expr.c (gfc_conv_procedure_call): Fix pointer checking for
+	TBPs, PPCs and pointer/allocatable components.
+
+2010-09-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/45081
+	* simplify.c (is_constant_array_expr): Allow structure array
+	elements as well as constants.
+	(gfc_simplify_pack, gfc_simplify_reshape, gfc_simplify_spread,
+	gfc_simplify_transpose, gfc_simplify_unpack): Copy the derived
+	type of source to the result.
+
+2010-09-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	* frontend-passes.c (gfc_expr_walker):  Also
+	handle EXPR_SUBSTRING.
+
+2010-09-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	* frontend-passes.c (gfc_expr_walker):  Handle
+	constructors and references.
+
+2010-09-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43665
+	* trans-types.c (create_fn_spec): New function.
+	(gfc_get_function_type): Call it.
+
+2010-09-16  Jakub Jelinek  <jakub@redhat.com>
+
+	* gfortran.h (walk_code_fn_t, walk_expr_fn_t): New types.
+	(gfc_expr_walker, gfc_code_walker): New prototypes.
+	* frontend-passes.c (gfc_expr_walker, gfc_code_walker): New functions.
+	(WALK_SUBEXPR, WALK_SUBEXPR_TAIL, WALK_SUBCODE): Define.
+	(optimize_namespace): Use gfc_code_walker.
+	(optimize_code, optimize_expr): Rewritten as gfc_code_walker hooks.
+	(optimize_expr_0, optimize_code_node,
+	optimize_actual_arglist): Removed.
+	(optimize_assignment): Don't call optimize_expr_0.
+
+2010-09-16  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45674
+	* interface.c (compare_parameter): Create vtab for actual argument,
+	instead of formal (if needed).
+
+2010-09-15  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45577
+	* resolve.c (resolve_allocate_expr): Do default initialization via
+	EXEC_INIT_ASSIGN.
+
+2010-09-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* mathbuiltins.def: Do not defined huge_val built-in.
+	* trans-const.c (gfc_build_inf_or_huge): New function.
+	* trans-const.h (gfc_build_inf_or_huge): New prototype.
+	* f95-lang.c (gfc_init_builtin_functions): Don't defined
+	huge_val built-ins.
+	* trans-intrinsic.c (gfc_build_intrinsic_lib_fndecls): We don't
+	have functions of type (*) (void) anymore.
+	(gfc_conv_intrinsic_minmaxloc): Call gfc_build_inf_or_huge.
+	(gfc_conv_intrinsic_nearest): Call gfc_build_inf_or_huge instead
+	of generating a call to huge_val().
+
+2010-09-11  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* gfortran.h (gfc_expr): Remove inline_noncopying_intrinsic attribute.
+	* dependency.c (gfc_check_dependency): Don't depend on
+	expr's inline_noncopying_intrinsic_attribute.
+	* dependency.c (gfc_check_argument_var_dependency,
+	gfc_check_argument_dependency): Ditto. Recursively check dependency
+	as NOT_ELEMENTAL in the non-copying (=transpose) case.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Ditto.
+	* resolve.c (find_noncopying_intrinsics): Remove.
+	(resolve_function, resolve_call): Remove call to
+	find_noncopying_intrinsics.
+
+	* trans-array.c (gfc_conv_array_transpose): Remove.
+	(gfc_walk_subexpr): Make non-static. Move prototype...
+	* trans-array.h (gfc_walk_subexpr): ... here.
+	* trans-intrinsic.c (gfc_conv_intrinsic_function): Update transpose
+	handling.
+	(walk_inline_intrinsic_transpose, walk_inline_intrinsic_function,
+	gfc_inline_intrinsic_function_p): New.
+	(gfc_is_intrinsic_libcall): Return early in inline intrinsic case.
+	Remove transpose from the libcall list.
+	(gfc_walk_intrinsic_function): Special case inline intrinsic.
+	* trans.h (gfc_inline_intrinsic_function_p): New prototype.
+
+2010-09-10  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-expr.c (expr_is_variable): New function taking non-copying
+	intrinsic functions into account.
+	(gfc_trans_assignment_1): Use expr_is_variable.
+
+2010-09-10  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-array.c (gfc_conv_loop_setup): Access the shape along the
+	real array dimension instead of the scalarizer (loop) dimension.
+
+2010-09-10  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-array.c (gfc_conv_resolve_dependencies): Handle same-array
+	transposed references.
+
+2010-09-10  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45186
+	* trans.h (build1_stat_loc, build2_stat_loc, build3_stat_loc,
+	build4_stat_loc): New inline functions.
+	(build1_loc, build2_loc, build3_loc, build4_loc): New macros.
+	(build1_v, build2_v, build3_v, build4_v): Use input_location
+	as locus.
+	* trans-array.c (gfc_trans_scalarized_loop_end,
+	gfc_conv_array_parameter): Replace build[1-4] by build[1-4]_loc.
+	* trans.c (gfc_build_addr_expr, gfc_build_array_ref,
+	gfc_finish_wrapped_block): Ditto.
+	* trans-decl.c (gfc_init_default_dt, init_intent_out_dt): Ditto.
+	* trans-expr.c (gfc_conv_missing_dummy,
+	gfc_trans_alloc_subarray_assign, gfc_trans_zero_assign): Ditto.
+	* trans-openmp.c (gfc_omp_clause_default_ctor,
+	gfc_trans_omp_critical, gfc_trans_omp_parallel,
+	gfc_trans_omp_parallel_do, gfc_trans_omp_parallel_sections,
+	gfc_trans_omp_parallel_workshare, gfc_trans_omp_sections
+	gfc_trans_omp_single, gfc_trans_omp_task,
+	gfc_trans_omp_workshare): Ditto.
+
+2010-09-09  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* fortran/expr.c (check_inquiry): OPTIONAL attribute is not allowed
+	for dummy argument that appears in a specification statement.
+
+2010-09-09  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-array.c (gfc_get_array_ref_dim): New function.
+	(gfc_trans_create_temp_array): Reconstruct array
+	bounds from loop bounds. Use array bounds instead of loop bounds.
+
+2010-09-09  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-array.c (gfc_set_loop_bounds_from_array_spec):
+	Get the array dimension from the dim array.
+
+2010-09-09  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-array.c (gfc_trans_preloop_setup): Unconditionally use the
+	dim array to get the stride in the innermost loop.
+
+2010-09-09  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-array.c (gfc_trans_create_temp_array): Don't set dim array.
+	(gfc_conv_loop_setup, gfc_walk_function_expr): Set dim array.
+	* trans-intrinsic.c (gfc_walk_intrinsic_libfunc): Ditto.
+
+2010-09-09  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-array.c (gfc_trans_create_temp_array): Assert loop dimension
+	and info dimension are the same. Loop over loop dimension.
+	* trans-stmt.c (gfc_conv_elemental_dependencies): Set loop dimension
+
+2010-09-09  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-array.c (gfc_conv_array_transpose): Change generated descriptor
+	name
+
+2010-09-09  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43665
+	* intrincic.texi (FGET, FGETC, FPUT, FPUTC, FSTAT, GETCWD, KILL,
+	STAT): Show also syntax for the function version.
+	* intrinsic.c (add_sym_1s_intent, add_sym_2s_intent,
+	 add_sym_3s_intent): Remove function.
+	(add_sym_1s, add_sym_2s, add_sym_3s): Take always the intent
+	as argument.
+	(add_sym_2_intent): New function.
+	(add_functions): Set intent for functions which modify
+	the argument: fstat, fgetc, fget, hostnm, lstat, stat. Change
+	argument name of hostnm from "a" to "c"
+	(add_subroutines): Change add_sym_*s_intent to
+	add_sym_*s and add intent to the add_sym_*s calls.
+
+2010-09-08  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/38282
+	* intrinsic.c (add_functions): Add B{G,L}{E,T}, DSHIFT{L,R},
+	MASK{L,R}, MERGE_BITS and SHIFT{A,L,R}.
+	* gfortran.h: Define ISYM values for above intrinsics.
+	* intrinsic.h (gfc_check_bge_bgt_ble_blt, gfc_check_dshift,
+	gfc_check_mask, gfc_check_merge_bits, gfc_check_shift,
+	gfc_simplify_bge, gfc_simplify_bgt, gfc_simplify_ble,
+	gfc_simplify_blt, gfc_simplify_dshiftl, gfc_simplify_dshiftr,
+	gfc_simplify_lshift, gfc_simplify_maskl, gfc_simplify_maskr,
+	gfc_simplify_merge_bits, gfc_simplify_rshift,
+	gfc_simplify_shifta, gfc_simplify_shiftl, gfc_simplify_shiftr,
+	gfc_resolve_dshift, gfc_resolve_mask, gfc_resolve_merge_bits,
+	gfc_resolve_shift): New prototypes.
+	* iresolve.c (gfc_resolve_dshift, gfc_resolve_mask,
+	gfc_resolve_merge_bits, gfc_resolve_shift): New functions.
+	* check.c (gfc_check_bge_bgt_ble_blt, gfc_check_dshift,
+	gfc_check_mask, gfc_check_merge_bits, gfc_check_shift): New
+	functions.
+	* trans-intrinsic.c (gfc_conv_intrinsic_dshift,
+	gfc_conv_intrinsic_bitcomp, gfc_conv_intrinsic_shift,
+	gfc_conv_intrinsic_merge_bits, gfc_conv_intrinsic_mask): New
+	functions.
+	(gfc_conv_intrinsic_function): Call above static functions.
+	* intrinsic.texi: Document new intrinsics.
+	* simplify.c (gfc_simplify_bge, gfc_simplify_bgt, gfc_simplify_ble,
+	gfc_simplify_blt, gfc_simplify_dshiftl, gfc_simplify_dshiftr,
+	gfc_simplify_lshift, gfc_simplify_maskl, gfc_simplify_maskr,
+	gfc_simplify_merge_bits, gfc_simplify_rshift, 
+	gfc_simplify_shifta, gfc_simplify_shiftl, gfc_simplify_shiftr):
+	New functions.
+
+2010-09-08  Jakub Jelinek  <jakub@redhat.com>
+
+	* frontend-passes.c (optimize_code_node): Walk block chain by default.
+
+	PR fortran/45597
+	* trans-openmp.c (gfc_trans_omp_do): Store exit/cycle labels on code
+	instead of code->block.
+
+	PR fortran/45595
+	* openmp.c (resolve_omp_do): Report not enough do loops for
+	collapse even if block->next is NULL.
+
+2010-09-07  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/45576
+	* dependency.c (gfc_deb_compare_expr):  Take missing optional
+	arguments into account.
+
+2010-09-08  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans.h (gfor_fndecl_clz128, gfor_fndecl_ctz128): Remove.
+	* trans-decl.c (gfor_fndecl_clz128, gfor_fndecl_ctz128): Remove.
+	(gfc_build_intrinsic_function_decls): Don't build the
+	gfor_fndecl_clz128 and gfor_fndecl_ctz128.
+	* trans-intrinsic.c (gfc_conv_intrinsic_leadz,
+	gfc_conv_intrinsic_trailz): Generate inline arithmetic instead
+	of calling clz128/ctz128 library functions.
+
+2010-09-07  Jan Hubicka  <jh@suse.cz>
+
+	* trans-expr.c (gfc_conv_initializer): Set STATIC flags for
+	initializers.
+
+2010-09-07  Tobias Burnus <burnus@net-b.de>
+	
+	PR fortran/45583
+	* intrinsic.texi (COS): Remove superfluous "n".
+
+2010-09-07  Tobias Burnus <burnus@net-b.de>
+
+	PR fortran/45186
+	* trans-array.c (gfc_conv_descriptor_data_get,
+	gfc_conv_descriptor_data_set, gfc_conv_descriptor_data_addr,
+	gfc_conv_descriptor_offset, gfc_conv_descriptor_dtype,
+	gfc_conv_descriptor_dimension, gfc_conv_descriptor_stride,
+	gfc_conv_descriptor_lbound, gfc_conv_descriptor_ubound,
+	gfc_conv_shift_descriptor_lbound,
+	gfc_set_loop_bounds_from_array_spec,
+	gfc_trans_allocate_array_storage, gfc_trans_create_temp_array,
+	gfc_conv_array_transpose, gfc_get_iteration_count,
+	gfc_grow_array, gfc_trans_array_ctor_element,
+	gfc_trans_array_constructor_subarray,
+	gfc_trans_array_constructor_value,
+	constant_array_constructor_loop_size, gfc_trans_array_constructor,
+	gfc_set_vector_loop_bounds, gfc_trans_array_bound_check,
+	gfc_conv_array_index_offset, gfc_conv_scalarized_array_ref,
+	gfc_conv_array_ref, gfc_trans_preloop_setup,
+	gfc_trans_scalarized_loop_end, gfc_conv_ss_startstride,
+	gfc_conv_loop_setup, gfc_conv_array_extent_dim,
+	gfc_conv_descriptor_size, gfc_array_init_size,
+	gfc_array_allocate, gfc_array_deallocate,
+	gfc_trans_array_bounds, gfc_trans_auto_array_allocation,
+	gfc_trans_dummy_array_bias, gfc_get_dataptr_offset,
+	get_array_charlen, gfc_conv_expr_descriptor,
+	array_parameter_size, gfc_conv_array_parameter,
+	gfc_trans_dealloc_allocated, get_full_array_size,
+	duplicate_allocatable,
+	structure_alloc_comps): Change fold_build[0-9] to
+	fold_build[0-9]_loc.
+	(duplicate_allocatable, structure_alloc_comps,
+	gfc_duplicate_allocatable): Add space after function name.
+
+2010-09-07  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-stmt.c (gfc_trans_character_select): Be conversion-safe while
+	checking string length value.
+	* trans-intrinsic.c (gfc_conv_intrinsic_char): Build integer using
+	gfc_charlen_type_node type.
+
+	PR fortran/45564
+	* trans-intrinsic.c (gfc_conv_intrinsic_transfer): Convert string
+	length to gfc_charlen_type_node.
+
+2010-09-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/36931
+	* frontend-passes.c (optimize_binop_array_assignment):  New
+	function.
+	(optimize_assignment):  Call it.
+
+2010-09-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/34145
+	* trans-expr.c (gfc_conv_substring):  If start and end
+	of the string reference are equal, set the length to one.
+
+2010-09-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45560
+	* dump-parse-tree.c (gfc_debug_expr): Use stderr instead of stdout.
+
+2010-09-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45560
+	* dump-parse-tree.c (gfc_debug_expr): New function.
+
+2010-09-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/38282
+	* intrinsic.c (add_functions): Support IALL, IANY, IPARITY.
+	(check_specific): Special case for those intrinsics.
+	* gfortran.h (gfc_isym_id): Add new intrinsics
+	* intrinsic.h (gfc_check_transf_bit_intrins,
+	gfc_simplify_iall, gfc_simplify_iany, gfc_simplify_iparity,
+	gfc_resolve_iall, gfc_resolve_iany, gfc_resolve_iparity):
+	New prototypes.
+	* iresolve.c (gfc_resolve_iall, gfc_resolve_iany,
+	gfc_resolve_iparity, resolve_transformational): New functions.
+	(gfc_resolve_product, gfc_resolve_sum,
+	gfc_resolve_parity): Use resolve_transformational.
+	* check.c (gfc_check_transf_bit_intrins): New function.
+	* simplify.c (gfc_simplify_iall, gfc_simplify_iany,
+	gfc_simplify_iparity, do_bit_any, do_bit_ior,
+	do_bit_xor, simplify_transformation): New functions.
+	(gfc_simplify_all, gfc_simplify_any, gfc_simplify_parity,
+	gfc_simplify_sum, gfc_simplify_product): Use simplify_transformation.
+	* trans-intrinsic.c (gfc_conv_intrinsic_arith,
+	gfc_conv_intrinsic_function, gfc_is_intrinsic_libcall):
+	Handle IALL, IANY and IPARITY intrinsics.	
+	* intrinsic.texi (IMAGE_INDEX): Move up to fix alphabetic
+	order.
+	(IALL, IANY, IPARITY): Document new intrinsics.
+
+2010-09-05  Tobias Burnus <burnus@net-b.de>
+
+	PR fortran/45186
+	* f95-lang.c (gfc_truthvalue_conversion): Use
+	fold_build[0-9]_loc instead of fold_build[0-9].
+	* convert.c (convert): Ditto.
+	* trans-intrinsic.c (gfc_conv_intrinsic_conversion,
+	build_fixbound_expr, build_fix_expr, gfc_conv_intrinsic_aint,
+	gfc_conv_intrinsic_int, gfc_conv_intrinsic_imagpart,
+	gfc_conv_intrinsic_conjg, gfc_trans_same_strlen_check,
+	gfc_conv_intrinsic_bound, gfc_conv_intrinsic_abs,
+	gfc_conv_intrinsic_cmplx, gfc_conv_intrinsic_mod,
+	gfc_conv_intrinsic_dim, gfc_conv_intrinsic_sign,
+	gfc_conv_intrinsic_dprod, gfc_conv_intrinsic_char,
+	gfc_conv_intrinsic_ctime, gfc_conv_intrinsic_fdate,
+	gfc_conv_intrinsic_ttynam, gfc_conv_intrinsic_minmax,
+	gfc_conv_intrinsic_minmax_char, gfc_conv_intrinsic_anyall,
+	gfc_conv_intrinsic_count, gfc_conv_intrinsic_arith,
+	gfc_conv_intrinsic_dot_product, gfc_conv_intrinsic_minmaxloc,
+	gfc_conv_intrinsic_minmaxval, gfc_conv_intrinsic_btest,
+	gfc_conv_intrinsic_bitop, gfc_conv_intrinsic_not,
+	gfc_conv_intrinsic_singlebitop, gfc_conv_intrinsic_ibits,
+	gfc_conv_intrinsic_rlshift, gfc_conv_intrinsic_ishft,
+	gfc_conv_intrinsic_ishftc, gfc_conv_intrinsic_leadz,
+	gfc_conv_intrinsic_trailz, gfc_conv_intrinsic_popcnt_poppar,
+	gfc_conv_intrinsic_ichar, gfc_conv_has_intvalue,
+	gfc_conv_intrinsic_merge, gfc_conv_intrinsic_spacing,
+	gfc_conv_intrinsic_rrspacing, gfc_conv_intrinsic_size,
+	size_of_string_in_bytes, gfc_conv_intrinsic_sizeof,
+	gfc_conv_intrinsic_storage_size, gfc_conv_intrinsic_strcmp,
+	gfc_conv_intrinsic_transfer, gfc_conv_allocated,
+	gfc_conv_associated, gfc_conv_same_type_as,
+	gfc_conv_intrinsic_trim, gfc_conv_intrinsic_repeat): Ditto.
+
+2010-09-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45530
+	* resolve.c (resolve_fl_namelist): Change constraint checking
+	order to prevent endless loop.
+
+2010-09-04  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45507
+	* resolve.c (resolve_allocate_expr): Generate default initializers
+	already at this point, resolve them and put them into expr3, ...
+	* trans-stmt.c (gfc_trans_allocate): ... instead of waiting until
+	translation stage.
+
+2010-09-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45186
+	* trans-intrinsic.c (gfc_conv_intrinsic_sign,
+	gfc_conv_intrinsic_leadz): Use build_call_expr_loc instead
+	of build_call_expr.
+	* trans-expr.c (gfc_conv_expr_present, gfc_conv_missing_dummy,
+	gfc_conv_string_length, gfc_conv_substring,
+	gfc_conv_component_ref, gfc_conv_unary_op, gfc_conv_powi,
+	gfc_conv_cst_int_power, gfc_conv_string_tmp, gfc_conv_concat_op,
+	gfc_conv_expr_op, gfc_build_compare_string,
+	gfc_set_interface_mapping_bounds, gfc_conv_subref_array_arg,
+	gfc_conv_derived_to_class, conv_isocbinding_procedure,
+	gfc_conv_procedure_call, fill_with_spaces,
+	gfc_trans_string_copy, gfc_trans_alloc_subarray_assign,
+	gfc_trans_structure_assign, gfc_trans_pointer_assignment,
+	gfc_trans_scalar_assign, gfc_trans_zero_assign,
+	gfc_trans_array_copy, gfc_trans_array_constructor_copy): Change
+	fold_build[0-9] to fold_build[0-9]_loc.
+	* trans-io.c (set_parameter_const, set_parameter_value,
+	set_parameter_ref, gfc_convert_array_to_string, set_string,
+	set_internal_unit, io_result, set_error_locus,
+	nml_get_addr_expr, build_dt): Ditto.
+	* trans-openmp.c (gfc_omp_clause_default_ctor,
+	gfc_omp_clause_copy_ctor, gfc_omp_clause_assign_op,
+	gfc_trans_omp_array_reduction, gfc_trans_omp_atomic,
+	gfc_trans_omp_do): Ditto.
+	* trans.c (gfc_add_modify, gfc_build_addr_expr,
+	gfc_build_array_ref, gfc_trans_runtime_error_vararg,
+	gfc_trans_runtime_check, gfc_call_malloc,
+	gfc_allocate_with_status, gfc_allocate_array_with_status,
+	gfc_call_free, gfc_deallocate_with_status,
+	gfc_call_realloc): Ditto.
+
+2010-09-03  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/45159
+	* dependency.c (gfc_deb_compare_expr):  Compare equal for equal
+	arglists for pure user functions, or for those intrinsic
+	functions which are also pure.
+	* intrinsics.c (add_conv):  Mark conversion functions as pure.
+	(add_char_conversions):  Likewise.
+
+2010-09-03  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/34162
+	* resolve.c (resolve_actual_arglist): Allow internal procedure
+	as actual argument with Fortran 2008.
+
+2010-09-03  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/44602
+	* gfortran.h (struct gfc_code): Renamed `whichloop' to
+	`which_construct' as this is no longer restricted to loops.
+	* parse.h (struct gfc_state_data): New field `construct'.
+	* match.c (match_exit_cycle): Handle EXIT from non-loops.
+	* parse.c (push_state): Set `construct' field.
+	* resolve.c (resolve_select_type): Extend comment.
+	* trans-stmt.c (gfc_trans_if): Add exit label.
+	(gfc_trans_block_construct), (gfc_trans_select): Ditto.
+	(gfc_trans_simple_do): Store exit/cycle labels on the gfc_code itself.
+	(gfc_trans_do), (gfc_trans_do_while): Ditto.
+	(gfc_trans_exit): Use new name `which_construct' instead of `whichloop'.
+	(gfc_trans_cycle): Ditto.
+	(gfc_trans_if_1): Use fold_build3_loc instead of fold_build3.
+
+2010-09-03  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_aint): Fix whitespace.
+	(gfc_conv_intrinsic_ishft): Only evaluate arguments once.
+	(gfc_conv_intrinsic_ishftc): Only evaluate arguments once.
+	* intrinsic.texi (RSHIFT): Fix documentation.
+
+2010-09-02  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45186
+	* trans-common.c (create_common): Change build[0-9] to
+	build[0-9]_loc.
+	* trans-const.c (gfc_conv_constant_to_tree,
+	gfc_conv_constant_to_tree): Ditto.
+	* trans-decl.c (gfc_build_qualified_array, build_entry_thunks,
+	gfc_get_fake_result_decl, gfc_trans_auto_character_variable,
+	add_argument_checking, create_main_function,
+	gfc_generate_return): Ditto.
+	* trans-types.c (gfc_get_dtype, gfc_get_array_type_bounds): Ditto.
+	* trans-stmt.c (allocate_temp_for_forall_nest_1,
+	compute_inner_temp_size, compute_overall_iter_number,
+	generate_loop_for_rhs_to_temp, generate_loop_for_temp_to_lhs,
+	gfc_conv_elemental_dependencies, gfc_do_allocate,
+	gfc_evaluate_where_mask, gfc_trans_allocate,
+	gfc_trans_arithmetic_if, gfc_trans_call,
+	gfc_trans_character_select, gfc_trans_deallocate,
+	gfc_trans_do, gfc_trans_do_while, gfc_trans_forall_1,
+	gfc_trans_forall_loop, gfc_trans_goto, gfc_trans_if_1,
+	gfc_trans_integer_select, gfc_trans_logical_select,
+	gfc_trans_pointer_assign_need_temp, gfc_trans_return,
+	gfc_trans_simple_do, gfc_trans_sync, gfc_trans_where_2,
+	gfc_trans_where_assign) Ditto.
+
+2010-09-02  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44541
+	* resolve.c (resolve_symbol): Correct check for attributes of CLASS
+	variable.
+
+2010-09-02  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45489
+	* resolve.c (apply_default_init): Mark symbol as referenced,
+	if it is initialized.
+	(resolve_symbol): Change intialized check for BT_DERIVED such
+	that also function results get initialized; remove now obsolete
+	gfc_set_sym_referenced for BT_CLASS.
+
+2010-09-01  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44541
+	* class.c (gfc_find_derived_vtab): Add component '$def_init'.
+	* resolve.c (resolve_allocate_expr): Defer handling of default
+	initialization to 'gfc_trans_allocate'.
+	(apply_default_init,resolve_symbol): Handle polymorphic dummies.
+	(resolve_fl_derived): Suppress error messages for vtypes.
+	* trans-stmt.c (gfc_trans_allocate): Handle initialization via
+	polymorphic MOLD expression.
+	* trans-expr.c (gfc_trans_class_init_assign): Now only used for
+	dummy initialization.
+
+2010-09-01  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.texi (preprocessing): Update URL to COCO.
+
+2010-09-01  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans-intrinsic.c (gfc_build_intrinsic_lib_fndecls): Resize
+	array quad_decls. Remove unnecessary assignment.
+
+2010-09-01  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans-expr.c (gfc_conv_power_op): Handle floating-point types
+	other than long double.
+	* mathbuiltins.def: Add builtins from the POW and CPOW family.
+	* trans.h (gfc_builtin_decl_for_float_kind): New prototype.
+	* trans-intrinsic.c (gfc_builtin_decl_for_float_kind): Add gfc_
+	prefix to function name.
+	(gfc_build_intrinsic_lib_fndecls): Add cpow prototype.
+	(gfc_conv_intrinsic_aint): Use gfc_builtin_decl_for_float_kind
+	function name.
+	(gfc_conv_intrinsic_exponent): Likewise.
+	(gfc_conv_intrinsic_abs): Likewise.
+	(gfc_conv_intrinsic_mod): Likewise.
+	(gfc_conv_intrinsic_sign): Likewise.
+	(gfc_conv_intrinsic_arith): Likewise.
+	(gfc_conv_intrinsic_fraction): Likewise.
+	(gfc_conv_intrinsic_nearest): Likewise.
+	(gfc_conv_intrinsic_spacing): Likewise.
+	(gfc_conv_intrinsic_rrspacing): Likewise.
+	(gfc_conv_intrinsic_scale): Likewise.
+	(gfc_conv_intrinsic_set_exponent): Likewise.
+
+2010-09-01  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* intrinsic.c: Add EXECUTE_COMMAND_LINE intrinsic.
+	* intrinsic.h (gfc_resolve_execute_command_line): New function.
+	* iresolve.c (gfc_resolve_execute_command_line): New function.
+	* gfortran.h (GFC_ISYM_EXECUTE_COMMAND_LINE): New value.
+	* intrinsic.texi: Document EXECUTE_COMMAND_LINE.
+
+2010-08-31  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/38282
+	* f95-lang.c (gfc_init_builtin_functions): Define popcount{,l,ll}
+	and parity{,l,ll} builtins.
+	* trans-intrinsic.c (gfc_conv_intrinsic_popcnt_poppar): New function.
+	(gfc_conv_intrinsic_function): Call above new functions.
+	* simplify.c (gfc_simplify_popcnt, gfc_simplify_poppar): New
+	functions.
+	* intrinsic.texi: Document POPCNT and POPPAR.
+
+2010-08-30  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45456
+	* resolve.c (resolve_structure_cons): Handle pointer-valued PPCs.
+
+2010-08-30  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* Make-lang.in: Add frontend-passes.o dependencies.
+
+2010-08-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42769
+	* resolve.c (resolve_structure_cons): For derived types, make sure the
+	type has been resolved.
+	(resolve_typebound_procedures): Make sure the vtab has been generated.
+
+2010-08-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45439
+	* match.c (gfc_match_select_type): Give the associate-name the
+	FL_VARIABLE attribute.
+
+2010-08-28  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* simplify.c (gfc_simplify_bessel_n2): Fix indention
+	and argument type.
+
+2010-08-28  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/45436
+	* trans-types.c (gfc_init_kinds): Disable TFmode.
+
+2010-08-27  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45432
+	* match.c (gfc_match_allocate): Avoid double free on error.
+
+2010-08-27  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32049
+	* gfortran.h (gfc_real_info): Add c_float128 field.
+	* mathbuiltins.def: Indicate which builtins are const.
+	* trans-types.h (float128_type_node, complex_float128_type_node,
+	gfc_real16_is_float128): New variables.
+	* trans-types.c (float128_type_node, complex_float128_type_node,
+	gfc_real16_is_float128): New variables.
+	(gfc_init_kinds): Allow TFmode.
+	(gfc_build_real_type): Mark __float128 types as such.
+	(gfc_init_types): Initialize float128_type_node and
+	complex_float128_type_node
+	* f95-lang.c (gfc_init_builtin_functions): Adjust for new
+	argument of OTHER_BUILTIN macro.
+	* trans-intrinsic.c (gfc_intrinsic_map_t): Likewise.
+	(builtin_decl_for_precision): Special case for __float128.
+	(builtin_decl_for_float_kind): Likewise.
+	(define_quad_builtin): New function.
+	(gfc_build_intrinsic_lib_fndecls): Create all __float128
+	library decls if necessary. Store them in the real16_decl and
+	complex16_decl builtin map fields.
+	(gfc_get_intrinsic_lib_fndecl): Handle q-suffixed __float128
+	library function names.
+
+2010-08-27  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33197
+	* gcc/fortran/intrinsic.c (add_functions): Add norm2 and parity.
+	* gcc/fortran/intrinsic.h (gfc_check_norm2, gfc_check_parity):
+	gfc_simplify_norm2, gfc_simplify_parity, gfc_resolve_norm2,
+	gfc_resolve_parity): New prototypes.
+	* gcc/fortran/gfortran.h (gfc_isym_id): New enum items
+	GFC_ISYM_NORM2 and GFC_ISYM_PARITY.
+	* gcc/fortran/iresolve.c (gfc_resolve_norm2,
+	gfc_resolve_parity): New functions.
+	* gcc/fortran/check.c (gfc_check_norm2, gfc_check_parity):
+	New functions.
+	* gcc/fortran/trans-intrinsic.c (gfc_conv_intrinsic_arith,
+	gfc_conv_intrinsic_function): Handle NORM2 and PARITY.
+	* gcc/fortran/intrinsic.texi (NORM2, PARITY): Add.
+	* gcc/fortran/simplify.c (simplify_transformation_to_array):
+	Add post-processing opterator.
+	(gfc_simplify_all, gfc_simplify_any, gfc_simplify_count,
+	gfc_simplify_product, gfc_simplify_sum): Update call.
+	(add_squared, do_sqrt, gfc_simplify_norm2, do_xor,
+	gfc_simplify_parity): New functions.
+
+2010-08-27  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45420
+	* match.c (select_type_set_tmp): Add the possibility to reset the
+	temporary to NULL.
+	(gfc_match_class_is): Reset the temporary in CLASS DEFAULT clauses.
+
+2010-08-27  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/45159
+	* dependency.c (check_section_vs_section):  Single test for
+	identical strides which takes into account that only one
+	of the strides may be NULL.
+
+2010-08-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/43217
+	* primary.c (match_hollerith_constant): Calculate padding needed to
+	fill default integer and allocate string for that size.  Set pad bytes
+	to ' '.
+	* gfortran.h: Add hollerith pad value to type spec union.
+	* data.c (create_character_initializer): Fix spelling of function name.
+	Use hollerith pad value to calculate length.
+	* arith.c (hollerith2representation); Use hollerith pad value to
+	calculate length.
+
+2010-08-26  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/38936
+	PR fortran/44047
+	PR fortran/45384
+	* gfortran.h (struct gfc_association_list): New flag `dangling'.
+	(gfc_build_block_ns): Declared here...
+	* parse.h (gfc_build_block_ns): ...instead of here.
+	* trans.h (gfc_process_block_locals): Expect additionally the
+	gfc_association_list of BLOCK (if present).
+	* match.c (select_type_set_tmp): Create sym->assoc for temporary.
+	* resolve.c (resolve_variable): Only check for invalid *array*
+	references on associate-names.
+	(resolve_assoc_var): New method with code previously in resolve_symbol.
+	(resolve_select_type): Use association to give the selector and
+	temporaries their values instead of ordinary assignment.
+	(resolve_fl_var_and_proc): Allow CLASS associate-names.
+	(resolve_symbol): Use new `resolve_assoc_var' instead of inlining here.
+	* trans-stmt.c (gfc_trans_block_construct): Pass association-list
+	to `gfc_process_block_locals' to match new interface.
+	* trans-decl.c (gfc_get_symbol_decl): Don't defer associate-names
+	here automatically.
+	(gfc_process_block_locals): Defer them rather here when linked to
+	from the BLOCK's association list.
+
+2010-08-25  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Set
+	TREE_NOTHROW on fndecls that can't throw.  Set
+	TREE_READONLY on gfor_fndecl_math_ishftc{4,8,16}.
+	(gfc_build_builtin_function_decls): Set TREE_NOTHROW on
+	gfor_fndecl_associated.
+
+2010-08-23  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/45380
+	* frontend-passes.c (optimize_equality): Don't optimize array equality
+
+2010-08-23  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45366
+	* resolve.c (resolve_procedure_interface): New function split off from
+	'resolve_symbol'.
+	(resolve_formal_arglist): Call it here ...
+	(resolve_symbol): ... and here.
+
+2010-08-22  Joseph Myers  <joseph@codesourcery.com>
+
+	* Make-lang.in (gfortranspec.o): Update dependencies.
+	* gfortranspec.c: Include coretypes.h before gcc.h.  Include
+	opts.h.
+	(MATH_LIBRARY, FORTRAN_LIBRARY): Remove initial "-l".
+	(ADD_ARG_LIBGFORTRAN, Option, lookup_option): Remove.
+	(g77_xargc): Make unsigned.
+	(g77_xargv): Change to g77_x_decoded_options.
+	(g77_newargc): Make unsigned.
+	(g77_newargv): Change to g77_new_decoded_options.
+	(strings_same, options_same): New.
+	(append_arg): Use cl_decoded_option structures.
+	(append_option): New.
+	(add_arg_libgfortran): New.
+	(lang_specific_driver): Use cl_decoded_option structures.
+
+2010-08-21  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45271
+	PR fortran/45290
+	* class.c (add_proc_comp): Add static initializer for PPCs.
+	(add_procs_to_declared_vtab): Modified comment.
+	* module.c (mio_component): Add argument 'vtype'. Don't read/write the
+	initializer if the component is part of a vtype.
+	(mio_component_list): Add argument 'vtype', pass it on to
+	'mio_component'.
+	(mio_symbol): Modified call to 'mio_component_list'.
+	* trans.h (gfc_conv_initializer): Modified prototype.
+	(gfc_trans_assign_vtab_procs): Removed.
+	* trans-common.c (create_common): Modified call to
+	'gfc_conv_initializer'.
+	* trans-decl.c (gfc_get_symbol_decl,get_proc_pointer_decl,
+	gfc_emit_parameter_debug_info): Modified call to
+	'gfc_conv_initializer'.
+	(build_function_decl): Remove assertion.
+	* trans-expr.c (gfc_conv_derived_to_class,gfc_trans_class_assign):
+	Removed call to 'gfc_trans_assign_vtab_procs'.
+	(gfc_conv_initializer): Add argument 'procptr'.
+	(gfc_conv_structure): Modified call to 'gfc_conv_initializer'.
+	(gfc_trans_assign_vtab_procs): Removed.
+	* trans-stmt.c (gfc_trans_allocate): Removed call to
+	'gfc_trans_assign_vtab_procs'.
+
+2010-08-21  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/36158
+	PR fortran/33197
+	* intrinsic.c (add_sym): Init value attribute.
+	(set_attr_value): New function.
+	(add_functions) Use it and add JN/YN resolvers.
+	* symbol.c (gfc_copy_formal_args_intr): Copy value attr.
+	* intrinsic.h (gfc_resolve_bessel_n2): New prototype.
+	* gfortran.h (gfc_intrinsic_arg): Add value attribute.
+	* iresolve.c (gfc_resolve_bessel_n2): New function.
+	* trans-intrinsic.c (gfc_get_symbol_for_expr): Create
+	formal arg list.
+	(gfc_conv_intrinsic_function,gfc_is_intrinsic_libcall):
+	Add GFC_ISYM_JN2/GFC_ISYM_YN2 as case value.
+	* simplify.c (): For YN set to -INF if previous values
+	was -INF.
+	* trans-expr.c (gfc_conv_procedure_call): Don't crash
+	if sym->as is NULL.
+	* iresolve.c (gfc_resolve_extends_type_of): Set the
+	type of the dummy argument to the one of the actual.
+
+2010-08-20  Joseph Myers  <joseph@codesourcery.com>
+
+	* lang.opt (MD, MMD): Use NoDriverArg instead of NoArgDriver.
+
+2010-08-20  Joseph Myers  <joseph@codesourcery.com>
+
+	* gfortranspec.c (lang_specific_driver): Refer to -lgfortran in
+	comment, not -lg2c.
+
+2010-08-20  Nathan Froyd  <froydnj@codesourcery.com>
+
+	* trans-openmp.c: Use FOR_EACH_VEC_ELT.
+
+2010-08-19  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/29785
+	PR fortran/45016
+	* trans.h (struct gfc_se): New flag `byref_noassign'.
+	* trans-array.h (gfc_conv_shift_descriptor_lbound): New method.
+	(gfc_conv_array_extent_dim), (gfc_conv_descriptor_size): New methods.
+	* expr.c (gfc_check_pointer_assign): Allow bounds and rank remapping
+	and check for compile-time errors with those.
+	* trans-decl.c (trans_associate_var): Use new routine
+	`gfc_conv_shift_descriptor_lbound' instead of doing it manually.
+	* trans-array.c (gfc_conv_shift_descriptor_lbound): New method.
+	(gfc_conv_array_extent_dim), (gfc_conv_descriptor_size): New methods.
+	(gfc_array_init_size): Use new `gfc_conv_array_extent_dim'.
+	(gfc_conv_expr_descriptor): Handle new flag `byref_noassign'.
+	* trans-expr.c (gfc_trans_pointer_assignment): Handle bounds and
+	rank remapping for assignment.
+
+2010-08-19  Tobias Burnus  <burnus@net-b.de>
+
+	* intrinsic.texi (Bessel_jn, Bessel_yn): Fix typo.
+	* * simplify.c (gfc_simplify_bessel_yn): Change recursive
+	into recurrence.
+
+2010-08-19  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/36158
+	PR fortran/33197
+	* check.c (gfc_check_bessel_n2): New function.
+	* gfortran.h (gfc_isym_id): Add GFC_ISYM_JN2 and GFC_ISYM_YN2.
+	* intrinsic.c (add_functions): Add transformational version
+	of the Bessel_jn/yn intrinsics.
+	* intrinsic.h (gfc_check_bessel_n2,gfc_simplify_bessel_jn2,
+	gfc_simplify_bessel_yn2): New prototypes.
+	* intrinsic.texi (Bessel_jn, Bessel_yn): Document
+	transformational variant.
+	* simplify.c (gfc_simplify_bessel_jn, gfc_simplify_bessel_yn):
+	Check for negative order.
+	(gfc_simplify_bessel_n2,gfc_simplify_bessel_jn2,
+	gfc_simplify_bessel_yn2): New functions.
+
+2010-08-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/41859
+	* resolve.c (resolve_transfer): Traverse operands and set expression
+	to be checked to a non EXPR_OP type.
+
+2010-08-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45290
+	* gfortran.h (gfc_add_save): Modified prototype.
+	* decl.c (add_init_expr_to_sym): Defer checking of proc pointer init.
+	(match_pointer_init): New function to match F08 pointer initialization.
+	(variable_decl,match_procedure_decl,match_ppc_decl): Use
+	'match_pointer_init'.
+	(match_attr_spec): Module variables are implicitly SAVE.
+	(gfc_match_save): Modified call to 'gfc_add_save'.
+	* expr.c (gfc_check_assign_symbol): Extra checks for pointer
+	initialization.
+	* primary.c (gfc_variable_attr): Handle SAVE attribute.
+	* resolve.c (resolve_structure_cons): Add new argument and do pointer
+	initialization checks.
+	(gfc_resolve_expr): Modified call to 'resolve_structure_cons'.
+	(resolve_values): Call 'resolve_structure_cons' directly with init arg.
+	(resolve_fl_variable): Handle SAVE_IMPLICIT.
+	* symbol.c (gfc_add_save,gfc_copy_attr,save_symbol): Handle
+	SAVE_IMPLICIT.
+	* trans-decl.c (gfc_create_module_variable): Module variables with
+	TARGET can already exist.
+	* trans-expr.c (gfc_conv_variable): Check for 'current_function_decl'.
+	(gfc_conv_initializer): Implement non-NULL pointer
+	initialization.
+
+2010-08-18  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45295
+	* intrinsic.texi (selected_char_kind): Document ISO_10646
+	support.
+
+2010-08-17  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/45304
+	* trans-decl.c (build_library_function_decl_1): Chain on
+	void_list_node instead of creating a new TREE_LIST.
+	* trans-intrinsic.c (gfc_get_intrinsic_lib_fndecl): Likewise.
+	* trans-types.c (gfc_get_function_type): Likewise.  Set
+	typelist to void_list_node for the main program.
+
+2010-08-17  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/38936
+	* gfortran.h (struct gfc_association_list): New member `where'.
+	(gfc_is_associate_pointer) New method.
+	* match.c (gfc_match_associate): Remember locus for each associate
+	name matched and do not try to set variable flag.
+	* parse.c (parse_associate): Use remembered locus for symbols.
+	* primary.c (match_variable): Instead of variable-flag check for
+	associate names set it for all such names used.
+	* symbol.c (gfc_is_associate_pointer): New method.
+	* resolve.c (resolve_block_construct): Don't generate assignments
+	to give associate-names their values.
+	(resolve_fl_var_and_proc): Allow associate-names to be deferred-shape.
+	(resolve_symbol): Set some more attributes for associate variables,
+	set variable flag here and check it and don't try to build an
+	explicitely shaped array-spec for array associate variables.
+	* trans-expr.c (gfc_conv_variable): Dereference in case of association
+	to scalar variable.
+	* trans-types.c (gfc_is_nodesc_array): Handle array association symbols.
+	(gfc_sym_type): Return pointer type for association to scalar vars.
+	* trans-decl.c (gfc_get_symbol_decl): Defer association symbols.
+	(trans_associate_var): New method.
+	(gfc_trans_deferred_vars): Handle association symbols.
+
+2010-08-16  Joseph Myers  <joseph@codesourcery.com>
+
+	* lang.opt (MDX): Change back to MD.  Mark NoDriverArg instead of
+	RejectDriver.
+	(MMDX): Change back to MMD.  Mark NoDriverArg instead of
+	RejectDriver.
+	* cpp.c (gfc_cpp_handle_option): Use OPT_MD and OPT_MMD instead of
+	OPT_MDX and OPT_MMDX.
+
+2010-08-16  Joseph Myers  <joseph@codesourcery.com>
+
+	* lang.opt (MDX, MMDX): Mark RejectDriver.
+
+2010-08-15  Janus Weil  <janus@gcc.gnu.org>
+
+	* trans-expr.c (gfc_trans_assign_vtab_procs): Clean up (we don't have
+	vtabs for generics any more).
+
+2010-08-15  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/38936
+	* gfortran.h (gfc_find_proc_namespace): New method.
+	* expr.c (gfc_build_intrinsic_call): No need to build symtree messing
+	around with namespace.
+	* symbol.c (gfc_find_proc_namespace): New method.
+	* trans-decl.c (gfc_build_qualified_array): Use it for correct
+	value of nest.
+	* primary.c (gfc_match_varspec): Handle associate-names as arrays.
+	* parse.c (parse_associate): Removed assignment-generation here...
+	* resolve.c (resolve_block_construct): ...and added it here.
+	(resolve_variable): Handle names that are arrays but were not parsed
+	as such because of association.
+	(resolve_code): Fix BLOCK resolution.
+	(resolve_symbol): Generate array-spec for associate-names.
+
+2010-08-15  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45211
+	* decl.c (verify_c_interop_param): Remove superfluous space (" ").
+	(verify_c_interop): Handle unresolved DT with bind(C).
+
+2010-08-15  Tobias Burnus  <burnus@net-b.de>
+
+	* trans-expr.c (gfc_conv_expr_present): Regard nullified
+	pointer arrays as absent.
+	(gfc_conv_procedure_call): Handle EXPR_NULL for non-pointer
+	dummys as absent argument.
+	* interface.c (compare_actual_formal,compare_parameter):
+	Ditto.
+
+2010-08-15  Tobias Burnus  <burnus@net-b.de>
+
+	* interface.c (compare_pointer, ): Allow passing TARGETs to pointers
+	dummies with intent(in).
+
+2010-08-15  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/45197
+	* decl.c (gfc_match_prefix): Match IMPURE prefix and mark ELEMENTAL
+	routines not IMPURE also as PURE.
+	* intrinsic.c (enum klass): New class `CLASS_PURE' and renamed
+	`NO_CLASS' in `CLASS_IMPURE'.
+	(add_sym): Set symbol-attributes `pure' and `elemental' correctly.
+	(add_sym_0s): Renamed `NO_CLASS' in `CLASS_IMPURE'.
+	(add_functions): Ditto.
+	(add_subroutines): Ditto and mark `MOVE_ALLOC' as CLASS_PURE.
+	* resolve.c (gfc_pure): Do not treat ELEMENTAL as automatically PURE.
+	(resolve_formal_arglist): Check that arguments to ELEMENTAL procedures
+	are not ALLOCATABLE and have their INTENT specified.
+
+2010-08-13  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.h (array_type): New type `AS_IMPLIED_SHAPE'.
+	* array.c (gfc_match_array_spec): Match implied-shape specification and
+	handle AS_IMPLIED_SHAPE correctly otherwise.
+	* decl.c (add_init_expr_to_sym): Set upper bounds for implied-shape.
+	(variable_decl): Some checks for implied-shape declaration.
+	* resolve.c (resolve_symbol): Assert that array-spec is no longer
+	AS_IMPLIED_SHAPE in any case.
+
+2010-08-12  Joseph Myers  <joseph@codesourcery.com>
+
+	* lang.opt (MD, MMD): Change to MDX and MMDX.
+	* cpp.c (gfc_cpp_handle_option): Use OPT_MMD and OPT_MMDX.
+
+2010-08-11  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44595
+	* intrinsic.c (gfc_current_intrinsic_arg): Change type from 'char' to
+	'gfc_intrinsic_arg'.
+	(check_arglist,check_specific): Add reference to 'name' field.
+	(init_arglist): Remove reference to 'name' field.
+	* intrinsic.h (gfc_current_intrinsic_arg): Modify prototype.
+	* check.c (variable_check): Reverse order of checks. Respect intent of
+	formal arg.
+	(int_or_proc_check): New function.
+	(coarray_check): New function.
+	(allocatable_check): New function.
+	(gfc_check_allocated,gfc_check_move_alloc): Use 'allocatable_check'.
+	(gfc_check_complex): Use 'int_or_real_check'.
+	(gfc_check_lcobound,gfc_check_image_index,gfc_check_this_image,
+	gfc_check_ucobound): Use 'coarray_check'.
+	(gfc_check_pack): Use 'real_or_complex_check'.
+	(gfc_check_alarm_sub,gfc_check_signal,gfc_check_signal_sub): Use
+	'int_or_proc_check'.
+	(scalar_check,type_check,numeric_check,int_or_real_check,
+	real_or_complex_check,kind_check,double_check,logical_array_check,
+	array_check,same_type_check,rank_check,nonoptional_check,
+	kind_value_check,gfc_check_a_p,gfc_check_associated,gfc_check_cmplx,
+	gfc_check_cshift,gfc_check_dcmplx,gfc_check_dot_product,gfc_check_dprod,
+	gfc_check_eoshift,gfc_check_fn_rc2008,gfc_check_index,gfc_check_kind,
+	gfc_check_matmul,gfc_check_minloc_maxloc,check_reduction,gfc_check_null,
+	gfc_check_present,gfc_check_reshape,gfc_check_same_type_as,
+	gfc_check_spread,gfc_check_unpack,gfc_check_random_seed,
+	gfc_check_getarg,gfc_check_and,gfc_check_storage_size): Add reference
+	to 'name' field.
+
+2010-08-10  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.texi (Interoperability with C): Fix ordering in menu
+	and add new subsection about pointers.
+	(Interoperable Subroutines and Functions): Split off the pointer part.
+	(working with Pointers): New subsection with extended discussion
+	of pointers (especially procedure pointers).
+
+2010-08-09  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/44235
+	* array.c (gfc_ref_dimen_size):  Add end argument.
+	If end is non-NULL, calculate it.
+	(ref_size):  Adjust call to gfc_ref_dimen_size.
+	(gfc_array_dimen_size):  Likewise.
+	(gfc_array_res_shape):  Likewise.
+	* gfortran.h:  Adjust prototype for gfc_ref_dimen_size.
+	* resolve.c (resolve_array_ref):  For stride not equal to -1,
+	fill in the lowest possible end.
+
+2010-08-09  Janus Weil  <janus@gcc.gnu.org>
+
+	* intrinsic.texi: Correct documentation of ASINH, ACOSH and ATANH.
+
+2010-08-07  Nathan Froyd  <froydnj@codesourcery.com>
+
+	* interface.c (compare_actual_formal): Use XALLOCAVEC instead of
+	alloca.
+	(check_some_aliasing): Likewise.
+	* trans-intrinsic.c (gfc_conv_intrinsic_conversion): Likewise.
+	(gfc_conv_intrinsic_int): Likewise.
+	(gfc_conv_intrinsic_lib_function): Likewise.
+	(gfc_conv_intrinsic_cmplx): Likewise.
+	(gfc_conv_intrinsic_ctime): Likewise.
+	(gfc_conv_intrinsic_fdate): Likewise.
+	(gfc_conv_intrinsic_ttynam): Likewise.
+	(gfc_conv_intrinsic_minmax): Likewise.
+	(gfc_conv_intrinsic_minmax_char): Likewise.
+	(gfc_conv_intrinsic_ishftc): Likewise.
+	(gfc_conv_intrinsic_index_scan_verify): Likewise.
+	(gfc_conv_intrinsic_merge): Likewise.
+	(gfc_conv_intrinsic_trim): Likewise.
+	* trans.c (gfc_trans_runtime_error_vararg): Likewise.
+
+2010-08-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/45159
+	* dependency.c (check_section_vs_section):  Handle cases where
+	the start expression coincides with the lower or upper
+	bound of the array.
+
+2010-08-04  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42207
+	PR fortran/44064
+	PR fortran/44065
+	* class.c (gfc_find_derived_vtab): Do not generate vtabs for class
+	container types. Do not artificially increase refs. Commit symbols one
+	by one.
+	* interface.c (compare_parameter): Make sure vtabs are present before
+	generating module variables.
+	* resolve.c (resolve_allocate_expr): Ditto.
+
+2010-08-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45183
+	PR fortran/44857
+	* resolve.c (resolve_structure_cons): Fix
+	freeing of charlen.
+
+2010-08-04  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/42051
+	PR fortran/44064
+	* symbol.c (changed_syms): Made static again.
+	(gfc_symbol_state): Don't conditionalize on GFC_DEBUG.
+	Changed conditional internal error into assert.
+	Rename function to ...
+	(gfc_enforce_clean_symbol_state): ... this.
+	* gfortran.h (gfc_symbol_state, gfc_enforce_clean_symbol_state):
+	Rename the former to the latter.
+	* parse.c (decode_statement, decode_omp_directive,
+	decode_gcc_attribute): Update callers accordingly. Don't conditionalize
+	on GFC_DEBUG.
+	(changed_syms): Remove declaration.
+	(next_statement): Use gfc_enforce_clean_symbol_state.
+
+2010-08-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/44857
+	* resolve.c (resolve_structure_cons): Fix handling of
+	initialization structure constructors with character
+	elements of the wrong length.
+	* array.c (gfc_check_iter_variable): Add NULL check.
+	(gfc_resolve_character_array_constructor): Also truncate
+	character length.
+
+2010-08-04  Tobias Burnus  <burnus@net-b.de>
+
+	* trans-io.c (gfc_build_io_library_fndecls): Fix return
+	value of some libgfortran functions.
+
+2010-08-03  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/45159
+	* dependency.c (gfc_deb_compare_expr):  Remove any integer
+	conversion functions to larger types from both arguments.
+	Remove handling these functions futher down.
+
+2010-08-03  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44584
+	PR fortran/45161
+	* class.c (add_procs_to_declared_vtab1): Don't add erroneous procedures.
+	* resolve.c (resolve_tb_generic_targets): Check for errors.
+
+2010-08-02  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/45159
+	* depencency.c (gfc_dep_resolver):  Fix logic for when a loop
+	can be reversed.
+
+2010-08-02  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/36854
+	* dependency.h:  Add prototype for gfc_are_identical_variables.
+	* frontend-passes.c:  Include depencency.h.
+	(optimimize_equality):  Use gfc_are_identical_variables.
+	* dependency.c (identical_array_ref): New function.
+	(gfc_are_identical_variables):  New function.
+	(gfc_deb_compare_expr):  Use gfc_are_identical_variables.
+	* dependency.c (gfc_check_section_vs_section).  Rename gfc_
+	prefix from statc function.
+	(check_section_vs_section): Change arguments to gfc_array_ref,
+	adjust function body accordingly.
+
+2010-08-02  Mikael Morin  <mikael@gcc.gnu.org>
+	    Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42051
+	PR fortran/44064
+	PR fortran/45151
+	* intrinsic.c (gfc_get_intrinsic_sub_symbol): Commit changed symbol.
+	* symbol.c (gen_cptr_param, gen_fptr_param, gen_shape_param,
+	gfc_copy_formal_args, gfc_copy_formal_args_intr,
+	gfc_copy_formal_args_ppc, generate_isocbinding_symbol): Ditto.
+	* parse.c (parse_derived_contains, parse_spec, parse_progunit):
+	Call reject_statement in case of error.
+	(match_deferred_characteritics): Call gfc_undo_symbols in case match
+	fails.
+
+2010-08-01  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44912
+	* class.c (gfc_build_class_symbol): Make '$vptr' component private.
+	(gfc_find_derived_vtab): Make vtabs and vtypes public.
+	* module.c (read_module): When reading module files, always import
+	vtab and vtype symbols.
+
+2010-07-31  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/42051
+	PR fortran/44064
+	* symbol.c (changed_syms): Made non-static.
+	* parse.c (changed_syms): Declare new external.
+	(next_statement): Assert changed_syms is NULL at the beginning.
+
+2010-07-30  Janus Weil  <janus@gcc.gnu.org>
+	    Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/44929
+	* match.c (match_type_spec): Try to parse derived types before
+	intrinsic types.
+
+2010-07-30  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* gfortran.h (gfc_release_symbol): New prototype.
+	* symbol.c (gfc_release_symbol): New. Code taken from free_sym_tree.
+	(gfc_undo_symbols, free_sym_tree, gfc_free_finalizer):
+	Use gfc_release_symbol.
+	* parse.c (gfc_fixup_sibling_symbols): Ditto.
+	* resolve.c (resolve_symbol): Ditto.
+
+2010-07-29  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45087
+	PR fortran/45125
+	* trans-decl.c (gfc_get_extern_function_decl): Correctly handle
+	external procedure declarations in modules.
+	(gfc_get_symbol_decl): Modify assert.
+
+2010-07-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44962
+	* resolve.c (resolve_fl_derived): Call gfc_resolve_array_spec.
+
+2010-07-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/45004
+	* trans-stmt.h (gfc_trans_class_init_assign): New prototype.
+	(gfc_trans_class_assign): Modified prototype.
+	* trans.h (gfc_conv_intrinsic_move_alloc): New prototype.
+	* trans-expr.c (gfc_trans_class_init_assign): Split off from ...
+	(gfc_trans_class_assign): ... here. Modified actual arguments.
+	* trans-intrinsic.c (gfc_conv_intrinsic_move_alloc): New function to
+	handle the MOVE_ALLOC intrinsic with scalar and class arguments.
+	* trans.c (trans_code): Call 'gfc_conv_intrinsic_move_alloc'.
+
+2010-07-29  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/42051
+	PR fortran/44064
+	* class.c (gfc_find_derived_vtab): Accept or discard newly created
+	symbols before returning.
+
+2010-07-29  Joseph Myers  <joseph@codesourcery.com>
+
+	* lang.opt (cpp): Remove Joined and Separate markers.
+	(cpp=): New internal option.
+	* lang-specs.h (F951_CPP_OPTIONS): Generate -cpp= option.
+	* cpp.c (gfc_cpp_handle_option): Handle OPT_cpp_ instead of
+	OPT_cpp.
+
+2010-07-29  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/45117
+	* array.c (resolve_array_bound): Fix error message to properly handle
+	non-variable expressions.
+
+2010-07-28  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* decl.c (free_value): Also free repeat field.
+	* data.c (gfc_assign_data_value): Always free offset before returning.
+
+2010-07-28  Daniel Kraft  <d@domob.eu>
+
+	* gfortran.h (gfc_build_intrinsic_call): New method.
+	* expr.c (gfc_build_intrinsic_call): New method.
+	* simplify.c (range_check): Ignore non-constant value.
+	(simplify_bound_dim): Handle non-variable expressions and
+	fix memory leak with non-free'ed expression.
+	(simplify_bound): Handle non-variable expressions.
+	(gfc_simplify_shape): Ditto.
+	(gfc_simplify_size): Ditto, but only in certain cases possible.
+
+2010-07-28  Joseph Myers  <joseph@codesourcery.com>
+
+	* gfortranspec.c (SWITCH_TAKES_ARG, WORD_SWITCH_TAKES_ARG):
+	Remove.
+
+2010-07-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45077
+	* trans-types.c (gfc_get_derived_type): Fix DT declaration
+	from modules for whole-file mode.
+
+2010-07-27  Joseph Myers  <joseph@codesourcery.com>
+
+	* gfortran.h (gfc_handle_option): Update prototype and return
+	value type.
+	* options.c (gfc_handle_option): Update prototype and return value
+	type.
+
+2010-07-27  Joseph Myers  <joseph@codesourcery.com>
+
+	* cpp.c (gfc_cpp_init_options): Update prototype.  Use number of
+	decoded options in allocating deferred_opt.
+	* cpp.h (gfc_cpp_init_options): Update prototype.
+	* f95-lang.c (LANG_HOOKS_OPTION_LANG_MASK): Define.
+	* gfortran.h (gfc_option_lang_mask): New.
+	(gfc_init_options): Update prototype.
+	* options.c (gfc_option_lang_mask): New.
+	(gfc_init_options): Update prototype.  Pass new arguments to
+	gfc_cpp_init_options.
+
+2010-07-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40873
+	* trans-decl.c (gfc_get_extern_function_decl): Fix generation
+	for functions which are later in the same file.
+	(gfc_create_function_decl, build_function_decl,
+	build_entry_thunks): Add global argument.
+	* trans.c (gfc_generate_module_code): Update
+	gfc_create_function_decl call.
+	* trans.h (gfc_create_function_decl): Update prototype.
+	* resolve.c (resolve_global_procedure): Also resolve for
+	IFSRC_IFBODY.
+
+2010-07-26  Richard Henderson  <rth@redhat.com>
+
+	PR target/44132
+	* f95-lang.c (LANG_HOOKS_WRITE_GLOBALS): New.
+	(gfc_write_global_declarations): New.
+
+2010-07-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45066
+	* trans-io.c (build_dt): Use NULL_TREE rather than NULL
+	for call to transfer_namelist_element.
+	* trans-decl.c (gfc_get_symbol_decl): Also set sym->backend_decl
+	for -fwhole-file.
+
+2010-07-25  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/40628
+	* Make-lang.in:  Add fortran/frontend-passes.o.
+	* gfortran.h:  Add prototype for gfc_run_passes.
+	* resolve.c (gfc_resolve):  Call gfc_run_passes.
+	* frontend-passes.c:  New file.
+
+2010-07-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/42852
+	* scanner.c (gfc_next_char_literal): Enable truncation warning for
+	free-form '&'.
+
+2010-07-25  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/44660
+	* gfortran.h (gfc_namespace): New field old_equiv.
+	(gfc_free_equiv_until): New prototype.
+	* match.c (gfc_free_equiv_until): New, renamed from gfc_free_equiv with
+	a parameterized stop condition.
+	(gfc_free_equiv): Use gfc_free_equiv_until.
+	* parse.c (next_statement): Save equivalence list.
+	(reject_statement): Restore equivalence list.
+
+2010-07-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/42852
+	* scanner.c (gfc_next_char_literal): Move check for truncation earlier
+	in the function so that it does not get missed by early exits.
+	(load_line): Add checks for quoted strings and free form comments to
+	disable warnings on comments. Add check for ampersand as first
+	character after truncation and don't warn for this case, but warn if
+	there are subsequent non-whitespace characters.
+
+2010-07-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40011
+	* parse.c (gfc_parse_file): Do not override
+	gfc_global_ns_list items.
+
+2010-07-24  Tobias Burnus  <burnus@net-b.de>
+
+	* options.c (gfc_init_options): Enable -fwhole-file by default.
+	* interface.c (compare_parameter): Assume a Hollerith constant is
+	compatible with all other argument types.
+
+2010-07-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/44945
+	* trans-decl.c (gfc_get_symbol_decl): Use module decl with
+	-fwhole-file also for derived types.
+	* trans-types.c (copy_dt_decls_ifequal): Remove static and
+	rename to gfc_copy_dt_decls_ifequal.
+	(gfc_get_derived_type): Update call.
+	* trans-types.h (gfc_copy_dt_decls_ifequal): Add prototype.
+
+2010-07-23  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45030
+	* resolve.c (resolve_global_procedure): Properly handle ENTRY.
+
+2010-07-23  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-types.c (gfc_get_array_descriptor_base,
+	gfc_get_array_type_bounds): Set TYPE_NAMELESS.
+	* trans-decl.c (gfc_build_qualified_array): Set DECL_NAMELESS
+	instead of clearing DECL_NAME.
+	(gfc_build_dummy_array_decl): Set DECL_NAMELESS.
+
+2009-07-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24524
+	* trans-array.c (gfc_init_loopinfo): Initialize the reverse
+	field.
+	gfc_trans_scalarized_loop_end: If reverse set in dimension n,
+	reverse the scalarization loop.
+	gfc_conv_resolve_dependencies: Pass the reverse field of the
+	loopinfo to gfc_dep_resolver.
+	trans-expr.c (gfc_trans_assignment_1): Enable loop reversal for
+	assignment by resetting loop.reverse.
+	gfortran.h : Add the gfc_reverse enum.
+	trans.h : Add the reverse field to gfc_loopinfo.
+	dependency.c (gfc_check_dependency): Pass null to the new arg
+	of gfc_dep_resolver.
+	(gfc_check_section_vs_section): Check for reverse dependencies.
+	(gfc_dep_resolver): Add reverse argument and deal with the loop
+	reversal logic.
+	dependency.h : Modify prototype for gfc_dep_resolver to include
+	gfc_reverse *.
+
+2010-07-23  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/44709
+	* gfortran.h (gfc_find_symtree_in_proc): New method.
+	* symbol.c (gfc_find_symtree_in_proc): New method.
+	* match.c (match_exit_cycle): Look for loop name also in parent
+	namespaces within current procedure.
+
+2010-07-22  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/45019
+	* dependency.c (gfc_check_dependency): Add argument alising check.
+	* symbol.c (gfc_symbols_could_alias): Add argument alising check.
+
+2010-07-22  Daniel Kraft  <d@domob.eu>
+
+	* trans-stmt.c (gfc_trans_return): Put back in the handling of se.post,
+	now in the correct place.
+
+2010-07-21  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/44929
+	* Revert my commit r162325.
+
+2010-07-21  Daniel Kraft  <d@domob.eu>
+
+	* trans.h (gfc_get_return_label): Removed.
+	(gfc_generate_return): New method.
+	(gfc_trans_deferred_vars): Update gfc_wrapped_block rather than
+	returning a tree directly.
+	* trans-stmt.c (gfc_trans_return): Use `gfc_generate_return'.
+	(gfc_trans_block_construct): Update for new interface to
+	`gfc_trans_deferred_vars'.
+	* trans-decl.c (current_function_return_label): Removed.
+	(current_procedure_symbol): New variable.
+	(gfc_get_return_label): Removed.
+	(gfc_trans_deferred_vars): Update gfc_wrapped_block rather than
+	returning a tree directly.
+	(get_proc_result), (gfc_generate_return): New methods.
+	(gfc_generate_function_code): Clean up and do init/cleanup here
+	also with gfc_wrapped_block.  Remove return-label but rather
+	return directly.
+
+2010-07-19  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/44929
+	* fortran/match.c (match_type_spec): Check for derived type before
+	intrinsic types.
+
+2010-07-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/42385
+	* interface.c (matching_typebound_op): Add argument for the
+	return of the generic name for the procedure.
+	(build_compcall_for_operator): Add an argument for the generic
+	name of an operator procedure and supply it to the expression.
+	(gfc_extend_expr, gfc_extend_assign): Use the generic name in
+	calls to the above procedures.
+	* resolve.c (resolve_typebound_function): Catch procedure
+	component calls for CLASS objects, check that the vtable is
+	complete and insert the $vptr and procedure components, to make
+	the call.
+	(resolve_typebound_function): The same.
+	* trans-decl.c (gfc_trans_deferred_vars): Do not deallocate
+	an allocatable scalar if it is a result.
+
+2010-07-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/44353
+	* match.c (gfc_match_iterator): Reverted.
+
+2010-07-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/44353
+	* match.c (gfc_match_iterator): Remove error that iterator
+	cannot be INTENT(IN).
+
+2010-07-17  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-array.c (gfc_free_ss): Don't free beyond ss rank.
+	Access subscript through the "dim" field index.
+	(gfc_trans_create_temp_array): Access ss info through the "dim" field
+	index.
+	(gfc_conv_array_index_offset): Ditto.
+	(gfc_conv_loop_setup): Ditto.
+	(gfc_conv_expr_descriptor): Ditto.
+	(gfc_conv_ss_startstride): Ditto.  Update call to
+	gfc_conv_section_startstride.
+	(gfc_conv_section_startstride): Set values along the array dimension.
+	Get array dimension directly from the argument.
+
+2010-07-15  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans.h (gfc_string_to_single_character): New prototype.
+	* trans-expr.c (string_to_single_character): Renamed to ...
+	(gfc_string_to_single_character): ... this.  No longer static.
+	(gfc_conv_scalar_char_value, gfc_build_compare_string,
+	gfc_trans_string_copy): Adjust callers.
+	* config-lang.in (gtfiles): Add fortran/trans-stmt.c.
+	* trans-stmt.c: Include ggc.h and gt-fortran-trans-stmt.h.
+	(select_struct): Move to toplevel, add GTY(()).
+	(gfc_trans_character_select): Optimize SELECT CASE
+	with character length 1.
+
+2010-07-15  Nathan Froyd  <froydnj@codesourcery.com>
+
+	* f95-lang.c: Carefully replace TREE_CHAIN with DECL_CHAIN.
+	* trans-common.c: Likewise.
+	* trans-decl.c: Likewise.
+	* trans-types.c: Likewise.
+	* trans.c: Likewise.
+
+2010-07-15  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44936
+	* resolve.c (resolve_typebound_generic_call): Resolve generic
+	non-polymorphic type-bound procedure calls to the correct specific
+	procedure.
+	(resolve_typebound_subroutine): Remove superfluous code.
+
+2010-07-15  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/44709
+	* trans.h (struct gfc_wrapped_block): New struct.
+	(gfc_start_wrapped_block), (gfc_add_init_cleanup): New methods.
+	(gfc_finish_wrapped_block): New method.
+	(gfc_init_default_dt): Add new init code to block rather than
+	returning it.
+	* trans-array.h (gfc_trans_auto_array_allocation): Use gfc_wrapped_block
+	(gfc_trans_dummy_array_bias): Ditto.
+	(gfc_trans_g77_array): Ditto.
+	(gfc_trans_deferred_array): Ditto.
+	* trans.c (gfc_add_expr_to_block): Call add_expr_to_chain.
+	(add_expr_to_chain): New method based on old gfc_add_expr_to_block.
+	(gfc_start_wrapped_block), (gfc_add_init_cleanup): New methods.
+	(gfc_finish_wrapped_block): New method.
+	* trans-array.c (gfc_trans_auto_array_allocation): use gfc_wrapped_block
+	(gfc_trans_g77_array), (gfc_trans_dummy_array_bias): Ditto.
+	(gfc_trans_deferred_array): Ditto.
+	* trans-decl.c (gfc_trans_dummy_character): Ditto.
+	(gfc_trans_auto_character_variable), (gfc_trans_assign_aux_var): Ditto.
+	(init_intent_out_dt): Ditto.
+	(gfc_init_default_dt): Add new init code to block rather than
+	returning it.
+	(gfc_trans_deferred_vars): Use gfc_wrapped_block to collect all init
+	and cleanup code and put it all together.
+
+2010-07-15  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans.h (gfc_build_compare_string): Add CODE argument.
+	* trans-intrinsic.c (gfc_conv_intrinsic_strcmp): Pass OP to
+	gfc_build_compare_string.
+	* trans-expr.c (gfc_conv_expr_op): Pass CODE to
+	gfc_build_compare_string.
+	(string_to_single_character): Rename len variable to length.
+	(gfc_optimize_len_trim): New function.
+	(gfc_build_compare_string): Add CODE argument.  If it is EQ_EXPR
+	or NE_EXPR and one of the strings is string literal with LEN_TRIM
+	bigger than the length of the other string, they compare unequal.
+
+	PR fortran/40206
+	* trans-stmt.c (gfc_trans_character_select): Always use NULL for high
+	in CASE_LABEL_EXPR and use NULL for low for the default case.
+
+2010-07-14  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-array.c (gfc_conv_section_upper_bound): Remove
+	(gfc_conv_section_startstride): Don't set the upper bound in the
+	vector subscript case.
+	(gfc_conv_loop_setup): Don't use gfc_conv_section_upper_bound
+
+2010-07-14  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44925
+	* gfortran.h (gfc_is_data_pointer): Remove prototype.
+	* dependency.c (gfc_is_data_pointer): Make it static.
+	* intrinsic.texi: Update documentation on C_LOC.
+	* resolve.c (gfc_iso_c_func_interface): Fix pointer and target checks
+	and add a check for polymorphic variables.
+
+2010-07-14  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-expr.c (string_to_single_character): Also optimize
+	string literals containing a single char followed only by spaces.
+	(gfc_trans_string_copy): Remove redundant string_to_single_character
+	calls.
+
+	* trans-decl.c (gfc_build_intrinsic_function_decls,
+	gfc_build_builtin_function_decls): Mark functions as
+	DECL_PURE_P or TREE_READONLY.
+
+2010-07-13  Nathan Froyd  <froydnj@codesourcery.com>
+
+	* trans-decl.c (build_entry_thunks): Call build_call_expr_loc_vec
+	instead of build_function_call_expr.
+	* trans-intrinsic.c (gfc_conv_intrinsic_sr_kind): Likewise.
+
+2010-07-13  Tobias Burnus  <burnus@net-b.de>
+	    Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/43665
+	* trans.h (gfc_build_library_function_decl_with_spec): New prototype.
+	* trans-decl.c (gfc_build_library_function_decl_with_spec): Removed
+	static.
+	* trans-io (gfc_build_io_library_fndecls): Add "fn spec" annotations.
+
+2010-07-13  Daniel Franke  <franke.daniel@gmail.com>
+	    Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43665
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Add
+	noclobber/noescape annotations to function calls.
+	(gfc_build_builtin_function_decls): Likewise.
+
+2010-07-13  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44434
+	PR fortran/44565
+	PR fortran/43945
+	PR fortran/44869
+	* gfortran.h (gfc_find_derived_vtab): Modified prototype.
+	* class.c (gfc_build_class_symbol): Modified call to
+	'gfc_find_derived_vtab'.
+	(add_proc_component): Removed, moved code into 'add_proc_comp'.
+	(add_proc_comps): Renamed to 'add_proc_comp', removed treatment of
+	generics.
+	(add_procs_to_declared_vtab1): Removed unnecessary argument 'resolved'.
+	Removed treatment of generics.
+	(copy_vtab_proc_comps): Removed unnecessary argument 'resolved'.
+	Call 'add_proc_comp' instead of duplicating code.
+	(add_procs_to_declared_vtab): Removed unnecessary arguments 'resolved'
+	and 'declared'.
+	(add_generic_specifics,add_generics_to_declared_vtab): Removed.
+	(gfc_find_derived_vtab): Removed unnecessary argument 'resolved'.
+	Removed treatment of generics.
+	* iresolve.c (gfc_resolve_extends_type_of): Modified call to
+	'gfc_find_derived_vtab'.
+	* resolve.c (resolve_typebound_function,resolve_typebound_subroutine):
+	Removed treatment of generics.
+	(resolve_select_type,resolve_fl_derived): Modified call to
+	'gfc_find_derived_vtab'.
+	* trans-decl.c (gfc_get_symbol_decl): Ditto.
+	* trans-expr.c (gfc_conv_derived_to_class,gfc_trans_class_assign):
+	Ditto.
+	* trans-stmt.c (gfc_trans_allocate): Ditto.
+
+2010-07-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/37077
+	* trans-io.c (build_dt): Set common.unit to flag chracter(kind=4)
+	internal unit.
+
+2010-07-12  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* expr.c (gfc_get_int_expr): Don't initialize mpfr data twice.
+	* resolve.c (build_default_init_expr): Ditto.
+
+2010-07-11  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/44702
+	* module.c (sort_iso_c_rename_list): Remove.
+	(import_iso_c_binding_module,use_iso_fortran_env_module):
+	Allow multiple imports of the same symbol.
+
+2010-07-11  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* arith.c (gfc_arith_done_1): Release mpfr internal caches.
+
+2010-07-11  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44869
+	* decl.c (build_sym,attr_decl1): Only build the class container if the
+	symbol has sufficient attributes.
+	* expr.c (gfc_check_pointer_assign): Use class_pointer instead of
+	pointer attribute for classes.
+	* match.c (gfc_match_allocate,gfc_match_deallocate): Ditto.
+	* module.c (MOD_VERSION): Bump.
+	(enum ab_attribute,attr_bits): Add AB_CLASS_POINTER.
+	(mio_symbol_attribute): Handle class_pointer attribute.
+	* parse.c (parse_derived): Use class_pointer instead of pointer
+	attribute for classes.
+	* primary.c (gfc_variable_attr,gfc_expr_attr): Ditto.
+	* resolve.c (resolve_structure_cons,resolve_deallocate_expr,
+	resolve_allocate_expr,resolve_fl_derived): Ditto.
+	(resolve_fl_var_and_proc): Check for class_ok attribute.
+
+2010-07-10  Mikael Morin  <mikael@gcc.gnu.org>
+
+	* trans-io.c (gfc_build_st_parameter): Update calls to
+	gfc_add_field_to_struct.
+	* trans-stmt.c (ADD_FIELD): Ditto.
+	* trans-types.c
+	(gfc_get_derived_type): Ditto. Don't create backend_decl for C_PTR's
+	C_ADDRESS field.
+	(gfc_add_field_to_struct_1): Set TYPE_FIELDS(context) instead of
+	fieldlist, remove fieldlist from argument list.
+	(gfc_add_field_to_struct): Update call to gfc_add_field_to_struct_1
+	and remove fieldlist from argument list.
+	(gfc_get_desc_dim_type, gfc_get_array_descriptor_base,
+	gfc_get_mixed_entry_union): Move setting
+	TYPE_FIELDS to gfc_add_field_to_struct_1 and update calls to it.
+	* trans-types.h (gfc_add_field_to_struct): Update prototype.
+
+2010-07-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/44773
+	* trans-expr.c (arrayfunc_assign_needs_temporary): No temporary
+	if the lhs has never been host associated, as well as not being
+	use associated, a pointer or a target.
+	* resolve.c (resolve_variable): Mark variables that are host
+	associated.
+	* gfortran.h: Add the host_assoc bit to the symbol_attribute
+	structure.
+
+2010-07-09  Janus Weil  <janus@gcc.gnu.org>
+
+	* intrinsic.texi: Add documentation for SAME_TYPE_AS, EXTENDS_TYPE_OF,
+	STORAGE_SIZE, C_NULL_PTR and C_NULL_FUNPTR. Modify documentation of
+	SIZEOF and C_SIZEOF.
+
+2010-07-08  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44649
+	* gfortran.h (gfc_isym_id): Add GFC_ISYM_C_SIZEOF,GFC_ISYM_STORAGE_SIZE.
+	* intrinsic.h (gfc_check_c_sizeof,gfc_check_storage_size,
+	gfc_resolve_storage_size): New prototypes.
+	* check.c (gfc_check_c_sizeof,gfc_check_storage_size): New functions.
+	* intrinsic.c (add_functions): Add STORAGE_SIZE.
+	* iresolve.c (gfc_resolve_storage_size): New function.
+	* trans-intrinsic.c (gfc_conv_intrinsic_sizeof): Handle polymorphic
+	arguments.
+	(gfc_conv_intrinsic_storage_size): New function.
+	(gfc_conv_intrinsic_function): Handle STORAGE_SIZE.
+
+2010-07-08  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/44847
+	* match.c (match_exit_cycle): Error on EXIT also from collapsed
+	!$omp do loops.  Error on CYCLE to non-innermost collapsed
+	!$omp do loops.
+
+2010-07-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
+	* array.c (gfc_match_array_ref): Better error message for
+	coarrays with too few ranks.
+	(match_subscript): Move one diagnostic to caller.
+	* gfortran.h (gfc_get_corank): Add prottype.
+	* expr.c (gfc_get_corank): New function.
+	* iresolve.c (resolve_bound): Fix rank for cobounds.
+	(gfc_resolve_lbound,gfc_resolve_lcobound, gfc_resolve_ubound,
+	gfc_resolve_ucobound, gfc_resolve_this_image): Update
+	resolve_bound call.
+
+2010-07-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/44742
+	* array.c (gfc_expand_constructor): Add optional diagnostic.
+	* gfortran.h (gfc_expand_constructor): Update prototype.
+	* expr.c (gfc_simplify_expr, check_init_expr,
+	gfc_reduce_init_expr): Update gfc_expand_constructor call.
+	* resolve.c (gfc_resolve_expr): Ditto.
+
+2010-07-06  Tobias Burnus  <burnus@net-b.de>
+
+	* trans-decl.c: Include diagnostic-core.h besides toplev.h.
+	* trans-intrinsic.c: Ditto.
+	* trans-types.c: Ditto.
+	* convert.c: Include diagnostic-core.h instead of toplev.h.
+	* options.c: Ditto.
+	* trans-array.c: Ditto.
+	* trans-const.c: Ditto.
+	* trans-expr.c: Ditto.
+	* trans-io.c: Ditto.
+	* trans-openmp.c: Ditto.
+	* trans.c: Ditto.
+
+2010-07-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/PR44693
+	* check.c (dim_rank_check):  Also check intrinsic functions.
+	Adjust permissible rank for functions which reduce the rank of
+	their argument.  Spread is an exception, where DIM can
+	be one larger than the rank of array.
+
+2010-07-05  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/44797
+	* fortran/io.c (resolve_tag): Check EXIST tag is a default logical.
+
+2010-07-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/44596
+	* trans-types.c (gfc_get_derived_type): Derived type fields
+	with the vtype attribute must have TYPE_REF_CAN_ALIAS_ALL set
+	but build_pointer_type_for_mode must be used for this.
+
+2010-07-05  Nathan Froyd  <froydnj@codesourcery.com>
+
+	* trans.h (gfc_conv_procedure_call): Take a VEC instead of a tree.
+	* trans-intrinsic.c (gfc_conv_intrinsic_funcall): Adjust for new
+	type of gfc_conv_procedure_call.
+	(conv_generic_with_optional_char_arg): Likewise.
+	* trans-stmt.c (gfc_trans_call): Likewise.
+	* trans-expr.c (gfc_conv_function_expr): Likewise.
+	(gfc_conv_procedure_call): Use build_call_vec instead of
+	build_call_list.
+
+2010-07-04  Daniel Kraft  <d@domob.eu>
+
+	* gfc-internals.texi (gfc_code): Document BLOCK and ASSOCIATE.
+
+2010-07-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/44596
+	PR fortran/44745
+	* trans-types.c (gfc_get_derived_type): Derived type fields
+	with the vtype attribute must have TYPE_REF_CAN_ALIAS_ALL set.
+
+2010-07-02  Mikael Morin  <mikael@gcc.gnu.org>
+
+	PR fortran/44662
+	* decl.c (match_procedure_in_type): Clear structure before using.
+	(gfc_match_generic): Ditto.
+
+2010-07-02  Nathan Froyd  <froydnj@codesourcery.com>
+
+	* trans-types.h (gfc_add_field_to_struct): Add tree ** parameter.
+	* trans-types.c (gfc_add_field_to_struct_1): New function, most
+	of which comes from...
+	(gfc_add_field_to_struct): ...here.  Call it.  Add new parameter.
+	(gfc_get_desc_dim_type): Call gfc_add_field_to_struct_1 for
+	building fields.
+	(gfc_get_array_descriptor_base): Likewise.
+	(gfc_get_mixed_entry_union): Likewise.
+	(gfc_get_derived_type): Add extra chain parameter for
+	gfc_add_field_to_struct.
+	* trans-stmt.c (gfc_trans_character_select): Likewise.
+	* trans-io.c (gfc_build_st_parameter): Likewise.
+
+2010-06-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44718
+	* resolve.c (is_external_proc): Prevent procedure pointers from being
+	regarded as external procedures.
+
+2010-06-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44696
+	* trans-intrinsic.c (gfc_conv_associated): Handle polymorphic variables
+	passed as second argument of ASSOCIATED.
+
+2010-06-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/44582
+	* trans-expr.c (arrayfunc_assign_needs_temporary): New function
+	to determine if a function assignment can be made without a
+	temporary.
+	(gfc_trans_arrayfunc_assign): Move all the conditions that
+	suppress the direct function call to the above new functon and
+	call it.
+
+2010-06-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40158
+	* interface.c (argument_rank_mismatch): New function.
+	(compare_parameter): Call new function instead of generating
+	the error directly.
+
+2010-06-28  Nathan Froyd  <froydnj@codesourcery.com>
+
+	* trans-openmp.c (dovar_init): Define.  Define VECs containing it.
+	(gfc_trans_omp_do): Use a VEC to accumulate variables and their
+	initializers.
+
+2010-06-28  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* Make-lang.in: Update dependencies.
+
+2010-06-27  Nathan Froyd  <froydnj@codesourcery.com>
+
+	* gfortran.h (gfc_code): Split backend_decl field into cycle_label
+	and exit_label fields.
+	* trans-openmp.c (gfc_trans_omp_do): Assign to new fields
+	individually.
+	* trans-stmt.c (gfc_trans_simple_do): Likewise.
+	(gfc_trans_do): Likewise.
+	(gfc_trans_do_while): Likewise.
+	(gfc_trans_cycle): Use cycle_label directly.
+	(gfc_trans_exit): Use exit_label directly.
+
+2010-06-27  Daniel Kraft  <d@domob.eu>
+
+	* dump-parse-tree.c (show_symbol): Dump target-expression for
+	associate names.
+	(show_code_node): Make distinction between BLOCK and ASSOCIATE.
+	(show_namespace): Use show_level for correct indentation of
+	"inner namespaces" (contained procedures or BLOCK).
+
+2010-06-27  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/44678
+	* dump-parse-tree.c (show_code_node):  Show namespace for
+	EXEC_BLOCK.
+
+2010-06-26  Tobias Burnus  <burnus@net-b.de>
+
+	* decl.c (gfc_match_decl_type_spec): Support
+	TYPE(intrinsic-type-spec).
+
+2010-06-25  Tobias Burnus  <burnus@net-b.de>
+
+	* intrinsic.h (gfc_check_selected_real_kind,
+	gfc_simplify_selected_real_kind): Update prototypes.
+	* intrinsic.c (add_functions): Add radix support to
+	selected_real_kind.
+	* check.c (gfc_check_selected_real_kind): Ditto.
+	* simplify.c (gfc_simplify_selected_real_kind): Ditto.
+	* trans-decl.c (gfc_build_intrinsic_function_decls):
+	Change call from selected_real_kind to selected_real_kind2008.
+	* intrinsic.texi (SELECTED_REAL_KIND): Update for radix.
+	(PRECISION, RANGE, RADIX): Add cross @refs.
+
+2010-06-25  Tobias Burnus  <burnus@net-b.de>
+
+	* decl.c (gfc_match_entry): Mark ENTRY as GFC_STD_F2008_OBS.
+	* gfortran.texi (_gfortran_set_options): Update for
+	GFC_STD_F2008_OBS addition.
+	* libgfortran.h: Add GFC_STD_F2008_OBS.
+	* options.c (set_default_std_flags, gfc_handle_option): Handle
+	GFC_STD_F2008_OBS.
+	io.c (check_format): Fix allow_std check.
+
+2010-06-25  Tobias Burnus  <burnus@net-b.de>
+
+	* decl.c (gfc_match_entry): Allow END besides
+	END SUBROUTINE/END FUNCTION for contained procedures.
+
+2010-06-25  Tobias Burnus  <burnus@net-b.de>
+
+	* parse.c (next_free, next_fixed): Allow ";" as first character.
+
+2010-06-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/44614
+	* decl.c (variable_decl): Fix IMPORT diagnostic for CLASS.
+
+2010-06-22  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44616
+	* resolve.c (resolve_fl_derived): Avoid checking for abstract on class
+	containers.
+
+2010-06-21  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/40632
+	* interface.c (compare_parameter): Add gfc_is_simply_contiguous
+	checks.
+	* symbol.c (gfc_add_contiguous): New function.
+	(gfc_copy_attr, check_conflict): Handle contiguous attribute.
+	* decl.c (match_attr_spec): Ditto.
+	(gfc_match_contiguous): New function.
+	* resolve.c (resolve_fl_derived, resolve_symbol): Handle
+	contiguous.
+	* gfortran.h (symbol_attribute): Add contiguous.
+	(gfc_is_simply_contiguous): Add prototype.
+	(gfc_add_contiguous): Add prototype.
+	* match.h (gfc_match_contiguous): Add prototype.
+	* parse.c (decode_specification_statement,
+	decode_statement): Handle contiguous attribute.
+	* expr.c (gfc_is_simply_contiguous): New function.
+	* dump-parse-tree.c (show_attr): Handle contiguous.
+	* module.c (ab_attribute, attr_bits, mio_symbol_attribute):
+	Ditto.
+	* trans-expr.c (gfc_add_interface_mapping): Copy
+	attr.contiguous.
+	* trans-array.c (gfc_conv_descriptor_stride_get,
+	gfc_conv_array_parameter): Handle contiguous arrays.
+	* trans-types.c (gfc_build_array_type, gfc_build_array_type,
+	gfc_sym_type, gfc_get_derived_type, gfc_get_array_descr_info):
+	Ditto.
+	* trans.h (gfc_array_kind): Ditto.
+	* trans-decl.c (gfc_get_symbol_decl): Ditto.
+
+2010-06-20  Joseph Myers  <joseph@codesourcery.com>
+
+	* options.c (gfc_handle_option): Don't handle N_OPTS.
+
+2010-06-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44584
+	* resolve.c (resolve_fl_derived): Reverse ordering of conditions
+	to avoid ICE.
+
+2010-06-18  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/44556
+	* resolve.c (resolve_allocate_deallocate): Properly check
+	part-refs in stat=/errmsg= for invalid use.
+
+2010-06-17  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44558
+	* resolve.c (resolve_typebound_function,resolve_typebound_subroutine):
+	Return directly in case of an error.
+
+2010-06-16  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44549
+	* gfortran.h (gfc_get_typebound_proc): Modified Prototype.
+	* decl.c (match_procedure_in_type): Give a unique gfc_typebound_proc
+	structure to each procedure in a procedure list.
+	* module.c (mio_typebound_proc): Add NULL argument to
+	'gfc_get_typebound_proc'.
+	* symbol.c (gfc_get_typebound_proc): Add a new argument, which is used
+	to initialize the new structure.
+
+2010-06-15  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/43388
+	* gfortran.h (gfc_expr): Add new member 'mold'.
+	* match.c (gfc_match_allocate): Implement the MOLD tag.
+	* resolve.c (resolve_allocate_expr): Ditto.
+	* trans-stmt.c (gfc_trans_allocate): Ditto.
+
+2010-06-15  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/44536
+	* trans-openmp.c (gfc_omp_predetermined_sharing): Don't return
+	OMP_CLAUSE_DEFAULT_SHARED for artificial vars with
+	GFC_DECL_SAVED_DESCRIPTOR set.
+	(gfc_omp_report_decl): New function.
+	* trans.h (gfc_omp_report_decl): New prototype.
+	* f95-lang.c (LANG_HOOKS_OMP_REPORT_DECL): Redefine.
+
+2010-06-13  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31588
+	PR fortran/43954
+	* gfortranspec.c (lang_specific_driver): Removed deprecation
+	warning for -M.
+	* lang.opt: Add options -M, -MM, -MD, -MMD, -MF, -MG, -MP, -MT, -MQ.
+	* lang-specs.h (CPP_FORWARD_OPTIONS): Add -M* options.
+	* cpp.h (gfc_cpp_makedep): New.
+	(gfc_cpp_add_dep): New.
+	(gfc_cpp_add_target): New.
+	* cpp.c (gfc_cpp_option): Add deps* members.
+	(gfc_cpp_makedep): New.
+	(gfc_cpp_add_dep): New.
+	(gfc_cpp_add_target): New.
+	(gfc_cpp_init_options): Initialize new options.
+	(gfc_cpp_handle_option): Handle new options.
+	(gfc_cpp_post_options): Map new options to libcpp-options.
+	(gfc_cpp_init): Handle deferred -MQ and -MT options.
+	(gfc_cpp_done): If requested, write dependencies to file.
+	* module.c (gfc_dump_module): Add a module filename as target.
+	* scanner.c (open_included_file): New parameter system; add the
+	included file as dependency.
+	(gfc_open_included_file): Add the included file as dependency.
+	(gfc_open_intrinsic_module): Likewise.
+	* invoke.texi: Removed deprecation warning for -M.
+	* gfortran.texi: Removed Makefile-dependencies project.
+
+2010-06-12  Daniel Franke  <franke.daniel@gmail.com>
+
+        * resolve.c (resolve_global_procedure): Improved checking if an
+        explicit interface is required.
+
+2010-06-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans-decl.c (gfc_build_intrinsic_function_decls): Fix
+	return type.
+	* trans-intrinsic.c (gfc_conv_intrinsic_fdate): Fix argument type.
+	(gfc_conv_intrinsic_ttynam): Likewise.
+	(gfc_conv_intrinsic_trim): Likewise.
+
+2010-06-12  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40117
+	* decl.c (match_procedure_in_type): Allow procedure lists (F08).
+
+2010-06-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* trans-intrinsic.c (gfc_build_intrinsic_lib_fndecls): Fix comment.
+
+2010-06-11  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* mathbuiltins.def: Add builtins that do not directly correspond
+	to a Fortran intrinsic, with new macro OTHER_BUILTIN.
+	* f95-lang.c (gfc_init_builtin_functions): Define OTHER_BUILTIN.
+	* trans-intrinsic.c (gfc_intrinsic_map_t): Remove
+	code_{r,c}{4,8,10,16} fields. Add
+	{,complex}{float,double,long_double}_built_in fields.
+	(gfc_intrinsic_map): Adjust definitions of DEFINE_MATH_BUILTIN,
+	DEFINE_MATH_BUILTIN_C and LIB_FUNCTION accordingly. Add
+	definition of OTHER_BUILTIN.
+	(real_compnt_info): Remove unused struct.
+	(builtin_decl_for_precision, builtin_decl_for_float_kind): New
+	functions.
+	(build_round_expr): Call builtin_decl_for_precision instead of
+	series of if-else.
+	(gfc_conv_intrinsic_aint): Call builtin_decl_for_float_kind
+	instead of a switch.
+	(gfc_build_intrinsic_lib_fndecls): Match
+	{real,complex}{4,8,10,16}decl into the C-style built_in_decls.
+	(gfc_get_intrinsic_lib_fndecl): Do not hardcode floating-point
+	kinds.
+	(gfc_conv_intrinsic_lib_function): Go through all the extended
+	gfc_intrinsic_map.
+	(gfc_trans_same_strlen_check): Call builtin_decl_for_float_kind
+	instead of a switch.
+	(gfc_conv_intrinsic_abs): Likewise.
+	(gfc_conv_intrinsic_mod): Likewise.
+	(gfc_conv_intrinsic_sign): Likewise.
+	(gfc_conv_intrinsic_fraction): Likewise.
+	(gfc_conv_intrinsic_nearest): Likewise.
+	(gfc_conv_intrinsic_spacing): Likewise.
+	(gfc_conv_intrinsic_rrspacing): Likewise.
+	(gfc_conv_intrinsic_scale): Likewise.
+	(gfc_conv_intrinsic_set_exponent): Likewise.
+
+2010-06-11  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/42051
+	PR fortran/43896
+	* trans-expr.c (gfc_conv_derived_to_class): Handle array-valued
+	functions with CLASS formal arguments.
+
+2010-06-10  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44207
+	* resolve.c (conformable_arrays): Handle allocatable components.
+
+2010-06-10  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/38273
+	* gfortran.texi: Document that Cray pointers cannot be function
+	results.
+
+2010-06-10  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/36234
+	* gfortran.texi: Document lack of support for syntax
+	"complex FUNCTION name*16()", and existence of alternative
+	legacy syntax "complex*16 FUNCTION name()".
+
+2010-06-10  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/43032
+	* intrinsic.texi (FLUSH): Note the difference between FLUSH and
+	POSIX's fsync(), and how to call the latter from Fortran code.
+
+2010-06-10  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/44457
+	* interface.c (compare_actual_formal): Reject actual arguments with
+	array subscript passed to ASYNCHRONOUS dummys.
+
+2010-06-10  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/38936
+	* gfortran.h (enum gfc_statement): Add ST_ASSOCIATE, ST_END_ASSOCIATE.
+	(struct gfc_symbol): New field `assoc'.
+	(struct gfc_association_list): New struct.
+	(struct gfc_code): New struct `block' in union, move `ns' there
+	and add association list.
+	(gfc_free_association_list): New method.
+	(gfc_has_vector_subscript): Made public;
+	* match.h (gfc_match_associate): New method.
+	* parse.h (enum gfc_compile_state): Add COMP_ASSOCIATE.
+	* decl.c (gfc_match_end): Handle ST_END_ASSOCIATE.
+	* interface.c (gfc_has_vector_subscript): Made public.
+	(compare_actual_formal): Rename `has_vector_subscript' accordingly.
+	* match.c (gfc_match_associate): New method.
+	(gfc_match_select_type): Change reference to gfc_code's `ns' field.
+	* primary.c (match_variable): Don't allow names associated to expr here.
+	* parse.c (decode_statement): Try matching ASSOCIATE statement.
+	(case_exec_markers, case_end): Add ASSOCIATE statement.
+	(gfc_ascii_statement): Hande ST_ASSOCIATE and ST_END_ASSOCIATE.
+	(parse_associate): New method.
+	(parse_executable): Handle ST_ASSOCIATE.
+	(parse_block_construct): Change reference to gfc_code's `ns' field.
+	* resolve.c (resolve_select_type): Ditto.
+	(resolve_code): Ditto.
+	(resolve_block_construct): Ditto and add comment.
+	(resolve_select_type): Set association list in generated BLOCK to NULL.
+	(resolve_symbol): Resolve associate names.
+	* st.c (gfc_free_statement): Change reference to gfc_code's `ns' field
+	and free association list.
+	(gfc_free_association_list): New method.
+	* symbol.c (gfc_new_symbol): NULL new field `assoc'.
+	* trans-stmt.c (gfc_trans_block_construct): Change reference to
+	gfc_code's `ns' field.
+
+2010-06-10  Kai Tietz  <kai.tietz@onevision.com>
+
+	* error.c (error_print): Pre-initialize loc by NULL.
+	* openmp.c (resolve_omp_clauses): Add explicit
+	braces to avoid ambigous else.
+	* array.c (match_subscript): Pre-initialize m to MATCH_ERROR.
+
+2010-06-10  Gerald Pfeifer  <gerald@pfeifer.com>
+
+	* gfc-internals.texi: Move to GFDL 1.3.
+	* gfortran.texi: Ditto.
+	* intrinsic.texi: Ditto.
+	* invoke.texi: Ditto.
+
+2010-06-09  Daniel Franke  <franke.daniel@gmail.com>
+
+        PR fortran/44347
+        * check.c (gfc_check_selected_real_kind): Verify that the
+        actual arguments are scalar.
+
+2010-06-09  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/44359
+	* intrinsic.c (gfc_convert_type_warn): Further improve -Wconversion.
+
+2010-06-09  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44430
+	* dump-parse-tree.c (show_symbol): Avoid infinite loop.
+
+2010-06-09  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* fortran/symbol.c (check_conflict):  Remove an invalid conflict check.
+
+2010-06-09  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* fortran/intrinsic.c (add_functions): Change gfc_check_btest,
+	gfc_check_ibclr, and gfc_check_ibset to gfc_check_bitfcn.
+	* fortran/intrinsic.h: Remove prototypes for gfc_check_btest,
+	gfc_check_ibclr, and gfc_check_ibset.  Add prototype for
+	gfc_check_bitfcn.
+	* fortran/check.c (nonnegative_check, less_than_bitsize1, 
+	less_than_bitsize2): New functions.
+	(gfc_check_btest): Renamed to gfc_check_bitfcn.  Use
+	nonnegative_check and less_than_bitsize1.
+	(gfc_check_ibclr, gfc_check_ibset): Removed.
+	(gfc_check_ibits,gfc_check_mvbits): Use nonnegative_check and
+	less_than_bitsize1.
+
+2010-06-09  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44211
+	* resolve.c (resolve_typebound_function,resolve_typebound_subroutine):
+	Resolve references.
+
+2010-06-09  Kai Tietz  <kai.tietz@onevision.com>
+
+	* resolve.c (resolve_deallocate_expr): Avoid warning
+	about possible use of iunitialized sym.
+	(resolve_allocate_expr): Pre-initialize sym by NULL.
+
+2010-06-09  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/43040
+	* f95-lang.c (gfc_init_builtin_functions): Remove comment.
+
+2010-06-08  Laurynas Biveinis  <laurynas.biveinis@gmail.com>
+
+	* trans-types.c (gfc_get_nodesc_array_type): Use typed GC
+	allocation.
+	(gfc_get_array_type_bounds): Likewise.
+
+	* trans-decl.c (gfc_allocate_lang_decl): Likewise.
+	(gfc_find_module): Likewise.
+
+	* f95-lang.c (pushlevel): Likewise.
+
+	* trans.h (struct lang_type): Add variable_size GTY option.
+	(struct lang_decl): Likewise.
+
+2010-06-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/44446
+	* symbol.c (check_conflict): Move protected--external/procedure check ...
+	* resolve.c (resolve_select_type): ... to the resolution stage.
+
+2010-06-07  Tobias Burnus  <burnus@net-b.de>
+
+	* options.c (gfc_handle_option): Fix -fno-recursive.
+
+2010-06-07  Tobias Burnus  <burnus@net-b.de>
+
+	* gfc-internals.texi (copyrights-gfortran): Fix copyright year format.
+	* gfortran.texi (copyrights-gfortran): Ditto.
+
+2010-06-07  Joseph Myers  <joseph@codesourcery.com>
+
+	* lang.opt (fshort-enums): Define using Var and VarExists.
+	* options.c (gfc_handle_option): Don't set flag_short_enums here.
+
+2010-06-05  Paul Thomas  <pault@gcc.gnu.org>
+	    Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/43945
+	* resolve.c (get_declared_from_expr): Move to before
+	resolve_typebound_generic_call.  Make new_ref and class_ref
+	ignorable if set to NULL.
+	(resolve_typebound_generic_call): Once we have resolved the
+	generic call, check that the specific instance is that which
+	is bound to the declared type.
+	(resolve_typebound_function,resolve_typebound_subroutine): Avoid
+	freeing 'class_ref->next' twice.
+
+2010-06-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43895
+	* trans-array.c (structure_alloc_comps): Dereference scalar
+	'decl' if it is a REFERENCE_TYPE. Tidy expressions containing
+	TREE_TYPE (decl).
+
+2010-06-04  Joseph Myers  <joseph@codesourcery.com>
+
+	* gfortranspec.c (append_arg, lang_specific_driver): Use
+	GCC-specific formats in diagnostics.
+
+2010-06-02  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/44360
+	* parse.c (gfc_fixup_sibling_symbols): Do not "fix" use-associated
+	symbols.
+
+2010-06-01  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/44371
+	* match.c (gfc_match_stopcode): Move gfc_match_eos call inside 
+	condition block.
+
+2010-05-31  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* fortran/gfortran.texi:  Fix typos in description of variable-format-
+	expressions.
+
+2010-05-31  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/36928
+	* dependency.c (gfc_check_section_vs_section):  Check
+	for interleaving array assignments without conflicts.
+
+2010-05-30  Janus Weil  <janus@gcc.gnu.org>
+
+	* gcc/fortran/gfortran.h (CLASS_DATA): New macro for accessing the
+	$data component of a class container.
+	* gcc/fortran/decl.c (attr_decl1): Use macro CLASS_DATA.
+	* gcc/fortran/expr.c (gfc_check_pointer_assign,gfc_check_assign_symbol,
+	gfc_has_ultimate_allocatable,gfc_has_ultimate_pointer): Ditto.
+	* gcc/fortran/interface.c (matching_typebound_op): Ditto.
+	* gcc/fortran/match.c (gfc_match_allocate, gfc_match_deallocate): Ditto.
+	* gcc/fortran/parse.c (parse_derived): Ditto.
+	* gcc/fortran/primary.c (gfc_match_varspec, gfc_variable_attr,
+	gfc_expr_attr): Ditto.
+	* gcc/fortran/resolve.c (resolve_structure_cons, find_array_spec,
+	resolve_deallocate_expr, resolve_allocate_expr, resolve_select_type,
+	resolve_fl_var_and_proc, resolve_typebound_procedure,
+	resolve_fl_derived): Ditto.
+	* gcc/fortran/symbol.c (gfc_type_compatible): Restructured.
+	* gcc/fortran/trans-array.c (structure_alloc_comps): Use macro
+	CLASS_DATA.
+	* gcc/fortran/trans-decl.c (gfc_get_symbol_decl,
+	gfc_trans_deferred_vars): Ditto.
+	* gcc/fortran/trans-stmt.c (gfc_trans_allocate): Ditto.
+
+2010-05-28  Tobias Burnus  <burnus@net-b.de>
+
+	* options.c (gfc_handle_option): Fix handling of -fno-whole-file.
+
+2010-05-28  Joseph Myers  <joseph@codesourcery.com>
+
+	* gfortranspec.c (append_arg, lang_specific_driver): Use
+	fatal_error instead of fatal.  Use warning instead of fprintf for
+	warnings.
+
+2010-05-28  Joseph Myers  <joseph@codesourcery.com>
+
+	* cpp.c (gfc_cpp_init_0): Use xstrerror instead of strerror.
+	* module.c (write_char, gfc_dump_module, gfc_use_module): Use
+	xstrerror instead of strerror.
+
+2010-05-26  Joseph Myers  <joseph@codesourcery.com>
+
+	* cpp.c (cb_cpp_error): Save and restore
+	global_dc->warn_system_headers, not variable warn_system_headers.
+
+2010-05-26  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* fortran/f95-lang.c: Do not include libfuncs.h, expr.h, and except.h.
+
+2010-05-26  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* trans-common.c: Do not include rtl.h, include output.h instead.
+	* trans-decl.c: Likewise.
+
+2010-05-26  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40011
+	* resolve.c (resolve_global_procedure): Resolve the gsymbol's
+	namespace before trying to reorder the gsymbols.
+
+2010-05-25  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/30668
+	PR fortran/31346
+	PR fortran/34260
+	* resolve.c (resolve_global_procedure): Add check for global
+	procedures with implicit interfaces and assumed-shape or optional
+	dummy arguments. Verify that function return type, kind and string
+	lengths match.
+
+2010-05-21  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.h: Do not include system.h.
+	* bbt.c: Include system.h.
+	* data.c: Ditto.
+	* dependency.c: Ditto.
+	* dump-parse-tree.c: Ditto.
+	* arith.h: Do not include gfortran.h.
+	* constructor.h: Do not include gfortran.h and splay-tree.h.
+	* match.h: Do not include gfortran.h.
+	* parse.h: Ditto.
+	* target-memory.h: Ditto.
+	* openmp.c: Do not include toplev.h and target.h.
+	* trans-stmt.c: Ditto not include toplev.h.
+	* primary.c: Ditto.
+	* trans-common.c: Tell why toplev.h is needed. And
+	do not include target.h.
+	* trans-expr.c: Tell why toplev.h is needed.
+	* trans-array.c: Ditto.
+	* trans-openmp.c: Ditto.
+	* trans-const.c: Ditto.
+	* trans.c: Ditto.
+	* trans-types.c: Ditto.
+	* trans-io.c: Ditto.
+	* trans-decl.c: Ditto.
+	* scanner.c: Ditto.
+	* convert.c: Ditto.
+	* trans-intrinsic.c: Ditto.
+	* options.c: Ditto.
+
+2010-05-22 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+	PR fortran/43851
+	* match.c (gfc_match_stopcode): Use gfc_match_init_expr. Go to cleanup
+	before returning MATCH_ERROR. Add check for scalar. Add check for
+	default integer kind.
+
+2010-05-22  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44212
+	* match.c (gfc_match_select_type): On error jump back out of the local
+	namespace.
+	* parse.c (parse_derived): Defer creation of vtab symbols to resolution
+	stage, more precisely to ...
+	* resolve.c (resolve_fl_derived): ... this place.
+
+2010-05-22  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44213
+	* resolve.c (ensure_not_abstract): Allow abstract types with
+	non-abstract ancestors.
+
+2010-05-21  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* trans-const.c: Include realmpfr.h.
+	* Make-lang.in: Update dependencies.
+
+2010-05-21  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* trans-const.c, trans-types.c, trans-intrinsic.c:
+	Clean up redundant includes.
+
+2010-05-20  Daniel Franke  <franke.daniel@gmail.com>
+
+        PR fortran/38407
+        * lang.opt (Wunused-dummy-argument): New option.
+        * gfortran.h (gfc_option_t): Add warn_unused_dummy_argument.
+        * options.c (gfc_init_options): Disable warn_unused_dummy_argument.
+        (set_Wall): Enable warn_unused_dummy_argument.
+        (gfc_handle_option): Set warn_unused_dummy_argument according to
+        command line.
+        * trans-decl.c (generate_local_decl): Separate warnings about
+        unused variables and unused dummy arguments.
+        * invoke.texi: Documented new option.
+
+2010-05-20  Steven Bosscher  <steven@gcc.gnu.org>
+
+	* trans-expr.c: Do not include convert.h, ggc.h, real.h, and gimple.h.
+	(gfc_conv_string_tmp): Do not assert type comparibilty.
+	*  trans-array.c: Do not include gimple.h, ggc.h, and real.h.
+	(gfc_conv_expr_descriptor): Remove assert.
+	* trans-common.c: Clarify why rtl.h and tm.h are included.
+	* trans-openmp.c: Do not include ggc.h and real.h.
+	Explain why gimple.h is included.
+	* trans-const.c: Do not include ggc.h.
+	* trans-stmt.c: Do not include gimple.h, ggc.h, and real.h.
+	* trans.c: Do not include ggc.h and real.h.
+	Explain why gimple.h is included.
+	* trans-types.c: Do not include tm.h.  Explain why langhooks.h
+	and dwarf2out.h are included.
+	* trans-io.c: Do not include gimple.h and real.h.
+	* trans-decl.c: Explain why gimple.h, tm.h, and rtl.h are included.
+	* trans-intrinsic.c: Do not include gimple.h.  Explain why tm.h
+	is included.
+
+2010-05-20  Tobias Burnus  <burnus@net-b.de>
+
+	* options.c (gfc_init_options,gfc_post_options): Enable
+	flag_associative_math by default.
+
+2010-05-19 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+	PR fortran/43851
+	* trans-stmt.c (gfc_trans_stop): Add generation of call to
+	gfortran_error_stop_numeric. Fix up some whitespace. Use stop_string for
+	blank STOP, handling a null expression. (gfc_trans_pause): Use
+	pause_string for blank PAUSE.
+	* trans.h: Add external function declaration for error_stop_numeric.
+	* trans-decl.c (gfc_build_builtin_function_decls): Add the building of
+	the declaration for the library call. Adjust whitespaces.
+	* match.c (gfc_match_stopcode): Remove use of the actual stop code to
+	signal no stop code. Match the expression following the stop and pass
+	that to the translators. Remove the old use of digit matching.  Add
+	checks that the stop_code expression is INTEGER or CHARACTER, constant,
+	and if CHARACTER, default character KIND.
+
+2010-05-19  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/44055
+	* lang.opt (Wconversion-extra): New option.
+	* gfortran.h (gfc_option_t): Add warn_conversion_extra.
+	* options.c (gfc_init_options): Disable -Wconversion-extra by default.
+	(set_Wall): Enable -Wconversion.
+	(gfc_handle_option): Set warn_conversion_extra.
+	* intrinsic.c (gfc_convert_type_warn): Ignore kind conditions
+	introduced for -Wconversion if -Wconversion-extra is present.
+	* invoke.texi: Add -Wconversion to -Wall; document new behaviour of
+	-Wconversion; document -Wconversion-extra.
+
+2010-05-19  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/42360
+	* gfortran.h (gfc_has_default_initializer): New.
+	* expr.c (gfc_has_default_initializer): New.
+	* resolve.c (has_default_initializer): Removed, use
+	gfc_has_default_initializer() instead. Updated all callers.
+	* trans-array.c (has_default_initializer): Removed, use
+	gfc_has_default_initializer() instead. Updated all callers.
+	* trans-decl.c (generate_local_decl): Do not check the
+	first component only to check for initializers, but use
+	gfc_has_default_initializer() instead.
+
+2010-05-19  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/38404
+	* primary.c (match_string_constant): Move start_locus just inside 
+	the string.
+	* data.c (create_character_intializer): Clarified truncation warning.
+
+2010-05-19  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/34505
+	* intrinsic.h (gfc_check_float): New prototype.
+	(gfc_check_sngl): New prototype.
+	* check.c (gfc_check_float): New.
+	(gfc_check_sngl): New.
+	* intrinsic.c (add_functions): Moved DFLOAT from aliasing DBLE
+	to be a specific for REAL. Added check routines for FLOAT, DFLOAT
+	and SNGL.
+	* intrinsic.texi: Removed individual nodes of FLOAT, DFLOAT and SNGL,
+	added them to the list of specifics of REAL instead.
+
+2010-05-17  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/43990
+	* trans-expr.c (gfc_conv_structure): Remove unneeded and buggy code.
+	This is now handled via 'gfc_class_null_initializer'.
+
+2010-05-17  Janus Weil  <janus@gcc.gnu.org>
+
+	* class.c (gfc_add_component_ref,gfc_class_null_initializer,
+	gfc_build_class_symbol,add_proc_component,add_proc_comps, 
+	add_procs_to_declared_vtab1,copy_vtab_proc_comps,
+	add_procs_to_declared_vtab,add_generic_specifics, 
+	add_generics_to_declared_vtab,gfc_find_derived_vtab,
+	find_typebound_proc_uop,gfc_find_typebound_proc,
+	gfc_find_typebound_user_op,gfc_find_typebound_intrinsic_op, 
+	gfc_get_tbp_symtree): Moved here from other places.
+	* expr.c (gfc_add_component_ref,gfc_class_null_initializer): Move to
+	class.c.
+	* gfortran.h (gfc_build_class_symbol,gfc_find_derived_vtab,
+	gfc_find_typebound_proc,gfc_find_typebound_user_op,
+	gfc_find_typebound_intrinsic_op,gfc_get_tbp_symtree,
+	gfc_add_component_ref, gfc_class_null_initializer): Moved to class.c.
+	* Make-lang.in: Add class.o.
+	* symbol.c (gfc_build_class_symbol,add_proc_component,add_proc_comps,
+	add_procs_to_declared_vtab1,copy_vtab_proc_comps,
+	add_procs_to_declared_vtab,add_generic_specifics,
+	add_generics_to_declared_vtab,gfc_find_derived_vtab,
+	find_typebound_proc_uop,gfc_find_typebound_proc,
+	gfc_find_typebound_user_op,gfc_find_typebound_intrinsic_op,
+	gfc_get_tbp_symtree): Move to class.c.
+
+2010-05-17  Nathan Froyd  <froydnj@codesourcery.com>
+
+	* trans-types.c (gfc_init_types): Use build_function_type_list.
+	(gfc_get_ppc_type): Likewise.
+	* trans-decl.c (gfc_generate_constructors): Likewise.
+	* f95-lang.c (build_builtin_fntypes): Likewise.
+	(gfc_init_builtin_functions): Likewise.
+	(DEF_FUNCTION_TYPE_0): Likewise.
+	(DEF_FUNCTION_TYPE_1): Likewise.
+	(DEF_FUNCTION_TYPE_2): Likewise.
+	(DEF_FUNCTION_TYPE_3): Likewise.
+	(DEF_FUNCTION_TYPE_4): Likewise.
+	(DEF_FUNCTION_TYPE_5): Likewise.
+	(DEF_FUNCTION_TYPE_6): Likewise.
+	(DEF_FUNCTION_TYPE_7): Likewise.  Use ARG7.
+	(DEF_FUNCTION_TYPE_VAR_0): Use build_varags_function_type_list.
+ 
+2010-05-17  Nathan Froyd  <froydnj@codesourcery.com>
+
+	* trans-array.c (gfc_trans_array_constructor_value): Use
+	build_constructor instead of build_constructor_from_list.
+	(gfc_build_constant_array_constructor): Likewise.
+	* trans-decl.c (create_main_function): Likewise.
+	* trans-stmt.c (gfc_trans_character_select): Likewise.
+
+2010-05-17  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44044
+	* resolve.c (resolve_fl_var_and_proc): Move error messages here from ...
+	(resolve_fl_variable_derived): ... this place.
+	(resolve_symbol): Make sure function symbols (and their result
+	variables) are not resolved twice.
+
+2010-05-16  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/35779
+	* array.c (match_array_list): Revert change from 2010-05-13.
+
+2010-05-16  Richard Guenther  <rguenther@suse.de>
+
+	* trans-decl.c (module_htab_decls_hash): Revert last change.
+
+2010-05-16  Richard Guenther  <rguenther@suse.de>
+
+	* trans-decl.c (module_htab_decls_hash): Use IDENTIFIER_HASH_VALUE.
+
+2010-05-16  Manuel López-Ibáñez  <manu@gcc.gnu.org>
+
+	* options.c (set_Wall): Remove special logic for Wuninitialized
+	without -O.
+
+2010-05-15  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44154
+	PR fortran/42647
+	* trans-decl.c (gfc_trans_deferred_vars): Modify ordering of
+	if branches.
+
+2010-05-15  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/43207
+	PR fortran/43969
+	* gfortran.h (gfc_class_null_initializer): New prototype.
+	* expr.c (gfc_class_null_initializer): New function to build a NULL
+	initializer for CLASS pointers.
+	* symbol.c (gfc_build_class_symbol): Modify internal naming of class
+	containers. Remove default NULL initialization of $data component.
+	* trans.c (gfc_allocate_array_with_status): Fix wording of an error 
+	message.
+	* trans-expr.c (gfc_conv_initializer,gfc_trans_subcomponent_assign):
+	Use new function 'gfc_class_null_initializer'.
+	* trans-intrinsic.c (gfc_conv_allocated): Handle allocatable scalar
+	class variables.
+
+2010-05-14  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/44135
+	* fortran/interface.c (get_sym_storage_size): Use signed instead of
+	unsigned mpz_get_?i routines.
+
+2010-05-14  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans.c (trans_code): Set backend locus early.
+	* trans-decl.c (gfc_get_fake_result_decl): Use source location
+	of the function instead of current input_location.
+
+2010-05-13  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/35779
+	* intrinsic.c (gfc_init_expr): Renamed to gfc_init_expr_flag.
+	Updated all usages.
+	* expr.c (init_flag): Removed; use gfc_init_expr_flag everywhere.
+	* array.c (match_array_list): Pass on gfc_init_expr_flag when matching
+	iterators.
+
+2010-05-13  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/44036
+	* openmp.c (resolve_omp_clauses): Allow procedure pointers in clause
+	variable lists.
+	* trans-openmp.c (gfc_omp_privatize_by_reference): Don't privatize
+	by reference dummy procedures or non-dummy procedure pointers.
+	(gfc_omp_predetermined_sharing): Return
+	OMP_CLAUSE_DEFAULT_FIRSTPRIVATE for dummy procedures.
+
+2010-05-11  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/43711
+	* openmp.c (gfc_match_omp_taskwait): Report unexpected characters
+	after OMP statement.
+	(gfc_match_omp_critical): Likewise.
+	(gfc_match_omp_flush): Likewise.
+	(gfc_match_omp_workshare): Likewise.
+	(gfc_match_omp_master): Likewise.
+	(gfc_match_omp_ordered): Likewise.
+	(gfc_match_omp_atomic): Likewise.
+	(gfc_match_omp_barrier): Likewise.
+	(gfc_match_omp_end_nowait): Likewise.
+
+2010-05-11  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/31820
+	* resolve.c (validate_case_label_expr): Removed FIXME.
+	(resolve_select): Raise default warning on case labels out of range
+	of the case expression.
+
+2010-05-10  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/27866
+	PR fortran/35003
+	PR fortran/42809
+	* intrinsic.c (gfc_convert_type_warn): Be more discriminative
+	about conversion warnings.
+
+2010-05-10  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44044
+	* match.c (gfc_match_select_type): Move error message to
+	resolve_select_type.
+	* resolve.c (resolve_select_type): Error message moved here from
+	gfc_match_select_type. Correctly set type of temporary.
+
+2010-05-10  Richard Guenther  <rguenther@suse.de>
+
+	* trans-decl.c (gfc_build_library_function_decl): Split out
+	worker to ...
+	(build_library_function_decl_1): ... this new function.
+	Set a fnspec attribute if a specification was provided.
+	(gfc_build_library_function_decl_with_spec): New function.
+	(gfc_build_intrinsic_function_decls): Annotate internal_pack
+	and internal_unpack.
+
+2010-05-07  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/40728
+	* intrinc.c (gfc_is_intrinsic): Do not prematurely mark symbol
+	as external.
+
+2010-05-07  Jason Merrill  <jason@redhat.com>
+
+	* trans-expr.c (gfc_conv_procedure_call): Rename nullptr to null_ptr
+	to avoid -Wc++-compat warning.
+
+2010-05-06  Manuel López-Ibáñez  <manu@gcc.gnu.org>
+
+	PR 40989
+	* options.c (gfc_handle_option): Add argument kind.
+	* gfortran.h (gfc_handle_option): Update declaration.
+
+2010-05-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43985
+	* trans-types.c (gfc_sym_type): Mark Cray pointees as
+	GFC_POINTER_TYPE_P.
+
+2010-05-05  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/32331
+	* resolve.c (traverse_data_list): Rephrase error message for
+	non-constant bounds in data-implied-do.
+
+2010-05-05  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/24978
+	* gfortran.h: Removed repeat count from constructor, removed
+	all usages.
+	* data.h (gfc_assign_data_value_range): Changed return value from
+	void to gfc_try.
+	* data.c (gfc_assign_data_value): Add location to constructor element.
+	(gfc_assign_data_value_range): Call gfc_assign_data_value()
+	for each element in range. Return early if an error was generated.
+	* resolve.c (check_data_variable): Stop early if range assignment
+	generated an error.
+
+2010-05-05  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/43696
+	* resolve.c (resolve_fl_derived): Some fixes for class variables.
+	* symbol.c (gfc_build_class_symbol): Add separate class container for
+	class pointers.
+
+2010-05-03  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/43592
+	* fortran/parse.c (parse_interface): Do not dereference a NULL pointer.
+
+2010-05-02  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
+	* intrinsic.c (add_functions): Fix GFC_STD and add gfc_resolve_ calls
+	for lcobound, ucobound, image_index and this_image.
+	* intrinsic.h (gfc_resolve_lcobound, gfc_resolve_this_image,
+	gfc_resolve_image_index, gfc_resolve_ucobound): New prototypes.
+	* iresolve.c (gfc_resolve_lcobound, gfc_resolve_this_image,
+	gfc_resolve_image_index, gfc_resolve_ucobound, resolve_bound): New
+	functions.
+	(gfc_resolve_lbound, gfc_resolve_ubound): Use resolve_bound.
+
+2010-04-30  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
+	PR fortran/43931
+	*  trans-types.c (gfc_get_array_descriptor_base): Fix index
+	calculation for array descriptor types.
+
+2010-04-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/43896
+	* symbol.c (add_proc_component,copy_vtab_proc_comps): Remove
+	initializers for PPC members of the vtabs.
+
+2010-04-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42274
+	* symbol.c (add_proc_component,add_proc_comps): Correctly set the 'ppc'
+	attribute for all PPC members of the vtypes.
+	(copy_vtab_proc_comps): Copy the correct interface.
+	* trans.h (gfc_trans_assign_vtab_procs): Modified prototype.
+	* trans-expr.c (gfc_trans_assign_vtab_procs): Pass the derived type as
+	a dummy argument and make sure all PPC members of the vtab are
+	initialized correctly.
+	(gfc_conv_derived_to_class,gfc_trans_class_assign): Additional argument
+	in call to gfc_trans_assign_vtab_procs.
+	* trans-stmt.c (gfc_trans_allocate): Ditto.
+
+2010-04-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43326
+	* resolve.c (resolve_typebound_function): Renamed
+	resolve_class_compcall.Do all the detection of class references
+	here.
+	(resolve_typebound_subroutine): resolve_class_typebound_call
+	renamed. Otherwise same as resolve_typebound_function.
+	(gfc_resolve_expr): Call resolve_typebound_function.
+	(resolve_code): Call resolve_typebound_subroutine.
+
+2010-04-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/43492
+	* resolve.c (resolve_typebound_generic_call): For CLASS methods
+	pass back the specific symtree name, rather than the target
+	name.
+
+2010-04-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/42353
+	* resolve.c (resolve_structure_cons): Make the initializer of
+	the vtab component 'extends' the same type as the component.
+
+2010-04-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/42680
+	* interface.c (check_interface1): Pass symbol name rather than NULL to
+	gfc_compare_interfaces.(gfc_compare_interfaces): Add assert to
+	trap MULL. (gfc_compare_derived_types): Revert previous change
+	incorporated incorrectly during merge from trunk, r155778.
+	* resolve.c (check_generic_tbp_ambiguity): Pass symbol name rather
+	than NULL to gfc_compare_interfaces.
+	* symbol.c (add_generic_specifics): Likewise.
+
+2010-02-29  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42353
+	* interface.c (gfc_compare_derived_types): Add condition for vtype.
+	* symbol.c (gfc_find_derived_vtab): Sey access to private.
+	(gfc_find_derived_vtab): Likewise.
+	* module.c (ab_attribute): Add enumerator AB_VTAB.
+	(mio_symbol_attribute): Use new attribute, AB_VTAB.
+	(check_for_ambiguous): Likewise.
+
+2010-04-29  Paul Thomas  <pault@gcc.gnu.org>
+	    Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/41829
+	* trans-expr.c (select_class_proc): Remove function.
+	(conv_function_val): Delete reference to previous.
+	(gfc_conv_derived_to_class): Add second argument to the call to
+	gfc_find_derived_vtab.
+	(gfc_conv_structure): Exclude proc_pointer components when
+	accessing $data field of class objects.
+	(gfc_trans_assign_vtab_procs): New function.
+	(gfc_trans_class_assign): Add second argument to the call to
+	gfc_find_derived_vtab.
+	* symbol.c (gfc_build_class_symbol): Add delayed_vtab arg and
+	implement holding off searching for the vptr derived type.
+	(add_proc_component): New function.
+	(add_proc_comps): New function.
+	(add_procs_to_declared_vtab1): New function.
+	(copy_vtab_proc_comps): New function.
+	(add_procs_to_declared_vtab): New function.
+	(void add_generic_specifics): New function.
+	(add_generics_to_declared_vtab): New function.
+	(gfc_find_derived_vtab): Add second argument to the call to
+	gfc_find_derived_vtab. Add the calls to
+	add_procs_to_declared_vtab and add_generics_to_declared_vtab.
+	* decl.c (build_sym, build_struct): Use new arg in calls to
+	gfc_build_class_symbol.
+	* gfortran.h : Add vtype bitfield to symbol_attr. Remove the
+	definition of struct gfc_class_esym_list. Modify prototypes
+	of gfc_build_class_symbol and gfc_find_derived_vtab.
+	* trans-stmt.c (gfc_trans_allocate): Add second argument to the
+	call to gfc_find_derived_vtab.
+	* module.c : Add the vtype attribute.
+	* trans.h : Add prototype for gfc_trans_assign_vtab_procs.
+	* resolve.c (resolve_typebound_generic_call): Add second arg
+	to pass along the generic name for class methods.
+	(resolve_typebound_call): The same.
+	(resolve_compcall): Use the second arg to carry the generic
+	name from the above. Remove the reference to class_esym.
+	(check_members, check_class_members, resolve_class_esym,
+	hash_value_expr): Remove functions.
+	(resolve_class_compcall, resolve_class_typebound_call): Modify
+	to use vtable rather than member by member calls.
+	(gfc_resolve_expr): Modify second arg in call to
+	resolve_compcall.
+	(resolve_select_type): Add second arg in call to
+	gfc_find_derived_vtab.
+	(resolve_code): Add second arg in call resolve_typebound_call.
+	(resolve_fl_derived): Exclude vtypes from check for late
+	procedure definitions. Likewise for checking of explicit
+	interface and checking of pass arg.
+	* iresolve.c (gfc_resolve_extends_type_of): Add second arg in
+	calls to gfc_find_derived_vtab.
+	* match.c (select_type_set_tmp): Use new arg in call to
+	gfc_build_class_symbol.
+	* trans-decl.c (gfc_get_symbol_decl): Complete vtable if
+	necessary.
+	* parse.c (endType): Finish incomplete classes.
+
+2010-04-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
+	PR fortran/43919
+	* simplify.c (simplify_cobound): Handle scalar coarrays.
+
+2010-04-27  Tobias Burnus  <burnus@net-b.de>
+
+	* gfc-internals.texi: Update copyright year.
+	* gfortran.texi: Ditto.
+	* invoke.texi: Ditto.
+
+2010-04-27  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
+	* resolve.c (resolve_allocate_expr): Allow array coarrays.
+	* trans-types.h (gfc_get_array_type_bounds): Update prototype.
+	* trans-types.c (gfc_get_array_type_bounds,
+	gfc_get_array_descriptor_base): Add corank argument.
+	* trans-array.c (gfc_array_init_size): Handle corank.
+	(gfc_trans_create_temp_array, gfc_array_allocate,
+	gfc_conv_expr_descriptor): Add corank argument to call.
+	* trans-stmt.c (gfc_trans_pointer_assign_need_temp): Ditto.
+
+2010-04-24  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/30073
+	PR fortran/43793
+	* trans-array.c (gfc_trans_array_bound_check): Use TREE_CODE instead
+	of mucking with a tree directly.
+
+2010-04-24  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/43832
+	* io.c (gfc_match_open): Remove branch to syntax error. Add call to
+	gfc_error with new error message.
+
+2010-04-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43841
+	PR fortran/43843
+	* trans-expr.c (gfc_conv_expr): Supply an address expression for
+	GFC_SS_REFERENCE.
+	(gfc_conv_expr_reference): Call gfc_conv_expr and return for
+	GFC_SS_REFERENCE.
+	* trans-array.c (gfc_add_loop_ss_code): Store the value rather
+	than the address of a GFC_SS_REFERENCE.
+	* trans.h : Change comment on GFC_SS_REFERENCE. 
+
+2010-04-22  Richard Guenther  <rguenther@suse.de>
+
+	PR fortran/43829
+	* resolve.c (gfc_resolve_index): Wrap around ...
+	(gfc_resolve_index_1): ... this.  Add parameter to allow
+	any integer kind index type.
+	(resolve_array_ref): Allow any integer kind for the start
+	index of an array ref.
+
+2010-04-21  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/43836
+	* f95-lang.c (gfc_define_builtin): Set TREE_NOTHROW on
+	the decl.
+
+2010-04-20  Harald Anlauf  <anlauf@gmx.de>
+
+	* intrinsic.c (sort_actual): Remove 'is' in error message.
+
+2010-04-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43227
+	* resolve.c (resolve_fl_derived): If a component character
+	length has not been resolved, do so now.
+	(resolve_symbol): The same as above for a symbol character
+	length.
+	* trans-decl.c (gfc_create_module_variable): A 'length' decl is
+	not needed for a character valued, procedure pointer.
+
+	PR fortran/43266
+	* resolve.c (ensure_not_abstract_walker): If 'overriding' is
+	not found, return FAILURE rather than ICEing.
+
+2010-04-19  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/43339
+	* openmp.c (gfc_resolve_do_iterator): Only make iteration vars for
+	sequential loops private in the innermost containing task region.
+
+2010-04-18  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* f95-lang.c (gfc_init_decl_processing): Remove second argument in call
+	to build_common_tree_nodes.
+
+2010-04-17  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/31538
+	* fortran/trans-array.c (gfc_conv_ss_startstride): Remove the use of
+	gfc_msg_bounds by using 'Array bound mismatch' directly.
+	(gfc_trans_dummy_array_bias):  Remove the use of gfc_msg_bounds.  Reword
+	error message to include the mismatch in the extent of array bound.
+	* fortran/trans.c: Remove gfc_msg_bounds.  It is only used in one place.
+	* fortran/trans.h: Remove extern definition of gfc_msg_bounds.
+
+2010-04-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	* gfortran.texi: Update information on temporary file locations.
+
+2010-04-16  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-decl.c (gfc_build_qualified_array): Ensure
+	ubound.N and lbound.N artificial variable names don't appear
+	in debug info.
+
+2010-04-15  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/30073
+	* trans-array.c (gfc_trans_array_bound_check): Eliminate a redundant
+	block of code.  Set name to the variable associated with the descriptor.
+
+2010-04-15  Jakub Jelinek  <jakub@redhat.com>
+
+	* trans-decl.c (gfc_build_qualified_array): Clear DECL_IGNORED_P
+	on VAR_DECL LBOUND and/or UBOUND, even for -O1.
+
+2010-04-14  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	* intrinsic.texi: Add the missing specific name of intrinsic
+	procedure where the specific name is identical to the generic name.
+	Fix inconsistent or mismatch in the argument names in intrinsic
+	procedure descriptions.  Add the SCALAR allocatable description to
+	ALLOCATED.
+
+2010-04-14  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
+	* array.c (gfc_find_array_ref): Handle codimensions.
+	(gfc_match_array_spec,gfc_match_array_ref): Use gfc_fatal_error.
+	* check.c (is_coarray, dim_corank_check, gfc_check_lcobound,
+	gfc_check_image_index, gfc_check_this_image, gfc_check_ucobound):
+	New functions.
+	* gfortran.h (gfc_isym_id): Add GFC_ISYM_IMAGE_INDEX,
+	GFC_ISYM_LCOBOUND, GFC_ISYM_THIS_IMAGE,
+	GFC_ISYM_UCOBOUND.
+	* intrinsic.h (add_functions): Add this_image, image_index,
+	lcobound and ucobound intrinsics.
+	* intrinsic.c (gfc_check_lcobound,gfc_check_ucobound,
+	gfc_check_image_index, gfc_check_this_image,
+	gfc_simplify_image_index, gfc_simplify_lcobound,
+	gfc_simplify_this_image, gfc_simplify_ucobound):
+	New function prototypes.
+	* intrinsic.texi (IMAGE_INDEX, LCOBOUND, THIS_IMAGE
+	IMAGE_INDEX): Document new intrinsic functions.
+	* match.c (gfc_match_critical, sync_statement): Make -fcoarray=none
+	error fatal.
+	* simplify.c (simplify_bound_dim): Handle coarrays.
+	(simplify_bound): Update simplify_bound_dim call.
+	(gfc_simplify_num_images): Add -fcoarray=none check.
+	(simplify_cobound, gfc_simplify_lcobound, gfc_simplify_ucobound,
+	gfc_simplify_ucobound, gfc_simplify_ucobound): New functions.
+
+2010-04-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/43747
+	* constructor.c: Fix typo in comment.
+	* expr.c (find_array_section): Add check for max array limit.
+
+2010-04-13  Iain Sandoe  <iains@gcc.gnu.org>
+
+	PR bootstrap/31400
+	* gfortranspec.c (lookup_option): Check for -static and return
+	OPTION_static.
+	(lang_specific_driver): Break when OPTION_static is discovered.
+
+2010-04-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	* array.c (extract_element): Restore function from trunk.
+	(gfc_get_array_element): Restore function from trunk.
+	(gfc_expand_constructor): Restore check against
+	flag_max_array_constructor.
+	* constructor.c (node_copy_and_append): Delete unused.
+	* gfortran.h: Delete comment and extra include.
+	* constructor.h: Bump copyright and clean up TODO comments.
+	* resolve.c: Whitespace.
+
+2010-04-12  Daniel Franke  <franke.daniel@gmail.com>
+
+	* simplify.c (compute_dot_product): Replaced usage of ADVANCE macro
+	with direct access access to elements. Adjusted prototype, fixed all
+	callers.
+	(gfc_simplify_dot_product): Removed duplicate check for zero-sized
+	array.
+	(gfc_simplify_matmul): Removed usage of ADVANCE macro.
+	(gfc_simplify_spread): Removed workaround, directly insert elements
+	at a given array position.
+	(gfc_simplify_transpose): Likewise.
+	(gfc_simplify_pack): Replaced usage of ADVANCE macro with corresponding
+	function calls.
+	(gfc_simplify_unpack): Likewise.
+
+2010-04-12  Daniel Franke  <franke.daniel@gmail.com>
+
+	* simplify.c (only_convert_cmplx_boz): Renamed to ...
+	(convert_boz): ... this and moved to start of file.
+	(gfc_simplify_abs): Whitespace fix.
+	(gfc_simplify_acos): Whitespace fix.
+	(gfc_simplify_acosh): Whitespace fix.
+	(gfc_simplify_aint): Whitespace fix.
+	(gfc_simplify_dint): Whitespace fix.
+	(gfc_simplify_anint): Whitespace fix.
+	(gfc_simplify_and): Replaced if-gate by more common switch-over-type.
+	(gfc_simplify_dnint): Whitespace fix.
+	(gfc_simplify_asin): Whitespace fix.
+	(gfc_simplify_asinh): Moved creation of result-expr out of switch.
+	(gfc_simplify_atan): Likewise.
+	(gfc_simplify_atanh): Whitespace fix.
+	(gfc_simplify_atan2): Whitespace fix.
+	(gfc_simplify_bessel_j0): Removed ATTRIBUTE_UNUSED.
+	(gfc_simplify_bessel_j1): Likewise.
+	(gfc_simplify_bessel_jn): Likewise.
+	(gfc_simplify_bessel_y0): Likewise.
+	(gfc_simplify_bessel_y1): Likewise.
+	(gfc_simplify_bessel_yn): Likewise.
+	(gfc_simplify_ceiling): Reorderd statements.
+	(simplify_cmplx): Use convert_boz(), check for constant arguments.
+	Whitespace fix.
+	(gfc_simplify_cmplx): Use correct default kind. Removed check for
+	constant arguments.
+	(gfc_simplify_complex): Replaced if-gate. Removed check for
+	constant arguments.
+	(gfc_simplify_conjg): Whitespace fix.
+	(gfc_simplify_cos): Whitespace fix.
+	(gfc_simplify_cosh): Replaced if-gate by more common switch-over-type.
+	(gfc_simplify_dcmplx): Removed check for constant arguments.
+	(gfc_simplify_dble): Use convert_boz() and gfc_convert_constant().
+	(gfc_simplify_digits): Whitespace fix.
+	(gfc_simplify_dim): Whitespace fix.
+	(gfc_simplify_dprod): Reordered statements.
+	(gfc_simplify_erf): Whitespace fix.
+	(gfc_simplify_erfc): Whitespace fix.
+	(gfc_simplify_epsilon): Whitespace fix.
+	(gfc_simplify_exp): Whitespace fix.
+	(gfc_simplify_exponent): Use convert_boz().
+	(gfc_simplify_floor): Reorderd statements.
+	(gfc_simplify_gamma): Whitespace fix.
+	(gfc_simplify_huge): Whitespace fix.
+	(gfc_simplify_iand): Whitespace fix.
+	(gfc_simplify_ieor): Whitespace fix.
+	(simplify_intconv): Use gfc_convert_constant().
+	(gfc_simplify_int): Use simplify_intconv().
+	(gfc_simplify_int2): Reorderd statements.
+	(gfc_simplify_idint): Reorderd statements.
+	(gfc_simplify_ior): Whitespace fix.
+	(gfc_simplify_ishftc): Removed duplicate type check.
+	(gfc_simplify_len): Use range_check() instead of manual range check.
+	(gfc_simplify_lgamma): Removed ATTRIBUTE_UNUSED. Whitespace fix.
+	(gfc_simplify_log): Whitespace fix.
+	(gfc_simplify_log10): Whitespace fix.
+	(gfc_simplify_minval): Whitespace fix.
+	(gfc_simplify_maxval): Whitespace fix.
+	(gfc_simplify_mod): Whitespace fix.
+	(gfc_simplify_modulo): Whitespace fix.
+	(simplify_nint): Reorderd statements.
+	(gfc_simplify_not): Whitespace fix.
+	(gfc_simplify_or): Replaced if-gate by more common switch-over-type.
+	(gfc_simplify_radix): Removed unused result-variable. Whitespace fix.
+	(gfc_simplify_range): Removed unused result-variable. Whitespace fix.
+	(gfc_simplify_real): Use convert_boz() and gfc_convert_constant().
+	(gfc_simplify_realpart): Whitespace fix.
+	(gfc_simplify_selected_char_kind): Removed unused result-variable.
+	(gfc_simplify_selected_int_kind): Removed unused result-variable.
+	(gfc_simplify_selected_real_kind): Removed unused result-variable.
+	(gfc_simplify_sign): Whitespace fix.
+	(gfc_simplify_sin): Whitespace fix.
+	(gfc_simplify_sinh): Replaced if-gate by more common switch-over-type.
+	(gfc_simplify_sqrt): Avoided goto by inlining check. Whitespace fix.
+	(gfc_simplify_tan): Replaced if-gate by more common switch-over-type.
+	(gfc_simplify_tanh): Replaced if-gate by more common switch-over-type.
+	(gfc_simplify_xor): Replaced if-gate by more common switch-over-type.
+
+2010-04-12  Daniel Franke  <franke.daniel@gmail.com>
+
+	* gfortran.h (gfc_start_constructor): Removed.
+	(gfc_get_array_element): Removed.
+	* array.c (gfc_start_constructor): Removed, use gfc_get_array_expr 
+	instead. Fixed all callers.
+	(extract_element): Removed.
+	(gfc_expand_constructor): Temporarily removed check for
+	max-array-constructor. Will be re-introduced later if still required.
+	(gfc_get_array_element): Removed, use gfc_constructor_lookup_expr
+	instead. Fixed all callers.
+	* expr.c (find_array_section): Replaced manual lookup of elements
+	by gfc_constructor_lookup.
+
+2010-04-12  Daniel Franke  <franke.daniel@gmail.com>
+
+	* gfortran.h (gfc_get_null_expr): New prototype.
+	(gfc_get_operator_expr): New prototype.
+	(gfc_get_character_expr): New prototype.
+	(gfc_get_iokind_expr): New prototype.
+	* expr.c (gfc_get_null_expr): New.
+	(gfc_get_character_expr): New.
+	(gfc_get_iokind_expr): New.
+	(gfc_get_operator_expr): Moved here from matchexp.c (build_node).
+	* matchexp.c (build_node): Renamed and moved to
+	expr.c (gfc_get_operator_expr). Reordered arguments to match 
+	other functions. Fixed all callers.
+	(gfc_get_parentheses): Use specific function to build expr.
+	* array.c (gfc_match_array_constructor): Likewise.
+	* arith.c (eval_intrinsic): Likewise.
+	(gfc_hollerith2int): Likewise.
+	(gfc_hollerith2real): Likewise.
+	(gfc_hollerith2complex): Likewise.
+	(gfc_hollerith2logical): Likewise.
+	* data.c (create_character_intializer): Likewise.
+	* decl.c (gfc_match_null): Likewise.
+	(enum_initializer): Likewise.
+	* io.c (gfc_match_format): Likewise.
+	(match_io): Likewise.
+	* match.c (gfc_match_nullify): Likewise.
+	* primary.c (match_string_constant): Likewise.
+	(match_logical_constant): Likewise.
+	(build_actual_constructor): Likewise.
+	* resolve.c (build_default_init_expr): Likewise.
+	* symbol.c (generate_isocbinding_symbol): Likewise.
+	(gfc_build_class_symbol): Likewise.
+	(gfc_find_derived_vtab): Likewise.
+	* simplify.c (simplify_achar_char): Likewise.
+	(gfc_simplify_adjustl): Likewise.
+	(gfc_simplify_adjustr): Likewise.
+	(gfc_simplify_and): Likewise.
+	(gfc_simplify_bit_size): Likewise.
+	(gfc_simplify_is_iostat_end): Likewise.
+	(gfc_simplify_is_iostat_eor): Likewise.
+	(gfc_simplify_isnan): Likewise.
+	(simplify_bound): Likewise.
+	(gfc_simplify_leadz): Likewise.
+	(gfc_simplify_len_trim): Likewise.
+	(gfc_simplify_logical): Likewise.
+	(gfc_simplify_maxexponent): Likewise.
+	(gfc_simplify_minexponent): Likewise.
+	(gfc_simplify_new_line): Likewise.
+	(gfc_simplify_null): Likewise.
+	(gfc_simplify_or): Likewise.
+	(gfc_simplify_precision): Likewise.
+	(gfc_simplify_repeat): Likewise.
+	(gfc_simplify_scan): Likewise.
+	(gfc_simplify_size): Likewise.
+	(gfc_simplify_trailz): Likewise.
+	(gfc_simplify_trim): Likewise.
+	(gfc_simplify_verify): Likewise.
+	(gfc_simplify_xor): Likewise.
+	* trans-io.c (build_dt): Likewise.
+	(gfc_new_nml_name_expr): Removed.
+
+2010-04-12  Daniel Franke  <franke.daniel@gmail.com>
+
+	* arith.h (gfc_constant_result): Removed prototype.
+	* constructor.h (gfc_build_array_expr): Removed prototype.
+	(gfc_build_structure_constructor_expr): Removed prototype.
+	* gfortran.h (gfc_int_expr): Removed prototype.
+	(gfc_logical_expr): Removed prototype.
+	(gfc_get_array_expr): New prototype.
+	(gfc_get_structure_constructor_expr): New prototype.
+	(gfc_get_constant_expr): New prototype.
+	(gfc_get_int_expr): New prototype.
+	(gfc_get_logical_expr): New prototype.
+	* arith.c (gfc_constant_result): Moved and renamed to
+	expr.c (gfc_get_constant_expr). Fixed all callers.
+	* constructor.c (gfc_build_array_expr): Moved and renamed to
+	expr.c (gfc_get_array_expr). Split gfc_typespec argument to type
+	and kind. Fixed all callers.
+	(gfc_build_structure_constructor_expr): Moved and renamed to
+	expr.c (gfc_get_structure_constructor_expr). Split gfc_typespec argument
+	to type and kind. Fixed all callers.
+	* expr.c (gfc_logical_expr): Renamed to ...
+	(gfc_get_logical_expr): ... this. Added kind argument. Fixed all callers.
+	(gfc_int_expr): Renamed to ...
+	(gfc_get_int_expr): ... this. Added kind and where arguments. Fixed all
+	callers.
+	(gfc_get_constant_expr): New.
+	(gfc_get_array_expr): New.
+	(gfc_get_structure_constructor_expr): New.
+	* simplify.c (int_expr_with_kind): Removed, callers use gfc_get_int_expr
+	instead.
+
+2010-04-12  Daniel Franke  <franke.daniel@gmail.com>
+
+	* constructor.h: New.
+	* constructor.c: New.
+	* Make-lang.in: Add new files to F95_PARSER_OBJS.
+	* arith.c (reducy_unary): Use constructor API.
+	(reduce_binary_ac): Likewise.
+	(reduce_binary_ca): Likewise.
+	(reduce_binary_aa): Likewise.
+	* check.c (gfc_check_pack): Likewise.
+	(gfc_check_reshape): Likewise.
+	(gfc_check_unpack): Likewise.
+	* decl.c (add_init_expr_to_sym): Likewise.
+	(build_struct): Likewise.
+	* dependency.c (gfc_check_dependency): Likewise.
+	(contains_forall_index_p): Likewise.
+	* dump-parse-tree.c (show_constructor): Likewise.
+	* expr.c (free_expr0): Likewise.
+	(gfc_copy_expr): Likewise.
+	(gfc_is_constant_expr): Likewise.
+	(simplify_constructor): Likewise.
+	(find_array_element): Likewise.
+	(find_component_ref): Likewise.
+	(find_array_section): Likewise.
+	(find_substring_ref): Likewise.
+	(simplify_const_ref): Likewise.
+	(scalarize_intrinsic_call): Likewise.
+	(check_alloc_comp_init): Likewise.
+	(gfc_default_initializer): Likewise.
+	(gfc_traverse_expr): Likewise.
+	* iresolve.c (check_charlen_present): Likewise.
+	(gfc_resolve_reshape): Likewise.
+	(gfc_resolve_transfer): Likewise.
+	* module.c (mio_constructor): Likewise.
+	* primary.c (build_actual_constructor): Likewise.
+	(gfc_match_structure_constructor): Likewise.
+	* resolve.c (resolve_structure_cons): Likewise.
+	* simplify.c (is_constant_array_expr): Likewise.
+	(init_result_expr): Likewise.
+	(transformational_result): Likewise.
+	(simplify_transformation_to_scalar): Likewise.
+	(simplify_transformation_to_array): Likewise.
+	(gfc_simplify_dot_product): Likewise.
+	(simplify_bound): Likewise.
+	(simplify_matmul): Likewise.
+	(simplify_minval_maxval): Likewise.
+	(gfc_simplify_pack): Likewise.
+	(gfc_simplify_reshape): Likewise.
+	(gfc_simplify_shape): Likewise.
+	(gfc_simplify_spread): Likewise.
+	(gfc_simplify_transpose): Likewise.
+	(gfc_simplify_unpack): Likewise.q
+	(gfc_convert_constant): Likewise.
+	(gfc_convert_char_constant): Likewise.
+	* target-memory.c (size_array): Likewise.
+	(encode_array): Likewise.
+	(encode_derived): Likewise.
+	(interpret_array): Likewise.
+	(gfc_interpret_derived): Likewise.
+	(expr_to_char): Likewise.
+	(gfc_merge_initializers): Likewise.
+	* trans-array.c (gfc_get_array_constructor_size): Likewise.
+	(gfc_trans_array_constructor_value): Likewise.
+	(get_array_ctor_strlen): Likewise.
+	(gfc_constant_array_constructor_p): Likewise.
+	(gfc_build_constant_array_constructor): Likewise.
+	(gfc_trans_array_constructor): Likewise.
+	(gfc_conv_array_initializer): Likewise.
+	* trans-decl.c (check_constant_initializer): Likewise.
+	* trans-expr.c (flatten_array_ctors_without_strlen): Likewise.
+	(gfc_apply_interface_mapping_to_cons): Likewise.
+	(gfc_trans_structure_assign): Likewise.
+	(gfc_conv_structure): Likewise.
+	* array.c (check_duplicate_iterator): Likewise.
+	(match_array_list): Likewise.
+	(match_array_cons_element): Likewise.
+	(gfc_match_array_constructor): Likewise.
+	(check_constructor_type): Likewise.
+	(check_constructor): Likewise.
+	(expand): Likewise.
+	(expand_constructor): Likewise.
+	(extract_element): Likewise.
+	(gfc_expanded_ac): Likewise.
+	(resolve_array_list): Likewise.
+	(gfc_resolve_character_array_constructor): Likewise.
+	(copy_iterator): Renamed to ...
+	(gfc_copy_iterator): ... this.
+	(gfc_append_constructor): Removed.
+	(gfc_insert_constructor): Removed unused function.
+	(gfc_get_constructor): Removed.
+	(gfc_free_constructor): Removed.
+	(qgfc_copy_constructor): Removed.
+	* gfortran.h (struct gfc_expr): Removed member 'con_by_offset'.
+	Removed all references. Replaced constructor list by splay-tree.
+	(struct gfc_constructor): Removed member 'next', moved 'offset' from
+	the inner struct, added member 'base'.
+	(gfc_append_constructor): Removed prototype.
+	(gfc_insert_constructor): Removed prototype.
+	(gfc_get_constructor): Removed prototype.
+	(gfc_free_constructor): Removed prototype.
+	(qgfc_copy_constructor): Removed prototype.
+	(gfc_copy_iterator): New prototype.
+	* trans-array.h (gfc_constant_array_constructor_p): Adjusted prototype.
+
+2010-04-10  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43591
+	* expr.c (gfc_is_constant_expr, gfc_traverse_expr): Handle
+	proc-pointers and type-bound procedures.
+	(gfc_specification_expr): Check proc-pointers for pureness.
+
+2010-04-09  Iain Sandoe  <iains@gcc.gnu.org>
+
+	PR bootstrap/43684
+	* gfortranspec.c (lang_specific_driver): Do not expose vars 
+	only used by HAVE_LD_STATIC_DYNAMIC targets unless compiling
+	for such.
+
+2010-04-09  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
+	* decl.c (variable_decl, match_attr_spec): Fix setting the array
+	spec.
+	* array.c (match_subscript,gfc_match_array_ref): Add coarray support.
+	* data.c (gfc_assign_data_value): Ditto.
+	* expr.c (gfc_check_pointer_assign): Add check for coarray constraint.
+	(gfc_traverse_expr): Traverse also through codimension expressions.
+	(gfc_is_coindexed, gfc_has_ultimate_allocatable,
+	gfc_has_ultimate_pointer): New functions.
+	* gfortran.h (gfc_array_ref_dimen_type): Add DIMEN_STAR for coarrays.
+	(gfc_array_ref): Add codimen.
+	(gfc_array_ref): Add in_allocate.
+	(gfc_is_coindexed, gfc_has_ultimate_allocatable,
+	gfc_has_ultimate_pointer): Add prototypes.
+	* interface.c (compare_parameter, compare_actual_formal,
+	check_intents): Add coarray constraints.
+	* match.c (gfc_match_iterator): Add coarray constraint.
+	* match.h (gfc_match_array_ref): Update interface.
+	* primary.c (gfc_match_varspec): Handle codimensions.
+	* resolve.c (coarray_alloc, inquiry_argument): New static variables.
+	(check_class_members): Return gfc_try instead for error recovery.
+	(resolve_typebound_function,resolve_typebound_subroutine,
+	check_members): Handle return value of check_class_members.
+	(resolve_structure_cons, resolve_actual_arglist, resolve_function,
+	check_dimension, compare_spec_to_ref, resolve_array_ref,
+	resolve_ref, resolve_variable, gfc_resolve_expr, conformable_arrays,
+	resolve_allocate_expr, resolve_ordinary_assign): Add coarray
+	support.
+	* trans-array.c (gfc_conv_array_ref, gfc_walk_variable_expr):
+	Skip over coarray refs.
+	(gfc_array_allocate) Add support for references containing coindexes.
+	* trans-expr.c (gfc_add_interface_mapping): Copy coarray attribute.
+	(gfc_map_intrinsic_function): Ignore codimensions.
+
+2010-04-08  Bud Davis  <bdavis9659@sbcglobal.net>
+
+	PR fortran/28039
+	* io.c (check_format_string):  Added check for additional non 
+	blank characters after the format string was successfully 
+	parsed.
+	* io.c (check_format): Changed the error messages for positive
+	int required and period required to drop through the error logic
+	and report with gfc_error instead of gfc_error_now.  Corrected
+	format postion for hollerith strings.
+
+2010-04-08  Tobias Burnus  <burnus@net-b.de>
+
+	* module.c (use_iso_fortran_env_module): Fix standard check.
+
+2010-04-07  Jakub Jelinek  <jakub@redhat.com>
+
+	* parse.c (parse_derived, parse_enum): Avoid set but not used
+	warning.
+
+2010-04-07  Janne Blomqvist  <jb@gcc.gnu.org>
+
+	PR fortran/40539
+	* gfortran.texi: Add section about representation of
+	LOGICAL variables.
+
+2010-04-07  Simon Baldwin  <simonb@google.com>
+
+	* cpp.c (cb_cpp_error): Add warning reason argument, set a value
+	for diagnostic_override_option_index if CPP_W_WARNING_DIRECTIVE.
+
+2010-04-07  Richard Guenther  <rguenther@suse.de>
+
+	* options.c (gfc_init_options): Do not set.
+
+2010-04-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
+	* array.c (gfc_match_array_spec): Add error for -fcoarray=none.
+	* match.c (gfc_match_critical, sync_statement): Ditto.
+	* gfortran.h (gfc_fcoarray): New enum.
+	(gfc_option_t): Use it.
+	* lang.opt (fcoarray): Add new flag.
+	* invoke.texi (fcoarray): Document it.
+	* options.c (gfc_init_options,gfc_handle_option): Handle -fcoarray=.
+	(gfc_handle_coarray_option): New function.
+
+2010-04-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
+	* gfortran.h (gfc_array_spec): Add cotype.
+	* array.c (gfc_match_array_spec,gfc_set_array_spec): Use it
+	and defer error diagnostic.
+	* resolve.c (resolve_fl_derived): Add missing check.
+	(resolve_symbol): Add cotype/type check.
+	* parse.c (parse_derived): Fix setting of coarray_comp.
+
+2010-04-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
+	* array.c (gfc_free_array_spec,gfc_resolve_array_spec,
+	match_array_element_spec,gfc_copy_array_spec,
+	gfc_compare_array_spec): Include corank.
+	(match_array_element_spec,gfc_set_array_spec): Support codimension.
+	* decl.c (build_sym,build_struct,variable_decl,
+	match_attr_spec,attr_decl1,cray_pointer_decl,
+	gfc_match_volatile): Add codimension.
+	(gfc_match_codimension): New function.
+	* dump-parse-tree.c (show_array_spec,show_attr): Support codimension.
+	* gfortran.h (symbol_attribute,gfc_array_spec): Ditto.
+	(gfc_add_codimension): New function prototype.
+	* match.h (gfc_match_codimension): New function prototype.
+	(gfc_match_array_spec): Update prototype
+	* match.c (gfc_match_common): Update gfc_match_array_spec call.
+	* module.c (MOD_VERSION): Bump.
+	(mio_symbol_attribute): Support coarray attributes.
+	(mio_array_spec): Add corank support.
+	* parse.c (decode_specification_statement,decode_statement,
+	parse_derived): Add coarray support.
+	* resolve.c (resolve_formal_arglist, was_declared,
+	is_non_constant_shape_array, resolve_fl_variable,
+	resolve_fl_derived, resolve_symbol): Add coarray support.
+	* symbol.c (check_conflict, gfc_add_volatile, gfc_copy_attr,
+	gfc_build_class_symbol): Add coarray support.
+	(gfc_add_codimension): New function.
+
+2010-04-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/18918
+	* iso-fortran-env.def: Add the integer parameters atomic_int_kind,
+	atomic_logical_kind, iostat_inquire_internal_unit, stat_locked,
+	stat_locked_other_image, stat_stopped_image and stat_unlocked of
+	Fortran 2008.
+	* intrinsic.texi (iso_fortran_env): Ditto.
+	* libgfortran.h (libgfortran_stat_codes): New enum.
+	* module.c (use_iso_fortran_env_module): Honour -std= when loading
+	constants from the intrinsic module.
+
+2010-04-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/39997
+	* intrinsic.c (add_functions): Add num_images.
+	* decl.c (gfc_match_end): Handle END CRITICAL.
+	* intrinsic.h (gfc_simplify_num_images): Add prototype.
+	* dump-parse-tree.c (show_code_node): Dump CRITICAL, ERROR STOP,
+	and SYNC.
+	* gfortran.h (gfc_statement): Add enum items for those.
+	(gfc_exec_op) Ditto.
+	(gfc_isym_id): Add num_images.
+	* trans-stmt.c (gfc_trans_stop): Handle ERROR STOP.
+	(gfc_trans_sync,gfc_trans_critical): New functions.
+	* trans-stmt.h (gfc_trans_stop,gfc_trans_sync,
+	gfc_trans_critical): Add/update prototypes.
+	* trans.c (gfc_trans_code): Handle CRITICAL, ERROR STOP,
+	and SYNC statements.
+	* trans.h (gfor_fndecl_error_stop_string) Add variable.
+	* resolve.c (resolve_sync): Add function.
+	(gfc_resolve_blocks): Handle CRITICAL.
+	(resolve_code): Handle CRITICAL, ERROR STOP,
+	(resolve_branch): Add CRITICAL constraint check.
+	and SYNC statements.
+	* st.c (gfc_free_statement): Add new statements.
+	* trans-decl.c (gfor_fndecl_error_stop_string): Global variable.
+	(gfc_build_builtin_function_decls): Initialize it.
+	* match.c (gfc_match_if): Handle ERROR STOP and SYNC.
+	(gfc_match_critical, gfc_match_error_stop, sync_statement,
+	gfc_match_sync_all, gfc_match_sync_images, gfc_match_sync_memory):
+	New functions.
+	(match_exit_cycle): Handle CRITICAL constraint.
+	(gfc_match_stopcode): Handle ERROR STOP.
+	* match.h (gfc_match_critical, gfc_match_error_stop,
+	gfc_match_sync_all, gfc_match_sync_images,
+	gfc_match_sync_memory): Add prototype.
+	* parse.c (decode_statement, gfc_ascii_statement,
+	parse_executable): Handle new statements.
+	(parse_critical_block): New function.
+	* parse.h (gfc_compile_state): Add COMP_CRITICAL.
+	* intrinsic.texi (num_images): Document new function.
+	* simplify.c (gfc_simplify_num_images): Add function.
+
+2010-04-06  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43178
+	* trans-array.c (gfc_conv_expr_descriptor): Update
+	gfc_trans_scalar_assign call.
+	(has_default_initializer): New function.
+	(gfc_trans_deferred_array): Nullify less often.
+	* trans-expr.c (gfc_conv_subref_array_arg,
+	gfc_trans_subcomponent_assign): Update call to
+	gfc_trans_scalar_assign.
+	(gfc_trans_scalar_assign): Add parameter and pass it on.
+	(gfc_trans_assignment_1): Optionally, do not dealloc before
+	assignment.
+	* trans-openmp.c (gfc_trans_omp_array_reduction): Update
+	call to gfc_trans_scalar_assign.
+	* trans-decl.c (gfc_get_symbol_decl): Do not always apply
+	initializer to static variables.
+	(gfc_init_default_dt): Add dealloc parameter and pass it on.
+	* trans-stmt.c (forall_make_variable_temp,
+	generate_loop_for_temp_to_lhs, generate_loop_for_rhs_to_temp,
+	gfc_trans_forall_1, gfc_trans_where_assign, gfc_trans_where_3
+	gfc_trans_allocate): Update gfc_trans_assignment call.
+	* trans.h (gfc_trans_scalar_assign, gfc_init_default_dt,
+	gfc_init_default_dt, gfc_trans_assignment): Add bool dealloc
+	parameter to prototype.
+
+2010-03-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	* ioparm.def : Update copyright.
+	* lang.opt : ditto
+	* trans-array.c : ditto
+	* trans-array.h : ditto
+	* expr.c: ditto
+	* trans-types.c: ditto
+	* dependency.c : ditto
+	* gfortran.h : ditto
+	* options.c : ditto
+	* trans-io.c : ditto
+	* trans-intrinsic.c : ditto
+	* libgfortran.h : ditto
+	* invoke.texi : ditto
+	* intrinsic.texi : ditto
+	* trans.c : ditto
+	* trans.h : ditto
+	* intrinsic.c : ditto
+	* interface.c : ditto
+	* iresolve.c : ditto
+	* trans-stmt.c : ditto
+	* trans-stmt.h : ditto
+	* parse,c : ditto
+	* match.h : ditto
+	* error.c : ditto
+
+2010-03-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43450
+	* trans-decl.c (gfc_create_module_variable): With -fwhole-file
+	do not assert the context of derived types.
+
+2010-03-20  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/43409
+	* ioparm.def: Change inquire size variable to type pointer to
+	GFC_IO_INT type.
+
+2010-03-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43039
+	* trans-expr.c (conv_parent_component_references): Ensure that
+	'dt' has a backend_decl.
+
+	PR fortran/43043
+	* trans-expr.c (gfc_conv_structure): Ensure that the derived
+	type has a backend_decl.
+
+	PR fortran/43044
+	* resolve.c (resolve_global_procedure): Check that the 'cl'
+	structure is not NULL.
+
+2010-03-18  Shujing Zhao  <pearly.zhao@oracle.com>
+
+	* lang.opt (-ffixed-line-length-, ffree-line-length-): Remove
+	redundant tab.
+
+2010-03-17  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43331
+	* trans-array.c (gfc_conv_array_index_offset,gfc_conv_array_ref,
+	gfc_conv_ss_startstride): Remove no-longer-needed cp_was_assumed
+	check.
+	* decl.c (gfc_match_derived_decl): Don't mark assumed-size Cray
+	pointees as having explizit size.
+	* expr.c (gfc_check_assign): Remove now unreachable Cray pointee
+	check.
+	* trans-types.c (gfc_is_nodesc_array): Add cp_was_assumed to assert.
+	(gfc_sym_type): Don't mark Cray pointees as restricted pointers.
+	* resolve.c (resolve_symbol): Handle cp_was_assumed.
+	* trans-decl.c (gfc_trans_deferred_vars): Ditto.
+	(gfc_finish_var_decl): Don't mark Cray pointees as restricted
+	pointers.
+
+2010-03-14  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43362
+	* resolve.c (resolve_structure_cons): Add missing PURE constraint.
+	(resolve_ordinary_assign): Add check to avoid segfault.
+
+2010-03-12  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43291
+	PR fortran/43326
+	* resolve.c (resolve_compcall): Add new boolean dummy argument
+	'class_members'. Only resolve expression at end if false.
+	Remove redundant, static variable 'class_object'.
+	(check_class_members): Add extra argument to call of
+	resolve_compcall.
+	(resolve_typebound_function): Renamed resolve_class_compcall.
+	Do all the detection of class references here. Correct calls to
+	resolve_compcall for extra argument.
+	(resolve_typebound_subroutine): resolve_class_typebound_call
+	renamed. Otherwise same as resolve_typebound_function.
+	(gfc_resolve_expr): Call resolve_typebound_function.
+	(resolve_code): Call resolve_typebound_subroutine.
+
+2010-03-10  Tobias Burnus  <burnus@net-b.de
+
+	PR fortran/43303
+	* symbol.c (get_iso_c_sym): Set sym->result.
+
+2010-03-08  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/43256
+	* resolve.c (resolve_compcall): Don't set 'value.function.name' here
+	for TBPs, otherwise they will not be resolved properly.
+	(resolve_function): Use 'value.function.esym' instead of
+	'value.function.name' to check if we're dealing with a TBP.
+	(check_class_members): Set correct type of passed object for all TBPs,
+	not only generic ones, except if the type is abstract.
+
+2010-03-04  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/43244
+	* decl.c (gfc_match_final_decl): Make sure variable names starting with
+	'final...' are not misinterpreted as FINAL statements.
+
+2010-03-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43243
+	* trans-array.c (gfc_conv_array_parameter): Contiguous refs to
+	allocatable ultimate components do not need temporaries, whilst
+	ultimate pointer components do.
+
+2010-03-03  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/43169
+	* resolve.c (resolve_code): Correctly set gfc_current_ns for
+	EXEC_SELECT_TYPE.
+	(gfc_impure_variable): Make it work with sub-namespaces (BLOCK etc).
+	(gfc_pure): Ditto.
+
+2010-03-02  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43180
+	* trans-array.c (gfc_conv_array_parameter): A full array of
+	derived type need not be restricted to a symbol without an
+	array spec to use the call to gfc_conv_expr_descriptor.
+
+	PR fortran/43173
+	* trans-array.c (gfc_conv_array_parameter): Contiguous refs to
+	allocatable arrays do not need temporaries.
+
+2010-03-01  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43199
+	* resolve.c (find_array_spec): Handle REF_COMPONENT with
+	CLASS components.
+
+2010-02-28  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43205
+	* trans-expr.c (is_zero_initializer_p): Move up in the file.
+	(gfc_conv_initializer): Handle zero initializer as special case.
+
+2010-02-27  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43185
+	* resolve.c (resolve_fl_variable_derived): Imply SAVE
+	for module variables for Fortran 2008.
+
+2010-02-25  Jakub Jelinek  <jakub@redhat.com>
+
+	PR debug/43166
+	* trans-common.c (build_common_decl): Also update DECL_MODE,
+	and DECL_SIZE when encountering a larger common block and call
+	layout_decl.
+
+2010-02-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43042
+	* trans-expr.c (gfc_conv_initializer): Call directly
+	gfc_conv_constant for C_NULL_(FUN)PTR.
+
+2010-02-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43072
+	* dependency.c (gfc_full_array_ref_p): Check for contiguous by
+	checking the rest of the dimensions for elements.
+
+2010-02-21  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/35259
+	* gfortran.h (gfc_option_t): New flag -fprotect-parens.
+	* lang.opt: Ditto.
+	* option.c (gfc_init_options,gfc_handle_option): Ditto.
+	* trans-expr.c (gfc_conv_expr_op): Use the flag.
+	* invoke.texi: Document new -fno-protect-parens flag.
+
+2010-02-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/36932
+	PR fortran/36933
+	PR fortran/43072
+	PR fortran/43111
+	* dependency.c (gfc_check_argument_var_dependency): Use enum
+	value instead of arithmetic vaue for 'elemental'.
+	(check_data_pointer_types): New function.
+	(gfc_check_dependency): Call check_data_pointer_types.
+	* trans-array.h : Change fourth argument of
+	gfc_conv_array_parameter to boolean.
+	* trans-array.c (gfc_conv_array_parameter): A contiguous array
+	can be a dummy but it must not be assumed shape or deferred.
+	Change fourth argument to boolean. Array constructor exprs will
+	always be contiguous and do not need packing and unpacking.
+	* trans-expr.c (gfc_conv_procedure_call): Clean up some white
+	space and change fourth argument of gfc_conv_array_parameter
+	to boolean.
+	(gfc_trans_arrayfunc_assign): Change fourth argument of
+	gfc_conv_array_parameter to boolean.
+	* trans-io.c (gfc_convert_array_to_string): The same.
+	* trans-intrinsic.c (gfc_conv_intrinsic_loc): The same.
+
+2010-02-20  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/42958
+	* libgfortran.h: Add GFC_RTCHECK_MEM.
+	* invoke.texi (-fcheck=): Document -fcheck=mem.
+	* tranc.c (gfc_call_malloc): Remove negative-size run-time error
+	and enable malloc-success check only with -fcheck=mem.
+	* option.c (gfc_handle_runtime_check_option): Add -fcheck=mem.
+
+2010-02-16  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43040
+	* gfortran.h (gfc_isym_id): Rename GFS_ISYM_GAMMA to GFS_ISYM_TGAMMA.
+	* intrinsic.c (add_functions): Ditto.
+	* iresolve.c (gfc_resolve_gamma): Call tgamma instead of gamma.
+	* mathbuiltins.def: Use TGAMMA instead of GAMMA with "tgamma".
+
+2010-02-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/32382
+	* trans-stmt.h: Add prototype for gfc_trans_code_cond. Add tree cond to
+	gfc_trans_do prototype.
+	* trans-stmt.c (gfc_trans_simple_do): Add optional argument to pass in
+	a loop exit condition.  If exit condition is given, build the loop exit
+	code, checking IO results of implied do loops in READ and WRITE.
+	(gfc_trans_do): Likewise.
+	* trans.c (trans_code): New static work function, previously
+	gfc_trans_code. Passes exit condition to gfc_trans_do.
+	(gfc_trans_code): Calls trans_code with NULL_TREE condition.
+	(gfc_trans_code_cond): Calls trans_code with loop exit condition.
+	* trans-io.c (build_dt): Build an exit condition to allow checking IO
+	result status bits in the dtparm structure. Use this condition in call
+	to gfc_trans_code_cond.
+
+2010-02-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41113
+	PR fortran/41117
+	* trans-array.c (gfc_conv_array_parameter): Use
+	gfc_full_array_ref_p to detect full and contiguous variable
+	arrays. Full array components and contiguous arrays do not need
+	internal_pack and internal_unpack.
+
+2010-02-11  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/43030
+	* resolve.c (gfc_resolve_dim_arg): Call gfc_clear_ts.
+
+	PR fortran/43029
+	* decl.c (enumerator_decl): Don't call gfc_free_enum_history
+	here.
+	(gfc_match_enumerator_def): But here whenever enumerator_decl returns
+	MATCH_ERROR.
+
+2010-02-10  Joost VandeVondele <jv244@cam.ac.uk>
+	    Tobias Burnus <burnus@net-b.de>
+
+	PR fortran/40823
+	* decl.c (gfc_match_subroutine): Explicitly set sym->declared_at.
+
+2010-02-10  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/43015
+	* trans-decl.c (gfc_generate_function_code): Only check
+	actual-vs.-dummy character bounds if not bind(C).
+
+2010-02-10  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/42309
+	* trans-expr.c (gfc_conv_subref_array_arg): Avoid accessing
+	info->dimen after info has been freed.
+
+2010-02-09  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/42999
+	* array.c (gfc_constant_ac): Do not prevent expansion of constructors
+	with iterators.
+
+2010-02-09  Jakub Jelinek  <jakub@redhat.com>
+
+	* module.c (fix_mio_expr): Declare sym.
+
+2010-02-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41869
+	* module.c (fix_mio_expr): Fix for private generic procedures.
+
+2010-02-09  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/39171
+	* resolve.c (resolve_charlen): Change warning about negative CHARACTER
+	length to be correct and issue only with -Wsurprising.
+	* invoke.texi (Wsurprising): Mention this new warning that is
+	turned on by -Wsurprising.
+
+2010-02-09  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/41507
+	* intrinsic.texi (MAXVAL): Remove wrong claim that array argument
+	can be CHARACTER type.
+	(MINVAL), (MAXLOC), (MINLOC): Ditto.
+
+2010-02-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/42309
+	* trans-expr.c (gfc_conv_subref_array_arg): Add new argument
+	'formal_ptr'. If this is true, give returned descriptor unity
+	lbounds, in all dimensions, and the appropriate offset.
+	(gfc_conv_procedure_call); If formal is a pointer, set the last
+	argument of gfc_conv_subref_array_arg to true.
+	* trans.h : Add last argument for gfc_conv_subref_array_arg.
+	* trans-io.c (set_internal_unit, gfc_trans_transfer): Set the
+	new arg of gfc_conv_subref_array_arg to false.
+	* trans-stmt.c (forall_make_variable_temp): The same.
+
+2010-02-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/42936
+	* interface.c (compare_parameter): Disable rank-checking
+	for NULL().
+
+2010-02-02  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/42650
+	* parse.c (decode_specification_statement): Use sym->result not sym.
+
+2010-02-01  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/42922
+	* decl.c (variable_decl): Allow default initializer in
+	TYPE declarations in PURE functions.
+
+2010-01-31  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42888
+	* resolve.c (resolve_allocate_expr): Move default initialization code
+	here from gfc_trans_allocate.
+	* trans.c (gfc_trans_code): Call gfc_trans_class_assign also for
+	EXEC_INIT_ASSIGN.
+	* trans-expr.c (gfc_trans_class_assign): Handle default initialization
+	of CLASS variables via memcpy.
+	* trans-stmt.c (gfc_trans_allocate): Move default initialization code
+	to resolve_allocate_expr.
+
+2010-01-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38324
+	* expr.c (gfc_get_full_arrayspec_from_expr): New function.
+	* gfortran.h : Add prototype for above.
+	* trans-expr.c (gfc_trans_alloc_subarray_assign): New function.
+	(gfc_trans_subcomponent_assign): Call new function to replace
+	the code to deal with allocatable components.
+	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Call
+	gfc_get_full_arrayspec_from_expr to replace existing code.
+
+2010-01-25  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/42858
+	* array.c (gfc_array_dimen_size): Fix intrinsic procedure
+	check.
+
+2010-01-24  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41044
+	PR fortran/41167
+	* expr.c (remove_subobject_ref): If the constructor is NULL use
+	the expression as the source.
+	(simplify_const_ref): Change the type of expression if
+	there are component references.  Allow for substring to be at
+	the end of an arbitrarily long chain of references.  If an
+	element is found that is not in an EXPR_ARRAY, assume that this
+	is scalar initialization of array. Call remove_subobject_ref in
+	this case with NULL second argument.
+
+2010-01-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/39304
+	* array.c (gfc_array_dimen_size): Use correct specific
+	function in the check.
+
+2010-01-21  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/42736
+	* trans-stmt.c (gfc_conv_elemental_dependencies): If temporary
+	is required, turn any trailing array elements after a range
+	into ranges so that offsets can be calculated.
+
+2010-01-20  Joern Rennecke  <amylaar@spamcop.net>
+
+	* module.c (mio_f2k_derived): Use enumerator as initializer of
+	enum variable.
+
+	PR bootstrap/42812
+	* gfortran.h  (struct gfc_namespace) <resolved>: Change to signed
+	bitfield of width 2.
+
+2010-01-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42804
+	* resolve.c (extract_compcall_passed_object): Set locus for
+	passed-object argument.
+	(extract_ppc_passed_object): Set locus and correctly remove PPC
+	reference.
+
+2010-01-19  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/42783
+	* trans-decl.c (add_argument_checking): Do not use the backend
+	decl directly to test for the presence of an optional dummy
+	argument.  Use gfc_conv_expr_present, remembering to set the
+	symbol referenced.
+
+	PR fortran/42772
+	* trans-decl.c (gfc_generate_function_code): Small white space
+	changes. If 'recurcheckvar' is NULL do not try to reset it.
+
+2010-01-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42545
+	* resolve.c (resolve_fl_derived): Set the accessibility of the parent
+	component for extended types.
+	* symbol.c (gfc_find_component): Remove a wrongly-worded error message
+	and take care of parent component accessibility.
+
+2010-01-17  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42677
+	* gfortran.h (symbol_attribute): Remove 'ambiguous_interfaces'.
+	* interface.c (check_interface1): Move a warning message here from
+	resolve_fl_procedure.
+	(check_sym_interfaces): Removed 'attr.ambiguous_interfaces'.
+	* module.c (read_module): Remove call to gfc_check_interfaces, since
+	this comes too early here.
+	* resolve.c (resolve_fl_procedure): Move warning message to
+	check_interface1.
+
+2010-01-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+	PR fortran/42684
+	* interface.c (check_interface1): Pass symbol name rather than NULL to
+	gfc_compare_interfaces.	(gfc_compare_interfaces): Add assert to
+	trap MULL.
+	* resolve.c (check_generic_tbp_ambiguity): Pass symbol name rather
+	than NULL to gfc_compare_interfaces.
+
+2010-01-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41478
+	* trans-array.c (duplicate_allocatable):  Static version of
+	gfc_duplicate_allocatable with provision to handle scalar
+	components. New boolean argument to switch off call to malloc
+	if true.
+	(gfc_duplicate_allocatable): New function to call above with
+	new argument false.
+	(gfc_copy_allocatable_data): New function to call above with
+	new argument true.
+	(structure_alloc_comps): Do not apply indirect reference to
+	scalar pointers. Add new section to copy allocatable components
+	of arrays. Extend copying of allocatable components to include
+	scalars.
+	(gfc_copy_only_alloc_comp): New function to copy allocatable
+	component derived types, without allocating the base structure.
+	* trans-array.h : Add primitive for gfc_copy_allocatable_data.
+	Add primitive for gfc_copy_only_alloc_comp.
+	* trans-expr.c (gfc_conv_procedure_call): After calls to
+	transformational functions with results that are derived types
+	with allocatable components, copy the components in the result.
+	(gfc_trans_arrayfunc_assign): Deallocate allocatable components
+	of lhs derived types before allocation.
+	
+2010-01-14  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/42481
+	* module.c (load_generic_interfaces): If a procedure that is
+	use associated but not generic is given an interface that
+	includes itself, then make it generic.
+
+2010-01-11  Joseph Myers  <joseph@codesourcery.com>
+	    Shujing Zhao  <pearly.zhao@oracle.com>
+
+	PR translation/42469
+	* lang.opt (fblas-matmul-limit=, finit-character=, finit-integer=,
+	finit-logical=, finit-real=, fmax-array-constructor=): Use tab
+	character between option name and help text.
+
+2010-01-09 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+	PR fortran/20923
+	PR fortran/32489
+	* trans-array.c (gfc_conv_array_initializer): Change call to
+	gfc_error_now to call to gfc_fatal_error.
+	* array.c (count_elements): Whitespace. (extract_element): Whitespace.
+	(is_constant_element): Changed name from constant_element.
+	(gfc_constant_ac): Only use expand_construuctor for expression
+	types of EXPR_ARRAY.  If expression type is EXPR_CONSTANT, no need to
+	call gfc_is_constant_expr.
+	* expr.c (gfc_reduce_init_expr): Adjust conditionals and delete error
+	message.
+	* resolve.c (gfc_is_expandable_expr): New function that determiners if
+	array expressions should have their constructors expanded.
+	(gfc_resolve_expr): Use new function to determine whether or not to call
+	gfc_expand_constructor.
+
+2010-01-09  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41298
+	* trans-expr.c (gfc_trans_structure_assign): Handle
+	c_null_(fun)ptr.
+	* symbol.c (gen_special_c_interop_ptr): Add NULL_EXPR
+	to the constructor for c_null_(fun)ptr.
+	* resolve.c (resolve_structure_cons): Add special case
+	for c_null_(fun)ptr.
+
+2010-01-09  Jakub Jelinek  <jakub@redhat.com>
+
+	* gfortranspec.c (lang_specific_driver): Update copyright notice
+	dates.
+
+2010-01-08  Tobias Burnus  <burnus@net-b.de>
+
+	PR/fortran 25829
+	* symbol.c (check_conflict, gfc_copy_attr): Add
+	ASYNCHRONOUS support.
+	(gfc_add_asynchronous): New function.
+	* decl.c (match_attr_spec): Add ASYNCHRONOUS support.
+	(gfc_match_asynchronous): New function.
+	* dump-parse-tree.c (show_attr): Add ASYNCHRONOUS support.
+	* gfortran.h (symbol_attribute): New ASYNCHRONOUS bit.
+	(gfc_add_asynchronous): New Prototype.
+	* module.c (ab_attribute, mio_symbol_attribute): Add
+	ASYNCHRONOUS support.
+	* resolve.c (was_declared): Ditto.
+	* match.h (gfc_match_asynchronous): New prototype.
+	* parse.c (decode_specification_statement,decode_statement):
+	Add ASYNCHRONOUS support.
+
+2010-01-07  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/42597
+	* trans-decl.c (get_proc_pointer_decl): Fix call to
+	gfc_conv_initializer for array-valued proc-pointer funcs.
+
+2010-01-07  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41872
+	* trans-decl.c (gfc_trans_deferred_vars): Don't initialize
+	allocatable scalars with SAVE attribute.
+
+2010-01-05  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/42517
+	* options.c (gfc_post_options): Set -frecursion
+	when -fopenmp is used.
+
+2010-01-05  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41872
+	* trans-expr.c (gfc_conv_procedure_call): Nullify
+	return value for allocatable-scalar character functions.
+
+2010-01-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/36161
+	* error.c (error_printf, gfc_warning, gfc_notify_std,
+	gfc_warning_now, gfc_error, gfc_error_now,
+	gfc_fatal_error): Change argument name from nocmsgid to
+	gmsgid to enable (x)gettext's % checking.
+
+2010-01-04  Tobias Burnus  <burnus@net-b.de>
+	
+	* trans-decl.c (gfc_trans_deferred_vars): Fix spelling.
+
+2010-01-04  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/41872
+	* trans-expr.c (gfc_conv_procedure_call): Add indirect ref
+	for functions returning allocatable scalars.
+	* trans-stmt.c (gfc_trans_allocate): Emmit error when
+	reallocating an allocatable scalar.
+	* trans.c (gfc_allocate_with_status): Fix pseudocode syntax
+	in comment.
+	* trans-decl.c (gfc_trans_deferred_vars): Nullify local
+	allocatable scalars.
+	(gfc_generate_function_code): Nullify result variable for
+	allocatable scalars.
+	
+	PR fortran/40849
+	* module.c (gfc_use_module): Fix warning string to allow
+	for translation.
+
+	PR fortran/42517
+	* invoke.texi (-fcheck=recursion): Mention that the checking
+	is also disabled for -frecursive.
+	* trans-decl.c (gfc_generate_function_code): Disable
+	-fcheck=recursion when -frecursive is used.
+
+	* intrinsic.texi (iso_c_binding): Improve wording.
+
+
+Copyright (C) 2010 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved.
diff --git a/gcc/fortran/ChangeLog.ptr b/gcc/fortran/ChangeLog.ptr
new file mode 100644
index 000000000..c8d8527f9
--- /dev/null
+++ b/gcc/fortran/ChangeLog.ptr
@@ -0,0 +1,17 @@
+2007-05-15  Andrew Pinski  <andrew_pinski@playstation.sony.com>
+
+	* trans-intrinsic.c (gfc_conv_intrinsic_repeat): Use
+	POINTER_PLUS_EXPR instead of PLUS_EXPR for pointer addition.
+
+2007-05-07  Andrew Pinski  <andrew_pinski@playstation.sony.com>
+
+	* trans-expr.c (gfc_trans_string_copy): Create
+	POINTER_PLUS_EXPR instead of a PLUS_EXPR
+	for pointer types.
+
+
+Copyright (C) 2007 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved.
diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
new file mode 100644
index 000000000..318064a80
--- /dev/null
+++ b/gcc/fortran/Make-lang.in
@@ -0,0 +1,365 @@
+# -*- makefile -*-
+# Top level makefile fragment for GNU gfortran, the GNU Fortran 95 compiler.
+# Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+# Free Software Foundation, Inc.
+# Contributed by Paul Brook <paul@nowt.org
+# and Steven Bosscher <s.bosscher@student.tudelft.nl>
+
+#This file is part of GCC.
+
+#GCC is free software; you can redistribute it and/or modify
+#it under the terms of the GNU General Public License as published by
+#the Free Software Foundation; either version 3, or (at your option)
+#any later version.
+
+#GCC is distributed in the hope that it will be useful,
+#but WITHOUT ANY WARRANTY; without even the implied warranty of
+#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#GNU General Public License for more details.
+
+#You should have received a copy of the GNU General Public License
+#along with GCC; see the file COPYING3.  If not see
+#<http://www.gnu.org/licenses/>.
+
+# This file provides the language dependent support in the main Makefile.
+# Each language makefile fragment must provide the following targets:
+#
+# foo.all.cross, foo.start.encap, foo.rest.encap,
+# foo.install-common, foo.install-man, foo.install-info, foo.install-pdf,
+# foo.install-html, foo.info, foo.dvi, foo.pdf, foo.html, foo.uninstall,
+# foo.mostlyclean, foo.clean, foo.distclean,
+# foo.maintainer-clean, foo.stage1, foo.stage2, foo.stage3, foo.stage4
+#
+# where `foo' is the name of the language.
+#
+# It should also provide rules for:
+#
+# - making any compiler driver (eg: gfortran)
+# - the compiler proper (eg: f951)
+# - define the names for selecting the language in LANGUAGES.
+# $(srcdir) must be set to the gcc/ source directory (*not* gcc/fortran/).
+
+# Actual name to use when installing a native compiler.
+GFORTRAN_INSTALL_NAME := $(shell echo gfortran|sed '$(program_transform_name)')
+GFORTRAN_TARGET_INSTALL_NAME := $(target_noncanonical)-$(shell echo gfortran|sed '$(program_transform_name)')
+
+#^L
+
+# Use strict warnings for this front end.
+fortran-warn = $(STRICT_WARN)
+
+# These are the groups of object files we have.  The F95_PARSER_OBJS are
+# all the front end files, the F95_OBJS are the files for the translation
+# from the parse tree to GENERIC
+
+F95_PARSER_OBJS = fortran/arith.o fortran/array.o fortran/bbt.o \
+    fortran/check.o fortran/class.o fortran/constructor.o fortran/cpp.o \
+    fortran/data.o fortran/decl.o fortran/dump-parse-tree.o fortran/error.o \
+    fortran/expr.o fortran/interface.o fortran/intrinsic.o fortran/io.o \
+    fortran/iresolve.o fortran/match.o fortran/matchexp.o fortran/misc.o \
+    fortran/module.o fortran/openmp.o fortran/options.o fortran/parse.o \
+    fortran/primary.o fortran/resolve.o fortran/scanner.o fortran/simplify.o \
+    fortran/st.o fortran/symbol.o fortran/target-memory.o
+
+F95_OBJS = $(F95_PARSER_OBJS) $(FORTRAN_TARGET_OBJS) \
+    fortran/convert.o fortran/dependency.o fortran/f95-lang.o \
+    fortran/trans.o fortran/trans-array.o fortran/trans-common.o \
+    fortran/trans-const.o fortran/trans-decl.o fortran/trans-expr.o \
+    fortran/trans-intrinsic.o fortran/trans-io.o fortran/trans-openmp.o \
+    fortran/trans-stmt.o fortran/trans-types.o fortran/frontend-passes.o
+
+fortran_OBJS = $(F95_OBJS) gfortranspec.o
+
+#
+# Define the names for selecting gfortran in LANGUAGES.
+fortran: f951$(exeext)
+
+# Tell GNU make to ignore files by these names if they exist.
+.PHONY: fortran
+
+gfortranspec.o: $(srcdir)/fortran/gfortranspec.c $(SYSTEM_H) $(TM_H) $(GCC_H) \
+	$(CONFIG_H) coretypes.h intl.h $(OPTS_H)
+	(SHLIB_LINK='$(SHLIB_LINK)'; \
+	$(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(DRIVER_DEFINES) \
+		$(INCLUDES) $(srcdir)/fortran/gfortranspec.c)
+
+# Create the compiler driver gfortran.
+GFORTRAN_D_OBJS = $(GCC_OBJS) gfortranspec.o version.o prefix.o intl.o
+gfortran$(exeext): $(GFORTRAN_D_OBJS) $(EXTRA_GCC_OBJS) $(LIBDEPS)
+	+$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ \
+	  $(GFORTRAN_D_OBJS) $(EXTRA_GCC_OBJS) $(LIBS)
+
+# Create a version of the gfortran driver which calls the cross-compiler.
+gfortran-cross$(exeext): gfortran$(exeext)
+	-rm -f gfortran-cross$(exeext)
+	cp gfortran$(exeext) gfortran-cross$(exeext)
+
+# The compiler itself is called f951.
+f951$(exeext): $(F95_OBJS) \
+		$(BACKEND) $(LIBDEPS) attribs.o
+	+$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ \
+		$(F95_OBJS) $(BACKEND) $(LIBS) attribs.o $(BACKENDLIBS)
+
+gt-fortran-trans.h    : s-gtype; @true
+#
+# Build hooks:
+
+fortran.all.cross: gfortran-cross$(exeext)
+
+fortran.start.encap: gfortran$(exeext)
+fortran.rest.encap:
+
+fortran.srcinfo: doc/gfortran.info
+	-cp -p $^ $(srcdir)/fortran
+
+fortran.tags: force
+	cd $(srcdir)/fortran; etags -o TAGS.sub *.c *.h; \
+	etags --include TAGS.sub --include ../TAGS.sub
+
+fortran.info: doc/gfortran.info doc/gfc-internals.info
+fortran.dvi: doc/gfortran.dvi doc/gfc-internals.dvi
+
+F95_HTMLFILES = $(build_htmldir)/gfortran
+
+fortran.html: $(F95_HTMLFILES)/index.html
+
+fortran.install-html: $(F95_HTMLFILES)
+	@$(NORMAL_INSTALL)
+	test -z "$(htmldir)" || $(mkinstalldirs) "$(DESTDIR)$(htmldir)"
+	@list='$(F95_HTMLFILES)'; for p in $$list; do \
+	  if test -f "$$p" || test -d "$$p"; then d=""; else d="$(srcdir)/"; fi; \
+	  f=$(html__strip_dir) \
+	  if test -d "$$d$$p"; then \
+	    echo " $(mkinstalldirs) '$(DESTDIR)$(htmldir)/$$f'"; \
+	    $(mkinstalldirs) "$(DESTDIR)$(htmldir)/$$f" || exit 1; \
+	    echo " $(INSTALL_DATA) '$$d$$p'/* '$(DESTDIR)$(htmldir)/$$f'"; \
+	    $(INSTALL_DATA) "$$d$$p"/* "$(DESTDIR)$(htmldir)/$$f"; \
+	  else \
+	    echo " $(INSTALL_DATA) '$$d$$p' '$(DESTDIR)$(htmldir)/$$f'"; \
+	    $(INSTALL_DATA) "$$d$$p" "$(DESTDIR)$(htmldir)/$$f"; \
+	  fi; \
+	done
+
+F95_PDFFILES = doc/gfortran.pdf
+
+fortran.pdf: $(F95_PDFFILES) doc/gfc-internals.pdf
+
+fortran.install-pdf: $(F95_PDFFILES)
+	@$(NORMAL_INSTALL)
+	test -z "$(pdfdir)/gcc" || $(mkinstalldirs) "$(DESTDIR)$(pdfdir)/gcc"
+	@list='$(F95_PDFFILES)'; for p in $$list; do \
+	  if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
+	  f=$(pdf__strip_dir) \
+	  echo " $(INSTALL_DATA) '$$d$$p' '$(DESTDIR)$(pdfdir)/gcc/$$f'"; \
+	  $(INSTALL_DATA) "$$d$$p" "$(DESTDIR)$(pdfdir)/gcc/$$f"; \
+	done
+
+F95_MANFILES = doc/gfortran.1
+
+fortran.man: $(F95_MANFILES)
+
+fortran.srcman: $(F95_MANFILES)
+	-cp -p $^ $(srcdir)/doc
+
+fortran.srcextra:
+
+check-f95 : check-gfortran
+check-fortran : check-gfortran
+check-f95-subtargets : check-gfortran-subtargets
+check-fortran-subtargets : check-gfortran-subtargets
+lang_checks += check-gfortran
+lang_checks_parallelized += check-gfortran
+# For description see comment above check_gcc_parallelize in gcc/Makefile.in.
+check_gfortran_parallelize = dg.exp=gfortran.dg/\[a-cA-C\]* \
+			     dg.exp=gfortran.dg/\[d-mD-M\]* \
+			     dg.exp=gfortran.dg/\[n-zN-Z0-9\]*
+
+# GFORTRAN documentation.
+GFORTRAN_TEXI = \
+  $(srcdir)/fortran/gfortran.texi \
+  $(srcdir)/fortran/intrinsic.texi \
+  $(srcdir)/fortran/invoke.texi \
+  $(srcdir)/doc/include/fdl.texi \
+  $(srcdir)/doc/include/gpl_v3.texi \
+  $(srcdir)/doc/include/funding.texi \
+  $(srcdir)/doc/include/gcc-common.texi \
+  gcc-vers.texi
+
+doc/gfortran.info: $(GFORTRAN_TEXI)
+	if [ x$(BUILD_INFO) = xinfo ]; then \
+	  rm -f doc/gfortran.info-*; \
+	  $(MAKEINFO) -I $(srcdir)/doc/include -I $(srcdir)/fortran \
+	    -o $@ $<; \
+	else true; fi
+
+doc/gfortran.dvi: $(GFORTRAN_TEXI)
+	$(TEXI2DVI) -I $(srcdir)/fortran -I $(abs_docdir)/include -o $@ $<
+
+doc/gfortran.pdf: $(GFORTRAN_TEXI)
+	$(TEXI2PDF) -I $(srcdir)/fortran -I $(abs_docdir)/include -o $@ $<
+
+$(build_htmldir)/gfortran/index.html: $(GFORTRAN_TEXI)
+	$(mkinstalldirs) $(@D)
+	rm -f $(@D)/*
+	$(TEXI2HTML) -I $(gcc_docdir)/include -I $(srcdir)/fortran -o $(@D) $<
+
+.INTERMEDIATE: gfortran.pod
+
+gfortran.pod: $(GFORTRAN_TEXI)
+	-$(TEXI2POD) -DBUGURL="$(BUGURL_TEXI)" \
+	  < $(srcdir)/fortran/invoke.texi > $@
+
+# GFORTRAN internals documentation.
+GFC_INTERNALS_TEXI = \
+  $(srcdir)/fortran/gfc-internals.texi \
+  $(srcdir)/doc/include/fdl.texi \
+  $(srcdir)/doc/include/gcc-common.texi \
+  gcc-vers.texi
+
+doc/gfc-internals.info: $(GFC_INTERNALS_TEXI)
+	if [ x$(BUILD_INFO) = xinfo ]; then \
+	  rm -f doc/gfc-internals.info-*; \
+	  $(MAKEINFO) -I $(srcdir)/doc/include -I $(srcdir)/fortran \
+	    -o $@ $<; \
+	else true; fi
+
+doc/gfc-internals.dvi: $(GFC_INTERNALS_TEXI)
+	$(TEXI2DVI) -I $(srcdir)/fortran -I $(abs_docdir)/include -o $@ $<
+
+doc/gfc-internals.pdf: $(GFC_INTERNALS_TEXI)
+	$(TEXI2PDF) -I $(srcdir)/fortran -I $(abs_docdir)/include -o $@ $<
+
+# Create or recreate the gfortran private include file directory.
+install-finclude-dir: installdirs
+	$(mkinstalldirs) -m 0755 $(DESTDIR)$(libsubdir)/finclude
+#
+# Install hooks:
+# f951 is installed elsewhere as part of $(COMPILERS).
+
+# Install the driver program as $(target)-gfortran
+# and also as either gfortran (if native) or $(tooldir)/bin/gfortran.
+fortran.install-common: install-finclude-dir installdirs
+	-if [ -f f951$(exeext) ] ; then \
+	  rm -f $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext); \
+	  $(INSTALL_PROGRAM) gfortran$(exeext) $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext); \
+	  chmod a+x $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext); \
+	  if [ -f gfortran-cross$(exeext) ] ; then \
+	    if [ -d $(DESTDIR)$(gcc_tooldir)/bin/. ] ; then \
+	      rm -f $(DESTDIR)$(gcc_tooldir)/bin/gfortran$(exeext); \
+	      $(INSTALL_PROGRAM) gfortran-cross$(exeext) $(DESTDIR)$(gcc_tooldir)/bin/gfortran$(exeext); \
+	    else true; fi; \
+	  else \
+	    rm -f $(DESTDIR)$(bindir)/$(GFORTRAN_TARGET_INSTALL_NAME)$(exeext); \
+	    $(LN) $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext) $(DESTDIR)$(bindir)/$(GFORTRAN_TARGET_INSTALL_NAME)$(exeext); \
+	  fi ; \
+	fi
+
+fortran.install-plugin:
+
+fortran.install-info: $(DESTDIR)$(infodir)/gfortran.info
+
+fortran.install-man: $(DESTDIR)$(man1dir)/$(GFORTRAN_INSTALL_NAME)$(man1ext)
+
+$(DESTDIR)$(man1dir)/$(GFORTRAN_INSTALL_NAME)$(man1ext): doc/gfortran.1 \
+		installdirs
+	-rm -f $@
+	-$(INSTALL_DATA) $< $@
+	-chmod a-x $@
+
+fortran.uninstall:
+	if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \
+	  echo " install-info --delete --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/gfortran.info"; \
+	  install-info --delete --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/gfortran.info || : ; \
+	else : ; fi; \
+	rm -rf $(DESTDIR)$(bindir)/$(GFORTRAN_INSTALL_NAME)$(exeext); \
+	rm -rf $(DESTDIR)$(man1dir)/$(GFORTRAN_INSTALL_NAME)$(man1ext); \
+	rm -rf $(DESTDIR)$(bindir)/$(GFORTRAN_TARGET_INSTALL_NAME)$(exeext); \
+	rm -rf $(DESTDIR)$(infodir)/gfortran.info*
+
+#
+# Clean hooks:
+# A lot of the ancillary files are deleted by the main makefile.
+# We just have to delete files specific to us.
+
+fortran.mostlyclean:
+	-rm -f f951$(exeext)
+	-rm -f fortran/*.o
+
+fortran.clean:
+fortran.distclean:
+	-rm -f fortran/config.status fortran/Makefile
+
+fortran.extraclean:
+fortran.maintainer-clean:
+	-rm -f doc/gfortran.info* fortran/gfortran.*aux
+	-rm -f $(docobjdir)/gfortran.1
+
+#
+# Stage hooks:
+# The toplevel makefile has already created stage?/fortran at this point.
+
+fortran.stage1: stage1-start
+	-mv fortran/*$(objext) stage1/fortran
+fortran.stage2: stage2-start
+	-mv fortran/*$(objext) stage2/fortran
+fortran.stage3: stage3-start
+	-mv fortran/*$(objext) stage3/fortran
+fortran.stage4: stage4-start
+	-mv fortran/*$(objext) stage4/fortran
+fortran.stageprofile: stageprofile-start
+	-mv fortran/*$(objext) stageprofile/fortran
+fortran.stagefeedback: stageprofile-start
+	-mv fortran/*$(objext) stagefeedback/fortran
+
+#
+# .o: .h dependencies.
+
+# Everything depends on gfortran.h, but only a few files depend on
+# the other headers.  So at some point we'll have to split out
+# which objects depend on what.  FIXME
+# TODO: Add dependencies on the backend/tree header files
+
+$(F95_PARSER_OBJS): fortran/gfortran.h fortran/libgfortran.h \
+		fortran/intrinsic.h fortran/match.h fortran/constructor.h \
+		fortran/parse.h fortran/arith.h fortran/target-memory.h \
+		$(CONFIG_H) $(SYSTEM_H) $(TM_H) $(TM_P_H) coretypes.h \
+		$(RTL_H) $(TREE_H) $(TREE_DUMP_H) $(GGC_H) $(EXPR_H) \
+		$(FLAGS_H) output.h $(DIAGNOSTIC_H) errors.h $(FUNCTION_H) 
+fortran/openmp.o: pointer-set.h $(TARGET_H) toplev.h
+
+GFORTRAN_TRANS_DEPS = fortran/gfortran.h fortran/libgfortran.h \
+    fortran/intrinsic.h fortran/trans-array.h \
+    fortran/trans-const.h fortran/trans-const.h fortran/trans.h \
+    fortran/trans-stmt.h fortran/trans-types.h \
+    $(CONFIG_H) $(SYSTEM_H) $(TREE_H) $(TM_H) coretypes.h $(GGC_H)
+
+fortran/f95-lang.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \
+  gt-fortran-f95-lang.h gtype-fortran.h $(CGRAPH_H) $(TARGET_H) fortran/cpp.h \
+  $(BUILTINS_DEF) fortran/types.def \
+  libfuncs.h expr.h
+fortran/scanner.o: toplev.h fortran/cpp.h
+fortran/convert.o: $(GFORTRAN_TRANS_DEPS)
+fortran/frontend-passes.o: $(GFORTRAN_TRANS_DEPS)
+fortran/trans.o: $(GFORTRAN_TRANS_DEPS) tree-iterator.h
+fortran/trans-decl.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-decl.h \
+  $(CGRAPH_H) $(TARGET_H) $(FUNCTION_H) $(FLAGS_H) $(RTL_H) $(GIMPLE_H) \
+  $(TREE_DUMP_H) debug.h pointer-set.h
+fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \
+  $(REAL_H) toplev.h $(TARGET_H) $(FLAGS_H) dwarf2out.h
+fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS) realmpfr.h
+fortran/trans-expr.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
+fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
+fortran/trans-openmp.o: $(GFORTRAN_TRANS_DEPS)
+fortran/trans-io.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-io.h \
+  fortran/ioparm.def
+fortran/trans-array.o: $(GFORTRAN_TRANS_DEPS)
+fortran/trans-intrinsic.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \
+  gt-fortran-trans-intrinsic.h
+fortran/dependency.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
+fortran/trans-common.o: $(GFORTRAN_TRANS_DEPS) $(TARGET_H) $(RTL_H)
+fortran/resolve.o: fortran/dependency.h fortran/data.h fortran/target-memory.h
+fortran/data.o: fortran/data.h
+fortran/options.o: $(PARAMS_H) $(TARGET_H) fortran/cpp.h
+fortran/cpp.o: fortran/cpp.c incpath.h incpath.o cppbuiltin.h
+	$(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) \
+		$< $(OUTPUT_OPTION)
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
new file mode 100644
index 000000000..2a9ea7501
--- /dev/null
+++ b/gcc/fortran/arith.c
@@ -0,0 +1,2364 @@
+/* Compiler arithmetic
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* Since target arithmetic must be done on the host, there has to
+   be some way of evaluating arithmetic expressions as the host
+   would evaluate them.  We use the GNU MP library and the MPFR
+   library to do arithmetic, and this file provides the interface.  */
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "arith.h"
+#include "target-memory.h"
+#include "constructor.h"
+
+/* MPFR does not have a direct replacement for mpz_set_f() from GMP.
+   It's easily implemented with a few calls though.  */
+
+void
+gfc_mpfr_to_mpz (mpz_t z, mpfr_t x, locus *where)
+{
+  mp_exp_t e;
+
+  if (mpfr_inf_p (x) || mpfr_nan_p (x))
+    {
+      gfc_error ("Conversion of an Infinity or Not-a-Number at %L "
+		 "to INTEGER", where);
+      mpz_set_ui (z, 0);
+      return;
+    }
+
+  e = mpfr_get_z_exp (z, x);
+
+  if (e > 0)
+    mpz_mul_2exp (z, z, e);
+  else
+    mpz_tdiv_q_2exp (z, z, -e);
+}
+
+
+/* Set the model number precision by the requested KIND.  */
+
+void
+gfc_set_model_kind (int kind)
+{
+  int index = gfc_validate_kind (BT_REAL, kind, false);
+  int base2prec;
+
+  base2prec = gfc_real_kinds[index].digits;
+  if (gfc_real_kinds[index].radix != 2)
+    base2prec *= gfc_real_kinds[index].radix / 2;
+  mpfr_set_default_prec (base2prec);
+}
+
+
+/* Set the model number precision from mpfr_t x.  */
+
+void
+gfc_set_model (mpfr_t x)
+{
+  mpfr_set_default_prec (mpfr_get_prec (x));
+}
+
+
+/* Given an arithmetic error code, return a pointer to a string that
+   explains the error.  */
+
+static const char *
+gfc_arith_error (arith code)
+{
+  const char *p;
+
+  switch (code)
+    {
+    case ARITH_OK:
+      p = _("Arithmetic OK at %L");
+      break;
+    case ARITH_OVERFLOW:
+      p = _("Arithmetic overflow at %L");
+      break;
+    case ARITH_UNDERFLOW:
+      p = _("Arithmetic underflow at %L");
+      break;
+    case ARITH_NAN:
+      p = _("Arithmetic NaN at %L");
+      break;
+    case ARITH_DIV0:
+      p = _("Division by zero at %L");
+      break;
+    case ARITH_INCOMMENSURATE:
+      p = _("Array operands are incommensurate at %L");
+      break;
+    case ARITH_ASYMMETRIC:
+      p =
+	_("Integer outside symmetric range implied by Standard Fortran at %L");
+      break;
+    default:
+      gfc_internal_error ("gfc_arith_error(): Bad error code");
+    }
+
+  return p;
+}
+
+
+/* Get things ready to do math.  */
+
+void
+gfc_arith_init_1 (void)
+{
+  gfc_integer_info *int_info;
+  gfc_real_info *real_info;
+  mpfr_t a, b;
+  int i;
+
+  mpfr_set_default_prec (128);
+  mpfr_init (a);
+
+  /* Convert the minimum and maximum values for each kind into their
+     GNU MP representation.  */
+  for (int_info = gfc_integer_kinds; int_info->kind != 0; int_info++)
+    {
+      /* Huge  */
+      mpz_init (int_info->huge);
+      mpz_set_ui (int_info->huge, int_info->radix);
+      mpz_pow_ui (int_info->huge, int_info->huge, int_info->digits);
+      mpz_sub_ui (int_info->huge, int_info->huge, 1);
+
+      /* These are the numbers that are actually representable by the
+	 target.  For bases other than two, this needs to be changed.  */
+      if (int_info->radix != 2)
+	gfc_internal_error ("Fix min_int calculation");
+
+      /* See PRs 13490 and 17912, related to integer ranges.
+	 The pedantic_min_int exists for range checking when a program
+	 is compiled with -pedantic, and reflects the belief that
+	 Standard Fortran requires integers to be symmetrical, i.e.
+	 every negative integer must have a representable positive
+	 absolute value, and vice versa.  */
+
+      mpz_init (int_info->pedantic_min_int);
+      mpz_neg (int_info->pedantic_min_int, int_info->huge);
+
+      mpz_init (int_info->min_int);
+      mpz_sub_ui (int_info->min_int, int_info->pedantic_min_int, 1);
+
+      /* Range  */
+      mpfr_set_z (a, int_info->huge, GFC_RND_MODE);
+      mpfr_log10 (a, a, GFC_RND_MODE);
+      mpfr_trunc (a, a);
+      int_info->range = (int) mpfr_get_si (a, GFC_RND_MODE);
+    }
+
+  mpfr_clear (a);
+
+  for (real_info = gfc_real_kinds; real_info->kind != 0; real_info++)
+    {
+      gfc_set_model_kind (real_info->kind);
+
+      mpfr_init (a);
+      mpfr_init (b);
+
+      /* huge(x) = (1 - b**(-p)) * b**(emax-1) * b  */
+      /* 1 - b**(-p)  */
+      mpfr_init (real_info->huge);
+      mpfr_set_ui (real_info->huge, 1, GFC_RND_MODE);
+      mpfr_set_ui (a, real_info->radix, GFC_RND_MODE);
+      mpfr_pow_si (a, a, -real_info->digits, GFC_RND_MODE);
+      mpfr_sub (real_info->huge, real_info->huge, a, GFC_RND_MODE);
+
+      /* b**(emax-1)  */
+      mpfr_set_ui (a, real_info->radix, GFC_RND_MODE);
+      mpfr_pow_ui (a, a, real_info->max_exponent - 1, GFC_RND_MODE);
+
+      /* (1 - b**(-p)) * b**(emax-1)  */
+      mpfr_mul (real_info->huge, real_info->huge, a, GFC_RND_MODE);
+
+      /* (1 - b**(-p)) * b**(emax-1) * b  */
+      mpfr_mul_ui (real_info->huge, real_info->huge, real_info->radix,
+		   GFC_RND_MODE);
+
+      /* tiny(x) = b**(emin-1)  */
+      mpfr_init (real_info->tiny);
+      mpfr_set_ui (real_info->tiny, real_info->radix, GFC_RND_MODE);
+      mpfr_pow_si (real_info->tiny, real_info->tiny,
+		   real_info->min_exponent - 1, GFC_RND_MODE);
+
+      /* subnormal (x) = b**(emin - digit)  */
+      mpfr_init (real_info->subnormal);
+      mpfr_set_ui (real_info->subnormal, real_info->radix, GFC_RND_MODE);
+      mpfr_pow_si (real_info->subnormal, real_info->subnormal,
+		   real_info->min_exponent - real_info->digits, GFC_RND_MODE);
+
+      /* epsilon(x) = b**(1-p)  */
+      mpfr_init (real_info->epsilon);
+      mpfr_set_ui (real_info->epsilon, real_info->radix, GFC_RND_MODE);
+      mpfr_pow_si (real_info->epsilon, real_info->epsilon,
+		   1 - real_info->digits, GFC_RND_MODE);
+
+      /* range(x) = int(min(log10(huge(x)), -log10(tiny))  */
+      mpfr_log10 (a, real_info->huge, GFC_RND_MODE);
+      mpfr_log10 (b, real_info->tiny, GFC_RND_MODE);
+      mpfr_neg (b, b, GFC_RND_MODE);
+
+      /* a = min(a, b)  */
+      mpfr_min (a, a, b, GFC_RND_MODE);
+      mpfr_trunc (a, a);
+      real_info->range = (int) mpfr_get_si (a, GFC_RND_MODE);
+
+      /* precision(x) = int((p - 1) * log10(b)) + k  */
+      mpfr_set_ui (a, real_info->radix, GFC_RND_MODE);
+      mpfr_log10 (a, a, GFC_RND_MODE);
+      mpfr_mul_ui (a, a, real_info->digits - 1, GFC_RND_MODE);
+      mpfr_trunc (a, a);
+      real_info->precision = (int) mpfr_get_si (a, GFC_RND_MODE);
+
+      /* If the radix is an integral power of 10, add one to the precision.  */
+      for (i = 10; i <= real_info->radix; i *= 10)
+	if (i == real_info->radix)
+	  real_info->precision++;
+
+      mpfr_clears (a, b, NULL);
+    }
+}
+
+
+/* Clean up, get rid of numeric constants.  */
+
+void
+gfc_arith_done_1 (void)
+{
+  gfc_integer_info *ip;
+  gfc_real_info *rp;
+
+  for (ip = gfc_integer_kinds; ip->kind; ip++)
+    {
+      mpz_clear (ip->min_int);
+      mpz_clear (ip->pedantic_min_int);
+      mpz_clear (ip->huge);
+    }
+
+  for (rp = gfc_real_kinds; rp->kind; rp++)
+    mpfr_clears (rp->epsilon, rp->huge, rp->tiny, rp->subnormal, NULL);
+
+  mpfr_free_cache ();
+}
+
+
+/* Given a wide character value and a character kind, determine whether
+   the character is representable for that kind.  */
+bool
+gfc_check_character_range (gfc_char_t c, int kind)
+{
+  /* As wide characters are stored as 32-bit values, they're all
+     representable in UCS=4.  */
+  if (kind == 4)
+    return true;
+
+  if (kind == 1)
+    return c <= 255 ? true : false;
+
+  gcc_unreachable ();
+}
+
+
+/* Given an integer and a kind, make sure that the integer lies within
+   the range of the kind.  Returns ARITH_OK, ARITH_ASYMMETRIC or
+   ARITH_OVERFLOW.  */
+
+arith
+gfc_check_integer_range (mpz_t p, int kind)
+{
+  arith result;
+  int i;
+
+  i = gfc_validate_kind (BT_INTEGER, kind, false);
+  result = ARITH_OK;
+
+  if (pedantic)
+    {
+      if (mpz_cmp (p, gfc_integer_kinds[i].pedantic_min_int) < 0)
+	result = ARITH_ASYMMETRIC;
+    }
+
+
+  if (gfc_option.flag_range_check == 0)
+    return result;
+
+  if (mpz_cmp (p, gfc_integer_kinds[i].min_int) < 0
+      || mpz_cmp (p, gfc_integer_kinds[i].huge) > 0)
+    result = ARITH_OVERFLOW;
+
+  return result;
+}
+
+
+/* Given a real and a kind, make sure that the real lies within the
+   range of the kind.  Returns ARITH_OK, ARITH_OVERFLOW or
+   ARITH_UNDERFLOW.  */
+
+static arith
+gfc_check_real_range (mpfr_t p, int kind)
+{
+  arith retval;
+  mpfr_t q;
+  int i;
+
+  i = gfc_validate_kind (BT_REAL, kind, false);
+
+  gfc_set_model (p);
+  mpfr_init (q);
+  mpfr_abs (q, p, GFC_RND_MODE);
+
+  retval = ARITH_OK;
+
+  if (mpfr_inf_p (p))
+    {
+      if (gfc_option.flag_range_check != 0)
+	retval = ARITH_OVERFLOW;
+    }
+  else if (mpfr_nan_p (p))
+    {
+      if (gfc_option.flag_range_check != 0)
+	retval = ARITH_NAN;
+    }
+  else if (mpfr_sgn (q) == 0)
+    {
+      mpfr_clear (q);
+      return retval;
+    }
+  else if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0)
+    {
+      if (gfc_option.flag_range_check == 0)
+	mpfr_set_inf (p, mpfr_sgn (p));
+      else
+	retval = ARITH_OVERFLOW;
+    }
+  else if (mpfr_cmp (q, gfc_real_kinds[i].subnormal) < 0)
+    {
+      if (gfc_option.flag_range_check == 0)
+	{
+	  if (mpfr_sgn (p) < 0)
+	    {
+	      mpfr_set_ui (p, 0, GFC_RND_MODE);
+	      mpfr_set_si (q, -1, GFC_RND_MODE);
+	      mpfr_copysign (p, p, q, GFC_RND_MODE);
+	    }
+	  else
+	    mpfr_set_ui (p, 0, GFC_RND_MODE);
+	}
+      else
+	retval = ARITH_UNDERFLOW;
+    }
+  else if (mpfr_cmp (q, gfc_real_kinds[i].tiny) < 0)
+    {
+      mp_exp_t emin, emax;
+      int en;
+
+      /* Save current values of emin and emax.  */
+      emin = mpfr_get_emin ();
+      emax = mpfr_get_emax ();
+
+      /* Set emin and emax for the current model number.  */
+      en = gfc_real_kinds[i].min_exponent - gfc_real_kinds[i].digits + 1;
+      mpfr_set_emin ((mp_exp_t) en);
+      mpfr_set_emax ((mp_exp_t) gfc_real_kinds[i].max_exponent);
+      mpfr_check_range (q, 0, GFC_RND_MODE);
+      mpfr_subnormalize (q, 0, GFC_RND_MODE);
+
+      /* Reset emin and emax.  */
+      mpfr_set_emin (emin);
+      mpfr_set_emax (emax);
+
+      /* Copy sign if needed.  */
+      if (mpfr_sgn (p) < 0)
+	mpfr_neg (p, q, GMP_RNDN);
+      else
+	mpfr_set (p, q, GMP_RNDN);
+    }
+
+  mpfr_clear (q);
+
+  return retval;
+}
+
+
+/* Low-level arithmetic functions.  All of these subroutines assume
+   that all operands are of the same type and return an operand of the
+   same type.  The other thing about these subroutines is that they
+   can fail in various ways -- overflow, underflow, division by zero,
+   zero raised to the zero, etc.  */
+
+static arith
+gfc_arith_not (gfc_expr *op1, gfc_expr **resultp)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, op1->ts.kind, &op1->where);
+  result->value.logical = !op1->value.logical;
+  *resultp = result;
+
+  return ARITH_OK;
+}
+
+
+static arith
+gfc_arith_and (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2),
+				  &op1->where);
+  result->value.logical = op1->value.logical && op2->value.logical;
+  *resultp = result;
+
+  return ARITH_OK;
+}
+
+
+static arith
+gfc_arith_or (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2),
+				  &op1->where);
+  result->value.logical = op1->value.logical || op2->value.logical;
+  *resultp = result;
+
+  return ARITH_OK;
+}
+
+
+static arith
+gfc_arith_eqv (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2),
+				  &op1->where);
+  result->value.logical = op1->value.logical == op2->value.logical;
+  *resultp = result;
+
+  return ARITH_OK;
+}
+
+
+static arith
+gfc_arith_neqv (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2),
+				  &op1->where);
+  result->value.logical = op1->value.logical != op2->value.logical;
+  *resultp = result;
+
+  return ARITH_OK;
+}
+
+
+/* Make sure a constant numeric expression is within the range for
+   its type and kind.  Note that there's also a gfc_check_range(),
+   but that one deals with the intrinsic RANGE function.  */
+
+arith
+gfc_range_check (gfc_expr *e)
+{
+  arith rc;
+  arith rc2;
+
+  switch (e->ts.type)
+    {
+    case BT_INTEGER:
+      rc = gfc_check_integer_range (e->value.integer, e->ts.kind);
+      break;
+
+    case BT_REAL:
+      rc = gfc_check_real_range (e->value.real, e->ts.kind);
+      if (rc == ARITH_UNDERFLOW)
+	mpfr_set_ui (e->value.real, 0, GFC_RND_MODE);
+      if (rc == ARITH_OVERFLOW)
+	mpfr_set_inf (e->value.real, mpfr_sgn (e->value.real));
+      if (rc == ARITH_NAN)
+	mpfr_set_nan (e->value.real);
+      break;
+
+    case BT_COMPLEX:
+      rc = gfc_check_real_range (mpc_realref (e->value.complex), e->ts.kind);
+      if (rc == ARITH_UNDERFLOW)
+	mpfr_set_ui (mpc_realref (e->value.complex), 0, GFC_RND_MODE);
+      if (rc == ARITH_OVERFLOW)
+	mpfr_set_inf (mpc_realref (e->value.complex),
+		      mpfr_sgn (mpc_realref (e->value.complex)));
+      if (rc == ARITH_NAN)
+	mpfr_set_nan (mpc_realref (e->value.complex));
+
+      rc2 = gfc_check_real_range (mpc_imagref (e->value.complex), e->ts.kind);
+      if (rc == ARITH_UNDERFLOW)
+	mpfr_set_ui (mpc_imagref (e->value.complex), 0, GFC_RND_MODE);
+      if (rc == ARITH_OVERFLOW)
+	mpfr_set_inf (mpc_imagref (e->value.complex), 
+		      mpfr_sgn (mpc_imagref (e->value.complex)));
+      if (rc == ARITH_NAN)
+	mpfr_set_nan (mpc_imagref (e->value.complex));
+
+      if (rc == ARITH_OK)
+	rc = rc2;
+      break;
+
+    default:
+      gfc_internal_error ("gfc_range_check(): Bad type");
+    }
+
+  return rc;
+}
+
+
+/* Several of the following routines use the same set of statements to
+   check the validity of the result.  Encapsulate the checking here.  */
+
+static arith
+check_result (arith rc, gfc_expr *x, gfc_expr *r, gfc_expr **rp)
+{
+  arith val = rc;
+
+  if (val == ARITH_UNDERFLOW)
+    {
+      if (gfc_option.warn_underflow)
+	gfc_warning (gfc_arith_error (val), &x->where);
+      val = ARITH_OK;
+    }
+
+  if (val == ARITH_ASYMMETRIC)
+    {
+      gfc_warning (gfc_arith_error (val), &x->where);
+      val = ARITH_OK;
+    }
+
+  if (val != ARITH_OK)
+    gfc_free_expr (r);
+  else
+    *rp = r;
+
+  return val;
+}
+
+
+/* It may seem silly to have a subroutine that actually computes the
+   unary plus of a constant, but it prevents us from making exceptions
+   in the code elsewhere.  Used for unary plus and parenthesized
+   expressions.  */
+
+static arith
+gfc_arith_identity (gfc_expr *op1, gfc_expr **resultp)
+{
+  *resultp = gfc_copy_expr (op1);
+  return ARITH_OK;
+}
+
+
+static arith
+gfc_arith_uminus (gfc_expr *op1, gfc_expr **resultp)
+{
+  gfc_expr *result;
+  arith rc;
+
+  result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
+
+  switch (op1->ts.type)
+    {
+    case BT_INTEGER:
+      mpz_neg (result->value.integer, op1->value.integer);
+      break;
+
+    case BT_REAL:
+      mpfr_neg (result->value.real, op1->value.real, GFC_RND_MODE);
+      break;
+
+    case BT_COMPLEX:
+      mpc_neg (result->value.complex, op1->value.complex, GFC_MPC_RND_MODE);
+      break;
+
+    default:
+      gfc_internal_error ("gfc_arith_uminus(): Bad basic type");
+    }
+
+  rc = gfc_range_check (result);
+
+  return check_result (rc, op1, result, resultp);
+}
+
+
+static arith
+gfc_arith_plus (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+  arith rc;
+
+  result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
+
+  switch (op1->ts.type)
+    {
+    case BT_INTEGER:
+      mpz_add (result->value.integer, op1->value.integer, op2->value.integer);
+      break;
+
+    case BT_REAL:
+      mpfr_add (result->value.real, op1->value.real, op2->value.real,
+	       GFC_RND_MODE);
+      break;
+
+    case BT_COMPLEX:
+      mpc_add (result->value.complex, op1->value.complex, op2->value.complex,
+	       GFC_MPC_RND_MODE);
+      break;
+
+    default:
+      gfc_internal_error ("gfc_arith_plus(): Bad basic type");
+    }
+
+  rc = gfc_range_check (result);
+
+  return check_result (rc, op1, result, resultp);
+}
+
+
+static arith
+gfc_arith_minus (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+  arith rc;
+
+  result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
+
+  switch (op1->ts.type)
+    {
+    case BT_INTEGER:
+      mpz_sub (result->value.integer, op1->value.integer, op2->value.integer);
+      break;
+
+    case BT_REAL:
+      mpfr_sub (result->value.real, op1->value.real, op2->value.real,
+		GFC_RND_MODE);
+      break;
+
+    case BT_COMPLEX:
+      mpc_sub (result->value.complex, op1->value.complex,
+	       op2->value.complex, GFC_MPC_RND_MODE);
+      break;
+
+    default:
+      gfc_internal_error ("gfc_arith_minus(): Bad basic type");
+    }
+
+  rc = gfc_range_check (result);
+
+  return check_result (rc, op1, result, resultp);
+}
+
+
+static arith
+gfc_arith_times (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+  arith rc;
+
+  result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
+
+  switch (op1->ts.type)
+    {
+    case BT_INTEGER:
+      mpz_mul (result->value.integer, op1->value.integer, op2->value.integer);
+      break;
+
+    case BT_REAL:
+      mpfr_mul (result->value.real, op1->value.real, op2->value.real,
+	       GFC_RND_MODE);
+      break;
+
+    case BT_COMPLEX:
+      gfc_set_model (mpc_realref (op1->value.complex));
+      mpc_mul (result->value.complex, op1->value.complex, op2->value.complex,
+	       GFC_MPC_RND_MODE);
+      break;
+
+    default:
+      gfc_internal_error ("gfc_arith_times(): Bad basic type");
+    }
+
+  rc = gfc_range_check (result);
+
+  return check_result (rc, op1, result, resultp);
+}
+
+
+static arith
+gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+  arith rc;
+
+  rc = ARITH_OK;
+
+  result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
+
+  switch (op1->ts.type)
+    {
+    case BT_INTEGER:
+      if (mpz_sgn (op2->value.integer) == 0)
+	{
+	  rc = ARITH_DIV0;
+	  break;
+	}
+
+      mpz_tdiv_q (result->value.integer, op1->value.integer,
+		  op2->value.integer);
+      break;
+
+    case BT_REAL:
+      if (mpfr_sgn (op2->value.real) == 0 && gfc_option.flag_range_check == 1)
+	{
+	  rc = ARITH_DIV0;
+	  break;
+	}
+
+      mpfr_div (result->value.real, op1->value.real, op2->value.real,
+	       GFC_RND_MODE);
+      break;
+
+    case BT_COMPLEX:
+      if (mpc_cmp_si_si (op2->value.complex, 0, 0) == 0
+	  && gfc_option.flag_range_check == 1)
+	{
+	  rc = ARITH_DIV0;
+	  break;
+	}
+
+      gfc_set_model (mpc_realref (op1->value.complex));
+      if (mpc_cmp_si_si (op2->value.complex, 0, 0) == 0)
+      {
+	/* In Fortran, return (NaN + NaN I) for any zero divisor.  See
+	   PR 40318. */
+	mpfr_set_nan (mpc_realref (result->value.complex));
+	mpfr_set_nan (mpc_imagref (result->value.complex));
+      }
+      else
+	mpc_div (result->value.complex, op1->value.complex, op2->value.complex,
+		 GFC_MPC_RND_MODE);
+      break;
+
+    default:
+      gfc_internal_error ("gfc_arith_divide(): Bad basic type");
+    }
+
+  if (rc == ARITH_OK)
+    rc = gfc_range_check (result);
+
+  return check_result (rc, op1, result, resultp);
+}
+
+/* Raise a number to a power.  */
+
+static arith
+arith_power (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  int power_sign;
+  gfc_expr *result;
+  arith rc;
+
+  rc = ARITH_OK;
+  result = gfc_get_constant_expr (op1->ts.type, op1->ts.kind, &op1->where);
+
+  switch (op2->ts.type)
+    {
+    case BT_INTEGER:
+      power_sign = mpz_sgn (op2->value.integer);
+
+      if (power_sign == 0)
+	{
+	  /* Handle something to the zeroth power.  Since we're dealing
+	     with integral exponents, there is no ambiguity in the
+	     limiting procedure used to determine the value of 0**0.  */
+	  switch (op1->ts.type)
+	    {
+	    case BT_INTEGER:
+	      mpz_set_ui (result->value.integer, 1);
+	      break;
+
+	    case BT_REAL:
+	      mpfr_set_ui (result->value.real, 1, GFC_RND_MODE);
+	      break;
+
+	    case BT_COMPLEX:
+	      mpc_set_ui (result->value.complex, 1, GFC_MPC_RND_MODE);
+	      break;
+
+	    default:
+	      gfc_internal_error ("arith_power(): Bad base");
+	    }
+	}
+      else
+	{
+	  switch (op1->ts.type)
+	    {
+	    case BT_INTEGER:
+	      {
+		int power;
+
+		/* First, we simplify the cases of op1 == 1, 0 or -1.  */
+		if (mpz_cmp_si (op1->value.integer, 1) == 0)
+		  {
+		    /* 1**op2 == 1 */
+		    mpz_set_si (result->value.integer, 1);
+		  }
+		else if (mpz_cmp_si (op1->value.integer, 0) == 0)
+		  {
+		    /* 0**op2 == 0, if op2 > 0
+	               0**op2 overflow, if op2 < 0 ; in that case, we
+		       set the result to 0 and return ARITH_DIV0.  */
+		    mpz_set_si (result->value.integer, 0);
+		    if (mpz_cmp_si (op2->value.integer, 0) < 0)
+		      rc = ARITH_DIV0;
+		  }
+		else if (mpz_cmp_si (op1->value.integer, -1) == 0)
+		  {
+		    /* (-1)**op2 == (-1)**(mod(op2,2)) */
+		    unsigned int odd = mpz_fdiv_ui (op2->value.integer, 2);
+		    if (odd)
+		      mpz_set_si (result->value.integer, -1);
+		    else
+		      mpz_set_si (result->value.integer, 1);
+		  }
+		/* Then, we take care of op2 < 0.  */
+		else if (mpz_cmp_si (op2->value.integer, 0) < 0)
+		  {
+		    /* if op2 < 0, op1**op2 == 0  because abs(op1) > 1.  */
+		    mpz_set_si (result->value.integer, 0);
+		  }
+		else if (gfc_extract_int (op2, &power) != NULL)
+		  {
+		    /* If op2 doesn't fit in an int, the exponentiation will
+		       overflow, because op2 > 0 and abs(op1) > 1.  */
+		    mpz_t max;
+		    int i;
+		    i = gfc_validate_kind (BT_INTEGER, result->ts.kind, false);
+
+		    if (gfc_option.flag_range_check)
+		      rc = ARITH_OVERFLOW;
+
+		    /* Still, we want to give the same value as the
+		       processor.  */
+		    mpz_init (max);
+		    mpz_add_ui (max, gfc_integer_kinds[i].huge, 1);
+		    mpz_mul_ui (max, max, 2);
+		    mpz_powm (result->value.integer, op1->value.integer,
+			      op2->value.integer, max);
+		    mpz_clear (max);
+		  }
+		else
+		  mpz_pow_ui (result->value.integer, op1->value.integer,
+			      power);
+	      }
+	      break;
+
+	    case BT_REAL:
+	      mpfr_pow_z (result->value.real, op1->value.real,
+			  op2->value.integer, GFC_RND_MODE);
+	      break;
+
+	    case BT_COMPLEX:
+	      mpc_pow_z (result->value.complex, op1->value.complex,
+			 op2->value.integer, GFC_MPC_RND_MODE);
+	      break;
+
+	    default:
+	      break;
+	    }
+	}
+      break;
+
+    case BT_REAL:
+
+      if (gfc_init_expr_flag)
+	{
+	  if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Noninteger "
+			      "exponent in an initialization "
+			      "expression at %L", &op2->where) == FAILURE)
+	    return ARITH_PROHIBIT;
+	}
+
+      if (mpfr_cmp_si (op1->value.real, 0) < 0)
+	{
+	  gfc_error ("Raising a negative REAL at %L to "
+		     "a REAL power is prohibited", &op1->where);
+	  gfc_free (result);
+	  return ARITH_PROHIBIT;
+	}
+
+	mpfr_pow (result->value.real, op1->value.real, op2->value.real,
+		  GFC_RND_MODE);
+      break;
+
+    case BT_COMPLEX:
+      {
+	if (gfc_init_expr_flag)
+	  {
+	    if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Noninteger "
+				"exponent in an initialization "
+				"expression at %L", &op2->where) == FAILURE)
+	      return ARITH_PROHIBIT;
+	  }
+
+	mpc_pow (result->value.complex, op1->value.complex,
+		 op2->value.complex, GFC_MPC_RND_MODE);
+      }
+      break;
+    default:
+      gfc_internal_error ("arith_power(): unknown type");
+    }
+
+  if (rc == ARITH_OK)
+    rc = gfc_range_check (result);
+
+  return check_result (rc, op1, result, resultp);
+}
+
+
+/* Concatenate two string constants.  */
+
+static arith
+gfc_arith_concat (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+  int len;
+
+  gcc_assert (op1->ts.kind == op2->ts.kind);
+  result = gfc_get_constant_expr (BT_CHARACTER, op1->ts.kind,
+				  &op1->where);
+
+  len = op1->value.character.length + op2->value.character.length;
+
+  result->value.character.string = gfc_get_wide_string (len + 1);
+  result->value.character.length = len;
+
+  memcpy (result->value.character.string, op1->value.character.string,
+	  op1->value.character.length * sizeof (gfc_char_t));
+
+  memcpy (&result->value.character.string[op1->value.character.length],
+	  op2->value.character.string,
+	  op2->value.character.length * sizeof (gfc_char_t));
+
+  result->value.character.string[len] = '\0';
+
+  *resultp = result;
+
+  return ARITH_OK;
+}
+
+/* Comparison between real values; returns 0 if (op1 .op. op2) is true.
+   This function mimics mpfr_cmp but takes NaN into account.  */
+
+static int
+compare_real (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
+{
+  int rc;
+  switch (op)
+    {
+      case INTRINSIC_EQ:
+	rc = mpfr_equal_p (op1->value.real, op2->value.real) ? 0 : 1;
+	break;
+      case INTRINSIC_GT:
+	rc = mpfr_greater_p (op1->value.real, op2->value.real) ? 1 : -1;
+	break;
+      case INTRINSIC_GE:
+	rc = mpfr_greaterequal_p (op1->value.real, op2->value.real) ? 1 : -1;
+	break;
+      case INTRINSIC_LT:
+	rc = mpfr_less_p (op1->value.real, op2->value.real) ? -1 : 1;
+	break;
+      case INTRINSIC_LE:
+	rc = mpfr_lessequal_p (op1->value.real, op2->value.real) ? -1 : 1;
+	break;
+      default:
+	gfc_internal_error ("compare_real(): Bad operator");
+    }
+
+  return rc;
+}
+
+/* Comparison operators.  Assumes that the two expression nodes
+   contain two constants of the same type. The op argument is
+   needed to handle NaN correctly.  */
+
+int
+gfc_compare_expr (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
+{
+  int rc;
+
+  switch (op1->ts.type)
+    {
+    case BT_INTEGER:
+      rc = mpz_cmp (op1->value.integer, op2->value.integer);
+      break;
+
+    case BT_REAL:
+      rc = compare_real (op1, op2, op);
+      break;
+
+    case BT_CHARACTER:
+      rc = gfc_compare_string (op1, op2);
+      break;
+
+    case BT_LOGICAL:
+      rc = ((!op1->value.logical && op2->value.logical)
+	    || (op1->value.logical && !op2->value.logical));
+      break;
+
+    default:
+      gfc_internal_error ("gfc_compare_expr(): Bad basic type");
+    }
+
+  return rc;
+}
+
+
+/* Compare a pair of complex numbers.  Naturally, this is only for
+   equality and inequality.  */
+
+static int
+compare_complex (gfc_expr *op1, gfc_expr *op2)
+{
+  return mpc_cmp (op1->value.complex, op2->value.complex) == 0;
+}
+
+
+/* Given two constant strings and the inverse collating sequence, compare the
+   strings.  We return -1 for a < b, 0 for a == b and 1 for a > b. 
+   We use the processor's default collating sequence.  */
+
+int
+gfc_compare_string (gfc_expr *a, gfc_expr *b)
+{
+  int len, alen, blen, i;
+  gfc_char_t ac, bc;
+
+  alen = a->value.character.length;
+  blen = b->value.character.length;
+
+  len = MAX(alen, blen);
+
+  for (i = 0; i < len; i++)
+    {
+      ac = ((i < alen) ? a->value.character.string[i] : ' ');
+      bc = ((i < blen) ? b->value.character.string[i] : ' ');
+
+      if (ac < bc)
+	return -1;
+      if (ac > bc)
+	return 1;
+    }
+
+  /* Strings are equal */
+  return 0;
+}
+
+
+int
+gfc_compare_with_Cstring (gfc_expr *a, const char *b, bool case_sensitive)
+{
+  int len, alen, blen, i;
+  gfc_char_t ac, bc;
+
+  alen = a->value.character.length;
+  blen = strlen (b);
+
+  len = MAX(alen, blen);
+
+  for (i = 0; i < len; i++)
+    {
+      ac = ((i < alen) ? a->value.character.string[i] : ' ');
+      bc = ((i < blen) ? b[i] : ' ');
+
+      if (!case_sensitive)
+	{
+	  ac = TOLOWER (ac);
+	  bc = TOLOWER (bc);
+	}
+
+      if (ac < bc)
+	return -1;
+      if (ac > bc)
+	return 1;
+    }
+
+  /* Strings are equal */
+  return 0;
+}
+
+
+/* Specific comparison subroutines.  */
+
+static arith
+gfc_arith_eq (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
+				  &op1->where);
+  result->value.logical = (op1->ts.type == BT_COMPLEX)
+			? compare_complex (op1, op2)
+			: (gfc_compare_expr (op1, op2, INTRINSIC_EQ) == 0);
+
+  *resultp = result;
+  return ARITH_OK;
+}
+
+
+static arith
+gfc_arith_ne (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
+				  &op1->where);
+  result->value.logical = (op1->ts.type == BT_COMPLEX)
+			? !compare_complex (op1, op2)
+			: (gfc_compare_expr (op1, op2, INTRINSIC_EQ) != 0);
+
+  *resultp = result;
+  return ARITH_OK;
+}
+
+
+static arith
+gfc_arith_gt (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
+				  &op1->where);
+  result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_GT) > 0);
+  *resultp = result;
+
+  return ARITH_OK;
+}
+
+
+static arith
+gfc_arith_ge (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
+				  &op1->where);
+  result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_GE) >= 0);
+  *resultp = result;
+
+  return ARITH_OK;
+}
+
+
+static arith
+gfc_arith_lt (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
+				  &op1->where);
+  result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_LT) < 0);
+  *resultp = result;
+
+  return ARITH_OK;
+}
+
+
+static arith
+gfc_arith_le (gfc_expr *op1, gfc_expr *op2, gfc_expr **resultp)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind,
+				  &op1->where);
+  result->value.logical = (gfc_compare_expr (op1, op2, INTRINSIC_LE) <= 0);
+  *resultp = result;
+
+  return ARITH_OK;
+}
+
+
+static arith
+reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **), gfc_expr *op,
+	      gfc_expr **result)
+{
+  gfc_constructor_base head;
+  gfc_constructor *c;
+  gfc_expr *r;
+  arith rc;
+
+  if (op->expr_type == EXPR_CONSTANT)
+    return eval (op, result);
+
+  rc = ARITH_OK;
+  head = gfc_constructor_copy (op->value.constructor);
+  for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c))
+    {
+      rc = reduce_unary (eval, c->expr, &r);
+
+      if (rc != ARITH_OK)
+	break;
+
+      gfc_replace_expr (c->expr, r);
+    }
+
+  if (rc != ARITH_OK)
+    gfc_constructor_free (head);
+  else
+    {
+      gfc_constructor *c = gfc_constructor_first (head);
+      r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind,
+			      &op->where);
+      r->shape = gfc_copy_shape (op->shape, op->rank);
+      r->rank = op->rank;
+      r->value.constructor = head;
+      *result = r;
+    }
+
+  return rc;
+}
+
+
+static arith
+reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
+		  gfc_expr *op1, gfc_expr *op2, gfc_expr **result)
+{
+  gfc_constructor_base head;
+  gfc_constructor *c;
+  gfc_expr *r;
+  arith rc = ARITH_OK;
+
+  head = gfc_constructor_copy (op1->value.constructor);
+  for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c))
+    {
+      if (c->expr->expr_type == EXPR_CONSTANT)
+        rc = eval (c->expr, op2, &r);
+      else
+	rc = reduce_binary_ac (eval, c->expr, op2, &r);
+
+      if (rc != ARITH_OK)
+	break;
+
+      gfc_replace_expr (c->expr, r);
+    }
+
+  if (rc != ARITH_OK)
+    gfc_constructor_free (head);
+  else
+    {
+      gfc_constructor *c = gfc_constructor_first (head);
+      r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind,
+			      &op1->where);
+      r->shape = gfc_copy_shape (op1->shape, op1->rank);
+      r->rank = op1->rank;
+      r->value.constructor = head;
+      *result = r;
+    }
+
+  return rc;
+}
+
+
+static arith
+reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
+		  gfc_expr *op1, gfc_expr *op2, gfc_expr **result)
+{
+  gfc_constructor_base head;
+  gfc_constructor *c;
+  gfc_expr *r;
+  arith rc = ARITH_OK;
+
+  head = gfc_constructor_copy (op2->value.constructor);
+  for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c))
+    {
+      if (c->expr->expr_type == EXPR_CONSTANT)
+	rc = eval (op1, c->expr, &r);
+      else
+	rc = reduce_binary_ca (eval, op1, c->expr, &r);
+
+      if (rc != ARITH_OK)
+	break;
+
+      gfc_replace_expr (c->expr, r);
+    }
+
+  if (rc != ARITH_OK)
+    gfc_constructor_free (head);
+  else
+    {
+      gfc_constructor *c = gfc_constructor_first (head);
+      r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind,
+			      &op2->where);
+      r->shape = gfc_copy_shape (op2->shape, op2->rank);
+      r->rank = op2->rank;
+      r->value.constructor = head;
+      *result = r;
+    }
+
+  return rc;
+}
+
+
+/* We need a forward declaration of reduce_binary.  */
+static arith reduce_binary (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
+			    gfc_expr *op1, gfc_expr *op2, gfc_expr **result);
+
+
+static arith
+reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
+		  gfc_expr *op1, gfc_expr *op2, gfc_expr **result)
+{
+  gfc_constructor_base head;
+  gfc_constructor *c, *d;
+  gfc_expr *r;
+  arith rc = ARITH_OK;
+
+  if (gfc_check_conformance (op1, op2,
+			     "elemental binary operation") != SUCCESS)
+    return ARITH_INCOMMENSURATE;
+
+  head = gfc_constructor_copy (op1->value.constructor);
+  for (c = gfc_constructor_first (head),
+       d = gfc_constructor_first (op2->value.constructor);
+       c && d;
+       c = gfc_constructor_next (c), d = gfc_constructor_next (d))
+    {
+	rc = reduce_binary (eval, c->expr, d->expr, &r);
+	if (rc != ARITH_OK)
+	  break;
+
+	gfc_replace_expr (c->expr, r);
+    }
+
+  if (c || d)
+    rc = ARITH_INCOMMENSURATE;
+
+  if (rc != ARITH_OK)
+    gfc_constructor_free (head);
+  else
+    {
+      gfc_constructor *c = gfc_constructor_first (head);
+      r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind,
+			      &op1->where);
+      r->shape = gfc_copy_shape (op1->shape, op1->rank);
+      r->rank = op1->rank;
+      r->value.constructor = head;
+      *result = r;
+    }
+
+  return rc;
+}
+
+
+static arith
+reduce_binary (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
+	       gfc_expr *op1, gfc_expr *op2, gfc_expr **result)
+{
+  if (op1->expr_type == EXPR_CONSTANT && op2->expr_type == EXPR_CONSTANT)
+    return eval (op1, op2, result);
+
+  if (op1->expr_type == EXPR_CONSTANT && op2->expr_type == EXPR_ARRAY)
+    return reduce_binary_ca (eval, op1, op2, result);
+
+  if (op1->expr_type == EXPR_ARRAY && op2->expr_type == EXPR_CONSTANT)
+    return reduce_binary_ac (eval, op1, op2, result);
+
+  return reduce_binary_aa (eval, op1, op2, result);
+}
+
+
+typedef union
+{
+  arith (*f2)(gfc_expr *, gfc_expr **);
+  arith (*f3)(gfc_expr *, gfc_expr *, gfc_expr **);
+}
+eval_f;
+
+/* High level arithmetic subroutines.  These subroutines go into
+   eval_intrinsic(), which can do one of several things to its
+   operands.  If the operands are incompatible with the intrinsic
+   operation, we return a node pointing to the operands and hope that
+   an operator interface is found during resolution.
+
+   If the operands are compatible and are constants, then we try doing
+   the arithmetic.  We also handle the cases where either or both
+   operands are array constructors.  */
+
+static gfc_expr *
+eval_intrinsic (gfc_intrinsic_op op,
+		eval_f eval, gfc_expr *op1, gfc_expr *op2)
+{
+  gfc_expr temp, *result;
+  int unary;
+  arith rc;
+
+  gfc_clear_ts (&temp.ts);
+
+  switch (op)
+    {
+    /* Logical unary  */
+    case INTRINSIC_NOT:
+      if (op1->ts.type != BT_LOGICAL)
+	goto runtime;
+
+      temp.ts.type = BT_LOGICAL;
+      temp.ts.kind = gfc_default_logical_kind;
+      unary = 1;
+      break;
+
+    /* Logical binary operators  */
+    case INTRINSIC_OR:
+    case INTRINSIC_AND:
+    case INTRINSIC_NEQV:
+    case INTRINSIC_EQV:
+      if (op1->ts.type != BT_LOGICAL || op2->ts.type != BT_LOGICAL)
+	goto runtime;
+
+      temp.ts.type = BT_LOGICAL;
+      temp.ts.kind = gfc_default_logical_kind;
+      unary = 0;
+      break;
+
+    /* Numeric unary  */
+    case INTRINSIC_UPLUS:
+    case INTRINSIC_UMINUS:
+      if (!gfc_numeric_ts (&op1->ts))
+	goto runtime;
+
+      temp.ts = op1->ts;
+      unary = 1;
+      break;
+
+    case INTRINSIC_PARENTHESES:
+      temp.ts = op1->ts;
+      unary = 1;
+      break;
+
+    /* Additional restrictions for ordering relations.  */
+    case INTRINSIC_GE:
+    case INTRINSIC_GE_OS:
+    case INTRINSIC_LT:
+    case INTRINSIC_LT_OS:
+    case INTRINSIC_LE:
+    case INTRINSIC_LE_OS:
+    case INTRINSIC_GT:
+    case INTRINSIC_GT_OS:
+      if (op1->ts.type == BT_COMPLEX || op2->ts.type == BT_COMPLEX)
+	{
+	  temp.ts.type = BT_LOGICAL;
+	  temp.ts.kind = gfc_default_logical_kind;
+	  goto runtime;
+	}
+
+    /* Fall through  */
+    case INTRINSIC_EQ:
+    case INTRINSIC_EQ_OS:
+    case INTRINSIC_NE:
+    case INTRINSIC_NE_OS:
+      if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER)
+	{
+	  unary = 0;
+	  temp.ts.type = BT_LOGICAL;
+	  temp.ts.kind = gfc_default_logical_kind;
+
+	  /* If kind mismatch, exit and we'll error out later.  */
+	  if (op1->ts.kind != op2->ts.kind)
+	    goto runtime;
+
+	  break;
+	}
+
+    /* Fall through  */
+    /* Numeric binary  */
+    case INTRINSIC_PLUS:
+    case INTRINSIC_MINUS:
+    case INTRINSIC_TIMES:
+    case INTRINSIC_DIVIDE:
+    case INTRINSIC_POWER:
+      if (!gfc_numeric_ts (&op1->ts) || !gfc_numeric_ts (&op2->ts))
+	goto runtime;
+
+      /* Insert any necessary type conversions to make the operands
+	 compatible.  */
+
+      temp.expr_type = EXPR_OP;
+      gfc_clear_ts (&temp.ts);
+      temp.value.op.op = op;
+
+      temp.value.op.op1 = op1;
+      temp.value.op.op2 = op2;
+
+      gfc_type_convert_binary (&temp, 0);
+
+      if (op == INTRINSIC_EQ || op == INTRINSIC_NE
+	  || op == INTRINSIC_GE || op == INTRINSIC_GT
+	  || op == INTRINSIC_LE || op == INTRINSIC_LT
+	  || op == INTRINSIC_EQ_OS || op == INTRINSIC_NE_OS
+	  || op == INTRINSIC_GE_OS || op == INTRINSIC_GT_OS
+	  || op == INTRINSIC_LE_OS || op == INTRINSIC_LT_OS)
+	{
+	  temp.ts.type = BT_LOGICAL;
+	  temp.ts.kind = gfc_default_logical_kind;
+	}
+
+      unary = 0;
+      break;
+
+    /* Character binary  */
+    case INTRINSIC_CONCAT:
+      if (op1->ts.type != BT_CHARACTER || op2->ts.type != BT_CHARACTER
+	  || op1->ts.kind != op2->ts.kind)
+	goto runtime;
+
+      temp.ts.type = BT_CHARACTER;
+      temp.ts.kind = op1->ts.kind;
+      unary = 0;
+      break;
+
+    case INTRINSIC_USER:
+      goto runtime;
+
+    default:
+      gfc_internal_error ("eval_intrinsic(): Bad operator");
+    }
+
+  if (op1->expr_type != EXPR_CONSTANT
+      && (op1->expr_type != EXPR_ARRAY
+	  || !gfc_is_constant_expr (op1) || !gfc_expanded_ac (op1)))
+    goto runtime;
+
+  if (op2 != NULL
+      && op2->expr_type != EXPR_CONSTANT
+	 && (op2->expr_type != EXPR_ARRAY
+	     || !gfc_is_constant_expr (op2) || !gfc_expanded_ac (op2)))
+    goto runtime;
+
+  if (unary)
+    rc = reduce_unary (eval.f2, op1, &result);
+  else
+    rc = reduce_binary (eval.f3, op1, op2, &result);
+
+
+  /* Something went wrong.  */
+  if (op == INTRINSIC_POWER && rc == ARITH_PROHIBIT)
+    return NULL;
+
+  if (rc != ARITH_OK)
+    {
+      gfc_error (gfc_arith_error (rc), &op1->where);
+      return NULL;
+    }
+
+  gfc_free_expr (op1);
+  gfc_free_expr (op2);
+  return result;
+
+runtime:
+  /* Create a run-time expression.  */
+  result = gfc_get_operator_expr (&op1->where, op, op1, op2);
+  result->ts = temp.ts;
+
+  return result;
+}
+
+
+/* Modify type of expression for zero size array.  */
+
+static gfc_expr *
+eval_type_intrinsic0 (gfc_intrinsic_op iop, gfc_expr *op)
+{
+  if (op == NULL)
+    gfc_internal_error ("eval_type_intrinsic0(): op NULL");
+
+  switch (iop)
+    {
+    case INTRINSIC_GE:
+    case INTRINSIC_GE_OS:
+    case INTRINSIC_LT:
+    case INTRINSIC_LT_OS:
+    case INTRINSIC_LE:
+    case INTRINSIC_LE_OS:
+    case INTRINSIC_GT:
+    case INTRINSIC_GT_OS:
+    case INTRINSIC_EQ:
+    case INTRINSIC_EQ_OS:
+    case INTRINSIC_NE:
+    case INTRINSIC_NE_OS:
+      op->ts.type = BT_LOGICAL;
+      op->ts.kind = gfc_default_logical_kind;
+      break;
+
+    default:
+      break;
+    }
+
+  return op;
+}
+
+
+/* Return nonzero if the expression is a zero size array.  */
+
+static int
+gfc_zero_size_array (gfc_expr *e)
+{
+  if (e->expr_type != EXPR_ARRAY)
+    return 0;
+
+  return e->value.constructor == NULL;
+}
+
+
+/* Reduce a binary expression where at least one of the operands
+   involves a zero-length array.  Returns NULL if neither of the
+   operands is a zero-length array.  */
+
+static gfc_expr *
+reduce_binary0 (gfc_expr *op1, gfc_expr *op2)
+{
+  if (gfc_zero_size_array (op1))
+    {
+      gfc_free_expr (op2);
+      return op1;
+    }
+
+  if (gfc_zero_size_array (op2))
+    {
+      gfc_free_expr (op1);
+      return op2;
+    }
+
+  return NULL;
+}
+
+
+static gfc_expr *
+eval_intrinsic_f2 (gfc_intrinsic_op op,
+		   arith (*eval) (gfc_expr *, gfc_expr **),
+		   gfc_expr *op1, gfc_expr *op2)
+{
+  gfc_expr *result;
+  eval_f f;
+
+  if (op2 == NULL)
+    {
+      if (gfc_zero_size_array (op1))
+	return eval_type_intrinsic0 (op, op1);
+    }
+  else
+    {
+      result = reduce_binary0 (op1, op2);
+      if (result != NULL)
+	return eval_type_intrinsic0 (op, result);
+    }
+
+  f.f2 = eval;
+  return eval_intrinsic (op, f, op1, op2);
+}
+
+
+static gfc_expr *
+eval_intrinsic_f3 (gfc_intrinsic_op op,
+		   arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
+		   gfc_expr *op1, gfc_expr *op2)
+{
+  gfc_expr *result;
+  eval_f f;
+
+  result = reduce_binary0 (op1, op2);
+  if (result != NULL)
+    return eval_type_intrinsic0(op, result);
+
+  f.f3 = eval;
+  return eval_intrinsic (op, f, op1, op2);
+}
+
+
+gfc_expr *
+gfc_parentheses (gfc_expr *op)
+{
+  if (gfc_is_constant_expr (op))
+    return op;
+
+  return eval_intrinsic_f2 (INTRINSIC_PARENTHESES, gfc_arith_identity,
+			    op, NULL);
+}
+
+gfc_expr *
+gfc_uplus (gfc_expr *op)
+{
+  return eval_intrinsic_f2 (INTRINSIC_UPLUS, gfc_arith_identity, op, NULL);
+}
+
+
+gfc_expr *
+gfc_uminus (gfc_expr *op)
+{
+  return eval_intrinsic_f2 (INTRINSIC_UMINUS, gfc_arith_uminus, op, NULL);
+}
+
+
+gfc_expr *
+gfc_add (gfc_expr *op1, gfc_expr *op2)
+{
+  return eval_intrinsic_f3 (INTRINSIC_PLUS, gfc_arith_plus, op1, op2);
+}
+
+
+gfc_expr *
+gfc_subtract (gfc_expr *op1, gfc_expr *op2)
+{
+  return eval_intrinsic_f3 (INTRINSIC_MINUS, gfc_arith_minus, op1, op2);
+}
+
+
+gfc_expr *
+gfc_multiply (gfc_expr *op1, gfc_expr *op2)
+{
+  return eval_intrinsic_f3 (INTRINSIC_TIMES, gfc_arith_times, op1, op2);
+}
+
+
+gfc_expr *
+gfc_divide (gfc_expr *op1, gfc_expr *op2)
+{
+  return eval_intrinsic_f3 (INTRINSIC_DIVIDE, gfc_arith_divide, op1, op2);
+}
+
+
+gfc_expr *
+gfc_power (gfc_expr *op1, gfc_expr *op2)
+{
+  return eval_intrinsic_f3 (INTRINSIC_POWER, arith_power, op1, op2);
+}
+
+
+gfc_expr *
+gfc_concat (gfc_expr *op1, gfc_expr *op2)
+{
+  return eval_intrinsic_f3 (INTRINSIC_CONCAT, gfc_arith_concat, op1, op2);
+}
+
+
+gfc_expr *
+gfc_and (gfc_expr *op1, gfc_expr *op2)
+{
+  return eval_intrinsic_f3 (INTRINSIC_AND, gfc_arith_and, op1, op2);
+}
+
+
+gfc_expr *
+gfc_or (gfc_expr *op1, gfc_expr *op2)
+{
+  return eval_intrinsic_f3 (INTRINSIC_OR, gfc_arith_or, op1, op2);
+}
+
+
+gfc_expr *
+gfc_not (gfc_expr *op1)
+{
+  return eval_intrinsic_f2 (INTRINSIC_NOT, gfc_arith_not, op1, NULL);
+}
+
+
+gfc_expr *
+gfc_eqv (gfc_expr *op1, gfc_expr *op2)
+{
+  return eval_intrinsic_f3 (INTRINSIC_EQV, gfc_arith_eqv, op1, op2);
+}
+
+
+gfc_expr *
+gfc_neqv (gfc_expr *op1, gfc_expr *op2)
+{
+  return eval_intrinsic_f3 (INTRINSIC_NEQV, gfc_arith_neqv, op1, op2);
+}
+
+
+gfc_expr *
+gfc_eq (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
+{
+  return eval_intrinsic_f3 (op, gfc_arith_eq, op1, op2);
+}
+
+
+gfc_expr *
+gfc_ne (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
+{
+  return eval_intrinsic_f3 (op, gfc_arith_ne, op1, op2);
+}
+
+
+gfc_expr *
+gfc_gt (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
+{
+  return eval_intrinsic_f3 (op, gfc_arith_gt, op1, op2);
+}
+
+
+gfc_expr *
+gfc_ge (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
+{
+  return eval_intrinsic_f3 (op, gfc_arith_ge, op1, op2);
+}
+
+
+gfc_expr *
+gfc_lt (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
+{
+  return eval_intrinsic_f3 (op, gfc_arith_lt, op1, op2);
+}
+
+
+gfc_expr *
+gfc_le (gfc_expr *op1, gfc_expr *op2, gfc_intrinsic_op op)
+{
+  return eval_intrinsic_f3 (op, gfc_arith_le, op1, op2);
+}
+
+
+/* Convert an integer string to an expression node.  */
+
+gfc_expr *
+gfc_convert_integer (const char *buffer, int kind, int radix, locus *where)
+{
+  gfc_expr *e;
+  const char *t;
+
+  e = gfc_get_constant_expr (BT_INTEGER, kind, where);
+  /* A leading plus is allowed, but not by mpz_set_str.  */
+  if (buffer[0] == '+')
+    t = buffer + 1;
+  else
+    t = buffer;
+  mpz_set_str (e->value.integer, t, radix);
+
+  return e;
+}
+
+
+/* Convert a real string to an expression node.  */
+
+gfc_expr *
+gfc_convert_real (const char *buffer, int kind, locus *where)
+{
+  gfc_expr *e;
+
+  e = gfc_get_constant_expr (BT_REAL, kind, where);
+  mpfr_set_str (e->value.real, buffer, 10, GFC_RND_MODE);
+
+  return e;
+}
+
+
+/* Convert a pair of real, constant expression nodes to a single
+   complex expression node.  */
+
+gfc_expr *
+gfc_convert_complex (gfc_expr *real, gfc_expr *imag, int kind)
+{
+  gfc_expr *e;
+
+  e = gfc_get_constant_expr (BT_COMPLEX, kind, &real->where);
+  mpc_set_fr_fr (e->value.complex, real->value.real, imag->value.real,
+		 GFC_MPC_RND_MODE);
+
+  return e;
+}
+
+
+/******* Simplification of intrinsic functions with constant arguments *****/
+
+
+/* Deal with an arithmetic error.  */
+
+static void
+arith_error (arith rc, gfc_typespec *from, gfc_typespec *to, locus *where)
+{
+  switch (rc)
+    {
+    case ARITH_OK:
+      gfc_error ("Arithmetic OK converting %s to %s at %L",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    case ARITH_OVERFLOW:
+      gfc_error ("Arithmetic overflow converting %s to %s at %L. This check "
+		 "can be disabled with the option -fno-range-check",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    case ARITH_UNDERFLOW:
+      gfc_error ("Arithmetic underflow converting %s to %s at %L. This check "
+		 "can be disabled with the option -fno-range-check",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    case ARITH_NAN:
+      gfc_error ("Arithmetic NaN converting %s to %s at %L. This check "
+		 "can be disabled with the option -fno-range-check",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    case ARITH_DIV0:
+      gfc_error ("Division by zero converting %s to %s at %L",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    case ARITH_INCOMMENSURATE:
+      gfc_error ("Array operands are incommensurate converting %s to %s at %L",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    case ARITH_ASYMMETRIC:
+      gfc_error ("Integer outside symmetric range implied by Standard Fortran"
+	 	 " converting %s to %s at %L",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    default:
+      gfc_internal_error ("gfc_arith_error(): Bad error code");
+    }
+
+  /* TODO: Do something about the error, i.e., throw exception, return
+     NaN, etc.  */
+}
+
+
+/* Convert integers to integers.  */
+
+gfc_expr *
+gfc_int2int (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+
+  result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
+
+  mpz_set (result->value.integer, src->value.integer);
+
+  if ((rc = gfc_check_integer_range (result->value.integer, kind)) != ARITH_OK)
+    {
+      if (rc == ARITH_ASYMMETRIC)
+	{
+	  gfc_warning (gfc_arith_error (rc), &src->where);
+	}
+      else
+	{
+	  arith_error (rc, &src->ts, &result->ts, &src->where);
+	  gfc_free_expr (result);
+	  return NULL;
+	}
+    }
+
+  return result;
+}
+
+
+/* Convert integers to reals.  */
+
+gfc_expr *
+gfc_int2real (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+
+  result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
+
+  mpfr_set_z (result->value.real, src->value.integer, GFC_RND_MODE);
+
+  if ((rc = gfc_check_real_range (result->value.real, kind)) != ARITH_OK)
+    {
+      arith_error (rc, &src->ts, &result->ts, &src->where);
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  return result;
+}
+
+
+/* Convert default integer to default complex.  */
+
+gfc_expr *
+gfc_int2complex (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+
+  result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
+
+  mpc_set_z (result->value.complex, src->value.integer, GFC_MPC_RND_MODE);
+
+  if ((rc = gfc_check_real_range (mpc_realref (result->value.complex), kind))
+      != ARITH_OK)
+    {
+      arith_error (rc, &src->ts, &result->ts, &src->where);
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  return result;
+}
+
+
+/* Convert default real to default integer.  */
+
+gfc_expr *
+gfc_real2int (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+
+  result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
+
+  gfc_mpfr_to_mpz (result->value.integer, src->value.real, &src->where);
+
+  if ((rc = gfc_check_integer_range (result->value.integer, kind)) != ARITH_OK)
+    {
+      arith_error (rc, &src->ts, &result->ts, &src->where);
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  return result;
+}
+
+
+/* Convert real to real.  */
+
+gfc_expr *
+gfc_real2real (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+
+  result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
+
+  mpfr_set (result->value.real, src->value.real, GFC_RND_MODE);
+
+  rc = gfc_check_real_range (result->value.real, kind);
+
+  if (rc == ARITH_UNDERFLOW)
+    {
+      if (gfc_option.warn_underflow)
+	gfc_warning (gfc_arith_error (rc), &src->where);
+      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+    }
+  else if (rc != ARITH_OK)
+    {
+      arith_error (rc, &src->ts, &result->ts, &src->where);
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  return result;
+}
+
+
+/* Convert real to complex.  */
+
+gfc_expr *
+gfc_real2complex (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+
+  result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
+
+  mpc_set_fr (result->value.complex, src->value.real, GFC_MPC_RND_MODE);
+
+  rc = gfc_check_real_range (mpc_realref (result->value.complex), kind);
+
+  if (rc == ARITH_UNDERFLOW)
+    {
+      if (gfc_option.warn_underflow)
+	gfc_warning (gfc_arith_error (rc), &src->where);
+      mpfr_set_ui (mpc_realref (result->value.complex), 0, GFC_RND_MODE);
+    }
+  else if (rc != ARITH_OK)
+    {
+      arith_error (rc, &src->ts, &result->ts, &src->where);
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  return result;
+}
+
+
+/* Convert complex to integer.  */
+
+gfc_expr *
+gfc_complex2int (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+
+  result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
+
+  gfc_mpfr_to_mpz (result->value.integer, mpc_realref (src->value.complex),
+		   &src->where);
+
+  if ((rc = gfc_check_integer_range (result->value.integer, kind)) != ARITH_OK)
+    {
+      arith_error (rc, &src->ts, &result->ts, &src->where);
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  return result;
+}
+
+
+/* Convert complex to real.  */
+
+gfc_expr *
+gfc_complex2real (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+
+  result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
+
+  mpc_real (result->value.real, src->value.complex, GFC_RND_MODE);
+
+  rc = gfc_check_real_range (result->value.real, kind);
+
+  if (rc == ARITH_UNDERFLOW)
+    {
+      if (gfc_option.warn_underflow)
+	gfc_warning (gfc_arith_error (rc), &src->where);
+      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+    }
+  if (rc != ARITH_OK)
+    {
+      arith_error (rc, &src->ts, &result->ts, &src->where);
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  return result;
+}
+
+
+/* Convert complex to complex.  */
+
+gfc_expr *
+gfc_complex2complex (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  arith rc;
+
+  result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
+
+  mpc_set (result->value.complex, src->value.complex, GFC_MPC_RND_MODE);
+
+  rc = gfc_check_real_range (mpc_realref (result->value.complex), kind);
+
+  if (rc == ARITH_UNDERFLOW)
+    {
+      if (gfc_option.warn_underflow)
+	gfc_warning (gfc_arith_error (rc), &src->where);
+      mpfr_set_ui (mpc_realref (result->value.complex), 0, GFC_RND_MODE);
+    }
+  else if (rc != ARITH_OK)
+    {
+      arith_error (rc, &src->ts, &result->ts, &src->where);
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  rc = gfc_check_real_range (mpc_imagref (result->value.complex), kind);
+
+  if (rc == ARITH_UNDERFLOW)
+    {
+      if (gfc_option.warn_underflow)
+	gfc_warning (gfc_arith_error (rc), &src->where);
+      mpfr_set_ui (mpc_imagref (result->value.complex), 0, GFC_RND_MODE);
+    }
+  else if (rc != ARITH_OK)
+    {
+      arith_error (rc, &src->ts, &result->ts, &src->where);
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  return result;
+}
+
+
+/* Logical kind conversion.  */
+
+gfc_expr *
+gfc_log2log (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
+  result->value.logical = src->value.logical;
+
+  return result;
+}
+
+
+/* Convert logical to integer.  */
+
+gfc_expr *
+gfc_log2int (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
+  mpz_set_si (result->value.integer, src->value.logical);
+
+  return result;
+}
+
+
+/* Convert integer to logical.  */
+
+gfc_expr *
+gfc_int2log (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+
+  result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
+  result->value.logical = (mpz_cmp_si (src->value.integer, 0) != 0);
+
+  return result;
+}
+
+
+/* Helper function to set the representation in a Hollerith conversion.  
+   This assumes that the ts.type and ts.kind of the result have already
+   been set.  */
+
+static void
+hollerith2representation (gfc_expr *result, gfc_expr *src)
+{
+  int src_len, result_len;
+
+  src_len = src->representation.length - src->ts.u.pad;
+  result_len = gfc_target_expr_size (result);
+
+  if (src_len > result_len)
+    {
+      gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
+		   &src->where, gfc_typename(&result->ts));
+    }
+
+  result->representation.string = XCNEWVEC (char, result_len + 1);
+  memcpy (result->representation.string, src->representation.string,
+	  MIN (result_len, src_len));
+
+  if (src_len < result_len)
+    memset (&result->representation.string[src_len], ' ', result_len - src_len);
+
+  result->representation.string[result_len] = '\0'; /* For debugger  */
+  result->representation.length = result_len;
+}
+
+
+/* Convert Hollerith to integer. The constant will be padded or truncated.  */
+
+gfc_expr *
+gfc_hollerith2int (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  result = gfc_get_constant_expr (BT_INTEGER, kind, &src->where);
+
+  hollerith2representation (result, src);
+  gfc_interpret_integer (kind, (unsigned char *) result->representation.string,
+			 result->representation.length, result->value.integer);
+
+  return result;
+}
+
+
+/* Convert Hollerith to real. The constant will be padded or truncated.  */
+
+gfc_expr *
+gfc_hollerith2real (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  result = gfc_get_constant_expr (BT_REAL, kind, &src->where);
+
+  hollerith2representation (result, src);
+  gfc_interpret_float (kind, (unsigned char *) result->representation.string,
+		       result->representation.length, result->value.real);
+
+  return result;
+}
+
+
+/* Convert Hollerith to complex. The constant will be padded or truncated.  */
+
+gfc_expr *
+gfc_hollerith2complex (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  result = gfc_get_constant_expr (BT_COMPLEX, kind, &src->where);
+
+  hollerith2representation (result, src);
+  gfc_interpret_complex (kind, (unsigned char *) result->representation.string,
+			 result->representation.length, result->value.complex);
+
+  return result;
+}
+
+
+/* Convert Hollerith to character. */
+
+gfc_expr *
+gfc_hollerith2character (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+
+  result = gfc_copy_expr (src);
+  result->ts.type = BT_CHARACTER;
+  result->ts.kind = kind;
+
+  result->value.character.length = result->representation.length;
+  result->value.character.string
+    = gfc_char_to_widechar (result->representation.string);
+
+  return result;
+}
+
+
+/* Convert Hollerith to logical. The constant will be padded or truncated.  */
+
+gfc_expr *
+gfc_hollerith2logical (gfc_expr *src, int kind)
+{
+  gfc_expr *result;
+  result = gfc_get_constant_expr (BT_LOGICAL, kind, &src->where);
+
+  hollerith2representation (result, src);
+  gfc_interpret_logical (kind, (unsigned char *) result->representation.string,
+			 result->representation.length, &result->value.logical);
+
+  return result;
+}
diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h
new file mode 100644
index 000000000..7e1dcca5e
--- /dev/null
+++ b/gcc/fortran/arith.h
@@ -0,0 +1,88 @@
+/* Compiler arithmetic header.
+   Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2010
+   Free Software Foundation, Inc.
+   Contributed by Steven Bosscher
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#ifndef GFC_ARITH_H
+#define GFC_ARITH_H
+
+/* MPFR also does not have the conversion of a mpfr_t to a mpz_t, so declare
+   a function for this as well.  */
+
+void gfc_mpfr_to_mpz (mpz_t, mpfr_t, locus *);
+void gfc_set_model_kind (int);
+void gfc_set_model (mpfr_t);
+
+/* Make sure a gfc_expr expression is within its allowed range.  Checks
+   for overflow and underflow.  */
+arith gfc_range_check (gfc_expr *);
+
+int gfc_compare_expr (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
+int gfc_compare_string (gfc_expr *, gfc_expr *);
+int gfc_compare_with_Cstring (gfc_expr *, const char *, bool);
+
+
+/* Constant folding for gfc_expr trees.  */
+gfc_expr *gfc_parentheses (gfc_expr * op);
+gfc_expr *gfc_uplus (gfc_expr * op);
+gfc_expr *gfc_uminus (gfc_expr * op);
+gfc_expr *gfc_add (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_subtract (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_multiply (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_divide (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_power (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_concat (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_and (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_or (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_not (gfc_expr *);
+gfc_expr *gfc_eqv (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_neqv (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_eq (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
+gfc_expr *gfc_ne (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
+gfc_expr *gfc_gt (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
+gfc_expr *gfc_ge (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
+gfc_expr *gfc_lt (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
+gfc_expr *gfc_le (gfc_expr *, gfc_expr *, gfc_intrinsic_op);
+
+/* Convert strings to literal constants.  */
+gfc_expr *gfc_convert_integer (const char *, int, int, locus *);
+gfc_expr *gfc_convert_real (const char *, int, locus *);
+gfc_expr *gfc_convert_complex (gfc_expr *, gfc_expr *, int);
+
+/* Convert a constant of one kind to another kind.  */
+gfc_expr *gfc_int2int (gfc_expr *, int);
+gfc_expr *gfc_int2real (gfc_expr *, int);
+gfc_expr *gfc_int2complex (gfc_expr *, int);
+gfc_expr *gfc_real2int (gfc_expr *, int);
+gfc_expr *gfc_real2real (gfc_expr *, int);
+gfc_expr *gfc_real2complex (gfc_expr *, int);
+gfc_expr *gfc_complex2int (gfc_expr *, int);
+gfc_expr *gfc_complex2real (gfc_expr *, int);
+gfc_expr *gfc_complex2complex (gfc_expr *, int);
+gfc_expr *gfc_log2log (gfc_expr *, int);
+gfc_expr *gfc_log2int (gfc_expr *, int);
+gfc_expr *gfc_int2log (gfc_expr *, int);
+gfc_expr *gfc_hollerith2int (gfc_expr *, int);
+gfc_expr *gfc_hollerith2real (gfc_expr *, int);
+gfc_expr *gfc_hollerith2complex (gfc_expr *, int);
+gfc_expr *gfc_hollerith2character (gfc_expr *, int);
+gfc_expr *gfc_hollerith2logical (gfc_expr *, int);
+
+#endif /* GFC_ARITH_H  */
+
diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
new file mode 100644
index 000000000..a5ad7507e
--- /dev/null
+++ b/gcc/fortran/array.c
@@ -0,0 +1,2318 @@
+/* Array things
+   Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+#include "match.h"
+#include "constructor.h"
+
+/**************** Array reference matching subroutines *****************/
+
+/* Copy an array reference structure.  */
+
+gfc_array_ref *
+gfc_copy_array_ref (gfc_array_ref *src)
+{
+  gfc_array_ref *dest;
+  int i;
+
+  if (src == NULL)
+    return NULL;
+
+  dest = gfc_get_array_ref ();
+
+  *dest = *src;
+
+  for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
+    {
+      dest->start[i] = gfc_copy_expr (src->start[i]);
+      dest->end[i] = gfc_copy_expr (src->end[i]);
+      dest->stride[i] = gfc_copy_expr (src->stride[i]);
+    }
+
+  dest->offset = gfc_copy_expr (src->offset);
+
+  return dest;
+}
+
+
+/* Match a single dimension of an array reference.  This can be a
+   single element or an array section.  Any modifications we've made
+   to the ar structure are cleaned up by the caller.  If the init
+   is set, we require the subscript to be a valid initialization
+   expression.  */
+
+static match
+match_subscript (gfc_array_ref *ar, int init, bool match_star)
+{
+  match m = MATCH_ERROR;
+  bool star = false;
+  int i;
+
+  i = ar->dimen + ar->codimen;
+
+  ar->c_where[i] = gfc_current_locus;
+  ar->start[i] = ar->end[i] = ar->stride[i] = NULL;
+
+  /* We can't be sure of the difference between DIMEN_ELEMENT and
+     DIMEN_VECTOR until we know the type of the element itself at
+     resolution time.  */
+
+  ar->dimen_type[i] = DIMEN_UNKNOWN;
+
+  if (gfc_match_char (':') == MATCH_YES)
+    goto end_element;
+
+  /* Get start element.  */
+  if (match_star && (m = gfc_match_char ('*')) == MATCH_YES)
+    star = true;
+
+  if (!star && init)
+    m = gfc_match_init_expr (&ar->start[i]);
+  else if (!star)
+    m = gfc_match_expr (&ar->start[i]);
+
+  if (m == MATCH_NO)
+    gfc_error ("Expected array subscript at %C");
+  if (m != MATCH_YES)
+    return MATCH_ERROR;
+
+  if (gfc_match_char (':') == MATCH_NO)
+    goto matched;
+
+  if (star)
+    {
+      gfc_error ("Unexpected '*' in coarray subscript at %C");
+      return MATCH_ERROR;
+    }
+
+  /* Get an optional end element.  Because we've seen the colon, we
+     definitely have a range along this dimension.  */
+end_element:
+  ar->dimen_type[i] = DIMEN_RANGE;
+
+  if (match_star && (m = gfc_match_char ('*')) == MATCH_YES)
+    star = true;
+  else if (init)
+    m = gfc_match_init_expr (&ar->end[i]);
+  else
+    m = gfc_match_expr (&ar->end[i]);
+
+  if (m == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  /* See if we have an optional stride.  */
+  if (gfc_match_char (':') == MATCH_YES)
+    {
+      if (star)
+	{
+	  gfc_error ("Strides not allowed in coarray subscript at %C");
+	  return MATCH_ERROR;
+	}
+
+      m = init ? gfc_match_init_expr (&ar->stride[i])
+	       : gfc_match_expr (&ar->stride[i]);
+
+      if (m == MATCH_NO)
+	gfc_error ("Expected array subscript stride at %C");
+      if (m != MATCH_YES)
+	return MATCH_ERROR;
+    }
+
+matched:
+  if (star)
+    ar->dimen_type[i] = DIMEN_STAR;
+
+  return MATCH_YES;
+}
+
+
+/* Match an array reference, whether it is the whole array or a
+   particular elements or a section. If init is set, the reference has
+   to consist of init expressions.  */
+
+match
+gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
+		     int corank)
+{
+  match m;
+  bool matched_bracket = false;
+
+  memset (ar, '\0', sizeof (ar));
+
+  ar->where = gfc_current_locus;
+  ar->as = as;
+  ar->type = AR_UNKNOWN;
+
+  if (gfc_match_char ('[') == MATCH_YES)
+    {
+       matched_bracket = true;
+       goto coarray;
+    }
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    {
+      ar->type = AR_FULL;
+      ar->dimen = 0;
+      return MATCH_YES;
+    }
+
+  for (ar->dimen = 0; ar->dimen < GFC_MAX_DIMENSIONS; ar->dimen++)
+    {
+      m = match_subscript (ar, init, false);
+      if (m == MATCH_ERROR)
+	return MATCH_ERROR;
+
+      if (gfc_match_char (')') == MATCH_YES)
+	{
+	  ar->dimen++;
+	  goto coarray;
+	}
+
+      if (gfc_match_char (',') != MATCH_YES)
+	{
+	  gfc_error ("Invalid form of array reference at %C");
+	  return MATCH_ERROR;
+	}
+    }
+
+  gfc_error ("Array reference at %C cannot have more than %d dimensions",
+	     GFC_MAX_DIMENSIONS);
+  return MATCH_ERROR;
+
+coarray:
+  if (!matched_bracket && gfc_match_char ('[') != MATCH_YES)
+    {
+      if (ar->dimen > 0)
+	return MATCH_YES;
+      else
+	return MATCH_ERROR;
+    }
+
+  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
+      return MATCH_ERROR;
+    }
+
+  if (corank == 0)
+    {
+	gfc_error ("Unexpected coarray designator at %C");
+	return MATCH_ERROR;
+    }
+
+  for (ar->codimen = 0; ar->codimen + ar->dimen < GFC_MAX_DIMENSIONS; ar->codimen++)
+    {
+      m = match_subscript (ar, init, true);
+      if (m == MATCH_ERROR)
+	return MATCH_ERROR;
+
+      if (gfc_match_char (']') == MATCH_YES)
+	{
+	  ar->codimen++;
+	  if (ar->codimen < corank)
+	    {
+	      gfc_error ("Too few codimensions at %C, expected %d not %d",
+			 corank, ar->codimen);
+	      return MATCH_ERROR;
+	    }
+	  return MATCH_YES;
+	}
+
+      if (gfc_match_char (',') != MATCH_YES)
+	{
+	  if (gfc_match_char ('*') == MATCH_YES)
+	    gfc_error ("Unexpected '*' for codimension %d of %d at %C",
+		       ar->codimen + 1, corank);
+	  else
+	    gfc_error ("Invalid form of coarray reference at %C");
+	  return MATCH_ERROR;
+	}
+      else if (ar->dimen_type[ar->codimen + ar->dimen] == DIMEN_STAR)
+	{
+	  gfc_error ("Unexpected '*' for codimension %d of %d at %C",
+		     ar->codimen + 1, corank);
+	  return MATCH_ERROR;
+	}
+
+      if (ar->codimen >= corank)
+	{
+	  gfc_error ("Invalid codimension %d at %C, only %d codimensions exist",
+		     ar->codimen + 1, corank);
+	  return MATCH_ERROR;
+	}
+    }
+
+  gfc_error ("Array reference at %C cannot have more than %d dimensions",
+	     GFC_MAX_DIMENSIONS);
+  return MATCH_ERROR;
+
+}
+
+
+/************** Array specification matching subroutines ***************/
+
+/* Free all of the expressions associated with array bounds
+   specifications.  */
+
+void
+gfc_free_array_spec (gfc_array_spec *as)
+{
+  int i;
+
+  if (as == NULL)
+    return;
+
+  for (i = 0; i < as->rank + as->corank; i++)
+    {
+      gfc_free_expr (as->lower[i]);
+      gfc_free_expr (as->upper[i]);
+    }
+
+  gfc_free (as);
+}
+
+
+/* Take an array bound, resolves the expression, that make up the
+   shape and check associated constraints.  */
+
+static gfc_try
+resolve_array_bound (gfc_expr *e, int check_constant)
+{
+  if (e == NULL)
+    return SUCCESS;
+
+  if (gfc_resolve_expr (e) == FAILURE
+      || gfc_specification_expr (e) == FAILURE)
+    return FAILURE;
+
+  if (check_constant && !gfc_is_constant_expr (e))
+    {
+      if (e->expr_type == EXPR_VARIABLE)
+	gfc_error ("Variable '%s' at %L in this context must be constant",
+		   e->symtree->n.sym->name, &e->where);
+      else
+	gfc_error ("Expression at %L in this context must be constant",
+		   &e->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Takes an array specification, resolves the expressions that make up
+   the shape and make sure everything is integral.  */
+
+gfc_try
+gfc_resolve_array_spec (gfc_array_spec *as, int check_constant)
+{
+  gfc_expr *e;
+  int i;
+
+  if (as == NULL)
+    return SUCCESS;
+
+  for (i = 0; i < as->rank + as->corank; i++)
+    {
+      e = as->lower[i];
+      if (resolve_array_bound (e, check_constant) == FAILURE)
+	return FAILURE;
+
+      e = as->upper[i];
+      if (resolve_array_bound (e, check_constant) == FAILURE)
+	return FAILURE;
+
+      if ((as->lower[i] == NULL) || (as->upper[i] == NULL))
+	continue;
+
+      /* If the size is negative in this dimension, set it to zero.  */
+      if (as->lower[i]->expr_type == EXPR_CONSTANT
+	    && as->upper[i]->expr_type == EXPR_CONSTANT
+	    && mpz_cmp (as->upper[i]->value.integer,
+			as->lower[i]->value.integer) < 0)
+	{
+	  gfc_free_expr (as->upper[i]);
+	  as->upper[i] = gfc_copy_expr (as->lower[i]);
+	  mpz_sub_ui (as->upper[i]->value.integer,
+		      as->upper[i]->value.integer, 1);
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* Match a single array element specification.  The return values as
+   well as the upper and lower bounds of the array spec are filled
+   in according to what we see on the input.  The caller makes sure
+   individual specifications make sense as a whole.
+
+
+	Parsed       Lower   Upper  Returned
+	------------------------------------
+	  :           NULL    NULL   AS_DEFERRED (*)
+	  x            1       x     AS_EXPLICIT
+	  x:           x      NULL   AS_ASSUMED_SHAPE
+	  x:y          x       y     AS_EXPLICIT
+	  x:*          x      NULL   AS_ASSUMED_SIZE
+	  *            1      NULL   AS_ASSUMED_SIZE
+
+  (*) For non-pointer dummy arrays this is AS_ASSUMED_SHAPE.  This
+  is fixed during the resolution of formal interfaces.
+
+   Anything else AS_UNKNOWN.  */
+
+static array_type
+match_array_element_spec (gfc_array_spec *as)
+{
+  gfc_expr **upper, **lower;
+  match m;
+
+  lower = &as->lower[as->rank + as->corank - 1];
+  upper = &as->upper[as->rank + as->corank - 1];
+
+  if (gfc_match_char ('*') == MATCH_YES)
+    {
+      *lower = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+      return AS_ASSUMED_SIZE;
+    }
+
+  if (gfc_match_char (':') == MATCH_YES)
+    return AS_DEFERRED;
+
+  m = gfc_match_expr (upper);
+  if (m == MATCH_NO)
+    gfc_error ("Expected expression in array specification at %C");
+  if (m != MATCH_YES)
+    return AS_UNKNOWN;
+  if (gfc_expr_check_typed (*upper, gfc_current_ns, false) == FAILURE)
+    return AS_UNKNOWN;
+
+  if (gfc_match_char (':') == MATCH_NO)
+    {
+      *lower = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+      return AS_EXPLICIT;
+    }
+
+  *lower = *upper;
+  *upper = NULL;
+
+  if (gfc_match_char ('*') == MATCH_YES)
+    return AS_ASSUMED_SIZE;
+
+  m = gfc_match_expr (upper);
+  if (m == MATCH_ERROR)
+    return AS_UNKNOWN;
+  if (m == MATCH_NO)
+    return AS_ASSUMED_SHAPE;
+  if (gfc_expr_check_typed (*upper, gfc_current_ns, false) == FAILURE)
+    return AS_UNKNOWN;
+
+  return AS_EXPLICIT;
+}
+
+
+/* Matches an array specification, incidentally figuring out what sort
+   it is. Match either a normal array specification, or a coarray spec
+   or both. Optionally allow [:] for coarrays.  */
+
+match
+gfc_match_array_spec (gfc_array_spec **asp, bool match_dim, bool match_codim)
+{
+  array_type current_type;
+  gfc_array_spec *as;
+  int i;
+
+  as = gfc_get_array_spec ();
+
+  if (!match_dim)
+    goto coarray;
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    {
+      if (!match_codim)
+	goto done;
+      goto coarray;
+    }
+
+  for (;;)
+    {
+      as->rank++;
+      current_type = match_array_element_spec (as);
+
+      /* Note that current_type == AS_ASSUMED_SIZE for both assumed-size
+	 and implied-shape specifications.  If the rank is at least 2, we can
+	 distinguish between them.  But for rank 1, we currently return
+	 ASSUMED_SIZE; this gets adjusted later when we know for sure
+	 whether the symbol parsed is a PARAMETER or not.  */
+
+      if (as->rank == 1)
+	{
+	  if (current_type == AS_UNKNOWN)
+	    goto cleanup;
+	  as->type = current_type;
+	}
+      else
+	switch (as->type)
+	  {		/* See how current spec meshes with the existing.  */
+	  case AS_UNKNOWN:
+	    goto cleanup;
+
+	  case AS_IMPLIED_SHAPE:
+	    if (current_type != AS_ASSUMED_SHAPE)
+	      {
+		gfc_error ("Bad array specification for implied-shape"
+			   " array at %C");
+		goto cleanup;
+	      }
+	    break;
+
+	  case AS_EXPLICIT:
+	    if (current_type == AS_ASSUMED_SIZE)
+	      {
+		as->type = AS_ASSUMED_SIZE;
+		break;
+	      }
+
+	    if (current_type == AS_EXPLICIT)
+	      break;
+
+	    gfc_error ("Bad array specification for an explicitly shaped "
+		       "array at %C");
+
+	    goto cleanup;
+
+	  case AS_ASSUMED_SHAPE:
+	    if ((current_type == AS_ASSUMED_SHAPE)
+		|| (current_type == AS_DEFERRED))
+	      break;
+
+	    gfc_error ("Bad array specification for assumed shape "
+		       "array at %C");
+	    goto cleanup;
+
+	  case AS_DEFERRED:
+	    if (current_type == AS_DEFERRED)
+	      break;
+
+	    if (current_type == AS_ASSUMED_SHAPE)
+	      {
+		as->type = AS_ASSUMED_SHAPE;
+		break;
+	      }
+
+	    gfc_error ("Bad specification for deferred shape array at %C");
+	    goto cleanup;
+
+	  case AS_ASSUMED_SIZE:
+	    if (as->rank == 2 && current_type == AS_ASSUMED_SIZE)
+	      {
+		as->type = AS_IMPLIED_SHAPE;
+		break;
+	      }
+
+	    gfc_error ("Bad specification for assumed size array at %C");
+	    goto cleanup;
+	  }
+
+      if (gfc_match_char (')') == MATCH_YES)
+	break;
+
+      if (gfc_match_char (',') != MATCH_YES)
+	{
+	  gfc_error ("Expected another dimension in array declaration at %C");
+	  goto cleanup;
+	}
+
+      if (as->rank + as->corank >= GFC_MAX_DIMENSIONS)
+	{
+	  gfc_error ("Array specification at %C has more than %d dimensions",
+		     GFC_MAX_DIMENSIONS);
+	  goto cleanup;
+	}
+
+      if (as->corank + as->rank >= 7
+	  && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Array "
+			     "specification at %C with more than 7 dimensions")
+	     == FAILURE)
+	goto cleanup;
+    }
+
+  if (!match_codim)
+    goto done;
+
+coarray:
+  if (gfc_match_char ('[')  != MATCH_YES)
+    goto done;
+
+  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Coarray declaration at %C")
+      == FAILURE)
+    goto cleanup;
+
+  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
+      goto cleanup;
+    }
+
+  for (;;)
+    {
+      as->corank++;
+      current_type = match_array_element_spec (as);
+
+      if (current_type == AS_UNKNOWN)
+	goto cleanup;
+
+      if (as->corank == 1)
+	as->cotype = current_type;
+      else
+	switch (as->cotype)
+	  { /* See how current spec meshes with the existing.  */
+	    case AS_IMPLIED_SHAPE:
+	    case AS_UNKNOWN:
+	      goto cleanup;
+
+	    case AS_EXPLICIT:
+	      if (current_type == AS_ASSUMED_SIZE)
+		{
+		  as->cotype = AS_ASSUMED_SIZE;
+		  break;
+		}
+
+	      if (current_type == AS_EXPLICIT)
+		break;
+
+	      gfc_error ("Bad array specification for an explicitly "
+			 "shaped array at %C");
+
+	      goto cleanup;
+
+	    case AS_ASSUMED_SHAPE:
+	      if ((current_type == AS_ASSUMED_SHAPE)
+		  || (current_type == AS_DEFERRED))
+		break;
+
+	      gfc_error ("Bad array specification for assumed shape "
+			 "array at %C");
+	      goto cleanup;
+
+	    case AS_DEFERRED:
+	      if (current_type == AS_DEFERRED)
+		break;
+
+	      if (current_type == AS_ASSUMED_SHAPE)
+		{
+		  as->cotype = AS_ASSUMED_SHAPE;
+		  break;
+		}
+
+	      gfc_error ("Bad specification for deferred shape array at %C");
+	      goto cleanup;
+
+	    case AS_ASSUMED_SIZE:
+	      gfc_error ("Bad specification for assumed size array at %C");
+	      goto cleanup;
+	  }
+
+      if (gfc_match_char (']') == MATCH_YES)
+	break;
+
+      if (gfc_match_char (',') != MATCH_YES)
+	{
+	  gfc_error ("Expected another dimension in array declaration at %C");
+	  goto cleanup;
+	}
+
+      if (as->corank >= GFC_MAX_DIMENSIONS)
+	{
+	  gfc_error ("Array specification at %C has more than %d "
+		     "dimensions", GFC_MAX_DIMENSIONS);
+	  goto cleanup;
+	}
+    }
+
+  if (current_type == AS_EXPLICIT)
+    {
+      gfc_error ("Upper bound of last coarray dimension must be '*' at %C");
+      goto cleanup;
+    }
+
+  if (as->cotype == AS_ASSUMED_SIZE)
+    as->cotype = AS_EXPLICIT;
+
+  if (as->rank == 0)
+    as->type = as->cotype;
+
+done:
+  if (as->rank == 0 && as->corank == 0)
+    {
+      *asp = NULL;
+      gfc_free_array_spec (as);
+      return MATCH_NO;
+    }
+
+  /* If a lower bounds of an assumed shape array is blank, put in one.  */
+  if (as->type == AS_ASSUMED_SHAPE)
+    {
+      for (i = 0; i < as->rank + as->corank; i++)
+	{
+	  if (as->lower[i] == NULL)
+	    as->lower[i] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+	}
+    }
+
+  *asp = as;
+
+  return MATCH_YES;
+
+cleanup:
+  /* Something went wrong.  */
+  gfc_free_array_spec (as);
+  return MATCH_ERROR;
+}
+
+
+/* Given a symbol and an array specification, modify the symbol to
+   have that array specification.  The error locus is needed in case
+   something goes wrong.  On failure, the caller must free the spec.  */
+
+gfc_try
+gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc)
+{
+  int i;
+
+  if (as == NULL)
+    return SUCCESS;
+
+  if (as->rank
+      && gfc_add_dimension (&sym->attr, sym->name, error_loc) == FAILURE)
+    return FAILURE;
+
+  if (as->corank
+      && gfc_add_codimension (&sym->attr, sym->name, error_loc) == FAILURE)
+    return FAILURE;
+
+  if (sym->as == NULL)
+    {
+      sym->as = as;
+      return SUCCESS;
+    }
+
+  if (as->corank)
+    {
+      /* The "sym" has no corank (checked via gfc_add_codimension). Thus
+	 the codimension is simply added.  */
+      gcc_assert (as->rank == 0 && sym->as->corank == 0);
+
+      sym->as->cotype = as->cotype;
+      sym->as->corank = as->corank;
+      for (i = 0; i < as->corank; i++)
+	{
+	  sym->as->lower[sym->as->rank + i] = as->lower[i];
+	  sym->as->upper[sym->as->rank + i] = as->upper[i];
+	}
+    }
+  else
+    {
+      /* The "sym" has no rank (checked via gfc_add_dimension). Thus
+	 the dimension is added - but first the codimensions (if existing
+	 need to be shifted to make space for the dimension.  */
+      gcc_assert (as->corank == 0 && sym->as->rank == 0);
+
+      sym->as->rank = as->rank;
+      sym->as->type = as->type;
+      sym->as->cray_pointee = as->cray_pointee;
+      sym->as->cp_was_assumed = as->cp_was_assumed;
+
+      for (i = 0; i < sym->as->corank; i++)
+	{
+	  sym->as->lower[as->rank + i] = sym->as->lower[i];
+	  sym->as->upper[as->rank + i] = sym->as->upper[i];
+	}
+      for (i = 0; i < as->rank; i++)
+	{
+	  sym->as->lower[i] = as->lower[i];
+	  sym->as->upper[i] = as->upper[i];
+	}
+    }
+
+  gfc_free (as);
+  return SUCCESS;
+}
+
+
+/* Copy an array specification.  */
+
+gfc_array_spec *
+gfc_copy_array_spec (gfc_array_spec *src)
+{
+  gfc_array_spec *dest;
+  int i;
+
+  if (src == NULL)
+    return NULL;
+
+  dest = gfc_get_array_spec ();
+
+  *dest = *src;
+
+  for (i = 0; i < dest->rank + dest->corank; i++)
+    {
+      dest->lower[i] = gfc_copy_expr (dest->lower[i]);
+      dest->upper[i] = gfc_copy_expr (dest->upper[i]);
+    }
+
+  return dest;
+}
+
+
+/* Returns nonzero if the two expressions are equal.  Only handles integer
+   constants.  */
+
+static int
+compare_bounds (gfc_expr *bound1, gfc_expr *bound2)
+{
+  if (bound1 == NULL || bound2 == NULL
+      || bound1->expr_type != EXPR_CONSTANT
+      || bound2->expr_type != EXPR_CONSTANT
+      || bound1->ts.type != BT_INTEGER
+      || bound2->ts.type != BT_INTEGER)
+    gfc_internal_error ("gfc_compare_array_spec(): Array spec clobbered");
+
+  if (mpz_cmp (bound1->value.integer, bound2->value.integer) == 0)
+    return 1;
+  else
+    return 0;
+}
+
+
+/* Compares two array specifications.  They must be constant or deferred
+   shape.  */
+
+int
+gfc_compare_array_spec (gfc_array_spec *as1, gfc_array_spec *as2)
+{
+  int i;
+
+  if (as1 == NULL && as2 == NULL)
+    return 1;
+
+  if (as1 == NULL || as2 == NULL)
+    return 0;
+
+  if (as1->rank != as2->rank)
+    return 0;
+
+  if (as1->corank != as2->corank)
+    return 0;
+
+  if (as1->rank == 0)
+    return 1;
+
+  if (as1->type != as2->type)
+    return 0;
+
+  if (as1->type == AS_EXPLICIT)
+    for (i = 0; i < as1->rank + as1->corank; i++)
+      {
+	if (compare_bounds (as1->lower[i], as2->lower[i]) == 0)
+	  return 0;
+
+	if (compare_bounds (as1->upper[i], as2->upper[i]) == 0)
+	  return 0;
+      }
+
+  return 1;
+}
+
+
+/****************** Array constructor functions ******************/
+
+
+/* Given an expression node that might be an array constructor and a
+   symbol, make sure that no iterators in this or child constructors
+   use the symbol as an implied-DO iterator.  Returns nonzero if a
+   duplicate was found.  */
+
+static int
+check_duplicate_iterator (gfc_constructor_base base, gfc_symbol *master)
+{
+  gfc_constructor *c;
+  gfc_expr *e;
+
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+    {
+      e = c->expr;
+
+      if (e->expr_type == EXPR_ARRAY
+	  && check_duplicate_iterator (e->value.constructor, master))
+	return 1;
+
+      if (c->iterator == NULL)
+	continue;
+
+      if (c->iterator->var->symtree->n.sym == master)
+	{
+	  gfc_error ("DO-iterator '%s' at %L is inside iterator of the "
+		     "same name", master->name, &c->where);
+
+	  return 1;
+	}
+    }
+
+  return 0;
+}
+
+
+/* Forward declaration because these functions are mutually recursive.  */
+static match match_array_cons_element (gfc_constructor_base *);
+
+/* Match a list of array elements.  */
+
+static match
+match_array_list (gfc_constructor_base *result)
+{
+  gfc_constructor_base head;
+  gfc_constructor *p;
+  gfc_iterator iter;
+  locus old_loc;
+  gfc_expr *e;
+  match m;
+  int n;
+
+  old_loc = gfc_current_locus;
+
+  if (gfc_match_char ('(') == MATCH_NO)
+    return MATCH_NO;
+
+  memset (&iter, '\0', sizeof (gfc_iterator));
+  head = NULL;
+
+  m = match_array_cons_element (&head);
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  if (gfc_match_char (',') != MATCH_YES)
+    {
+      m = MATCH_NO;
+      goto cleanup;
+    }
+
+  for (n = 1;; n++)
+    {
+      m = gfc_match_iterator (&iter, 0);
+      if (m == MATCH_YES)
+	break;
+      if (m == MATCH_ERROR)
+	goto cleanup;
+
+      m = match_array_cons_element (&head);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	{
+	  if (n > 2)
+	    goto syntax;
+	  m = MATCH_NO;
+	  goto cleanup;		/* Could be a complex constant */
+	}
+
+      if (gfc_match_char (',') != MATCH_YES)
+	{
+	  if (n > 2)
+	    goto syntax;
+	  m = MATCH_NO;
+	  goto cleanup;
+	}
+    }
+
+  if (gfc_match_char (')') != MATCH_YES)
+    goto syntax;
+
+  if (check_duplicate_iterator (head, iter.var->symtree->n.sym))
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  e = gfc_get_array_expr (BT_UNKNOWN, 0, &old_loc);
+  e->value.constructor = head;
+
+  p = gfc_constructor_append_expr (result, e, &gfc_current_locus);
+  p->iterator = gfc_get_iterator ();
+  *p->iterator = iter;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in array constructor at %C");
+  m = MATCH_ERROR;
+
+cleanup:
+  gfc_constructor_free (head);
+  gfc_free_iterator (&iter, 0);
+  gfc_current_locus = old_loc;
+  return m;
+}
+
+
+/* Match a single element of an array constructor, which can be a
+   single expression or a list of elements.  */
+
+static match
+match_array_cons_element (gfc_constructor_base *result)
+{
+  gfc_expr *expr;
+  match m;
+
+  m = match_array_list (result);
+  if (m != MATCH_NO)
+    return m;
+
+  m = gfc_match_expr (&expr);
+  if (m != MATCH_YES)
+    return m;
+
+  gfc_constructor_append_expr (result, expr, &gfc_current_locus);
+  return MATCH_YES;
+}
+
+
+/* Match an array constructor.  */
+
+match
+gfc_match_array_constructor (gfc_expr **result)
+{
+  gfc_constructor_base head, new_cons;
+  gfc_expr *expr;
+  gfc_typespec ts;
+  locus where;
+  match m;
+  const char *end_delim;
+  bool seen_ts;
+
+  if (gfc_match (" (/") == MATCH_NO)
+    {
+      if (gfc_match (" [") == MATCH_NO)
+	return MATCH_NO;
+      else
+	{
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: [...] "
+			      "style array constructors at %C") == FAILURE)
+	    return MATCH_ERROR;
+	  end_delim = " ]";
+	}
+    }
+  else
+    end_delim = " /)";
+
+  where = gfc_current_locus;
+  head = new_cons = NULL;
+  seen_ts = false;
+
+  /* Try to match an optional "type-spec ::"  */
+  if (gfc_match_decl_type_spec (&ts, 0) == MATCH_YES)
+    {
+      seen_ts = (gfc_match (" ::") == MATCH_YES);
+
+      if (seen_ts)
+	{
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Array constructor "
+			      "including type specification at %C") == FAILURE)
+	    goto cleanup;
+
+	  if (ts.deferred)
+	    {
+	      gfc_error ("Type-spec at %L cannot contain a deferred "
+			 "type parameter", &where);
+	      goto cleanup;
+	    }
+	}
+    }
+
+  if (! seen_ts)
+    gfc_current_locus = where;
+
+  if (gfc_match (end_delim) == MATCH_YES)
+    {
+      if (seen_ts)
+	goto done;
+      else
+	{
+	  gfc_error ("Empty array constructor at %C is not allowed");
+	  goto cleanup;
+	}
+    }
+
+  for (;;)
+    {
+      m = match_array_cons_element (&head);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      if (gfc_match_char (',') == MATCH_NO)
+	break;
+    }
+
+  if (gfc_match (end_delim) == MATCH_NO)
+    goto syntax;
+
+done:
+  /* Size must be calculated at resolution time.  */
+  if (seen_ts)
+    {
+      expr = gfc_get_array_expr (ts.type, ts.kind, &where);
+      expr->ts = ts;
+    }
+  else
+    expr = gfc_get_array_expr (BT_UNKNOWN, 0, &where);
+
+  expr->value.constructor = head;
+  if (expr->ts.u.cl)
+    expr->ts.u.cl->length_from_typespec = seen_ts;
+
+  *result = expr;
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in array constructor at %C");
+
+cleanup:
+  gfc_constructor_free (head);
+  return MATCH_ERROR;
+}
+
+
+
+/************** Check array constructors for correctness **************/
+
+/* Given an expression, compare it's type with the type of the current
+   constructor.  Returns nonzero if an error was issued.  The
+   cons_state variable keeps track of whether the type of the
+   constructor being read or resolved is known to be good, bad or just
+   starting out.  */
+
+static gfc_typespec constructor_ts;
+static enum
+{ CONS_START, CONS_GOOD, CONS_BAD }
+cons_state;
+
+static int
+check_element_type (gfc_expr *expr, bool convert)
+{
+  if (cons_state == CONS_BAD)
+    return 0;			/* Suppress further errors */
+
+  if (cons_state == CONS_START)
+    {
+      if (expr->ts.type == BT_UNKNOWN)
+	cons_state = CONS_BAD;
+      else
+	{
+	  cons_state = CONS_GOOD;
+	  constructor_ts = expr->ts;
+	}
+
+      return 0;
+    }
+
+  if (gfc_compare_types (&constructor_ts, &expr->ts))
+    return 0;
+
+  if (convert)
+    return gfc_convert_type (expr, &constructor_ts, 1) == SUCCESS ? 0 : 1;
+
+  gfc_error ("Element in %s array constructor at %L is %s",
+	     gfc_typename (&constructor_ts), &expr->where,
+	     gfc_typename (&expr->ts));
+
+  cons_state = CONS_BAD;
+  return 1;
+}
+
+
+/* Recursive work function for gfc_check_constructor_type().  */
+
+static gfc_try
+check_constructor_type (gfc_constructor_base base, bool convert)
+{
+  gfc_constructor *c;
+  gfc_expr *e;
+
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+    {
+      e = c->expr;
+
+      if (e->expr_type == EXPR_ARRAY)
+	{
+	  if (check_constructor_type (e->value.constructor, convert) == FAILURE)
+	    return FAILURE;
+
+	  continue;
+	}
+
+      if (check_element_type (e, convert))
+	return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Check that all elements of an array constructor are the same type.
+   On FAILURE, an error has been generated.  */
+
+gfc_try
+gfc_check_constructor_type (gfc_expr *e)
+{
+  gfc_try t;
+
+  if (e->ts.type != BT_UNKNOWN)
+    {
+      cons_state = CONS_GOOD;
+      constructor_ts = e->ts;
+    }
+  else
+    {
+      cons_state = CONS_START;
+      gfc_clear_ts (&constructor_ts);
+    }
+
+  /* If e->ts.type != BT_UNKNOWN, the array constructor included a
+     typespec, and we will now convert the values on the fly.  */
+  t = check_constructor_type (e->value.constructor, e->ts.type != BT_UNKNOWN);
+  if (t == SUCCESS && e->ts.type == BT_UNKNOWN)
+    e->ts = constructor_ts;
+
+  return t;
+}
+
+
+
+typedef struct cons_stack
+{
+  gfc_iterator *iterator;
+  struct cons_stack *previous;
+}
+cons_stack;
+
+static cons_stack *base;
+
+static gfc_try check_constructor (gfc_constructor_base, gfc_try (*) (gfc_expr *));
+
+/* Check an EXPR_VARIABLE expression in a constructor to make sure
+   that that variable is an iteration variables.  */
+
+gfc_try
+gfc_check_iter_variable (gfc_expr *expr)
+{
+  gfc_symbol *sym;
+  cons_stack *c;
+
+  sym = expr->symtree->n.sym;
+
+  for (c = base; c && c->iterator; c = c->previous)
+    if (sym == c->iterator->var->symtree->n.sym)
+      return SUCCESS;
+
+  return FAILURE;
+}
+
+
+/* Recursive work function for gfc_check_constructor().  This amounts
+   to calling the check function for each expression in the
+   constructor, giving variables with the names of iterators a pass.  */
+
+static gfc_try
+check_constructor (gfc_constructor_base ctor, gfc_try (*check_function) (gfc_expr *))
+{
+  cons_stack element;
+  gfc_expr *e;
+  gfc_try t;
+  gfc_constructor *c;
+
+  for (c = gfc_constructor_first (ctor); c; c = gfc_constructor_next (c))
+    {
+      e = c->expr;
+
+      if (e->expr_type != EXPR_ARRAY)
+	{
+	  if ((*check_function) (e) == FAILURE)
+	    return FAILURE;
+	  continue;
+	}
+
+      element.previous = base;
+      element.iterator = c->iterator;
+
+      base = &element;
+      t = check_constructor (e->value.constructor, check_function);
+      base = element.previous;
+
+      if (t == FAILURE)
+	return FAILURE;
+    }
+
+  /* Nothing went wrong, so all OK.  */
+  return SUCCESS;
+}
+
+
+/* Checks a constructor to see if it is a particular kind of
+   expression -- specification, restricted, or initialization as
+   determined by the check_function.  */
+
+gfc_try
+gfc_check_constructor (gfc_expr *expr, gfc_try (*check_function) (gfc_expr *))
+{
+  cons_stack *base_save;
+  gfc_try t;
+
+  base_save = base;
+  base = NULL;
+
+  t = check_constructor (expr->value.constructor, check_function);
+  base = base_save;
+
+  return t;
+}
+
+
+
+/**************** Simplification of array constructors ****************/
+
+iterator_stack *iter_stack;
+
+typedef struct
+{
+  gfc_constructor_base base;
+  int extract_count, extract_n;
+  gfc_expr *extracted;
+  mpz_t *count;
+
+  mpz_t *offset;
+  gfc_component *component;
+  mpz_t *repeat;
+
+  gfc_try (*expand_work_function) (gfc_expr *);
+}
+expand_info;
+
+static expand_info current_expand;
+
+static gfc_try expand_constructor (gfc_constructor_base);
+
+
+/* Work function that counts the number of elements present in a
+   constructor.  */
+
+static gfc_try
+count_elements (gfc_expr *e)
+{
+  mpz_t result;
+
+  if (e->rank == 0)
+    mpz_add_ui (*current_expand.count, *current_expand.count, 1);
+  else
+    {
+      if (gfc_array_size (e, &result) == FAILURE)
+	{
+	  gfc_free_expr (e);
+	  return FAILURE;
+	}
+
+      mpz_add (*current_expand.count, *current_expand.count, result);
+      mpz_clear (result);
+    }
+
+  gfc_free_expr (e);
+  return SUCCESS;
+}
+
+
+/* Work function that extracts a particular element from an array
+   constructor, freeing the rest.  */
+
+static gfc_try
+extract_element (gfc_expr *e)
+{
+  if (e->rank != 0)
+    {				/* Something unextractable */
+      gfc_free_expr (e);
+      return FAILURE;
+    }
+
+  if (current_expand.extract_count == current_expand.extract_n)
+    current_expand.extracted = e;
+  else
+    gfc_free_expr (e);
+
+  current_expand.extract_count++;
+  
+  return SUCCESS;
+}
+
+
+/* Work function that constructs a new constructor out of the old one,
+   stringing new elements together.  */
+
+static gfc_try
+expand (gfc_expr *e)
+{
+  gfc_constructor *c = gfc_constructor_append_expr (&current_expand.base,
+						    e, &e->where);
+
+  c->n.component = current_expand.component;
+  return SUCCESS;
+}
+
+
+/* Given an initialization expression that is a variable reference,
+   substitute the current value of the iteration variable.  */
+
+void
+gfc_simplify_iterator_var (gfc_expr *e)
+{
+  iterator_stack *p;
+
+  for (p = iter_stack; p; p = p->prev)
+    if (e->symtree == p->variable)
+      break;
+
+  if (p == NULL)
+    return;		/* Variable not found */
+
+  gfc_replace_expr (e, gfc_get_int_expr (gfc_default_integer_kind, NULL, 0));
+
+  mpz_set (e->value.integer, p->value);
+
+  return;
+}
+
+
+/* Expand an expression with that is inside of a constructor,
+   recursing into other constructors if present.  */
+
+static gfc_try
+expand_expr (gfc_expr *e)
+{
+  if (e->expr_type == EXPR_ARRAY)
+    return expand_constructor (e->value.constructor);
+
+  e = gfc_copy_expr (e);
+
+  if (gfc_simplify_expr (e, 1) == FAILURE)
+    {
+      gfc_free_expr (e);
+      return FAILURE;
+    }
+
+  return current_expand.expand_work_function (e);
+}
+
+
+static gfc_try
+expand_iterator (gfc_constructor *c)
+{
+  gfc_expr *start, *end, *step;
+  iterator_stack frame;
+  mpz_t trip;
+  gfc_try t;
+
+  end = step = NULL;
+
+  t = FAILURE;
+
+  mpz_init (trip);
+  mpz_init (frame.value);
+  frame.prev = NULL;
+
+  start = gfc_copy_expr (c->iterator->start);
+  if (gfc_simplify_expr (start, 1) == FAILURE)
+    goto cleanup;
+
+  if (start->expr_type != EXPR_CONSTANT || start->ts.type != BT_INTEGER)
+    goto cleanup;
+
+  end = gfc_copy_expr (c->iterator->end);
+  if (gfc_simplify_expr (end, 1) == FAILURE)
+    goto cleanup;
+
+  if (end->expr_type != EXPR_CONSTANT || end->ts.type != BT_INTEGER)
+    goto cleanup;
+
+  step = gfc_copy_expr (c->iterator->step);
+  if (gfc_simplify_expr (step, 1) == FAILURE)
+    goto cleanup;
+
+  if (step->expr_type != EXPR_CONSTANT || step->ts.type != BT_INTEGER)
+    goto cleanup;
+
+  if (mpz_sgn (step->value.integer) == 0)
+    {
+      gfc_error ("Iterator step at %L cannot be zero", &step->where);
+      goto cleanup;
+    }
+
+  /* Calculate the trip count of the loop.  */
+  mpz_sub (trip, end->value.integer, start->value.integer);
+  mpz_add (trip, trip, step->value.integer);
+  mpz_tdiv_q (trip, trip, step->value.integer);
+
+  mpz_set (frame.value, start->value.integer);
+
+  frame.prev = iter_stack;
+  frame.variable = c->iterator->var->symtree;
+  iter_stack = &frame;
+
+  while (mpz_sgn (trip) > 0)
+    {
+      if (expand_expr (c->expr) == FAILURE)
+	goto cleanup;
+
+      mpz_add (frame.value, frame.value, step->value.integer);
+      mpz_sub_ui (trip, trip, 1);
+    }
+
+  t = SUCCESS;
+
+cleanup:
+  gfc_free_expr (start);
+  gfc_free_expr (end);
+  gfc_free_expr (step);
+
+  mpz_clear (trip);
+  mpz_clear (frame.value);
+
+  iter_stack = frame.prev;
+
+  return t;
+}
+
+
+/* Expand a constructor into constant constructors without any
+   iterators, calling the work function for each of the expanded
+   expressions.  The work function needs to either save or free the
+   passed expression.  */
+
+static gfc_try
+expand_constructor (gfc_constructor_base base)
+{
+  gfc_constructor *c;
+  gfc_expr *e;
+
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next(c))
+    {
+      if (c->iterator != NULL)
+	{
+	  if (expand_iterator (c) == FAILURE)
+	    return FAILURE;
+	  continue;
+	}
+
+      e = c->expr;
+
+      if (e->expr_type == EXPR_ARRAY)
+	{
+	  if (expand_constructor (e->value.constructor) == FAILURE)
+	    return FAILURE;
+
+	  continue;
+	}
+
+      e = gfc_copy_expr (e);
+      if (gfc_simplify_expr (e, 1) == FAILURE)
+	{
+	  gfc_free_expr (e);
+	  return FAILURE;
+	}
+      current_expand.offset = &c->offset;
+      current_expand.repeat = &c->repeat;
+      current_expand.component = c->n.component;
+      if (current_expand.expand_work_function (e) == FAILURE)
+	return FAILURE;
+    }
+  return SUCCESS;
+}
+
+
+/* Given an array expression and an element number (starting at zero),
+   return a pointer to the array element.  NULL is returned if the
+   size of the array has been exceeded.  The expression node returned
+   remains a part of the array and should not be freed.  Access is not
+   efficient at all, but this is another place where things do not
+   have to be particularly fast.  */
+
+static gfc_expr *
+gfc_get_array_element (gfc_expr *array, int element)
+{
+  expand_info expand_save;
+  gfc_expr *e;
+  gfc_try rc;
+
+  expand_save = current_expand;
+  current_expand.extract_n = element;
+  current_expand.expand_work_function = extract_element;
+  current_expand.extracted = NULL;
+  current_expand.extract_count = 0;
+
+  iter_stack = NULL;
+
+  rc = expand_constructor (array->value.constructor);
+  e = current_expand.extracted;
+  current_expand = expand_save;
+
+  if (rc == FAILURE)
+    return NULL;
+
+  return e;
+}
+
+
+/* Top level subroutine for expanding constructors.  We only expand
+   constructor if they are small enough.  */
+
+gfc_try
+gfc_expand_constructor (gfc_expr *e, bool fatal)
+{
+  expand_info expand_save;
+  gfc_expr *f;
+  gfc_try rc;
+
+  /* If we can successfully get an array element at the max array size then
+     the array is too big to expand, so we just return.  */
+  f = gfc_get_array_element (e, gfc_option.flag_max_array_constructor);
+  if (f != NULL)
+    {
+      gfc_free_expr (f);
+      if (fatal)
+	{
+	  gfc_error ("The number of elements in the array constructor "
+		     "at %L requires an increase of the allowed %d "
+		     "upper limit.   See -fmax-array-constructor "
+		     "option", &e->where,
+		     gfc_option.flag_max_array_constructor);
+	  return FAILURE;
+	}
+      return SUCCESS;
+    }
+
+  /* We now know the array is not too big so go ahead and try to expand it.  */
+  expand_save = current_expand;
+  current_expand.base = NULL;
+
+  iter_stack = NULL;
+
+  current_expand.expand_work_function = expand;
+
+  if (expand_constructor (e->value.constructor) == FAILURE)
+    {
+      gfc_constructor_free (current_expand.base);
+      rc = FAILURE;
+      goto done;
+    }
+
+  gfc_constructor_free (e->value.constructor);
+  e->value.constructor = current_expand.base;
+
+  rc = SUCCESS;
+
+done:
+  current_expand = expand_save;
+
+  return rc;
+}
+
+
+/* Work function for checking that an element of a constructor is a
+   constant, after removal of any iteration variables.  We return
+   FAILURE if not so.  */
+
+static gfc_try
+is_constant_element (gfc_expr *e)
+{
+  int rv;
+
+  rv = gfc_is_constant_expr (e);
+  gfc_free_expr (e);
+
+  return rv ? SUCCESS : FAILURE;
+}
+
+
+/* Given an array constructor, determine if the constructor is
+   constant or not by expanding it and making sure that all elements
+   are constants.  This is a bit of a hack since something like (/ (i,
+   i=1,100000000) /) will take a while as* opposed to a more clever
+   function that traverses the expression tree. FIXME.  */
+
+int
+gfc_constant_ac (gfc_expr *e)
+{
+  expand_info expand_save;
+  gfc_try rc;
+
+  iter_stack = NULL;
+  expand_save = current_expand;
+  current_expand.expand_work_function = is_constant_element;
+
+  rc = expand_constructor (e->value.constructor);
+
+  current_expand = expand_save;
+  if (rc == FAILURE)
+    return 0;
+
+  return 1;
+}
+
+
+/* Returns nonzero if an array constructor has been completely
+   expanded (no iterators) and zero if iterators are present.  */
+
+int
+gfc_expanded_ac (gfc_expr *e)
+{
+  gfc_constructor *c;
+
+  if (e->expr_type == EXPR_ARRAY)
+    for (c = gfc_constructor_first (e->value.constructor);
+	 c; c = gfc_constructor_next (c))
+      if (c->iterator != NULL || !gfc_expanded_ac (c->expr))
+	return 0;
+
+  return 1;
+}
+
+
+/*************** Type resolution of array constructors ***************/
+
+/* Recursive array list resolution function.  All of the elements must
+   be of the same type.  */
+
+static gfc_try
+resolve_array_list (gfc_constructor_base base)
+{
+  gfc_try t;
+  gfc_constructor *c;
+
+  t = SUCCESS;
+
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+    {
+      if (c->iterator != NULL
+	  && gfc_resolve_iterator (c->iterator, false) == FAILURE)
+	t = FAILURE;
+
+      if (gfc_resolve_expr (c->expr) == FAILURE)
+	t = FAILURE;
+    }
+
+  return t;
+}
+
+/* Resolve character array constructor. If it has a specified constant character
+   length, pad/truncate the elements here; if the length is not specified and
+   all elements are of compile-time known length, emit an error as this is
+   invalid.  */
+
+gfc_try
+gfc_resolve_character_array_constructor (gfc_expr *expr)
+{
+  gfc_constructor *p;
+  int found_length;
+
+  gcc_assert (expr->expr_type == EXPR_ARRAY);
+  gcc_assert (expr->ts.type == BT_CHARACTER);
+
+  if (expr->ts.u.cl == NULL)
+    {
+      for (p = gfc_constructor_first (expr->value.constructor);
+	   p; p = gfc_constructor_next (p))
+	if (p->expr->ts.u.cl != NULL)
+	  {
+	    /* Ensure that if there is a char_len around that it is
+	       used; otherwise the middle-end confuses them!  */
+	    expr->ts.u.cl = p->expr->ts.u.cl;
+	    goto got_charlen;
+	  }
+
+      expr->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+    }
+
+got_charlen:
+
+  found_length = -1;
+
+  if (expr->ts.u.cl->length == NULL)
+    {
+      /* Check that all constant string elements have the same length until
+	 we reach the end or find a variable-length one.  */
+
+      for (p = gfc_constructor_first (expr->value.constructor);
+	   p; p = gfc_constructor_next (p))
+	{
+	  int current_length = -1;
+	  gfc_ref *ref;
+	  for (ref = p->expr->ref; ref; ref = ref->next)
+	    if (ref->type == REF_SUBSTRING
+		&& ref->u.ss.start->expr_type == EXPR_CONSTANT
+		&& ref->u.ss.end->expr_type == EXPR_CONSTANT)
+	      break;
+
+	  if (p->expr->expr_type == EXPR_CONSTANT)
+	    current_length = p->expr->value.character.length;
+	  else if (ref)
+	    {
+	      long j;
+	      j = mpz_get_ui (ref->u.ss.end->value.integer)
+		- mpz_get_ui (ref->u.ss.start->value.integer) + 1;
+	      current_length = (int) j;
+	    }
+	  else if (p->expr->ts.u.cl && p->expr->ts.u.cl->length
+		   && p->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+	    {
+	      long j;
+	      j = mpz_get_si (p->expr->ts.u.cl->length->value.integer);
+	      current_length = (int) j;
+	    }
+	  else
+	    return SUCCESS;
+
+	  gcc_assert (current_length != -1);
+
+	  if (found_length == -1)
+	    found_length = current_length;
+	  else if (found_length != current_length)
+	    {
+	      gfc_error ("Different CHARACTER lengths (%d/%d) in array"
+			 " constructor at %L", found_length, current_length,
+			 &p->expr->where);
+	      return FAILURE;
+	    }
+
+	  gcc_assert (found_length == current_length);
+	}
+
+      gcc_assert (found_length != -1);
+
+      /* Update the character length of the array constructor.  */
+      expr->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+						NULL, found_length);
+    }
+  else 
+    {
+      /* We've got a character length specified.  It should be an integer,
+	 otherwise an error is signalled elsewhere.  */
+      gcc_assert (expr->ts.u.cl->length);
+
+      /* If we've got a constant character length, pad according to this.
+	 gfc_extract_int does check for BT_INTEGER and EXPR_CONSTANT and sets
+	 max_length only if they pass.  */
+      gfc_extract_int (expr->ts.u.cl->length, &found_length);
+
+      /* Now pad/truncate the elements accordingly to the specified character
+	 length.  This is ok inside this conditional, as in the case above
+	 (without typespec) all elements are verified to have the same length
+	 anyway.  */
+      if (found_length != -1)
+	for (p = gfc_constructor_first (expr->value.constructor);
+	     p; p = gfc_constructor_next (p))
+	  if (p->expr->expr_type == EXPR_CONSTANT)
+	    {
+	      gfc_expr *cl = NULL;
+	      int current_length = -1;
+	      bool has_ts;
+
+	      if (p->expr->ts.u.cl && p->expr->ts.u.cl->length)
+	      {
+		cl = p->expr->ts.u.cl->length;
+		gfc_extract_int (cl, &current_length);
+	      }
+
+	      /* If gfc_extract_int above set current_length, we implicitly
+		 know the type is BT_INTEGER and it's EXPR_CONSTANT.  */
+
+	      has_ts = (expr->ts.u.cl && expr->ts.u.cl->length_from_typespec);
+
+	      if (! cl
+		  || (current_length != -1 && current_length != found_length))
+		gfc_set_constant_character_len (found_length, p->expr,
+						has_ts ? -1 : found_length);
+	    }
+    }
+
+  return SUCCESS;
+}
+
+
+/* Resolve all of the expressions in an array list.  */
+
+gfc_try
+gfc_resolve_array_constructor (gfc_expr *expr)
+{
+  gfc_try t;
+
+  t = resolve_array_list (expr->value.constructor);
+  if (t == SUCCESS)
+    t = gfc_check_constructor_type (expr);
+
+  /* gfc_resolve_character_array_constructor is called in gfc_resolve_expr after
+     the call to this function, so we don't need to call it here; if it was
+     called twice, an error message there would be duplicated.  */
+
+  return t;
+}
+
+
+/* Copy an iterator structure.  */
+
+gfc_iterator *
+gfc_copy_iterator (gfc_iterator *src)
+{
+  gfc_iterator *dest;
+
+  if (src == NULL)
+    return NULL;
+
+  dest = gfc_get_iterator ();
+
+  dest->var = gfc_copy_expr (src->var);
+  dest->start = gfc_copy_expr (src->start);
+  dest->end = gfc_copy_expr (src->end);
+  dest->step = gfc_copy_expr (src->step);
+
+  return dest;
+}
+
+
+/********* Subroutines for determining the size of an array *********/
+
+/* These are needed just to accommodate RESHAPE().  There are no
+   diagnostics here, we just return a negative number if something
+   goes wrong.  */
+
+
+/* Get the size of single dimension of an array specification.  The
+   array is guaranteed to be one dimensional.  */
+
+gfc_try
+spec_dimen_size (gfc_array_spec *as, int dimen, mpz_t *result)
+{
+  if (as == NULL)
+    return FAILURE;
+
+  if (dimen < 0 || dimen > as->rank - 1)
+    gfc_internal_error ("spec_dimen_size(): Bad dimension");
+
+  if (as->type != AS_EXPLICIT
+      || as->lower[dimen]->expr_type != EXPR_CONSTANT
+      || as->upper[dimen]->expr_type != EXPR_CONSTANT
+      || as->lower[dimen]->ts.type != BT_INTEGER
+      || as->upper[dimen]->ts.type != BT_INTEGER)
+    return FAILURE;
+
+  mpz_init (*result);
+
+  mpz_sub (*result, as->upper[dimen]->value.integer,
+	   as->lower[dimen]->value.integer);
+
+  mpz_add_ui (*result, *result, 1);
+
+  return SUCCESS;
+}
+
+
+gfc_try
+spec_size (gfc_array_spec *as, mpz_t *result)
+{
+  mpz_t size;
+  int d;
+
+  mpz_init_set_ui (*result, 1);
+
+  for (d = 0; d < as->rank; d++)
+    {
+      if (spec_dimen_size (as, d, &size) == FAILURE)
+	{
+	  mpz_clear (*result);
+	  return FAILURE;
+	}
+
+      mpz_mul (*result, *result, size);
+      mpz_clear (size);
+    }
+
+  return SUCCESS;
+}
+
+
+/* Get the number of elements in an array section. Optionally, also supply
+   the end value.  */
+
+gfc_try
+gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end)
+{
+  mpz_t upper, lower, stride;
+  gfc_try t;
+
+  if (dimen < 0 || ar == NULL || dimen > ar->dimen - 1)
+    gfc_internal_error ("gfc_ref_dimen_size(): Bad dimension");
+
+  switch (ar->dimen_type[dimen])
+    {
+    case DIMEN_ELEMENT:
+      mpz_init (*result);
+      mpz_set_ui (*result, 1);
+      t = SUCCESS;
+      break;
+
+    case DIMEN_VECTOR:
+      t = gfc_array_size (ar->start[dimen], result);	/* Recurse! */
+      break;
+
+    case DIMEN_RANGE:
+      mpz_init (upper);
+      mpz_init (lower);
+      mpz_init (stride);
+      t = FAILURE;
+
+      if (ar->start[dimen] == NULL)
+	{
+	  if (ar->as->lower[dimen] == NULL
+	      || ar->as->lower[dimen]->expr_type != EXPR_CONSTANT)
+	    goto cleanup;
+	  mpz_set (lower, ar->as->lower[dimen]->value.integer);
+	}
+      else
+	{
+	  if (ar->start[dimen]->expr_type != EXPR_CONSTANT)
+	    goto cleanup;
+	  mpz_set (lower, ar->start[dimen]->value.integer);
+	}
+
+      if (ar->end[dimen] == NULL)
+	{
+	  if (ar->as->upper[dimen] == NULL
+	      || ar->as->upper[dimen]->expr_type != EXPR_CONSTANT)
+	    goto cleanup;
+	  mpz_set (upper, ar->as->upper[dimen]->value.integer);
+	}
+      else
+	{
+	  if (ar->end[dimen]->expr_type != EXPR_CONSTANT)
+	    goto cleanup;
+	  mpz_set (upper, ar->end[dimen]->value.integer);
+	}
+
+      if (ar->stride[dimen] == NULL)
+	mpz_set_ui (stride, 1);
+      else
+	{
+	  if (ar->stride[dimen]->expr_type != EXPR_CONSTANT)
+	    goto cleanup;
+	  mpz_set (stride, ar->stride[dimen]->value.integer);
+	}
+
+      mpz_init (*result);
+      mpz_sub (*result, upper, lower);
+      mpz_add (*result, *result, stride);
+      mpz_div (*result, *result, stride);
+
+      /* Zero stride caught earlier.  */
+      if (mpz_cmp_ui (*result, 0) < 0)
+	mpz_set_ui (*result, 0);
+      t = SUCCESS;
+
+      if (end)
+	{
+	  mpz_init (*end);
+
+	  mpz_sub_ui (*end, *result, 1UL);
+	  mpz_mul (*end, *end, stride);
+	  mpz_add (*end, *end, lower);
+	}
+
+    cleanup:
+      mpz_clear (upper);
+      mpz_clear (lower);
+      mpz_clear (stride);
+      return t;
+
+    default:
+      gfc_internal_error ("gfc_ref_dimen_size(): Bad dimen_type");
+    }
+
+  return t;
+}
+
+
+static gfc_try
+ref_size (gfc_array_ref *ar, mpz_t *result)
+{
+  mpz_t size;
+  int d;
+
+  mpz_init_set_ui (*result, 1);
+
+  for (d = 0; d < ar->dimen; d++)
+    {
+      if (gfc_ref_dimen_size (ar, d, &size, NULL) == FAILURE)
+	{
+	  mpz_clear (*result);
+	  return FAILURE;
+	}
+
+      mpz_mul (*result, *result, size);
+      mpz_clear (size);
+    }
+
+  return SUCCESS;
+}
+
+
+/* Given an array expression and a dimension, figure out how many
+   elements it has along that dimension.  Returns SUCCESS if we were
+   able to return a result in the 'result' variable, FAILURE
+   otherwise.  */
+
+gfc_try
+gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result)
+{
+  gfc_ref *ref;
+  int i;
+
+  if (dimen < 0 || array == NULL || dimen > array->rank - 1)
+    gfc_internal_error ("gfc_array_dimen_size(): Bad dimension");
+
+  switch (array->expr_type)
+    {
+    case EXPR_VARIABLE:
+    case EXPR_FUNCTION:
+      for (ref = array->ref; ref; ref = ref->next)
+	{
+	  if (ref->type != REF_ARRAY)
+	    continue;
+
+	  if (ref->u.ar.type == AR_FULL)
+	    return spec_dimen_size (ref->u.ar.as, dimen, result);
+
+	  if (ref->u.ar.type == AR_SECTION)
+	    {
+	      for (i = 0; dimen >= 0; i++)
+		if (ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
+		  dimen--;
+
+	      return gfc_ref_dimen_size (&ref->u.ar, i - 1, result, NULL);
+	    }
+	}
+
+      if (array->shape && array->shape[dimen])
+	{
+	  mpz_init_set (*result, array->shape[dimen]);
+	  return SUCCESS;
+	}
+
+      if (array->symtree->n.sym->attr.generic
+	  && array->value.function.esym != NULL)
+	{
+	  if (spec_dimen_size (array->value.function.esym->as, dimen, result)
+	      == FAILURE)
+	    return FAILURE;
+	}
+      else if (spec_dimen_size (array->symtree->n.sym->as, dimen, result)
+	       == FAILURE)
+	return FAILURE;
+
+      break;
+
+    case EXPR_ARRAY:
+      if (array->shape == NULL) {
+	/* Expressions with rank > 1 should have "shape" properly set */
+	if ( array->rank != 1 )
+	  gfc_internal_error ("gfc_array_dimen_size(): Bad EXPR_ARRAY expr");
+	return gfc_array_size(array, result);
+      }
+
+      /* Fall through */
+    default:
+      if (array->shape == NULL)
+	return FAILURE;
+
+      mpz_init_set (*result, array->shape[dimen]);
+
+      break;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Given an array expression, figure out how many elements are in the
+   array.  Returns SUCCESS if this is possible, and sets the 'result'
+   variable.  Otherwise returns FAILURE.  */
+
+gfc_try
+gfc_array_size (gfc_expr *array, mpz_t *result)
+{
+  expand_info expand_save;
+  gfc_ref *ref;
+  int i;
+  gfc_try t;
+
+  switch (array->expr_type)
+    {
+    case EXPR_ARRAY:
+      gfc_push_suppress_errors ();
+
+      expand_save = current_expand;
+
+      current_expand.count = result;
+      mpz_init_set_ui (*result, 0);
+
+      current_expand.expand_work_function = count_elements;
+      iter_stack = NULL;
+
+      t = expand_constructor (array->value.constructor);
+
+      gfc_pop_suppress_errors ();
+
+      if (t == FAILURE)
+	mpz_clear (*result);
+      current_expand = expand_save;
+      return t;
+
+    case EXPR_VARIABLE:
+      for (ref = array->ref; ref; ref = ref->next)
+	{
+	  if (ref->type != REF_ARRAY)
+	    continue;
+
+	  if (ref->u.ar.type == AR_FULL)
+	    return spec_size (ref->u.ar.as, result);
+
+	  if (ref->u.ar.type == AR_SECTION)
+	    return ref_size (&ref->u.ar, result);
+	}
+
+      return spec_size (array->symtree->n.sym->as, result);
+
+
+    default:
+      if (array->rank == 0 || array->shape == NULL)
+	return FAILURE;
+
+      mpz_init_set_ui (*result, 1);
+
+      for (i = 0; i < array->rank; i++)
+	mpz_mul (*result, *result, array->shape[i]);
+
+      break;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Given an array reference, return the shape of the reference in an
+   array of mpz_t integers.  */
+
+gfc_try
+gfc_array_ref_shape (gfc_array_ref *ar, mpz_t *shape)
+{
+  int d;
+  int i;
+
+  d = 0;
+
+  switch (ar->type)
+    {
+    case AR_FULL:
+      for (; d < ar->as->rank; d++)
+	if (spec_dimen_size (ar->as, d, &shape[d]) == FAILURE)
+	  goto cleanup;
+
+      return SUCCESS;
+
+    case AR_SECTION:
+      for (i = 0; i < ar->dimen; i++)
+	{
+	  if (ar->dimen_type[i] != DIMEN_ELEMENT)
+	    {
+	      if (gfc_ref_dimen_size (ar, i, &shape[d], NULL) == FAILURE)
+		goto cleanup;
+	      d++;
+	    }
+	}
+
+      return SUCCESS;
+
+    default:
+      break;
+    }
+
+cleanup:
+  gfc_clear_shape (shape, d);
+  return FAILURE;
+}
+
+
+/* Given an array expression, find the array reference structure that
+   characterizes the reference.  */
+
+gfc_array_ref *
+gfc_find_array_ref (gfc_expr *e)
+{
+  gfc_ref *ref;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY
+	&& (ref->u.ar.type == AR_FULL || ref->u.ar.type == AR_SECTION
+	    || (ref->u.ar.type == AR_ELEMENT && ref->u.ar.dimen == 0)))
+      break;
+
+  if (ref == NULL)
+    gfc_internal_error ("gfc_find_array_ref(): No ref found");
+
+  return &ref->u.ar;
+}
+
+
+/* Find out if an array shape is known at compile time.  */
+
+int
+gfc_is_compile_time_shape (gfc_array_spec *as)
+{
+  int i;
+
+  if (as->type != AS_EXPLICIT)
+    return 0;
+
+  for (i = 0; i < as->rank; i++)
+    if (!gfc_is_constant_expr (as->lower[i])
+	|| !gfc_is_constant_expr (as->upper[i]))
+      return 0;
+
+  return 1;
+}
diff --git a/gcc/fortran/bbt.c b/gcc/fortran/bbt.c
new file mode 100644
index 000000000..a78467be8
--- /dev/null
+++ b/gcc/fortran/bbt.c
@@ -0,0 +1,198 @@
+/* Balanced binary trees using treaps.
+   Copyright (C) 2000, 2002, 2003, 2007, 2008, 2010
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* The idea is to balance the tree using pseudorandom numbers.  The
+   main constraint on this implementation is that we have several
+   distinct structures that have to be arranged in a binary tree.
+   These structures all contain a BBT_HEADER() in front that gives the
+   treap-related information.  The key and value are assumed to reside
+   in the rest of the structure.
+
+   When calling, we are also passed a comparison function that
+   compares two nodes.  We don't implement a separate 'find' function
+   here, but rather use separate functions for each variety of tree.
+   We are also restricted to not copy treap structures, which most
+   implementations find convenient, because we otherwise would need to
+   know how long the structure is.
+
+   This implementation is based on Stefan Nilsson's article in the
+   July 1997 Doctor Dobb's Journal, "Treaps in Java".  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+
+typedef struct gfc_treap
+{
+  BBT_HEADER (gfc_treap);
+}
+gfc_bbt;
+
+/* Simple linear congruential pseudorandom number generator.  The
+   period of this generator is 44071, which is plenty for our
+   purposes.  */
+
+static int
+pseudo_random (void)
+{
+  static int x0 = 5341;
+
+  x0 = (22611 * x0 + 10) % 44071;
+  return x0;
+}
+
+
+/* Rotate the treap left.  */
+
+static gfc_bbt *
+rotate_left (gfc_bbt *t)
+{
+  gfc_bbt *temp;
+
+  temp = t->right;
+  t->right = t->right->left;
+  temp->left = t;
+
+  return temp;
+}
+
+
+/* Rotate the treap right.  */
+
+static gfc_bbt *
+rotate_right (gfc_bbt *t)
+{
+  gfc_bbt *temp;
+
+  temp = t->left;
+  t->left = t->left->right;
+  temp->right = t;
+
+  return temp;
+}
+
+
+/* Recursive insertion function.  Returns the updated treap, or
+   aborts if we find a duplicate key.  */
+
+static gfc_bbt *
+insert (gfc_bbt *new_bbt, gfc_bbt *t, compare_fn compare)
+{
+  int c;
+
+  if (t == NULL)
+    return new_bbt;
+
+  c = (*compare) (new_bbt, t);
+
+  if (c < 0)
+    {
+      t->left = insert (new_bbt, t->left, compare);
+      if (t->priority < t->left->priority)
+	t = rotate_right (t);
+    }
+  else if (c > 0)
+    {
+      t->right = insert (new_bbt, t->right, compare);
+      if (t->priority < t->right->priority)
+	t = rotate_left (t);
+    }
+  else /* if (c == 0)  */
+    gfc_internal_error("insert_bbt(): Duplicate key found!");
+
+  return t;
+}
+
+
+/* Given root pointer, a new node and a comparison function, insert
+   the new node into the treap.  It is an error to insert a key that
+   already exists.  */
+
+void
+gfc_insert_bbt (void *root, void *new_node, compare_fn compare)
+{
+  gfc_bbt **r, *n;
+
+  r = (gfc_bbt **) root;
+  n = (gfc_bbt *) new_node;
+  n->priority = pseudo_random ();
+  *r = insert (n, *r, compare);
+}
+
+static gfc_bbt *
+delete_root (gfc_bbt *t)
+{
+  gfc_bbt *temp;
+
+  if (t->left == NULL)
+    return t->right;
+  if (t->right == NULL)
+    return t->left;
+
+  if (t->left->priority > t->right->priority)
+    {
+      temp = rotate_right (t);
+      temp->right = delete_root (t);
+    }
+  else
+    {
+      temp = rotate_left (t);
+      temp->left = delete_root (t);
+    }
+
+  return temp;
+}
+
+
+/* Delete an element from a tree.  The 'old' value does not
+   necessarily have to point to the element to be deleted, it must
+   just point to a treap structure with the key to be deleted.
+   Returns the new root node of the tree.  */
+
+static gfc_bbt *
+delete_treap (gfc_bbt *old, gfc_bbt *t, compare_fn compare)
+{
+  int c;
+
+  if (t == NULL)
+    return NULL;
+
+  c = (*compare) (old, t);
+
+  if (c < 0)
+    t->left = delete_treap (old, t->left, compare);
+  if (c > 0)
+    t->right = delete_treap (old, t->right, compare);
+  if (c == 0)
+    t = delete_root (t);
+
+  return t;
+}
+
+
+void
+gfc_delete_bbt (void *root, void *old, compare_fn compare)
+{
+  gfc_bbt **t;
+
+  t = (gfc_bbt **) root;
+  *t = delete_treap ((gfc_bbt *) old, *t, compare);
+}
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
new file mode 100644
index 000000000..a3d32b693
--- /dev/null
+++ b/gcc/fortran/check.c
@@ -0,0 +1,4892 @@
+/* Check functions
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught & Katherine Holcomb
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+/* These functions check to see if an argument list is compatible with
+   a particular intrinsic function or subroutine.  Presence of
+   required arguments has already been established, the argument list
+   has been sorted into the right order and has NULL arguments in the
+   correct places for missing optional arguments.  */
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "intrinsic.h"
+#include "constructor.h"
+
+
+/* Make sure an expression is a scalar.  */
+
+static gfc_try
+scalar_check (gfc_expr *e, int n)
+{
+  if (e->rank == 0)
+    return SUCCESS;
+
+  gfc_error ("'%s' argument of '%s' intrinsic at %L must be a scalar",
+	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+	     &e->where);
+
+  return FAILURE;
+}
+
+
+/* Check the type of an expression.  */
+
+static gfc_try
+type_check (gfc_expr *e, int n, bt type)
+{
+  if (e->ts.type == type)
+    return SUCCESS;
+
+  gfc_error ("'%s' argument of '%s' intrinsic at %L must be %s",
+	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+	     &e->where, gfc_basic_typename (type));
+
+  return FAILURE;
+}
+
+
+/* Check that the expression is a numeric type.  */
+
+static gfc_try
+numeric_check (gfc_expr *e, int n)
+{
+  if (gfc_numeric_ts (&e->ts))
+    return SUCCESS;
+
+  /* If the expression has not got a type, check if its namespace can
+     offer a default type.  */
+  if ((e->expr_type == EXPR_VARIABLE || e->expr_type == EXPR_VARIABLE)
+	&& e->symtree->n.sym->ts.type == BT_UNKNOWN
+	&& gfc_set_default_type (e->symtree->n.sym, 0,
+				 e->symtree->n.sym->ns) == SUCCESS
+	&& gfc_numeric_ts (&e->symtree->n.sym->ts))
+    {
+      e->ts = e->symtree->n.sym->ts;
+      return SUCCESS;
+    }
+
+  gfc_error ("'%s' argument of '%s' intrinsic at %L must be a numeric type",
+	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+	     &e->where);
+
+  return FAILURE;
+}
+
+
+/* Check that an expression is integer or real.  */
+
+static gfc_try
+int_or_real_check (gfc_expr *e, int n)
+{
+  if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
+		 "or REAL", gfc_current_intrinsic_arg[n]->name,
+		 gfc_current_intrinsic, &e->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Check that an expression is real or complex.  */
+
+static gfc_try
+real_or_complex_check (gfc_expr *e, int n)
+{
+  if (e->ts.type != BT_REAL && e->ts.type != BT_COMPLEX)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be REAL "
+		 "or COMPLEX", gfc_current_intrinsic_arg[n]->name,
+		 gfc_current_intrinsic, &e->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Check that an expression is INTEGER or PROCEDURE.  */
+
+static gfc_try
+int_or_proc_check (gfc_expr *e, int n)
+{
+  if (e->ts.type != BT_INTEGER && e->ts.type != BT_PROCEDURE)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
+		 "or PROCEDURE", gfc_current_intrinsic_arg[n]->name,
+		 gfc_current_intrinsic, &e->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Check that the expression is an optional constant integer
+   and that it specifies a valid kind for that type.  */
+
+static gfc_try
+kind_check (gfc_expr *k, int n, bt type)
+{
+  int kind;
+
+  if (k == NULL)
+    return SUCCESS;
+
+  if (type_check (k, n, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (k, n) == FAILURE)
+    return FAILURE;
+
+  if (k->expr_type != EXPR_CONSTANT)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a constant",
+		 gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+		 &k->where);
+      return FAILURE;
+    }
+
+  if (gfc_extract_int (k, &kind) != NULL
+      || gfc_validate_kind (type, kind, true) < 0)
+    {
+      gfc_error ("Invalid kind for %s at %L", gfc_basic_typename (type),
+		 &k->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Make sure the expression is a double precision real.  */
+
+static gfc_try
+double_check (gfc_expr *d, int n)
+{
+  if (type_check (d, n, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (d->ts.kind != gfc_default_double_kind)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be double "
+		 "precision", gfc_current_intrinsic_arg[n]->name,
+		 gfc_current_intrinsic, &d->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Check whether an expression is a coarray (without array designator).  */
+
+static bool
+is_coarray (gfc_expr *e)
+{
+  bool coarray = false;
+  gfc_ref *ref;
+
+  if (e->expr_type != EXPR_VARIABLE)
+    return false;
+
+  coarray = e->symtree->n.sym->attr.codimension;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_COMPONENT)
+	coarray = ref->u.c.component->attr.codimension;
+      else if (ref->type != REF_ARRAY || ref->u.ar.dimen != 0
+	       || ref->u.ar.codimen != 0)
+	coarray = false;
+    }
+
+  return coarray;
+}
+
+
+static gfc_try
+coarray_check (gfc_expr *e, int n)
+{
+  if (!is_coarray (e))
+    {
+      gfc_error ("Expected coarray variable as '%s' argument to the %s "
+                 "intrinsic at %L", gfc_current_intrinsic_arg[n]->name,
+		 gfc_current_intrinsic, &e->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Make sure the expression is a logical array.  */
+
+static gfc_try
+logical_array_check (gfc_expr *array, int n)
+{
+  if (array->ts.type != BT_LOGICAL || array->rank == 0)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a logical "
+		 "array", gfc_current_intrinsic_arg[n]->name,
+		 gfc_current_intrinsic, &array->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Make sure an expression is an array.  */
+
+static gfc_try
+array_check (gfc_expr *e, int n)
+{
+  if (e->rank != 0 && e->ts.type != BT_PROCEDURE)
+    return SUCCESS;
+
+  gfc_error ("'%s' argument of '%s' intrinsic at %L must be an array",
+	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+	     &e->where);
+
+  return FAILURE;
+}
+
+
+/* If expr is a constant, then check to ensure that it is greater than
+   of equal to zero.  */
+
+static gfc_try
+nonnegative_check (const char *arg, gfc_expr *expr)
+{
+  int i;
+
+  if (expr->expr_type == EXPR_CONSTANT)
+    {
+      gfc_extract_int (expr, &i);
+      if (i < 0)
+	{
+	  gfc_error ("'%s' at %L must be nonnegative", arg, &expr->where);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* If expr2 is constant, then check that the value is less than
+   (less than or equal to, if 'or_equal' is true) bit_size(expr1).  */
+
+static gfc_try
+less_than_bitsize1 (const char *arg1, gfc_expr *expr1, const char *arg2,
+		    gfc_expr *expr2, bool or_equal)
+{
+  int i2, i3;
+
+  if (expr2->expr_type == EXPR_CONSTANT)
+    {
+      gfc_extract_int (expr2, &i2);
+      i3 = gfc_validate_kind (BT_INTEGER, expr1->ts.kind, false);
+      if (or_equal)
+	{
+	  if (i2 > gfc_integer_kinds[i3].bit_size)
+	    {
+	      gfc_error ("'%s' at %L must be less than "
+			 "or equal to BIT_SIZE('%s')",
+			 arg2, &expr2->where, arg1);
+	      return FAILURE;
+	    }
+	}
+      else
+	{
+	  if (i2 >= gfc_integer_kinds[i3].bit_size)
+	    {
+	      gfc_error ("'%s' at %L must be less than BIT_SIZE('%s')",
+			 arg2, &expr2->where, arg1);
+	      return FAILURE;
+	    }
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* If expr is constant, then check that the value is less than or equal
+   to the bit_size of the kind k.  */
+
+static gfc_try
+less_than_bitsizekind (const char *arg, gfc_expr *expr, int k)
+{
+  int i, val;
+
+  if (expr->expr_type != EXPR_CONSTANT)
+    return SUCCESS;
+
+  i = gfc_validate_kind (BT_INTEGER, k, false);
+  gfc_extract_int (expr, &val);
+
+  if (val > gfc_integer_kinds[i].bit_size)
+    {
+      gfc_error ("'%s' at %L must be less than or equal to the BIT_SIZE of "
+		 "INTEGER(KIND=%d)", arg, &expr->where, k);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* If expr2 and expr3 are constants, then check that the value is less than
+   or equal to bit_size(expr1).  */
+
+static gfc_try
+less_than_bitsize2 (const char *arg1, gfc_expr *expr1, const char *arg2,
+	       gfc_expr *expr2, const char *arg3, gfc_expr *expr3)
+{
+  int i2, i3;
+
+  if (expr2->expr_type == EXPR_CONSTANT && expr3->expr_type == EXPR_CONSTANT)
+    {
+      gfc_extract_int (expr2, &i2);
+      gfc_extract_int (expr3, &i3);
+      i2 += i3;
+      i3 = gfc_validate_kind (BT_INTEGER, expr1->ts.kind, false);
+      if (i2 > gfc_integer_kinds[i3].bit_size)
+	{
+	  gfc_error ("'%s + %s' at %L must be less than or equal "
+		     "to BIT_SIZE('%s')",
+		     arg2, arg3, &expr2->where, arg1);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+/* Make sure two expressions have the same type.  */
+
+static gfc_try
+same_type_check (gfc_expr *e, int n, gfc_expr *f, int m)
+{
+  if (gfc_compare_types (&e->ts, &f->ts))
+    return SUCCESS;
+
+  gfc_error ("'%s' argument of '%s' intrinsic at %L must be the same type "
+	     "and kind as '%s'", gfc_current_intrinsic_arg[m]->name,
+	     gfc_current_intrinsic, &f->where,
+	     gfc_current_intrinsic_arg[n]->name);
+
+  return FAILURE;
+}
+
+
+/* Make sure that an expression has a certain (nonzero) rank.  */
+
+static gfc_try
+rank_check (gfc_expr *e, int n, int rank)
+{
+  if (e->rank == rank)
+    return SUCCESS;
+
+  gfc_error ("'%s' argument of '%s' intrinsic at %L must be of rank %d",
+	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+	     &e->where, rank);
+
+  return FAILURE;
+}
+
+
+/* Make sure a variable expression is not an optional dummy argument.  */
+
+static gfc_try
+nonoptional_check (gfc_expr *e, int n)
+{
+  if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must not be OPTIONAL",
+		 gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+		 &e->where);
+    }
+
+  /* TODO: Recursive check on nonoptional variables?  */
+
+  return SUCCESS;
+}
+
+
+/* Check for ALLOCATABLE attribute.  */
+
+static gfc_try
+allocatable_check (gfc_expr *e, int n)
+{
+  symbol_attribute attr;
+
+  attr = gfc_variable_attr (e, NULL);
+  if (!attr.allocatable)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be ALLOCATABLE",
+		 gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+		 &e->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Check that an expression has a particular kind.  */
+
+static gfc_try
+kind_value_check (gfc_expr *e, int n, int k)
+{
+  if (e->ts.kind == k)
+    return SUCCESS;
+
+  gfc_error ("'%s' argument of '%s' intrinsic at %L must be of kind %d",
+	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
+	     &e->where, k);
+
+  return FAILURE;
+}
+
+
+/* Make sure an expression is a variable.  */
+
+static gfc_try
+variable_check (gfc_expr *e, int n, bool allow_proc)
+{
+  if (e->expr_type == EXPR_VARIABLE
+      && e->symtree->n.sym->attr.intent == INTENT_IN
+      && (gfc_current_intrinsic_arg[n]->intent == INTENT_OUT
+	  || gfc_current_intrinsic_arg[n]->intent == INTENT_INOUT))
+    {
+      gfc_ref *ref;
+      bool pointer = e->symtree->n.sym->ts.type == BT_CLASS
+		     && CLASS_DATA (e->symtree->n.sym)
+		     ? CLASS_DATA (e->symtree->n.sym)->attr.class_pointer
+		     : e->symtree->n.sym->attr.pointer;
+
+      for (ref = e->ref; ref; ref = ref->next)
+	{
+	  if (pointer && ref->type == REF_COMPONENT)
+	    break;
+	  if (ref->type == REF_COMPONENT
+	      && ((ref->u.c.component->ts.type == BT_CLASS
+		   && CLASS_DATA (ref->u.c.component)->attr.class_pointer)
+		  || (ref->u.c.component->ts.type != BT_CLASS
+		      && ref->u.c.component->attr.pointer)))
+	    break;
+	}
+
+      if (!ref)
+	{
+	  gfc_error ("'%s' argument of '%s' intrinsic at %L cannot be "
+		     "INTENT(IN)", gfc_current_intrinsic_arg[n]->name,
+		     gfc_current_intrinsic, &e->where);
+	  return FAILURE;
+	}
+    }
+
+  if (e->expr_type == EXPR_VARIABLE
+      && e->symtree->n.sym->attr.flavor != FL_PARAMETER
+      && (allow_proc || !e->symtree->n.sym->attr.function))
+    return SUCCESS;
+
+  if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.function
+      && e->symtree->n.sym == e->symtree->n.sym->result)
+    {
+      gfc_namespace *ns;
+      for (ns = gfc_current_ns; ns; ns = ns->parent)
+	if (ns->proc_name == e->symtree->n.sym)
+	  return SUCCESS;
+    }
+
+  gfc_error ("'%s' argument of '%s' intrinsic at %L must be a variable",
+	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where);
+
+  return FAILURE;
+}
+
+
+/* Check the common DIM parameter for correctness.  */
+
+static gfc_try
+dim_check (gfc_expr *dim, int n, bool optional)
+{
+  if (dim == NULL)
+    return SUCCESS;
+
+  if (type_check (dim, n, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (dim, n) == FAILURE)
+    return FAILURE;
+
+  if (!optional && nonoptional_check (dim, n) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* If a coarray DIM parameter is a constant, make sure that it is greater than
+   zero and less than or equal to the corank of the given array.  */
+
+static gfc_try
+dim_corank_check (gfc_expr *dim, gfc_expr *array)
+{
+  gfc_array_ref *ar;
+  int corank;
+
+  gcc_assert (array->expr_type == EXPR_VARIABLE);
+
+  if (dim->expr_type != EXPR_CONSTANT)
+    return SUCCESS;
+
+  ar = gfc_find_array_ref (array);
+  corank = ar->as->corank;
+
+  if (mpz_cmp_ui (dim->value.integer, 1) < 0
+      || mpz_cmp_ui (dim->value.integer, corank) > 0)
+    {
+      gfc_error ("'dim' argument of '%s' intrinsic at %L is not a valid "
+		 "codimension index", gfc_current_intrinsic, &dim->where);
+
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* If a DIM parameter is a constant, make sure that it is greater than
+   zero and less than or equal to the rank of the given array.  If
+   allow_assumed is zero then dim must be less than the rank of the array
+   for assumed size arrays.  */
+
+static gfc_try
+dim_rank_check (gfc_expr *dim, gfc_expr *array, int allow_assumed)
+{
+  gfc_array_ref *ar;
+  int rank;
+
+  if (dim == NULL)
+    return SUCCESS;
+
+  if (dim->expr_type != EXPR_CONSTANT)
+    return SUCCESS;
+
+  if (array->expr_type == EXPR_FUNCTION && array->value.function.isym
+      && array->value.function.isym->id == GFC_ISYM_SPREAD)
+    rank = array->rank + 1;
+  else
+    rank = array->rank;
+
+  if (array->expr_type == EXPR_VARIABLE)
+    {
+      ar = gfc_find_array_ref (array);
+      if (ar->as->type == AS_ASSUMED_SIZE
+	  && !allow_assumed
+	  && ar->type != AR_ELEMENT
+	  && ar->type != AR_SECTION)
+	rank--;
+    }
+
+  if (mpz_cmp_ui (dim->value.integer, 1) < 0
+      || mpz_cmp_ui (dim->value.integer, rank) > 0)
+    {
+      gfc_error ("'dim' argument of '%s' intrinsic at %L is not a valid "
+		 "dimension index", gfc_current_intrinsic, &dim->where);
+
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Compare the size of a along dimension ai with the size of b along
+   dimension bi, returning 0 if they are known not to be identical,
+   and 1 if they are identical, or if this cannot be determined.  */
+
+static int
+identical_dimen_shape (gfc_expr *a, int ai, gfc_expr *b, int bi)
+{
+  mpz_t a_size, b_size;
+  int ret;
+
+  gcc_assert (a->rank > ai);
+  gcc_assert (b->rank > bi);
+
+  ret = 1;
+
+  if (gfc_array_dimen_size (a, ai, &a_size) == SUCCESS)
+    {
+      if (gfc_array_dimen_size (b, bi, &b_size) == SUCCESS)
+	{
+	  if (mpz_cmp (a_size, b_size) != 0)
+	    ret = 0;
+
+	  mpz_clear (b_size);
+	}
+      mpz_clear (a_size);
+    }
+  return ret;
+}
+
+/*  Calculate the length of a character variable, including substrings.
+    Strip away parentheses if necessary.  Return -1 if no length could
+    be determined.  */
+
+static long
+gfc_var_strlen (const gfc_expr *a)
+{
+  gfc_ref *ra;
+
+  while (a->expr_type == EXPR_OP && a->value.op.op == INTRINSIC_PARENTHESES)
+    a = a->value.op.op1;
+
+  for (ra = a->ref; ra != NULL && ra->type != REF_SUBSTRING; ra = ra->next)
+    ;
+
+  if (ra)
+    {
+      long start_a, end_a;
+
+      if (ra->u.ss.start->expr_type == EXPR_CONSTANT
+	  && ra->u.ss.end->expr_type == EXPR_CONSTANT)
+	{
+	  start_a = mpz_get_si (ra->u.ss.start->value.integer);
+	  end_a = mpz_get_si (ra->u.ss.end->value.integer);
+	  return end_a - start_a + 1;
+	}
+      else if (gfc_dep_compare_expr (ra->u.ss.start, ra->u.ss.end) == 0)
+	return 1;
+      else
+	return -1;
+    }
+
+  if (a->ts.u.cl && a->ts.u.cl->length
+      && a->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+    return mpz_get_si (a->ts.u.cl->length->value.integer);
+  else if (a->expr_type == EXPR_CONSTANT
+	   && (a->ts.u.cl == NULL || a->ts.u.cl->length == NULL))
+    return a->value.character.length;
+  else
+    return -1;
+
+}
+
+/* Check whether two character expressions have the same length;
+   returns SUCCESS if they have or if the length cannot be determined,
+   otherwise return FAILURE and raise a gfc_error.  */
+
+gfc_try
+gfc_check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name)
+{
+   long len_a, len_b;
+
+   len_a = gfc_var_strlen(a);
+   len_b = gfc_var_strlen(b);
+
+   if (len_a == -1 || len_b == -1 || len_a == len_b)
+     return SUCCESS;
+   else
+     {
+       gfc_error ("Unequal character lengths (%ld/%ld) in %s at %L",
+		  len_a, len_b, name, &a->where);
+       return FAILURE;
+     }
+}
+
+
+/***** Check functions *****/
+
+/* Check subroutine suitable for intrinsics taking a real argument and
+   a kind argument for the result.  */
+
+static gfc_try
+check_a_kind (gfc_expr *a, gfc_expr *kind, bt type)
+{
+  if (type_check (a, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+  if (kind_check (kind, 1, type) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Check subroutine suitable for ceiling, floor and nint.  */
+
+gfc_try
+gfc_check_a_ikind (gfc_expr *a, gfc_expr *kind)
+{
+  return check_a_kind (a, kind, BT_INTEGER);
+}
+
+
+/* Check subroutine suitable for aint, anint.  */
+
+gfc_try
+gfc_check_a_xkind (gfc_expr *a, gfc_expr *kind)
+{
+  return check_a_kind (a, kind, BT_REAL);
+}
+
+
+gfc_try
+gfc_check_abs (gfc_expr *a)
+{
+  if (numeric_check (a, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_achar (gfc_expr *a, gfc_expr *kind)
+{
+  if (type_check (a, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind_check (kind, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_access_func (gfc_expr *name, gfc_expr *mode)
+{
+  if (type_check (name, 0, BT_CHARACTER) == FAILURE
+      || scalar_check (name, 0) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (type_check (mode, 1, BT_CHARACTER) == FAILURE
+      || scalar_check (mode, 1) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (mode, 1, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_all_any (gfc_expr *mask, gfc_expr *dim)
+{
+  if (logical_array_check (mask, 0) == FAILURE)
+    return FAILURE;
+
+  if (dim_check (dim, 1, false) == FAILURE)
+    return FAILURE;
+
+  if (dim_rank_check (dim, mask, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_allocated (gfc_expr *array)
+{
+  if (variable_check (array, 0, false) == FAILURE)
+    return FAILURE;
+  if (allocatable_check (array, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Common check function where the first argument must be real or
+   integer and the second argument must be the same as the first.  */
+
+gfc_try
+gfc_check_a_p (gfc_expr *a, gfc_expr *p)
+{
+  if (int_or_real_check (a, 0) == FAILURE)
+    return FAILURE;
+
+  if (a->ts.type != p->ts.type)
+    {
+      gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L must "
+		 "have the same type", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		 &p->where);
+      return FAILURE;
+    }
+
+  if (a->ts.kind != p->ts.kind)
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
+			  &p->where) == FAILURE)
+       return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_x_yd (gfc_expr *x, gfc_expr *y)
+{
+  if (double_check (x, 0) == FAILURE || double_check (y, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
+{
+  symbol_attribute attr1, attr2;
+  int i;
+  gfc_try t;
+  locus *where;
+
+  where = &pointer->where;
+
+  if (pointer->expr_type == EXPR_VARIABLE || pointer->expr_type == EXPR_FUNCTION)
+    attr1 = gfc_expr_attr (pointer);
+  else if (pointer->expr_type == EXPR_NULL)
+    goto null_arg;
+  else
+    gcc_assert (0); /* Pointer must be a variable or a function.  */
+
+  if (!attr1.pointer && !attr1.proc_pointer)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER",
+		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+		 &pointer->where);
+      return FAILURE;
+    }
+
+  /* Target argument is optional.  */
+  if (target == NULL)
+    return SUCCESS;
+
+  where = &target->where;
+  if (target->expr_type == EXPR_NULL)
+    goto null_arg;
+
+  if (target->expr_type == EXPR_VARIABLE || target->expr_type == EXPR_FUNCTION)
+    attr2 = gfc_expr_attr (target);
+  else
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a pointer "
+		 "or target VARIABLE or FUNCTION",
+		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		 &target->where);
+      return FAILURE;
+    }
+
+  if (attr1.pointer && !attr2.pointer && !attr2.target)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER "
+		 "or a TARGET", gfc_current_intrinsic_arg[1]->name,
+		 gfc_current_intrinsic, &target->where);
+      return FAILURE;
+    }
+
+  t = SUCCESS;
+  if (same_type_check (pointer, 0, target, 1) == FAILURE)
+    t = FAILURE;
+  if (rank_check (target, 0, pointer->rank) == FAILURE)
+    t = FAILURE;
+  if (target->rank > 0)
+    {
+      for (i = 0; i < target->rank; i++)
+	if (target->ref->u.ar.dimen_type[i] == DIMEN_VECTOR)
+	  {
+	    gfc_error ("Array section with a vector subscript at %L shall not "
+		       "be the target of a pointer",
+		       &target->where);
+	    t = FAILURE;
+	    break;
+	  }
+    }
+  return t;
+
+null_arg:
+
+  gfc_error ("NULL pointer at %L is not permitted as actual argument "
+	     "of '%s' intrinsic function", where, gfc_current_intrinsic);
+  return FAILURE;
+
+}
+
+
+gfc_try
+gfc_check_atan_2 (gfc_expr *y, gfc_expr *x)
+{
+  /* gfc_notify_std would be a wast of time as the return value
+     is seemingly used only for the generic resolution.  The error
+     will be: Too many arguments.  */
+  if ((gfc_option.allow_std & GFC_STD_F2008) == 0)
+    return FAILURE;
+
+  return gfc_check_atan2 (y, x);
+}
+
+
+gfc_try
+gfc_check_atan2 (gfc_expr *y, gfc_expr *x)
+{
+  if (type_check (y, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+  if (same_type_check (y, 0, x, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* BESJN and BESYN functions.  */
+
+gfc_try
+gfc_check_besn (gfc_expr *n, gfc_expr *x)
+{
+  if (type_check (n, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (n->expr_type == EXPR_CONSTANT)
+    {
+      int i;
+      gfc_extract_int (n, &i);
+      if (i < 0 && gfc_notify_std (GFC_STD_GNU, "Extension: Negative argument "
+				   "N at %L", &n->where) == FAILURE)
+	return FAILURE;
+    }
+
+  if (type_check (x, 1, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Transformational version of the Bessel JN and YN functions.  */
+
+gfc_try
+gfc_check_bessel_n2 (gfc_expr *n1, gfc_expr *n2, gfc_expr *x)
+{
+  if (type_check (n1, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (scalar_check (n1, 0) == FAILURE)
+    return FAILURE;
+  if (nonnegative_check("N1", n1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (n2, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (scalar_check (n2, 1) == FAILURE)
+    return FAILURE;
+  if (nonnegative_check("N2", n2) == FAILURE)
+    return FAILURE;
+
+  if (type_check (x, 2, BT_REAL) == FAILURE)
+    return FAILURE;
+  if (scalar_check (x, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_bge_bgt_ble_blt (gfc_expr *i, gfc_expr *j)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (j, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_bitfcn (gfc_expr *i, gfc_expr *pos)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (pos, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (nonnegative_check ("pos", pos) == FAILURE)
+    return FAILURE;
+
+  if (less_than_bitsize1 ("i", i, "pos", pos, false) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_char (gfc_expr *i, gfc_expr *kind)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind_check (kind, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_chdir (gfc_expr *dir)
+{
+  if (type_check (dir, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (dir, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_chdir_sub (gfc_expr *dir, gfc_expr *status)
+{
+  if (type_check (dir, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (dir, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (scalar_check (status, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_chmod (gfc_expr *name, gfc_expr *mode)
+{
+  if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (type_check (mode, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (mode, 1, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_chmod_sub (gfc_expr *name, gfc_expr *mode, gfc_expr *status)
+{
+  if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (type_check (mode, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (mode, 1, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (status, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind)
+{
+  if (numeric_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  if (y != NULL)
+    {
+      if (numeric_check (y, 1) == FAILURE)
+	return FAILURE;
+
+      if (x->ts.type == BT_COMPLEX)
+	{
+	  gfc_error ("'%s' argument of '%s' intrinsic at %L must not be "
+		     "present if 'x' is COMPLEX",
+		     gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		     &y->where);
+	  return FAILURE;
+	}
+
+      if (y->ts.type == BT_COMPLEX)
+	{
+	  gfc_error ("'%s' argument of '%s' intrinsic at %L must have a type "
+		     "of either REAL or INTEGER",
+		     gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		     &y->where);
+	  return FAILURE;
+	}
+
+    }
+
+  if (kind_check (kind, 2, BT_COMPLEX) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_complex (gfc_expr *x, gfc_expr *y)
+{
+  if (int_or_real_check (x, 0) == FAILURE)
+    return FAILURE;
+  if (scalar_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  if (int_or_real_check (y, 1) == FAILURE)
+    return FAILURE;
+  if (scalar_check (y, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
+{
+  if (logical_array_check (mask, 0) == FAILURE)
+    return FAILURE;
+  if (dim_check (dim, 1, false) == FAILURE)
+    return FAILURE;
+  if (dim_rank_check (dim, mask, 0) == FAILURE)
+    return FAILURE;
+  if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim)
+{
+  if (array_check (array, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (shift, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (dim_check (dim, 2, true) == FAILURE)
+    return FAILURE;
+
+  if (dim_rank_check (dim, array, false) == FAILURE)
+    return FAILURE;
+
+  if (array->rank == 1 || shift->rank == 0)
+    {
+      if (scalar_check (shift, 1) == FAILURE)
+	return FAILURE;
+    }
+  else if (shift->rank == array->rank - 1)
+    {
+      int d;
+      if (!dim)
+	d = 1;
+      else if (dim->expr_type == EXPR_CONSTANT)
+	gfc_extract_int (dim, &d);
+      else
+	d = -1;
+
+      if (d > 0)
+	{
+	  int i, j;
+	  for (i = 0, j = 0; i < array->rank; i++)
+	    if (i != d - 1)
+	      {
+		if (!identical_dimen_shape (array, i, shift, j))
+		  {
+		    gfc_error ("'%s' argument of '%s' intrinsic at %L has "
+			       "invalid shape in dimension %d (%ld/%ld)",
+			       gfc_current_intrinsic_arg[1]->name,
+			       gfc_current_intrinsic, &shift->where, i + 1,
+			       mpz_get_si (array->shape[i]),
+			       mpz_get_si (shift->shape[j]));
+		    return FAILURE;
+		  }
+
+		j += 1;
+	      }
+	}
+    }
+  else
+    {
+      gfc_error ("'%s' argument of intrinsic '%s' at %L of must have rank "
+		 "%d or be a scalar", gfc_current_intrinsic_arg[1]->name,
+		 gfc_current_intrinsic, &shift->where, array->rank - 1);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ctime (gfc_expr *time)
+{
+  if (scalar_check (time, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (time, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try gfc_check_datan2 (gfc_expr *y, gfc_expr *x)
+{
+  if (double_check (y, 0) == FAILURE || double_check (x, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+gfc_try
+gfc_check_dcmplx (gfc_expr *x, gfc_expr *y)
+{
+  if (numeric_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  if (y != NULL)
+    {
+      if (numeric_check (y, 1) == FAILURE)
+	return FAILURE;
+
+      if (x->ts.type == BT_COMPLEX)
+	{
+	  gfc_error ("'%s' argument of '%s' intrinsic at %L must not be "
+		     "present if 'x' is COMPLEX",
+		     gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		     &y->where);
+	  return FAILURE;
+	}
+
+      if (y->ts.type == BT_COMPLEX)
+	{
+	  gfc_error ("'%s' argument of '%s' intrinsic at %L must have a type "
+		     "of either REAL or INTEGER",
+		     gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		     &y->where);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_dble (gfc_expr *x)
+{
+  if (numeric_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_digits (gfc_expr *x)
+{
+  if (int_or_real_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_dot_product (gfc_expr *vector_a, gfc_expr *vector_b)
+{
+  switch (vector_a->ts.type)
+    {
+    case BT_LOGICAL:
+      if (type_check (vector_b, 1, BT_LOGICAL) == FAILURE)
+	return FAILURE;
+      break;
+
+    case BT_INTEGER:
+    case BT_REAL:
+    case BT_COMPLEX:
+      if (numeric_check (vector_b, 1) == FAILURE)
+	return FAILURE;
+      break;
+
+    default:
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
+		 "or LOGICAL", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic, &vector_a->where);
+      return FAILURE;
+    }
+
+  if (rank_check (vector_a, 0, 1) == FAILURE)
+    return FAILURE;
+
+  if (rank_check (vector_b, 1, 1) == FAILURE)
+    return FAILURE;
+
+  if (! identical_dimen_shape (vector_a, 0, vector_b, 0))
+    {
+      gfc_error ("Different shape for arguments '%s' and '%s' at %L for "
+		 "intrinsic 'dot_product'", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic_arg[1]->name, &vector_a->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_dprod (gfc_expr *x, gfc_expr *y)
+{
+  if (type_check (x, 0, BT_REAL) == FAILURE
+      || type_check (y, 1, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (x->ts.kind != gfc_default_real_kind)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be default "
+		 "real", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic, &x->where);
+      return FAILURE;
+    }
+
+  if (y->ts.kind != gfc_default_real_kind)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be default "
+		 "real", gfc_current_intrinsic_arg[1]->name,
+		 gfc_current_intrinsic, &y->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (j, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (same_type_check (i, 0, j, 1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (shift, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (nonnegative_check ("SHIFT", shift) == FAILURE)
+    return FAILURE;
+
+  if (less_than_bitsize1 ("I", i, "SHIFT", shift, true) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
+		   gfc_expr *dim)
+{
+  if (array_check (array, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (shift, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (dim_check (dim, 3, true) == FAILURE)
+    return FAILURE;
+
+  if (dim_rank_check (dim, array, false) == FAILURE)
+    return FAILURE;
+
+  if (array->rank == 1 || shift->rank == 0)
+    {
+      if (scalar_check (shift, 1) == FAILURE)
+	return FAILURE;
+    }
+  else if (shift->rank == array->rank - 1)
+    {
+      int d;
+      if (!dim)
+	d = 1;
+      else if (dim->expr_type == EXPR_CONSTANT)
+	gfc_extract_int (dim, &d);
+      else
+	d = -1;
+
+      if (d > 0)
+	{
+	  int i, j;
+	  for (i = 0, j = 0; i < array->rank; i++)
+	    if (i != d - 1)
+	      {
+		if (!identical_dimen_shape (array, i, shift, j))
+		  {
+		    gfc_error ("'%s' argument of '%s' intrinsic at %L has "
+			       "invalid shape in dimension %d (%ld/%ld)",
+			       gfc_current_intrinsic_arg[1]->name,
+			       gfc_current_intrinsic, &shift->where, i + 1,
+			       mpz_get_si (array->shape[i]),
+			       mpz_get_si (shift->shape[j]));
+		    return FAILURE;
+		  }
+
+		j += 1;
+	      }
+	}
+    }
+  else
+    {
+      gfc_error ("'%s' argument of intrinsic '%s' at %L of must have rank "
+		 "%d or be a scalar", gfc_current_intrinsic_arg[1]->name,
+		 gfc_current_intrinsic, &shift->where, array->rank - 1);
+      return FAILURE;
+    }
+
+  if (boundary != NULL)
+    {
+      if (same_type_check (array, 0, boundary, 2) == FAILURE)
+	return FAILURE;
+
+      if (array->rank == 1 || boundary->rank == 0)
+	{
+	  if (scalar_check (boundary, 2) == FAILURE)
+	    return FAILURE;
+	}
+      else if (boundary->rank == array->rank - 1)
+	{
+	  if (gfc_check_conformance (shift, boundary,
+				     "arguments '%s' and '%s' for "
+				     "intrinsic %s",
+				     gfc_current_intrinsic_arg[1]->name,
+				     gfc_current_intrinsic_arg[2]->name,
+				     gfc_current_intrinsic ) == FAILURE)
+	    return FAILURE;
+	}
+      else
+	{
+	  gfc_error ("'%s' argument of intrinsic '%s' at %L of must have "
+		     "rank %d or be a scalar",
+		     gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		     &shift->where, array->rank - 1);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+gfc_try
+gfc_check_float (gfc_expr *a)
+{
+  if (type_check (a, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if ((a->ts.kind != gfc_default_integer_kind)
+      && gfc_notify_std (GFC_STD_GNU, "GNU extension: non-default INTEGER "
+			 "kind argument to %s intrinsic at %L",
+			 gfc_current_intrinsic, &a->where) == FAILURE	)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+/* A single complex argument.  */
+
+gfc_try
+gfc_check_fn_c (gfc_expr *a)
+{
+  if (type_check (a, 0, BT_COMPLEX) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+/* A single real argument.  */
+
+gfc_try
+gfc_check_fn_r (gfc_expr *a)
+{
+  if (type_check (a, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+/* A single double argument.  */
+
+gfc_try
+gfc_check_fn_d (gfc_expr *a)
+{
+  if (double_check (a, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+/* A single real or complex argument.  */
+
+gfc_try
+gfc_check_fn_rc (gfc_expr *a)
+{
+  if (real_or_complex_check (a, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_fn_rc2008 (gfc_expr *a)
+{
+  if (real_or_complex_check (a, 0) == FAILURE)
+    return FAILURE;
+
+  if (a->ts.type == BT_COMPLEX
+      && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: COMPLEX argument '%s' "
+			 "argument of '%s' intrinsic at %L",
+			 gfc_current_intrinsic_arg[0]->name,
+			 gfc_current_intrinsic, &a->where) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_fnum (gfc_expr *unit)
+{
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_huge (gfc_expr *x)
+{
+  if (int_or_real_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_hypot (gfc_expr *x, gfc_expr *y)
+{
+  if (type_check (x, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+  if (same_type_check (x, 0, y, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Check that the single argument is an integer.  */
+
+gfc_try
+gfc_check_i (gfc_expr *i)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_iand (gfc_expr *i, gfc_expr *j)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (j, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
+			  &i->where) == FAILURE)
+	return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ibits (gfc_expr *i, gfc_expr *pos, gfc_expr *len)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (pos, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (len, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (nonnegative_check ("pos", pos) == FAILURE)
+    return FAILURE;
+
+  if (nonnegative_check ("len", len) == FAILURE)
+    return FAILURE;
+
+  if (less_than_bitsize2 ("i", i, "pos", pos, "len", len) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
+{
+  int i;
+
+  if (type_check (c, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
+  if (c->expr_type == EXPR_VARIABLE || c->expr_type == EXPR_SUBSTRING)
+    {
+      gfc_expr *start;
+      gfc_expr *end;
+      gfc_ref *ref;
+
+      /* Substring references don't have the charlength set.  */
+      ref = c->ref;
+      while (ref && ref->type != REF_SUBSTRING)
+	ref = ref->next;
+
+      gcc_assert (ref == NULL || ref->type == REF_SUBSTRING);
+
+      if (!ref)
+	{
+	  /* Check that the argument is length one.  Non-constant lengths
+	     can't be checked here, so assume they are ok.  */
+	  if (c->ts.u.cl && c->ts.u.cl->length)
+	    {
+	      /* If we already have a length for this expression then use it.  */
+	      if (c->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+		return SUCCESS;
+	      i = mpz_get_si (c->ts.u.cl->length->value.integer);
+	    }
+	  else
+	    return SUCCESS;
+	}
+      else
+	{
+	  start = ref->u.ss.start;
+	  end = ref->u.ss.end;
+
+	  gcc_assert (start);
+	  if (end == NULL || end->expr_type != EXPR_CONSTANT
+	      || start->expr_type != EXPR_CONSTANT)
+	    return SUCCESS;
+
+	  i = mpz_get_si (end->value.integer) + 1
+	    - mpz_get_si (start->value.integer);
+	}
+    }
+  else
+    return SUCCESS;
+
+  if (i != 1)
+    {
+      gfc_error ("Argument of %s at %L must be of length one",
+		 gfc_current_intrinsic, &c->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_idnint (gfc_expr *a)
+{
+  if (double_check (a, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ieor (gfc_expr *i, gfc_expr *j)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (j, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
+			  &i->where) == FAILURE)
+	return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back,
+		 gfc_expr *kind)
+{
+  if (type_check (string, 0, BT_CHARACTER) == FAILURE
+      || type_check (substring, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (back != NULL && type_check (back, 2, BT_LOGICAL) == FAILURE)
+    return FAILURE;
+
+  if (kind_check (kind, 3, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
+  if (string->ts.kind != substring->ts.kind)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be the same "
+		 "kind as '%s'", gfc_current_intrinsic_arg[1]->name,
+		 gfc_current_intrinsic, &substring->where,
+		 gfc_current_intrinsic_arg[0]->name);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_int (gfc_expr *x, gfc_expr *kind)
+{
+  if (numeric_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_intconv (gfc_expr *x)
+{
+  if (numeric_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ior (gfc_expr *i, gfc_expr *j)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (j, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
+			  &i->where) == FAILURE)
+	return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ishft (gfc_expr *i, gfc_expr *shift)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE
+      || type_check (shift, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ishftc (gfc_expr *i, gfc_expr *shift, gfc_expr *size)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE
+      || type_check (shift, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (size != NULL && type_check (size, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_kill (gfc_expr *pid, gfc_expr *sig)
+{
+  if (type_check (pid, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (sig, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_kill_sub (gfc_expr *pid, gfc_expr *sig, gfc_expr *status)
+{
+  if (type_check (pid, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (pid, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (sig, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (sig, 1) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (status, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_kind (gfc_expr *x)
+{
+  if (x->ts.type == BT_DERIVED)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a "
+		 "non-derived type", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic, &x->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+  if (array_check (array, 0) == FAILURE)
+    return FAILURE;
+
+  if (dim_check (dim, 1, false) == FAILURE)
+    return FAILURE;
+
+  if (dim_rank_check (dim, array, 1) == FAILURE)
+    return FAILURE;
+
+  if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_lcobound (gfc_expr *coarray, gfc_expr *dim, gfc_expr *kind)
+{
+  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
+      return FAILURE;
+    }
+
+  if (coarray_check (coarray, 0) == FAILURE)
+    return FAILURE;
+
+  if (dim != NULL)
+    {
+      if (dim_check (dim, 1, false) == FAILURE)
+        return FAILURE;
+
+      if (dim_corank_check (dim, coarray) == FAILURE)
+        return FAILURE;
+    }
+
+  if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_len_lentrim (gfc_expr *s, gfc_expr *kind)
+{
+  if (type_check (s, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_lge_lgt_lle_llt (gfc_expr *a, gfc_expr *b)
+{
+  if (type_check (a, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (a, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (type_check (b, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (b, 1, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_link (gfc_expr *path1, gfc_expr *path2)
+{
+  if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_link_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status)
+{
+  if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (path2, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (status, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_loc (gfc_expr *expr)
+{
+  return variable_check (expr, 0, true);
+}
+
+
+gfc_try
+gfc_check_symlnk (gfc_expr *path1, gfc_expr *path2)
+{
+  if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_symlnk_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status)
+{
+  if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (status, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_logical (gfc_expr *a, gfc_expr *kind)
+{
+  if (type_check (a, 0, BT_LOGICAL) == FAILURE)
+    return FAILURE;
+  if (kind_check (kind, 1, BT_LOGICAL) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Min/max family.  */
+
+static gfc_try
+min_max_args (gfc_actual_arglist *arg)
+{
+  if (arg == NULL || arg->next == NULL)
+    {
+      gfc_error ("Intrinsic '%s' at %L must have at least two arguments",
+		 gfc_current_intrinsic, gfc_current_intrinsic_where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+static gfc_try
+check_rest (bt type, int kind, gfc_actual_arglist *arglist)
+{
+  gfc_actual_arglist *arg, *tmp;
+
+  gfc_expr *x;
+  int m, n;
+
+  if (min_max_args (arglist) == FAILURE)
+    return FAILURE;
+
+  for (arg = arglist, n=1; arg; arg = arg->next, n++)
+    {
+      x = arg->expr;
+      if (x->ts.type != type || x->ts.kind != kind)
+	{
+	  if (x->ts.type == type)
+	    {
+	      if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type "
+				  "kinds at %L", &x->where) == FAILURE)
+		return FAILURE;
+	    }
+	  else
+	    {
+	      gfc_error ("'a%d' argument of '%s' intrinsic at %L must be "
+			 "%s(%d)", n, gfc_current_intrinsic, &x->where,
+			 gfc_basic_typename (type), kind);
+	      return FAILURE;
+	    }
+	}
+
+      for (tmp = arglist, m=1; tmp != arg; tmp = tmp->next, m++)
+	if (gfc_check_conformance (tmp->expr, x,
+				   "arguments 'a%d' and 'a%d' for "
+				   "intrinsic '%s'", m, n,
+				   gfc_current_intrinsic) == FAILURE)
+	    return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_min_max (gfc_actual_arglist *arg)
+{
+  gfc_expr *x;
+
+  if (min_max_args (arg) == FAILURE)
+    return FAILURE;
+
+  x = arg->expr;
+
+  if (x->ts.type == BT_CHARACTER)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			  "with CHARACTER argument at %L",
+			  gfc_current_intrinsic, &x->where) == FAILURE)
+	return FAILURE;
+    }
+  else if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
+    {
+      gfc_error ("'a1' argument of '%s' intrinsic at %L must be INTEGER, "
+		 "REAL or CHARACTER", gfc_current_intrinsic, &x->where);
+      return FAILURE;
+    }
+
+  return check_rest (x->ts.type, x->ts.kind, arg);
+}
+
+
+gfc_try
+gfc_check_min_max_integer (gfc_actual_arglist *arg)
+{
+  return check_rest (BT_INTEGER, gfc_default_integer_kind, arg);
+}
+
+
+gfc_try
+gfc_check_min_max_real (gfc_actual_arglist *arg)
+{
+  return check_rest (BT_REAL, gfc_default_real_kind, arg);
+}
+
+
+gfc_try
+gfc_check_min_max_double (gfc_actual_arglist *arg)
+{
+  return check_rest (BT_REAL, gfc_default_double_kind, arg);
+}
+
+
+/* End of min/max family.  */
+
+gfc_try
+gfc_check_malloc (gfc_expr *size)
+{
+  if (type_check (size, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (size, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
+{
+  if ((matrix_a->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_a->ts))
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
+		 "or LOGICAL", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic, &matrix_a->where);
+      return FAILURE;
+    }
+
+  if ((matrix_b->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_b->ts))
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
+		 "or LOGICAL", gfc_current_intrinsic_arg[1]->name,
+		 gfc_current_intrinsic, &matrix_b->where);
+      return FAILURE;
+    }
+
+  if ((matrix_a->ts.type == BT_LOGICAL && gfc_numeric_ts (&matrix_b->ts))
+      || (gfc_numeric_ts (&matrix_a->ts) && matrix_b->ts.type == BT_LOGICAL))
+    {
+      gfc_error ("Argument types of '%s' intrinsic at %L must match (%s/%s)",
+		 gfc_current_intrinsic, &matrix_a->where,
+		 gfc_typename(&matrix_a->ts), gfc_typename(&matrix_b->ts));
+       return FAILURE;
+    }
+
+  switch (matrix_a->rank)
+    {
+    case 1:
+      if (rank_check (matrix_b, 1, 2) == FAILURE)
+	return FAILURE;
+      /* Check for case matrix_a has shape(m), matrix_b has shape (m, k).  */
+      if (!identical_dimen_shape (matrix_a, 0, matrix_b, 0))
+	{
+	  gfc_error ("Different shape on dimension 1 for arguments '%s' "
+		     "and '%s' at %L for intrinsic matmul",
+		     gfc_current_intrinsic_arg[0]->name,
+		     gfc_current_intrinsic_arg[1]->name, &matrix_a->where);
+	  return FAILURE;
+	}
+      break;
+
+    case 2:
+      if (matrix_b->rank != 2)
+	{
+	  if (rank_check (matrix_b, 1, 1) == FAILURE)
+	    return FAILURE;
+	}
+      /* matrix_b has rank 1 or 2 here. Common check for the cases
+	 - matrix_a has shape (n,m) and matrix_b has shape (m, k)
+	 - matrix_a has shape (n,m) and matrix_b has shape (m).  */
+      if (!identical_dimen_shape (matrix_a, 1, matrix_b, 0))
+	{
+	  gfc_error ("Different shape on dimension 2 for argument '%s' and "
+		     "dimension 1 for argument '%s' at %L for intrinsic "
+		     "matmul", gfc_current_intrinsic_arg[0]->name,
+		     gfc_current_intrinsic_arg[1]->name, &matrix_a->where);
+	  return FAILURE;
+	}
+      break;
+
+    default:
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be of rank "
+		 "1 or 2", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic, &matrix_a->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Whoever came up with this interface was probably on something.
+   The possibilities for the occupation of the second and third
+   parameters are:
+
+	 Arg #2     Arg #3
+	 NULL       NULL
+	 DIM	NULL
+	 MASK       NULL
+	 NULL       MASK	     minloc(array, mask=m)
+	 DIM	MASK
+
+   I.e. in the case of minloc(array,mask), mask will be in the second
+   position of the argument list and we'll have to fix that up.  */
+
+gfc_try
+gfc_check_minloc_maxloc (gfc_actual_arglist *ap)
+{
+  gfc_expr *a, *m, *d;
+
+  a = ap->expr;
+  if (int_or_real_check (a, 0) == FAILURE || array_check (a, 0) == FAILURE)
+    return FAILURE;
+
+  d = ap->next->expr;
+  m = ap->next->next->expr;
+
+  if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL
+      && ap->next->name == NULL)
+    {
+      m = d;
+      d = NULL;
+      ap->next->expr = NULL;
+      ap->next->next->expr = m;
+    }
+
+  if (dim_check (d, 1, false) == FAILURE)
+    return FAILURE;
+
+  if (dim_rank_check (d, a, 0) == FAILURE)
+    return FAILURE;
+
+  if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE)
+    return FAILURE;
+
+  if (m != NULL
+      && gfc_check_conformance (a, m,
+				"arguments '%s' and '%s' for intrinsic %s",
+				gfc_current_intrinsic_arg[0]->name,
+				gfc_current_intrinsic_arg[2]->name,
+				gfc_current_intrinsic ) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Similar to minloc/maxloc, the argument list might need to be
+   reordered for the MINVAL, MAXVAL, PRODUCT, and SUM intrinsics.  The
+   difference is that MINLOC/MAXLOC take an additional KIND argument.
+   The possibilities are:
+
+	 Arg #2     Arg #3
+	 NULL       NULL
+	 DIM	NULL
+	 MASK       NULL
+	 NULL       MASK	     minval(array, mask=m)
+	 DIM	MASK
+
+   I.e. in the case of minval(array,mask), mask will be in the second
+   position of the argument list and we'll have to fix that up.  */
+
+static gfc_try
+check_reduction (gfc_actual_arglist *ap)
+{
+  gfc_expr *a, *m, *d;
+
+  a = ap->expr;
+  d = ap->next->expr;
+  m = ap->next->next->expr;
+
+  if (m == NULL && d != NULL && d->ts.type == BT_LOGICAL
+      && ap->next->name == NULL)
+    {
+      m = d;
+      d = NULL;
+      ap->next->expr = NULL;
+      ap->next->next->expr = m;
+    }
+
+  if (dim_check (d, 1, false) == FAILURE)
+    return FAILURE;
+
+  if (dim_rank_check (d, a, 0) == FAILURE)
+    return FAILURE;
+
+  if (m != NULL && type_check (m, 2, BT_LOGICAL) == FAILURE)
+    return FAILURE;
+
+  if (m != NULL
+      && gfc_check_conformance (a, m,
+				"arguments '%s' and '%s' for intrinsic %s",
+				gfc_current_intrinsic_arg[0]->name,
+				gfc_current_intrinsic_arg[2]->name,
+				gfc_current_intrinsic) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_minval_maxval (gfc_actual_arglist *ap)
+{
+  if (int_or_real_check (ap->expr, 0) == FAILURE
+      || array_check (ap->expr, 0) == FAILURE)
+    return FAILURE;
+
+  return check_reduction (ap);
+}
+
+
+gfc_try
+gfc_check_product_sum (gfc_actual_arglist *ap)
+{
+  if (numeric_check (ap->expr, 0) == FAILURE
+      || array_check (ap->expr, 0) == FAILURE)
+    return FAILURE;
+
+  return check_reduction (ap);
+}
+
+
+/* For IANY, IALL and IPARITY.  */
+
+gfc_try
+gfc_check_mask (gfc_expr *i, gfc_expr *kind)
+{
+  int k;
+
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (nonnegative_check ("I", i) == FAILURE)
+    return FAILURE;
+
+  if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind)
+    gfc_extract_int (kind, &k);
+  else
+    k = gfc_default_integer_kind;
+
+  if (less_than_bitsizekind ("I", i, k) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_transf_bit_intrins (gfc_actual_arglist *ap)
+{
+  if (ap->expr->ts.type != BT_INTEGER)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER",
+                 gfc_current_intrinsic_arg[0]->name,
+                 gfc_current_intrinsic, &ap->expr->where);
+      return FAILURE;
+    }
+
+  if (array_check (ap->expr, 0) == FAILURE)
+    return FAILURE;
+
+  return check_reduction (ap);
+}
+
+
+gfc_try
+gfc_check_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
+{
+  if (same_type_check (tsource, 0, fsource, 1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (mask, 2, BT_LOGICAL) == FAILURE)
+    return FAILURE;
+
+  if (tsource->ts.type == BT_CHARACTER)
+    return gfc_check_same_strlen (tsource, fsource, "MERGE intrinsic");
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_merge_bits (gfc_expr *i, gfc_expr *j, gfc_expr *mask)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (j, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (mask, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (same_type_check (i, 0, j, 1) == FAILURE)
+    return FAILURE;
+
+  if (same_type_check (i, 0, mask, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_move_alloc (gfc_expr *from, gfc_expr *to)
+{
+  if (variable_check (from, 0, false) == FAILURE)
+    return FAILURE;
+  if (allocatable_check (from, 0) == FAILURE)
+    return FAILURE;
+
+  if (variable_check (to, 1, false) == FAILURE)
+    return FAILURE;
+  if (allocatable_check (to, 1) == FAILURE)
+    return FAILURE;
+
+  if (same_type_check (to, 1, from, 0) == FAILURE)
+    return FAILURE;
+
+  if (to->rank != from->rank)
+    {
+      gfc_error ("the '%s' and '%s' arguments of '%s' intrinsic at %L must "
+		 "have the same rank %d/%d", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		 &to->where,  from->rank, to->rank);
+      return FAILURE;
+    }
+
+  if (to->ts.kind != from->ts.kind)
+    {
+      gfc_error ("the '%s' and '%s' arguments of '%s' intrinsic at %L must "
+		 "be of the same kind %d/%d",
+		 gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		 &to->where, from->ts.kind, to->ts.kind);
+      return FAILURE;
+    }
+
+  /* CLASS arguments: Make sure the vtab is present.  */
+  if (to->ts.type == BT_CLASS)
+    gfc_find_derived_vtab (from->ts.u.derived);
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_nearest (gfc_expr *x, gfc_expr *s)
+{
+  if (type_check (x, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (type_check (s, 1, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_new_line (gfc_expr *a)
+{
+  if (type_check (a, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_norm2 (gfc_expr *array, gfc_expr *dim)
+{
+  if (type_check (array, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (array_check (array, 0) == FAILURE)
+    return FAILURE;
+
+  if (dim_rank_check (dim, array, false) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+gfc_try
+gfc_check_null (gfc_expr *mold)
+{
+  symbol_attribute attr;
+
+  if (mold == NULL)
+    return SUCCESS;
+
+  if (variable_check (mold, 0, true) == FAILURE)
+    return FAILURE;
+
+  attr = gfc_variable_attr (mold, NULL);
+
+  if (!attr.pointer && !attr.proc_pointer)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER",
+		 gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic, &mold->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector)
+{
+  if (array_check (array, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (mask, 1, BT_LOGICAL) == FAILURE)
+    return FAILURE;
+
+  if (gfc_check_conformance (array, mask,
+			     "arguments '%s' and '%s' for intrinsic '%s'",
+			     gfc_current_intrinsic_arg[0]->name,
+			     gfc_current_intrinsic_arg[1]->name,
+			     gfc_current_intrinsic) == FAILURE)
+    return FAILURE;
+
+  if (vector != NULL)
+    {
+      mpz_t array_size, vector_size;
+      bool have_array_size, have_vector_size;
+
+      if (same_type_check (array, 0, vector, 2) == FAILURE)
+	return FAILURE;
+
+      if (rank_check (vector, 2, 1) == FAILURE)
+	return FAILURE;
+
+      /* VECTOR requires at least as many elements as MASK
+         has .TRUE. values.  */
+      have_array_size = gfc_array_size (array, &array_size) == SUCCESS;
+      have_vector_size = gfc_array_size (vector, &vector_size) == SUCCESS;
+
+      if (have_vector_size
+	  && (mask->expr_type == EXPR_ARRAY
+	      || (mask->expr_type == EXPR_CONSTANT
+		  && have_array_size)))
+	{
+	  int mask_true_values = 0;
+
+	  if (mask->expr_type == EXPR_ARRAY)
+	    {
+	      gfc_constructor *mask_ctor;
+	      mask_ctor = gfc_constructor_first (mask->value.constructor);
+	      while (mask_ctor)
+		{
+		  if (mask_ctor->expr->expr_type != EXPR_CONSTANT)
+		    {
+		      mask_true_values = 0;
+		      break;
+		    }
+
+		  if (mask_ctor->expr->value.logical)
+		    mask_true_values++;
+
+		  mask_ctor = gfc_constructor_next (mask_ctor);
+		}
+	    }
+	  else if (mask->expr_type == EXPR_CONSTANT && mask->value.logical)
+	    mask_true_values = mpz_get_si (array_size);
+
+	  if (mpz_get_si (vector_size) < mask_true_values)
+	    {
+	      gfc_error ("'%s' argument of '%s' intrinsic at %L must "
+			 "provide at least as many elements as there "
+			 "are .TRUE. values in '%s' (%ld/%d)",
+			 gfc_current_intrinsic_arg[2]->name,
+			 gfc_current_intrinsic, &vector->where,
+			 gfc_current_intrinsic_arg[1]->name,
+			 mpz_get_si (vector_size), mask_true_values);
+	      return FAILURE;
+	    }
+	}
+
+      if (have_array_size)
+	mpz_clear (array_size);
+      if (have_vector_size)
+	mpz_clear (vector_size);
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_parity (gfc_expr *mask, gfc_expr *dim)
+{
+  if (type_check (mask, 0, BT_LOGICAL) == FAILURE)
+    return FAILURE;
+
+  if (array_check (mask, 0) == FAILURE)
+    return FAILURE;
+
+  if (dim_rank_check (dim, mask, false) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_precision (gfc_expr *x)
+{
+  if (real_or_complex_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_present (gfc_expr *a)
+{
+  gfc_symbol *sym;
+
+  if (variable_check (a, 0, true) == FAILURE)
+    return FAILURE;
+
+  sym = a->symtree->n.sym;
+  if (!sym->attr.dummy)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be of a "
+		 "dummy variable", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic, &a->where);
+      return FAILURE;
+    }
+
+  if (!sym->attr.optional)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be of "
+		 "an OPTIONAL dummy variable",
+		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+		 &a->where);
+      return FAILURE;
+    }
+
+  /* 13.14.82  PRESENT(A)
+     ......
+     Argument.  A shall be the name of an optional dummy argument that is
+     accessible in the subprogram in which the PRESENT function reference
+     appears...  */
+
+  if (a->ref != NULL
+      && !(a->ref->next == NULL && a->ref->type == REF_ARRAY
+	   && a->ref->u.ar.type == AR_FULL))
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must not be a "
+		 "subobject of '%s'", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic, &a->where, sym->name);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_radix (gfc_expr *x)
+{
+  if (int_or_real_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_range (gfc_expr *x)
+{
+  if (numeric_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* real, float, sngl.  */
+gfc_try
+gfc_check_real (gfc_expr *a, gfc_expr *kind)
+{
+  if (numeric_check (a, 0) == FAILURE)
+    return FAILURE;
+
+  if (kind_check (kind, 1, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_rename (gfc_expr *path1, gfc_expr *path2)
+{
+  if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_rename_sub (gfc_expr *path1, gfc_expr *path2, gfc_expr *status)
+{
+  if (type_check (path1, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (path1, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (type_check (path2, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (path2, 1, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (status, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_repeat (gfc_expr *x, gfc_expr *y)
+{
+  if (type_check (x, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (y, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (y, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
+		   gfc_expr *pad, gfc_expr *order)
+{
+  mpz_t size;
+  mpz_t nelems;
+  int shape_size;
+
+  if (array_check (source, 0) == FAILURE)
+    return FAILURE;
+
+  if (rank_check (shape, 1, 1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (shape, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (gfc_array_size (shape, &size) != SUCCESS)
+    {
+      gfc_error ("'shape' argument of 'reshape' intrinsic at %L must be an "
+		 "array of constant size", &shape->where);
+      return FAILURE;
+    }
+
+  shape_size = mpz_get_ui (size);
+  mpz_clear (size);
+
+  if (shape_size <= 0)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L is empty",
+		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		 &shape->where);
+      return FAILURE;
+    }
+  else if (shape_size > GFC_MAX_DIMENSIONS)
+    {
+      gfc_error ("'shape' argument of 'reshape' intrinsic at %L has more "
+		 "than %d elements", &shape->where, GFC_MAX_DIMENSIONS);
+      return FAILURE;
+    }
+  else if (shape->expr_type == EXPR_ARRAY)
+    {
+      gfc_expr *e;
+      int i, extent;
+      for (i = 0; i < shape_size; ++i)
+	{
+	  e = gfc_constructor_lookup_expr (shape->value.constructor, i);
+	  if (e->expr_type != EXPR_CONSTANT)
+	    continue;
+
+	  gfc_extract_int (e, &extent);
+	  if (extent < 0)
+	    {
+	      gfc_error ("'%s' argument of '%s' intrinsic at %L has "
+			 "negative element (%d)",
+			 gfc_current_intrinsic_arg[1]->name,
+			 gfc_current_intrinsic, &e->where, extent);
+	      return FAILURE;
+	    }
+	}
+    }
+
+  if (pad != NULL)
+    {
+      if (same_type_check (source, 0, pad, 2) == FAILURE)
+	return FAILURE;
+
+      if (array_check (pad, 2) == FAILURE)
+	return FAILURE;
+    }
+
+  if (order != NULL)
+    {
+      if (array_check (order, 3) == FAILURE)
+	return FAILURE;
+
+      if (type_check (order, 3, BT_INTEGER) == FAILURE)
+	return FAILURE;
+
+      if (order->expr_type == EXPR_ARRAY)
+	{
+	  int i, order_size, dim, perm[GFC_MAX_DIMENSIONS];
+	  gfc_expr *e;
+
+	  for (i = 0; i < GFC_MAX_DIMENSIONS; ++i)
+	    perm[i] = 0;
+
+	  gfc_array_size (order, &size);
+	  order_size = mpz_get_ui (size);
+	  mpz_clear (size);
+
+	  if (order_size != shape_size)
+	    {
+	      gfc_error ("'%s' argument of '%s' intrinsic at %L "
+			 "has wrong number of elements (%d/%d)",
+			 gfc_current_intrinsic_arg[3]->name,
+			 gfc_current_intrinsic, &order->where,
+			 order_size, shape_size);
+	      return FAILURE;
+	    }
+
+	  for (i = 1; i <= order_size; ++i)
+	    {
+	      e = gfc_constructor_lookup_expr (order->value.constructor, i-1);
+	      if (e->expr_type != EXPR_CONSTANT)
+		continue;
+
+	      gfc_extract_int (e, &dim);
+
+	      if (dim < 1 || dim > order_size)
+		{
+		  gfc_error ("'%s' argument of '%s' intrinsic at %L "
+			     "has out-of-range dimension (%d)",
+			     gfc_current_intrinsic_arg[3]->name,
+			     gfc_current_intrinsic, &e->where, dim);
+		  return FAILURE;
+		}
+
+	      if (perm[dim-1] != 0)
+		{
+		  gfc_error ("'%s' argument of '%s' intrinsic at %L has "
+			     "invalid permutation of dimensions (dimension "
+			     "'%d' duplicated)",
+			     gfc_current_intrinsic_arg[3]->name,
+			     gfc_current_intrinsic, &e->where, dim);
+		  return FAILURE;
+		}
+
+	      perm[dim-1] = 1;
+	    }
+	}
+    }
+
+  if (pad == NULL && shape->expr_type == EXPR_ARRAY
+      && gfc_is_constant_expr (shape)
+      && !(source->expr_type == EXPR_VARIABLE && source->symtree->n.sym->as
+	   && source->symtree->n.sym->as->type == AS_ASSUMED_SIZE))
+    {
+      /* Check the match in size between source and destination.  */
+      if (gfc_array_size (source, &nelems) == SUCCESS)
+	{
+	  gfc_constructor *c;
+	  bool test;
+
+
+	  mpz_init_set_ui (size, 1);
+	  for (c = gfc_constructor_first (shape->value.constructor);
+	       c; c = gfc_constructor_next (c))
+	    mpz_mul (size, size, c->expr->value.integer);
+
+	  test = mpz_cmp (nelems, size) < 0 && mpz_cmp_ui (size, 0) > 0;
+	  mpz_clear (nelems);
+	  mpz_clear (size);
+
+	  if (test)
+	    {
+	      gfc_error ("Without padding, there are not enough elements "
+			 "in the intrinsic RESHAPE source at %L to match "
+			 "the shape", &source->where);
+	      return FAILURE;
+	    }
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_same_type_as (gfc_expr *a, gfc_expr *b)
+{
+
+  if (a->ts.type != BT_DERIVED && a->ts.type != BT_CLASS)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L "
+		 "must be of a derived type",
+		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+		 &a->where);
+      return FAILURE;
+    }
+
+  if (!gfc_type_is_extensible (a->ts.u.derived))
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L "
+		 "must be of an extensible type",
+		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+		 &a->where);
+      return FAILURE;
+    }
+
+  if (b->ts.type != BT_DERIVED && b->ts.type != BT_CLASS)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L "
+		 "must be of a derived type",
+		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		 &b->where);
+      return FAILURE;
+    }
+
+  if (!gfc_type_is_extensible (b->ts.u.derived))
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L "
+		 "must be of an extensible type",
+		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		 &b->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_scale (gfc_expr *x, gfc_expr *i)
+{
+  if (type_check (x, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (type_check (i, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_scan (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind)
+{
+  if (type_check (x, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (y, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (z != NULL && type_check (z, 2, BT_LOGICAL) == FAILURE)
+    return FAILURE;
+
+  if (kind_check (kind, 3, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
+  if (same_type_check (x, 0, y, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_secnds (gfc_expr *r)
+{
+  if (type_check (r, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check (r, 0, 4) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (r, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_selected_char_kind (gfc_expr *name)
+{
+  if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (name, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_selected_int_kind (gfc_expr *r)
+{
+  if (type_check (r, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (r, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r, gfc_expr *radix)
+{
+  if (p == NULL && r == NULL
+      && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: SELECTED_REAL_KIND with"
+			 " neither 'P' nor 'R' argument at %L",
+			 gfc_current_intrinsic_where) == FAILURE)
+    return FAILURE;
+
+  if (p)
+    {
+      if (type_check (p, 0, BT_INTEGER) == FAILURE)
+	return FAILURE;
+
+      if (scalar_check (p, 0) == FAILURE)
+	return FAILURE;
+    }
+
+  if (r)
+    {
+      if (type_check (r, 1, BT_INTEGER) == FAILURE)
+	return FAILURE;
+
+      if (scalar_check (r, 1) == FAILURE)
+	return FAILURE;
+    }
+
+  if (radix)
+    {
+      if (type_check (radix, 1, BT_INTEGER) == FAILURE)
+	return FAILURE;
+
+      if (scalar_check (radix, 1) == FAILURE)
+	return FAILURE;
+
+      if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: '%s' intrinsic with "
+			  "RADIX argument at %L", gfc_current_intrinsic,
+			  &radix->where) == FAILURE)
+	return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_set_exponent (gfc_expr *x, gfc_expr *i)
+{
+  if (type_check (x, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (type_check (i, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_shape (gfc_expr *source, gfc_expr *kind)
+{
+  gfc_array_ref *ar;
+
+  if (source->rank == 0 || source->expr_type != EXPR_VARIABLE)
+    return SUCCESS;
+
+  ar = gfc_find_array_ref (source);
+
+  if (ar->as && ar->as->type == AS_ASSUMED_SIZE && ar->type == AR_FULL)
+    {
+      gfc_error ("'source' argument of 'shape' intrinsic at %L must not be "
+		 "an assumed size array", &source->where);
+      return FAILURE;
+    }
+
+  if (kind_check (kind, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_shift (gfc_expr *i, gfc_expr *shift)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (shift, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (nonnegative_check ("SHIFT", shift) == FAILURE)
+    return FAILURE;
+
+  if (less_than_bitsize1 ("I", i, "SHIFT", shift, true) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_sign (gfc_expr *a, gfc_expr *b)
+{
+  if (int_or_real_check (a, 0) == FAILURE)
+    return FAILURE;
+
+  if (same_type_check (a, 0, b, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+  if (array_check (array, 0) == FAILURE)
+    return FAILURE;
+
+  if (dim_check (dim, 1, true) == FAILURE)
+    return FAILURE;
+
+  if (dim_rank_check (dim, array, 0) == FAILURE)
+    return FAILURE;
+
+  if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_sizeof (gfc_expr *arg ATTRIBUTE_UNUSED)
+{
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_c_sizeof (gfc_expr *arg)
+{
+  if (verify_c_interop (&arg->ts) != SUCCESS)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be be an "
+		 "interoperable data entity",
+		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+		 &arg->where);
+      return FAILURE;
+    }
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_sleep_sub (gfc_expr *seconds)
+{
+  if (type_check (seconds, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (seconds, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+gfc_try
+gfc_check_sngl (gfc_expr *a)
+{
+  if (type_check (a, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if ((a->ts.kind != gfc_default_double_kind)
+      && gfc_notify_std (GFC_STD_GNU, "GNU extension: non double precision "
+			 "REAL argument to %s intrinsic at %L",
+			 gfc_current_intrinsic, &a->where) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+gfc_try
+gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies)
+{
+  if (source->rank >= GFC_MAX_DIMENSIONS)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be less "
+		 "than rank %d", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic, &source->where, GFC_MAX_DIMENSIONS);
+
+      return FAILURE;
+    }
+
+  if (dim == NULL)
+    return FAILURE;
+
+  if (dim_check (dim, 1, false) == FAILURE)
+    return FAILURE;
+
+  /* dim_rank_check() does not apply here.  */
+  if (dim
+      && dim->expr_type == EXPR_CONSTANT
+      && (mpz_cmp_ui (dim->value.integer, 1) < 0
+	  || mpz_cmp_ui (dim->value.integer, source->rank + 1) > 0))
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L is not a valid "
+		 "dimension index", gfc_current_intrinsic_arg[1]->name,
+		 gfc_current_intrinsic, &dim->where);
+      return FAILURE;
+    }
+
+  if (type_check (ncopies, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (ncopies, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Functions for checking FGETC, FPUTC, FGET and FPUT (subroutines and
+   functions).  */
+
+gfc_try
+gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status)
+{
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (c, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (c, 1, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 2, BT_INTEGER) == FAILURE
+      || kind_value_check (status, 2, gfc_default_integer_kind) == FAILURE
+      || scalar_check (status, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_fgetputc (gfc_expr *unit, gfc_expr *c)
+{
+  return gfc_check_fgetputc_sub (unit, c, NULL);
+}
+
+
+gfc_try
+gfc_check_fgetput_sub (gfc_expr *c, gfc_expr *status)
+{
+  if (type_check (c, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (c, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 1, BT_INTEGER) == FAILURE
+      || kind_value_check (status, 1, gfc_default_integer_kind) == FAILURE
+      || scalar_check (status, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_fgetput (gfc_expr *c)
+{
+  return gfc_check_fgetput_sub (c, NULL);
+}
+
+
+gfc_try
+gfc_check_fseek_sub (gfc_expr *unit, gfc_expr *offset, gfc_expr *whence, gfc_expr *status)
+{
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (offset, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (offset, 1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (whence, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (whence, 2) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 3, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check (status, 3, 4) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (status, 3) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+
+gfc_try
+gfc_check_fstat (gfc_expr *unit, gfc_expr *array)
+{
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (array, 1, BT_INTEGER) == FAILURE
+      || kind_value_check (unit, 0, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  if (array_check (array, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_fstat_sub (gfc_expr *unit, gfc_expr *array, gfc_expr *status)
+{
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (array, 1, BT_INTEGER) == FAILURE
+      || kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  if (array_check (array, 1) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 2, BT_INTEGER) == FAILURE
+      || kind_value_check (status, 2, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (status, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ftell (gfc_expr *unit)
+{
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ftell_sub (gfc_expr *unit, gfc_expr *offset)
+{
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (offset, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (offset, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_stat (gfc_expr *name, gfc_expr *array)
+{
+  if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (type_check (array, 1, BT_INTEGER) == FAILURE
+      || kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  if (array_check (array, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_stat_sub (gfc_expr *name, gfc_expr *array, gfc_expr *status)
+{
+  if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (type_check (array, 1, BT_INTEGER) == FAILURE
+      || kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  if (array_check (array, 1) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 2, BT_INTEGER) == FAILURE
+      || kind_value_check (array, 1, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (status, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub)
+{
+  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
+      return FAILURE;
+    }
+
+  if (coarray_check (coarray, 0) == FAILURE)
+    return FAILURE;
+
+  if (sub->rank != 1)
+    {
+      gfc_error ("%s argument to IMAGE_INDEX must be a rank one array at %L",
+                gfc_current_intrinsic_arg[1]->name, &sub->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_this_image (gfc_expr *coarray, gfc_expr *dim)
+{
+  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
+      return FAILURE;
+    }
+
+  if (dim != NULL &&  coarray == NULL)
+    {
+      gfc_error ("DIM argument without ARRAY argument not allowed for THIS_IMAGE "
+                "intrinsic at %L", &dim->where);
+      return FAILURE;
+    }
+
+  if (coarray == NULL)
+    return SUCCESS;
+
+  if (coarray_check (coarray, 0) == FAILURE)
+    return FAILURE;
+
+  if (dim != NULL)
+    {
+      if (dim_check (dim, 1, false) == FAILURE)
+       return FAILURE;
+
+      if (dim_corank_check (dim, coarray) == FAILURE)
+       return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_transfer (gfc_expr *source ATTRIBUTE_UNUSED,
+		    gfc_expr *mold ATTRIBUTE_UNUSED, gfc_expr *size)
+{
+  if (mold->ts.type == BT_HOLLERITH)
+    {
+      gfc_error ("'MOLD' argument of 'TRANSFER' intrinsic at %L must not be %s",
+		 &mold->where, gfc_basic_typename (BT_HOLLERITH));
+      return FAILURE;
+    }
+
+  if (size != NULL)
+    {
+      if (type_check (size, 2, BT_INTEGER) == FAILURE)
+	return FAILURE;
+
+      if (scalar_check (size, 2) == FAILURE)
+	return FAILURE;
+
+      if (nonoptional_check (size, 2) == FAILURE)
+	return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_transpose (gfc_expr *matrix)
+{
+  if (rank_check (matrix, 0, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+  if (array_check (array, 0) == FAILURE)
+    return FAILURE;
+
+  if (dim_check (dim, 1, false) == FAILURE)
+    return FAILURE;
+
+  if (dim_rank_check (dim, array, 0) == FAILURE)
+    return FAILURE;
+
+  if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ucobound (gfc_expr *coarray, gfc_expr *dim, gfc_expr *kind)
+{
+  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
+      return FAILURE;
+    }
+
+  if (coarray_check (coarray, 0) == FAILURE)
+    return FAILURE;
+
+  if (dim != NULL)
+    {
+      if (dim_check (dim, 1, false) == FAILURE)
+        return FAILURE;
+
+      if (dim_corank_check (dim, coarray) == FAILURE)
+        return FAILURE;
+    }
+
+  if (kind_check (kind, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
+{
+  mpz_t vector_size;
+
+  if (rank_check (vector, 0, 1) == FAILURE)
+    return FAILURE;
+
+  if (array_check (mask, 1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (mask, 1, BT_LOGICAL) == FAILURE)
+    return FAILURE;
+
+  if (same_type_check (vector, 0, field, 2) == FAILURE)
+    return FAILURE;
+
+  if (mask->expr_type == EXPR_ARRAY
+      && gfc_array_size (vector, &vector_size) == SUCCESS)
+    {
+      int mask_true_count = 0;
+      gfc_constructor *mask_ctor;
+      mask_ctor = gfc_constructor_first (mask->value.constructor);
+      while (mask_ctor)
+	{
+	  if (mask_ctor->expr->expr_type != EXPR_CONSTANT)
+	    {
+	      mask_true_count = 0;
+	      break;
+	    }
+
+	  if (mask_ctor->expr->value.logical)
+	    mask_true_count++;
+
+	  mask_ctor = gfc_constructor_next (mask_ctor);
+	}
+
+      if (mpz_get_si (vector_size) < mask_true_count)
+	{
+	  gfc_error ("'%s' argument of '%s' intrinsic at %L must "
+		     "provide at least as many elements as there "
+		     "are .TRUE. values in '%s' (%ld/%d)",
+		     gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+		     &vector->where, gfc_current_intrinsic_arg[1]->name,
+		     mpz_get_si (vector_size), mask_true_count);
+	  return FAILURE;
+	}
+
+      mpz_clear (vector_size);
+    }
+
+  if (mask->rank != field->rank && field->rank != 0)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must have "
+		 "the same rank as '%s' or be a scalar",
+		 gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic,
+		 &field->where, gfc_current_intrinsic_arg[1]->name);
+      return FAILURE;
+    }
+
+  if (mask->rank == field->rank)
+    {
+      int i;
+      for (i = 0; i < field->rank; i++)
+	if (! identical_dimen_shape (mask, i, field, i))
+	{
+	  gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L "
+		     "must have identical shape.",
+		     gfc_current_intrinsic_arg[2]->name,
+		     gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		     &field->where);
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_verify (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind)
+{
+  if (type_check (x, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (same_type_check (x, 0, y, 1) == FAILURE)
+    return FAILURE;
+
+  if (z != NULL && type_check (z, 2, BT_LOGICAL) == FAILURE)
+    return FAILURE;
+
+  if (kind_check (kind, 3, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' intrinsic "
+			      "with KIND argument at %L",
+			      gfc_current_intrinsic, &kind->where) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_trim (gfc_expr *x)
+{
+  if (type_check (x, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (x, 0) == FAILURE)
+    return FAILURE;
+
+   return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ttynam (gfc_expr *unit)
+{
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Common check function for the half a dozen intrinsics that have a
+   single real argument.  */
+
+gfc_try
+gfc_check_x (gfc_expr *x)
+{
+  if (type_check (x, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/************* Check functions for intrinsic subroutines *************/
+
+gfc_try
+gfc_check_cpu_time (gfc_expr *time)
+{
+  if (scalar_check (time, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (time, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (variable_check (time, 0, false) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_date_and_time (gfc_expr *date, gfc_expr *time,
+			 gfc_expr *zone, gfc_expr *values)
+{
+  if (date != NULL)
+    {
+      if (type_check (date, 0, BT_CHARACTER) == FAILURE)
+	return FAILURE;
+      if (kind_value_check (date, 0, gfc_default_character_kind) == FAILURE)
+	return FAILURE;
+      if (scalar_check (date, 0) == FAILURE)
+	return FAILURE;
+      if (variable_check (date, 0, false) == FAILURE)
+	return FAILURE;
+    }
+
+  if (time != NULL)
+    {
+      if (type_check (time, 1, BT_CHARACTER) == FAILURE)
+	return FAILURE;
+      if (kind_value_check (time, 1, gfc_default_character_kind) == FAILURE)
+	return FAILURE;
+      if (scalar_check (time, 1) == FAILURE)
+	return FAILURE;
+      if (variable_check (time, 1, false) == FAILURE)
+	return FAILURE;
+    }
+
+  if (zone != NULL)
+    {
+      if (type_check (zone, 2, BT_CHARACTER) == FAILURE)
+	return FAILURE;
+      if (kind_value_check (zone, 2, gfc_default_character_kind) == FAILURE)
+	return FAILURE;
+      if (scalar_check (zone, 2) == FAILURE)
+	return FAILURE;
+      if (variable_check (zone, 2, false) == FAILURE)
+	return FAILURE;
+    }
+
+  if (values != NULL)
+    {
+      if (type_check (values, 3, BT_INTEGER) == FAILURE)
+	return FAILURE;
+      if (array_check (values, 3) == FAILURE)
+	return FAILURE;
+      if (rank_check (values, 3, 1) == FAILURE)
+	return FAILURE;
+      if (variable_check (values, 3, false) == FAILURE)
+	return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_mvbits (gfc_expr *from, gfc_expr *frompos, gfc_expr *len,
+		  gfc_expr *to, gfc_expr *topos)
+{
+  if (type_check (from, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (frompos, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (len, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (same_type_check (from, 0, to, 3) == FAILURE)
+    return FAILURE;
+
+  if (variable_check (to, 3, false) == FAILURE)
+    return FAILURE;
+
+  if (type_check (topos, 4, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (nonnegative_check ("frompos", frompos) == FAILURE)
+    return FAILURE;
+
+  if (nonnegative_check ("topos", topos) == FAILURE)
+    return FAILURE;
+
+  if (nonnegative_check ("len", len) == FAILURE)
+    return FAILURE;
+
+  if (less_than_bitsize2 ("from", from, "frompos", frompos, "len", len)
+      == FAILURE)
+    return FAILURE;
+
+  if (less_than_bitsize2 ("to", to, "topos", topos, "len", len) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_random_number (gfc_expr *harvest)
+{
+  if (type_check (harvest, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (variable_check (harvest, 0, false) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
+{
+  unsigned int nargs = 0, kiss_size;
+  locus *where = NULL;
+  mpz_t put_size, get_size;
+  bool have_gfc_real_16; /* Try and mimic HAVE_GFC_REAL_16 in libgfortran.  */
+
+  have_gfc_real_16 = gfc_validate_kind (BT_REAL, 16, true) != -1;
+
+  /* Keep the number of bytes in sync with kiss_size in
+     libgfortran/intrinsics/random.c.  */
+  kiss_size = (have_gfc_real_16 ? 48 : 32) / gfc_default_integer_kind;
+
+  if (size != NULL)
+    {
+      if (size->expr_type != EXPR_VARIABLE
+	  || !size->symtree->n.sym->attr.optional)
+	nargs++;
+
+      if (scalar_check (size, 0) == FAILURE)
+	return FAILURE;
+
+      if (type_check (size, 0, BT_INTEGER) == FAILURE)
+	return FAILURE;
+
+      if (variable_check (size, 0, false) == FAILURE)
+	return FAILURE;
+
+      if (kind_value_check (size, 0, gfc_default_integer_kind) == FAILURE)
+	return FAILURE;
+    }
+
+  if (put != NULL)
+    {
+      if (put->expr_type != EXPR_VARIABLE
+	  || !put->symtree->n.sym->attr.optional)
+	{
+	  nargs++;
+	  where = &put->where;
+	}
+
+      if (array_check (put, 1) == FAILURE)
+	return FAILURE;
+
+      if (rank_check (put, 1, 1) == FAILURE)
+	return FAILURE;
+
+      if (type_check (put, 1, BT_INTEGER) == FAILURE)
+	return FAILURE;
+
+      if (kind_value_check (put, 1, gfc_default_integer_kind) == FAILURE)
+	return FAILURE;
+
+      if (gfc_array_size (put, &put_size) == SUCCESS
+	  && mpz_get_ui (put_size) < kiss_size)
+	gfc_error ("Size of '%s' argument of '%s' intrinsic at %L "
+		   "too small (%i/%i)",
+		   gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		   where, (int) mpz_get_ui (put_size), kiss_size);
+    }
+
+  if (get != NULL)
+    {
+      if (get->expr_type != EXPR_VARIABLE
+	  || !get->symtree->n.sym->attr.optional)
+	{
+	  nargs++;
+	  where = &get->where;
+	}
+
+      if (array_check (get, 2) == FAILURE)
+	return FAILURE;
+
+      if (rank_check (get, 2, 1) == FAILURE)
+	return FAILURE;
+
+      if (type_check (get, 2, BT_INTEGER) == FAILURE)
+	return FAILURE;
+
+      if (variable_check (get, 2, false) == FAILURE)
+	return FAILURE;
+
+      if (kind_value_check (get, 2, gfc_default_integer_kind) == FAILURE)
+	return FAILURE;
+
+       if (gfc_array_size (get, &get_size) == SUCCESS
+ 	  && mpz_get_ui (get_size) < kiss_size)
+	gfc_error ("Size of '%s' argument of '%s' intrinsic at %L "
+		   "too small (%i/%i)",
+		   gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic,
+		   where, (int) mpz_get_ui (get_size), kiss_size);
+    }
+
+  /* RANDOM_SEED may not have more than one non-optional argument.  */
+  if (nargs > 1)
+    gfc_error ("Too many arguments to %s at %L", gfc_current_intrinsic, where);
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_second_sub (gfc_expr *time)
+{
+  if (scalar_check (time, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (time, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check(time, 0, 4) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* The arguments of SYSTEM_CLOCK are scalar, integer variables.  Note,
+   count, count_rate, and count_max are all optional arguments */
+
+gfc_try
+gfc_check_system_clock (gfc_expr *count, gfc_expr *count_rate,
+			gfc_expr *count_max)
+{
+  if (count != NULL)
+    {
+      if (scalar_check (count, 0) == FAILURE)
+	return FAILURE;
+
+      if (type_check (count, 0, BT_INTEGER) == FAILURE)
+	return FAILURE;
+
+      if (variable_check (count, 0, false) == FAILURE)
+	return FAILURE;
+    }
+
+  if (count_rate != NULL)
+    {
+      if (scalar_check (count_rate, 1) == FAILURE)
+	return FAILURE;
+
+      if (type_check (count_rate, 1, BT_INTEGER) == FAILURE)
+	return FAILURE;
+
+      if (variable_check (count_rate, 1, false) == FAILURE)
+	return FAILURE;
+
+      if (count != NULL
+	  && same_type_check (count, 0, count_rate, 1) == FAILURE)
+	return FAILURE;
+
+    }
+
+  if (count_max != NULL)
+    {
+      if (scalar_check (count_max, 2) == FAILURE)
+	return FAILURE;
+
+      if (type_check (count_max, 2, BT_INTEGER) == FAILURE)
+	return FAILURE;
+
+      if (variable_check (count_max, 2, false) == FAILURE)
+	return FAILURE;
+
+      if (count != NULL
+	  && same_type_check (count, 0, count_max, 2) == FAILURE)
+	return FAILURE;
+
+      if (count_rate != NULL
+	  && same_type_check (count_rate, 1, count_max, 2) == FAILURE)
+	return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_irand (gfc_expr *x)
+{
+  if (x == NULL)
+    return SUCCESS;
+
+  if (scalar_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (x, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check(x, 0, 4) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_alarm_sub (gfc_expr *seconds, gfc_expr *handler, gfc_expr *status)
+{
+  if (scalar_check (seconds, 0) == FAILURE)
+    return FAILURE;
+  if (type_check (seconds, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (int_or_proc_check (handler, 1) == FAILURE)
+    return FAILURE;
+  if (handler->ts.type == BT_INTEGER && scalar_check (handler, 1) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (scalar_check (status, 2) == FAILURE)
+    return FAILURE;
+  if (type_check (status, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (status, 2, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_rand (gfc_expr *x)
+{
+  if (x == NULL)
+    return SUCCESS;
+
+  if (scalar_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (x, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check(x, 0, 4) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_srand (gfc_expr *x)
+{
+  if (scalar_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (x, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check(x, 0, 4) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ctime_sub (gfc_expr *time, gfc_expr *result)
+{
+  if (scalar_check (time, 0) == FAILURE)
+    return FAILURE;
+  if (type_check (time, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (result, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (result, 1, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_dtime_etime (gfc_expr *x)
+{
+  if (array_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  if (rank_check (x, 0, 1) == FAILURE)
+    return FAILURE;
+
+  if (variable_check (x, 0, false) == FAILURE)
+    return FAILURE;
+
+  if (type_check (x, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check(x, 0, 4) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_dtime_etime_sub (gfc_expr *values, gfc_expr *time)
+{
+  if (array_check (values, 0) == FAILURE)
+    return FAILURE;
+
+  if (rank_check (values, 0, 1) == FAILURE)
+    return FAILURE;
+
+  if (variable_check (values, 0, false) == FAILURE)
+    return FAILURE;
+
+  if (type_check (values, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check(values, 0, 4) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (time, 1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (time, 1, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check(time, 1, 4) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_fdate_sub (gfc_expr *date)
+{
+  if (type_check (date, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (date, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_gerror (gfc_expr *msg)
+{
+  if (type_check (msg, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (msg, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_getcwd_sub (gfc_expr *cwd, gfc_expr *status)
+{
+  if (type_check (cwd, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (cwd, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (scalar_check (status, 1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (status, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_getarg (gfc_expr *pos, gfc_expr *value)
+{
+  if (type_check (pos, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (pos->ts.kind > gfc_default_integer_kind)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be of a kind "
+		 "not wider than the default kind (%d)",
+		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+		 &pos->where, gfc_default_integer_kind);
+      return FAILURE;
+    }
+
+  if (type_check (value, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (value, 1, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_getlog (gfc_expr *msg)
+{
+  if (type_check (msg, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (msg, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_exit (gfc_expr *status)
+{
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (status, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_flush (gfc_expr *unit)
+{
+  if (unit == NULL)
+    return SUCCESS;
+
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_free (gfc_expr *i)
+{
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (i, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_hostnm (gfc_expr *name)
+{
+  if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_hostnm_sub (gfc_expr *name, gfc_expr *status)
+{
+  if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (scalar_check (status, 1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (status, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_itime_idate (gfc_expr *values)
+{
+  if (array_check (values, 0) == FAILURE)
+    return FAILURE;
+
+  if (rank_check (values, 0, 1) == FAILURE)
+    return FAILURE;
+
+  if (variable_check (values, 0, false) == FAILURE)
+    return FAILURE;
+
+  if (type_check (values, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check(values, 0, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ltime_gmtime (gfc_expr *time, gfc_expr *values)
+{
+  if (type_check (time, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check(time, 0, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (time, 0) == FAILURE)
+    return FAILURE;
+
+  if (array_check (values, 1) == FAILURE)
+    return FAILURE;
+
+  if (rank_check (values, 1, 1) == FAILURE)
+    return FAILURE;
+
+  if (variable_check (values, 1, false) == FAILURE)
+    return FAILURE;
+
+  if (type_check (values, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check(values, 1, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_ttynam_sub (gfc_expr *unit, gfc_expr *name)
+{
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (name, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (name, 1, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_isatty (gfc_expr *unit)
+{
+  if (unit == NULL)
+    return FAILURE;
+
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_isnan (gfc_expr *x)
+{
+  if (type_check (x, 0, BT_REAL) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_perror (gfc_expr *string)
+{
+  if (type_check (string, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (string, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_umask (gfc_expr *mask)
+{
+  if (type_check (mask, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (mask, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_umask_sub (gfc_expr *mask, gfc_expr *old)
+{
+  if (type_check (mask, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (mask, 0) == FAILURE)
+    return FAILURE;
+
+  if (old == NULL)
+    return SUCCESS;
+
+  if (scalar_check (old, 1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (old, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_unlink (gfc_expr *name)
+{
+  if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_unlink_sub (gfc_expr *name, gfc_expr *status)
+{
+  if (type_check (name, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (name, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (scalar_check (status, 1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (status, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_signal (gfc_expr *number, gfc_expr *handler)
+{
+  if (scalar_check (number, 0) == FAILURE)
+    return FAILURE;
+  if (type_check (number, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (int_or_proc_check (handler, 1) == FAILURE)
+    return FAILURE;
+  if (handler->ts.type == BT_INTEGER && scalar_check (handler, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_signal_sub (gfc_expr *number, gfc_expr *handler, gfc_expr *status)
+{
+  if (scalar_check (number, 0) == FAILURE)
+    return FAILURE;
+  if (type_check (number, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (int_or_proc_check (handler, 1) == FAILURE)
+    return FAILURE;
+  if (handler->ts.type == BT_INTEGER && scalar_check (handler, 1) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 2, BT_INTEGER) == FAILURE)
+    return FAILURE;
+  if (scalar_check (status, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_system_sub (gfc_expr *cmd, gfc_expr *status)
+{
+  if (type_check (cmd, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+  if (kind_value_check (cmd, 0, gfc_default_character_kind) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (status, 1) == FAILURE)
+    return FAILURE;
+
+  if (type_check (status, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (kind_value_check (status, 1, gfc_default_integer_kind) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* This is used for the GNU intrinsics AND, OR and XOR.  */
+gfc_try
+gfc_check_and (gfc_expr *i, gfc_expr *j)
+{
+  if (i->ts.type != BT_INTEGER && i->ts.type != BT_LOGICAL)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
+		 "or LOGICAL", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic, &i->where);
+      return FAILURE;
+    }
+
+  if (j->ts.type != BT_INTEGER && j->ts.type != BT_LOGICAL)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
+		 "or LOGICAL", gfc_current_intrinsic_arg[1]->name,
+		 gfc_current_intrinsic, &j->where);
+      return FAILURE;
+    }
+
+  if (i->ts.type != j->ts.type)
+    {
+      gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L must "
+		 "have the same type", gfc_current_intrinsic_arg[0]->name,
+		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		 &j->where);
+      return FAILURE;
+    }
+
+  if (scalar_check (i, 0) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (j, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_check_storage_size (gfc_expr *a ATTRIBUTE_UNUSED, gfc_expr *kind)
+{
+  if (kind == NULL)
+    return SUCCESS;
+
+  if (type_check (kind, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (kind, 1) == FAILURE)
+    return FAILURE;
+
+  if (kind->expr_type != EXPR_CONSTANT)
+    {
+      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a constant",
+		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
+		 &kind->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
new file mode 100644
index 000000000..f64cc1b2a
--- /dev/null
+++ b/gcc/fortran/class.c
@@ -0,0 +1,767 @@
+/* Implementation of Fortran 2003 Polymorphism.
+   Copyright (C) 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Richard Thomas <pault@gcc.gnu.org>
+   and Janus Weil <janus@gcc.gnu.org>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+/* class.c -- This file contains the front end functions needed to service
+              the implementation of Fortran 2003 polymorphism and other
+              object-oriented features.  */
+
+
+/* Outline of the internal representation:
+
+   Each CLASS variable is encapsulated by a class container, which is a
+   structure with two fields:
+    * _data: A pointer to the actual data of the variable. This field has the
+             declared type of the class variable and its attributes
+             (pointer/allocatable/dimension/...).
+    * _vptr: A pointer to the vtable entry (see below) of the dynamic type.
+    
+   For each derived type we set up a "vtable" entry, i.e. a structure with the
+   following fields:
+    * _hash:     A hash value serving as a unique identifier for this type.
+    * _size:     The size in bytes of the derived type.
+    * _extends:  A pointer to the vtable entry of the parent derived type.
+    * _def_init: A pointer to a default initialized variable of this type.
+    * _copy:     A procedure pointer to a copying procedure.
+   After these follow procedure pointer components for the specific
+   type-bound procedures.  */
+
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+#include "constructor.h"
+
+
+/* Insert a reference to the component of the given name.
+   Only to be used with CLASS containers and vtables.  */
+
+void
+gfc_add_component_ref (gfc_expr *e, const char *name)
+{
+  gfc_ref **tail = &(e->ref);
+  gfc_ref *next = NULL;
+  gfc_symbol *derived = e->symtree->n.sym->ts.u.derived;
+  while (*tail != NULL)
+    {
+      if ((*tail)->type == REF_COMPONENT)
+	derived = (*tail)->u.c.component->ts.u.derived;
+      if ((*tail)->type == REF_ARRAY && (*tail)->next == NULL)
+	break;
+      tail = &((*tail)->next);
+    }
+  if (*tail != NULL && strcmp (name, "_data") == 0)
+    next = *tail;
+  (*tail) = gfc_get_ref();
+  (*tail)->next = next;
+  (*tail)->type = REF_COMPONENT;
+  (*tail)->u.c.sym = derived;
+  (*tail)->u.c.component = gfc_find_component (derived, name, true, true);
+  gcc_assert((*tail)->u.c.component);
+  if (!next)
+    e->ts = (*tail)->u.c.component->ts;
+}
+
+
+/* Build a NULL initializer for CLASS pointers,
+   initializing the _data component to NULL and
+   the _vptr component to the declared type.  */
+
+gfc_expr *
+gfc_class_null_initializer (gfc_typespec *ts)
+{
+  gfc_expr *init;
+  gfc_component *comp;
+  
+  init = gfc_get_structure_constructor_expr (ts->type, ts->kind,
+					     &ts->u.derived->declared_at);
+  init->ts = *ts;
+  
+  for (comp = ts->u.derived->components; comp; comp = comp->next)
+    {
+      gfc_constructor *ctor = gfc_constructor_get();
+      if (strcmp (comp->name, "_vptr") == 0)
+	ctor->expr = gfc_lval_expr_from_sym (gfc_find_derived_vtab (ts->u.derived));
+      else
+	ctor->expr = gfc_get_null_expr (NULL);
+      gfc_constructor_append (&init->value.constructor, ctor);
+    }
+
+  return init;
+}
+
+
+/* Create a unique string identifier for a derived type, composed of its name
+   and module name. This is used to construct unique names for the class
+   containers and vtab symbols.  */
+
+static void
+get_unique_type_string (char *string, gfc_symbol *derived)
+{
+  char dt_name[GFC_MAX_SYMBOL_LEN+1];
+  sprintf (dt_name, "%s", derived->name);
+  dt_name[0] = TOUPPER (dt_name[0]);
+  if (derived->module)
+    sprintf (string, "%s_%s", derived->module, dt_name);
+  else if (derived->ns->proc_name)
+    sprintf (string, "%s_%s", derived->ns->proc_name->name, dt_name);
+  else
+    sprintf (string, "_%s", dt_name);
+}
+
+
+/* A relative of 'get_unique_type_string' which makes sure the generated
+   string will not be too long (replacing it by a hash string if needed).  */
+
+static void
+get_unique_hashed_string (char *string, gfc_symbol *derived)
+{
+  char tmp[2*GFC_MAX_SYMBOL_LEN+2];
+  get_unique_type_string (&tmp[0], derived);
+  /* If string is too long, use hash value in hex representation (allow for
+     extra decoration, cf. gfc_build_class_symbol & gfc_find_derived_vtab).  */
+  if (strlen (tmp) > GFC_MAX_SYMBOL_LEN - 11)
+    {
+      int h = gfc_hash_value (derived);
+      sprintf (string, "%X", h);
+    }
+  else
+    strcpy (string, tmp);
+}
+
+
+/* Assign a hash value for a derived type. The algorithm is that of SDBM.  */
+
+unsigned int
+gfc_hash_value (gfc_symbol *sym)
+{
+  unsigned int hash = 0;
+  char c[2*(GFC_MAX_SYMBOL_LEN+1)];
+  int i, len;
+  
+  get_unique_type_string (&c[0], sym);
+  len = strlen (c);
+  
+  for (i = 0; i < len; i++)
+    hash = (hash << 6) + (hash << 16) - hash + c[i];
+
+  /* Return the hash but take the modulus for the sake of module read,
+     even though this slightly increases the chance of collision.  */
+  return (hash % 100000000);
+}
+
+
+/* Build a polymorphic CLASS entity, using the symbol that comes from
+   build_sym. A CLASS entity is represented by an encapsulating type,
+   which contains the declared type as '_data' component, plus a pointer
+   component '_vptr' which determines the dynamic type.  */
+
+gfc_try
+gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
+			gfc_array_spec **as, bool delayed_vtab)
+{
+  char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1];
+  gfc_symbol *fclass;
+  gfc_symbol *vtab;
+  gfc_component *c;
+  
+  if (attr->class_ok)
+    /* Class container has already been built.  */
+    return SUCCESS;
+
+  attr->class_ok = attr->dummy || attr->pointer || attr->allocatable;
+  
+  if (!attr->class_ok)
+    /* We can not build the class container yet.  */
+    return SUCCESS;
+
+  if (*as)
+    {
+      gfc_fatal_error ("Polymorphic array at %C not yet supported");
+      return FAILURE;
+    }
+
+  /* Determine the name of the encapsulating type.  */
+  get_unique_hashed_string (tname, ts->u.derived);
+  if ((*as) && (*as)->rank && attr->allocatable)
+    sprintf (name, "__class_%s_%d_a", tname, (*as)->rank);
+  else if ((*as) && (*as)->rank)
+    sprintf (name, "__class_%s_%d", tname, (*as)->rank);
+  else if (attr->pointer)
+    sprintf (name, "__class_%s_p", tname);
+  else if (attr->allocatable)
+    sprintf (name, "__class_%s_a", tname);
+  else
+    sprintf (name, "__class_%s", tname);
+
+  gfc_find_symbol (name, ts->u.derived->ns, 0, &fclass);
+  if (fclass == NULL)
+    {
+      gfc_symtree *st;
+      /* If not there, create a new symbol.  */
+      fclass = gfc_new_symbol (name, ts->u.derived->ns);
+      st = gfc_new_symtree (&ts->u.derived->ns->sym_root, name);
+      st->n.sym = fclass;
+      gfc_set_sym_referenced (fclass);
+      fclass->refs++;
+      fclass->ts.type = BT_UNKNOWN;
+      fclass->attr.abstract = ts->u.derived->attr.abstract;
+      if (ts->u.derived->f2k_derived)
+	fclass->f2k_derived = gfc_get_namespace (NULL, 0);
+      if (gfc_add_flavor (&fclass->attr, FL_DERIVED,
+	  NULL, &gfc_current_locus) == FAILURE)
+	return FAILURE;
+
+      /* Add component '_data'.  */
+      if (gfc_add_component (fclass, "_data", &c) == FAILURE)
+	return FAILURE;
+      c->ts = *ts;
+      c->ts.type = BT_DERIVED;
+      c->attr.access = ACCESS_PRIVATE;
+      c->ts.u.derived = ts->u.derived;
+      c->attr.class_pointer = attr->pointer;
+      c->attr.pointer = attr->pointer || attr->dummy;
+      c->attr.allocatable = attr->allocatable;
+      c->attr.dimension = attr->dimension;
+      c->attr.codimension = attr->codimension;
+      c->attr.abstract = ts->u.derived->attr.abstract;
+      c->as = (*as);
+      c->initializer = NULL;
+
+      /* Add component '_vptr'.  */
+      if (gfc_add_component (fclass, "_vptr", &c) == FAILURE)
+	return FAILURE;
+      c->ts.type = BT_DERIVED;
+      if (delayed_vtab)
+	c->ts.u.derived = NULL;
+      else
+	{
+	  vtab = gfc_find_derived_vtab (ts->u.derived);
+	  gcc_assert (vtab);
+	  c->ts.u.derived = vtab->ts.u.derived;
+	}
+      c->attr.access = ACCESS_PRIVATE;
+      c->attr.pointer = 1;
+    }
+
+  /* Since the extension field is 8 bit wide, we can only have
+     up to 255 extension levels.  */
+  if (ts->u.derived->attr.extension == 255)
+    {
+      gfc_error ("Maximum extension level reached with type '%s' at %L",
+		 ts->u.derived->name, &ts->u.derived->declared_at);
+      return FAILURE;
+    }
+    
+  fclass->attr.extension = ts->u.derived->attr.extension + 1;
+  fclass->attr.is_class = 1;
+  ts->u.derived = fclass;
+  attr->allocatable = attr->pointer = attr->dimension = 0;
+  (*as) = NULL;  /* XXX */
+  return SUCCESS;
+}
+
+
+/* Add a procedure pointer component to the vtype
+   to represent a specific type-bound procedure.  */
+
+static void
+add_proc_comp (gfc_symbol *vtype, const char *name, gfc_typebound_proc *tb)
+{
+  gfc_component *c;
+  c = gfc_find_component (vtype, name, true, true);
+
+  if (c == NULL)
+    {
+      /* Add procedure component.  */
+      if (gfc_add_component (vtype, name, &c) == FAILURE)
+	return;
+
+      if (!c->tb)
+	c->tb = XCNEW (gfc_typebound_proc);
+      *c->tb = *tb;
+      c->tb->ppc = 1;
+      c->attr.procedure = 1;
+      c->attr.proc_pointer = 1;
+      c->attr.flavor = FL_PROCEDURE;
+      c->attr.access = ACCESS_PRIVATE;
+      c->attr.external = 1;
+      c->attr.untyped = 1;
+      c->attr.if_source = IFSRC_IFBODY;
+    }
+  else if (c->attr.proc_pointer && c->tb)
+    {
+      *c->tb = *tb;
+      c->tb->ppc = 1;
+    }
+
+  if (tb->u.specific)
+    {
+      c->ts.interface = tb->u.specific->n.sym;
+      if (!tb->deferred)
+	c->initializer = gfc_get_variable_expr (tb->u.specific);
+    }
+}
+
+
+/* Add all specific type-bound procedures in the symtree 'st' to a vtype.  */
+
+static void
+add_procs_to_declared_vtab1 (gfc_symtree *st, gfc_symbol *vtype)
+{
+  if (!st)
+    return;
+
+  if (st->left)
+    add_procs_to_declared_vtab1 (st->left, vtype);
+
+  if (st->right)
+    add_procs_to_declared_vtab1 (st->right, vtype);
+
+  if (st->n.tb && !st->n.tb->error 
+      && !st->n.tb->is_generic && st->n.tb->u.specific)
+    add_proc_comp (vtype, st->name, st->n.tb);
+}
+
+
+/* Copy procedure pointers components from the parent type.  */
+
+static void
+copy_vtab_proc_comps (gfc_symbol *declared, gfc_symbol *vtype)
+{
+  gfc_component *cmp;
+  gfc_symbol *vtab;
+
+  vtab = gfc_find_derived_vtab (declared);
+
+  for (cmp = vtab->ts.u.derived->components; cmp; cmp = cmp->next)
+    {
+      if (gfc_find_component (vtype, cmp->name, true, true))
+	continue;
+
+      add_proc_comp (vtype, cmp->name, cmp->tb);
+    }
+}
+
+
+/* Add procedure pointers for all type-bound procedures to a vtab.  */
+
+static void
+add_procs_to_declared_vtab (gfc_symbol *derived, gfc_symbol *vtype)
+{
+  gfc_symbol* super_type;
+
+  super_type = gfc_get_derived_super_type (derived);
+
+  if (super_type && (super_type != derived))
+    {
+      /* Make sure that the PPCs appear in the same order as in the parent.  */
+      copy_vtab_proc_comps (super_type, vtype);
+      /* Only needed to get the PPC initializers right.  */
+      add_procs_to_declared_vtab (super_type, vtype);
+    }
+
+  if (derived->f2k_derived && derived->f2k_derived->tb_sym_root)
+    add_procs_to_declared_vtab1 (derived->f2k_derived->tb_sym_root, vtype);
+
+  if (derived->f2k_derived && derived->f2k_derived->tb_uop_root)
+    add_procs_to_declared_vtab1 (derived->f2k_derived->tb_uop_root, vtype);
+}
+
+
+/* Find (or generate) the symbol for a derived type's vtab.  */
+
+gfc_symbol *
+gfc_find_derived_vtab (gfc_symbol *derived)
+{
+  gfc_namespace *ns;
+  gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL, *def_init = NULL;
+  gfc_symbol *copy = NULL, *src = NULL, *dst = NULL;
+  
+  /* Find the top-level namespace (MODULE or PROGRAM).  */
+  for (ns = gfc_current_ns; ns; ns = ns->parent)
+    if (!ns->parent)
+      break;
+
+  /* If the type is a class container, use the underlying derived type.  */
+  if (derived->attr.is_class)
+    derived = gfc_get_derived_super_type (derived);
+    
+  if (ns)
+    {
+      char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1];
+      
+      get_unique_hashed_string (tname, derived);
+      sprintf (name, "__vtab_%s", tname);
+
+      /* Look for the vtab symbol in various namespaces.  */
+      gfc_find_symbol (name, gfc_current_ns, 0, &vtab);
+      if (vtab == NULL)
+	gfc_find_symbol (name, ns, 0, &vtab);
+      if (vtab == NULL)
+	gfc_find_symbol (name, derived->ns, 0, &vtab);
+
+      if (vtab == NULL)
+	{
+	  gfc_get_symbol (name, ns, &vtab);
+	  vtab->ts.type = BT_DERIVED;
+	  if (gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL,
+	                      &gfc_current_locus) == FAILURE)
+	    goto cleanup;
+	  vtab->attr.target = 1;
+	  vtab->attr.save = SAVE_IMPLICIT;
+	  vtab->attr.vtab = 1;
+	  vtab->attr.access = ACCESS_PUBLIC;
+	  gfc_set_sym_referenced (vtab);
+	  sprintf (name, "__vtype_%s", tname);
+	  
+	  gfc_find_symbol (name, ns, 0, &vtype);
+	  if (vtype == NULL)
+	    {
+	      gfc_component *c;
+	      gfc_symbol *parent = NULL, *parent_vtab = NULL;
+
+	      gfc_get_symbol (name, ns, &vtype);
+	      if (gfc_add_flavor (&vtype->attr, FL_DERIVED,
+				  NULL, &gfc_current_locus) == FAILURE)
+		goto cleanup;
+	      vtype->attr.access = ACCESS_PUBLIC;
+	      vtype->attr.vtype = 1;
+	      gfc_set_sym_referenced (vtype);
+
+	      /* Add component '_hash'.  */
+	      if (gfc_add_component (vtype, "_hash", &c) == FAILURE)
+		goto cleanup;
+	      c->ts.type = BT_INTEGER;
+	      c->ts.kind = 4;
+	      c->attr.access = ACCESS_PRIVATE;
+	      c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
+						 NULL, derived->hash_value);
+
+	      /* Add component '_size'.  */
+	      if (gfc_add_component (vtype, "_size", &c) == FAILURE)
+		goto cleanup;
+	      c->ts.type = BT_INTEGER;
+	      c->ts.kind = 4;
+	      c->attr.access = ACCESS_PRIVATE;
+	      /* Remember the derived type in ts.u.derived,
+		 so that the correct initializer can be set later on
+		 (in gfc_conv_structure).  */
+	      c->ts.u.derived = derived;
+	      c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
+						 NULL, 0);
+
+	      /* Add component _extends.  */
+	      if (gfc_add_component (vtype, "_extends", &c) == FAILURE)
+		goto cleanup;
+	      c->attr.pointer = 1;
+	      c->attr.access = ACCESS_PRIVATE;
+	      parent = gfc_get_derived_super_type (derived);
+	      if (parent)
+		{
+		  parent_vtab = gfc_find_derived_vtab (parent);
+		  c->ts.type = BT_DERIVED;
+		  c->ts.u.derived = parent_vtab->ts.u.derived;
+		  c->initializer = gfc_get_expr ();
+		  c->initializer->expr_type = EXPR_VARIABLE;
+		  gfc_find_sym_tree (parent_vtab->name, parent_vtab->ns,
+				     0, &c->initializer->symtree);
+		}
+	      else
+		{
+		  c->ts.type = BT_DERIVED;
+		  c->ts.u.derived = vtype;
+		  c->initializer = gfc_get_null_expr (NULL);
+		}
+
+	      if (derived->components == NULL && !derived->attr.zero_comp)
+		{
+		  /* At this point an error must have occurred.
+		     Prevent further errors on the vtype components.  */
+		  found_sym = vtab;
+		  goto have_vtype;
+		}
+
+	      /* Add component _def_init.  */
+	      if (gfc_add_component (vtype, "_def_init", &c) == FAILURE)
+		goto cleanup;
+	      c->attr.pointer = 1;
+	      c->attr.access = ACCESS_PRIVATE;
+	      c->ts.type = BT_DERIVED;
+	      c->ts.u.derived = derived;
+	      if (derived->attr.abstract)
+		c->initializer = gfc_get_null_expr (NULL);
+	      else
+		{
+		  /* Construct default initialization variable.  */
+		  sprintf (name, "__def_init_%s", tname);
+		  gfc_get_symbol (name, ns, &def_init);
+		  def_init->attr.target = 1;
+		  def_init->attr.save = SAVE_IMPLICIT;
+		  def_init->attr.access = ACCESS_PUBLIC;
+		  def_init->attr.flavor = FL_VARIABLE;
+		  gfc_set_sym_referenced (def_init);
+		  def_init->ts.type = BT_DERIVED;
+		  def_init->ts.u.derived = derived;
+		  def_init->value = gfc_default_initializer (&def_init->ts);
+
+		  c->initializer = gfc_lval_expr_from_sym (def_init);
+		}
+
+	      /* Add component _copy.  */
+	      if (gfc_add_component (vtype, "_copy", &c) == FAILURE)
+		goto cleanup;
+	      c->attr.proc_pointer = 1;
+	      c->attr.access = ACCESS_PRIVATE;
+	      c->tb = XCNEW (gfc_typebound_proc);
+	      c->tb->ppc = 1;
+	      if (derived->attr.abstract)
+		c->initializer = gfc_get_null_expr (NULL);
+	      else
+		{
+		  /* Set up namespace.  */
+		  gfc_namespace *sub_ns = gfc_get_namespace (ns, 0);
+		  sub_ns->sibling = ns->contained;
+		  ns->contained = sub_ns;
+		  sub_ns->resolved = 1;
+		  /* Set up procedure symbol.  */
+		  sprintf (name, "__copy_%s", tname);
+		  gfc_get_symbol (name, sub_ns, &copy);
+		  sub_ns->proc_name = copy;
+		  copy->attr.flavor = FL_PROCEDURE;
+		  copy->attr.if_source = IFSRC_DECL;
+		  if (ns->proc_name->attr.flavor == FL_MODULE)
+		    copy->module = ns->proc_name->name;
+		  gfc_set_sym_referenced (copy);
+		  /* Set up formal arguments.  */
+		  gfc_get_symbol ("src", sub_ns, &src);
+		  src->ts.type = BT_DERIVED;
+		  src->ts.u.derived = derived;
+		  src->attr.flavor = FL_VARIABLE;
+		  src->attr.dummy = 1;
+		  gfc_set_sym_referenced (src);
+		  copy->formal = gfc_get_formal_arglist ();
+		  copy->formal->sym = src;
+		  gfc_get_symbol ("dst", sub_ns, &dst);
+		  dst->ts.type = BT_DERIVED;
+		  dst->ts.u.derived = derived;
+		  dst->attr.flavor = FL_VARIABLE;
+		  dst->attr.dummy = 1;
+		  gfc_set_sym_referenced (dst);
+		  copy->formal->next = gfc_get_formal_arglist ();
+		  copy->formal->next->sym = dst;
+		  /* Set up code.  */
+		  sub_ns->code = gfc_get_code ();
+		  sub_ns->code->op = EXEC_INIT_ASSIGN;
+		  sub_ns->code->expr1 = gfc_lval_expr_from_sym (dst);
+		  sub_ns->code->expr2 = gfc_lval_expr_from_sym (src);
+		  /* Set initializer.  */
+		  c->initializer = gfc_lval_expr_from_sym (copy);
+		  c->ts.interface = copy;
+		}
+
+	      /* Add procedure pointers for type-bound procedures.  */
+	      add_procs_to_declared_vtab (derived, vtype);
+	    }
+
+have_vtype:
+	  vtab->ts.u.derived = vtype;
+	  vtab->value = gfc_default_initializer (&vtab->ts);
+	}
+    }
+
+  found_sym = vtab;
+
+cleanup:
+  /* It is unexpected to have some symbols added at resolution or code
+     generation time. We commit the changes in order to keep a clean state.  */
+  if (found_sym)
+    {
+      gfc_commit_symbol (vtab);
+      if (vtype)
+	gfc_commit_symbol (vtype);
+      if (def_init)
+	gfc_commit_symbol (def_init);
+      if (copy)
+	gfc_commit_symbol (copy);
+      if (src)
+	gfc_commit_symbol (src);
+      if (dst)
+	gfc_commit_symbol (dst);
+    }
+  else
+    gfc_undo_symbols ();
+
+  return found_sym;
+}
+
+
+/* General worker function to find either a type-bound procedure or a
+   type-bound user operator.  */
+
+static gfc_symtree*
+find_typebound_proc_uop (gfc_symbol* derived, gfc_try* t,
+			 const char* name, bool noaccess, bool uop,
+			 locus* where)
+{
+  gfc_symtree* res;
+  gfc_symtree* root;
+
+  /* Set correct symbol-root.  */
+  gcc_assert (derived->f2k_derived);
+  root = (uop ? derived->f2k_derived->tb_uop_root
+	      : derived->f2k_derived->tb_sym_root);
+
+  /* Set default to failure.  */
+  if (t)
+    *t = FAILURE;
+
+  /* Try to find it in the current type's namespace.  */
+  res = gfc_find_symtree (root, name);
+  if (res && res->n.tb && !res->n.tb->error)
+    {
+      /* We found one.  */
+      if (t)
+	*t = SUCCESS;
+
+      if (!noaccess && derived->attr.use_assoc
+	  && res->n.tb->access == ACCESS_PRIVATE)
+	{
+	  if (where)
+	    gfc_error ("'%s' of '%s' is PRIVATE at %L",
+		       name, derived->name, where);
+	  if (t)
+	    *t = FAILURE;
+	}
+
+      return res;
+    }
+
+  /* Otherwise, recurse on parent type if derived is an extension.  */
+  if (derived->attr.extension)
+    {
+      gfc_symbol* super_type;
+      super_type = gfc_get_derived_super_type (derived);
+      gcc_assert (super_type);
+
+      return find_typebound_proc_uop (super_type, t, name,
+				      noaccess, uop, where);
+    }
+
+  /* Nothing found.  */
+  return NULL;
+}
+
+
+/* Find a type-bound procedure or user operator by name for a derived-type
+   (looking recursively through the super-types).  */
+
+gfc_symtree*
+gfc_find_typebound_proc (gfc_symbol* derived, gfc_try* t,
+			 const char* name, bool noaccess, locus* where)
+{
+  return find_typebound_proc_uop (derived, t, name, noaccess, false, where);
+}
+
+gfc_symtree*
+gfc_find_typebound_user_op (gfc_symbol* derived, gfc_try* t,
+			    const char* name, bool noaccess, locus* where)
+{
+  return find_typebound_proc_uop (derived, t, name, noaccess, true, where);
+}
+
+
+/* Find a type-bound intrinsic operator looking recursively through the
+   super-type hierarchy.  */
+
+gfc_typebound_proc*
+gfc_find_typebound_intrinsic_op (gfc_symbol* derived, gfc_try* t,
+				 gfc_intrinsic_op op, bool noaccess,
+				 locus* where)
+{
+  gfc_typebound_proc* res;
+
+  /* Set default to failure.  */
+  if (t)
+    *t = FAILURE;
+
+  /* Try to find it in the current type's namespace.  */
+  if (derived->f2k_derived)
+    res = derived->f2k_derived->tb_op[op];
+  else  
+    res = NULL;
+
+  /* Check access.  */
+  if (res && !res->error)
+    {
+      /* We found one.  */
+      if (t)
+	*t = SUCCESS;
+
+      if (!noaccess && derived->attr.use_assoc
+	  && res->access == ACCESS_PRIVATE)
+	{
+	  if (where)
+	    gfc_error ("'%s' of '%s' is PRIVATE at %L",
+		       gfc_op2string (op), derived->name, where);
+	  if (t)
+	    *t = FAILURE;
+	}
+
+      return res;
+    }
+
+  /* Otherwise, recurse on parent type if derived is an extension.  */
+  if (derived->attr.extension)
+    {
+      gfc_symbol* super_type;
+      super_type = gfc_get_derived_super_type (derived);
+      gcc_assert (super_type);
+
+      return gfc_find_typebound_intrinsic_op (super_type, t, op,
+					      noaccess, where);
+    }
+
+  /* Nothing found.  */
+  return NULL;
+}
+
+
+/* Get a typebound-procedure symtree or create and insert it if not yet
+   present.  This is like a very simplified version of gfc_get_sym_tree for
+   tbp-symtrees rather than regular ones.  */
+
+gfc_symtree*
+gfc_get_tbp_symtree (gfc_symtree **root, const char *name)
+{
+  gfc_symtree *result;
+
+  result = gfc_find_symtree (*root, name);
+  if (!result)
+    {
+      result = gfc_new_symtree (root, name);
+      gcc_assert (result);
+      result->n.tb = NULL;
+    }
+
+  return result;
+}
diff --git a/gcc/fortran/config-lang.in b/gcc/fortran/config-lang.in
new file mode 100644
index 000000000..43aab7a20
--- /dev/null
+++ b/gcc/fortran/config-lang.in
@@ -0,0 +1,33 @@
+# Copyright (C) 2004, 2005, 2006, 2007, 2010 Free Software Foundation, Inc.
+#
+# This file is part of GCC.
+#
+# GCC is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# GCC is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3.  If not see
+# <http://www.gnu.org/licenses/>.
+
+# Configure looks for the existence of this file to auto-config each language.
+# We define several parameters used by configure:
+#
+# language	- name of language as it would appear in $(LANGUAGES)
+# compilers	- value to add to $(COMPILERS)
+# diff_excludes	- files to ignore when building diffs between two versions.
+
+language="fortran"
+
+compilers="f951\$(exeext)"
+
+target_libs=target-libgfortran
+
+gtfiles="\$(srcdir)/fortran/f95-lang.c \$(srcdir)/fortran/trans-decl.c \$(srcdir)/fortran/trans-intrinsic.c \$(srcdir)/fortran/trans-io.c \$(srcdir)/fortran/trans-stmt.c \$(srcdir)/fortran/trans-types.c \$(srcdir)/fortran/trans-types.h \$(srcdir)/fortran/trans.h \$(srcdir)/fortran/trans-const.h"
+
diff --git a/gcc/fortran/constructor.c b/gcc/fortran/constructor.c
new file mode 100644
index 000000000..9f2cd2628
--- /dev/null
+++ b/gcc/fortran/constructor.c
@@ -0,0 +1,277 @@
+/* Array and structure constructors
+   Copyright (C) 2009, 2010, 2011
+   Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+#include "constructor.h"
+
+
+static void
+node_free (splay_tree_value value)
+{
+  gfc_constructor *c = (gfc_constructor*)value;
+
+  if (c->expr)
+    gfc_free_expr (c->expr);
+
+  if (c->iterator)
+    gfc_free_iterator (c->iterator, 1);
+
+  mpz_clear (c->offset);
+  mpz_clear (c->repeat);
+
+  gfc_free (c);
+}
+
+
+static gfc_constructor *
+node_copy (splay_tree_node node, void *base)
+{
+  gfc_constructor *c, *src = (gfc_constructor*)node->value;
+
+  c = XCNEW (gfc_constructor);
+  c->base = (gfc_constructor_base)base;
+  c->expr = gfc_copy_expr (src->expr);
+  c->iterator = gfc_copy_iterator (src->iterator);
+  c->where = src->where;
+  c->n.component = src->n.component;
+
+  mpz_init_set (c->offset, src->offset);
+  mpz_init_set (c->repeat, src->repeat);
+
+  return c;
+}
+
+
+static int
+node_copy_and_insert (splay_tree_node node, void *base)
+{
+  int n = mpz_get_si (((gfc_constructor*)node->value)->offset);
+  gfc_constructor_insert ((gfc_constructor_base*)base,
+			  node_copy (node, base), n);
+  return 0;
+}
+
+
+gfc_constructor *
+gfc_constructor_get (void)
+{
+  gfc_constructor *c = XCNEW (gfc_constructor);
+  c->base = NULL;
+  c->expr = NULL;
+  c->iterator = NULL;
+
+  mpz_init_set_si (c->offset, 0);
+  mpz_init_set_si (c->repeat, 1);
+
+  return c;
+}
+
+gfc_constructor_base gfc_constructor_get_base (void)
+{
+  return splay_tree_new (splay_tree_compare_ints, NULL, node_free);
+}
+
+
+gfc_constructor_base
+gfc_constructor_copy (gfc_constructor_base base)
+{
+  gfc_constructor_base new_base;
+
+  if (!base)
+    return NULL;
+
+  new_base = gfc_constructor_get_base ();
+  splay_tree_foreach (base, node_copy_and_insert, &new_base);
+
+  return new_base;
+}
+
+
+void
+gfc_constructor_free (gfc_constructor_base base)
+{
+  if (base)
+    splay_tree_delete (base);
+}
+
+
+gfc_constructor *
+gfc_constructor_append (gfc_constructor_base *base, gfc_constructor *c)
+{
+  int offset = 0;
+  if (*base)
+    offset = (int)(splay_tree_max (*base)->key) + 1;
+
+  return gfc_constructor_insert (base, c, offset);
+}
+
+
+gfc_constructor *
+gfc_constructor_append_expr (gfc_constructor_base *base,
+			     gfc_expr *e, locus *where)
+{
+  gfc_constructor *c = gfc_constructor_get ();
+  c->expr = e;
+  if (where)
+    c->where = *where;
+
+  return gfc_constructor_append (base, c);
+}
+
+
+gfc_constructor *
+gfc_constructor_insert (gfc_constructor_base *base, gfc_constructor *c, int n)
+{
+  splay_tree_node node;
+
+  if (*base == NULL)
+    *base = splay_tree_new (splay_tree_compare_ints, NULL, node_free);
+
+  c->base = *base;
+  mpz_set_si (c->offset, n);
+
+  node = splay_tree_insert (*base, (splay_tree_key) n, (splay_tree_value) c);
+  gcc_assert (node);
+
+  return (gfc_constructor*)node->value;
+}
+
+
+gfc_constructor *
+gfc_constructor_insert_expr (gfc_constructor_base *base,
+			     gfc_expr *e, locus *where, int n)
+{
+  gfc_constructor *c = gfc_constructor_get ();
+  c->expr = e;
+  if (where)
+    c->where = *where;
+
+  return gfc_constructor_insert (base, c, n);
+}
+
+
+gfc_constructor *
+gfc_constructor_lookup (gfc_constructor_base base, int offset)
+{
+  gfc_constructor *c;
+  splay_tree_node node;
+
+  if (!base)
+    return NULL;
+
+  node = splay_tree_lookup (base, (splay_tree_key) offset);
+  if (node)
+    return (gfc_constructor *) node->value;
+
+  /* Check if the previous node has a repeat count big enough to
+     cover the offset looked for.  */
+  node = splay_tree_predecessor (base, (splay_tree_key) offset);
+  if (!node)
+    return NULL;
+
+  c = (gfc_constructor *) node->value;
+  if (mpz_cmp_si (c->repeat, 1) > 0)
+    {
+      if (mpz_get_si (c->offset) + mpz_get_si (c->repeat) <= offset)
+	c = NULL;
+    }
+  else
+    c = NULL;
+
+  return c;
+}
+
+
+gfc_expr *
+gfc_constructor_lookup_expr (gfc_constructor_base base, int offset)
+{
+  gfc_constructor *c = gfc_constructor_lookup (base, offset);
+  return c ? c->expr : NULL;
+}
+
+
+int
+gfc_constructor_expr_foreach (gfc_constructor *ctor ATTRIBUTE_UNUSED,
+			      int(*f)(gfc_expr *) ATTRIBUTE_UNUSED)
+{
+  gcc_assert (0);
+  return 0;
+}
+
+void
+gfc_constructor_swap (gfc_constructor *ctor ATTRIBUTE_UNUSED,
+                      int n ATTRIBUTE_UNUSED, int m ATTRIBUTE_UNUSED)
+{
+  gcc_assert (0);
+}
+
+
+
+gfc_constructor *
+gfc_constructor_first (gfc_constructor_base base)
+{
+  if (base)
+    {
+      splay_tree_node node = splay_tree_min (base);
+      return node ? (gfc_constructor*) node->value : NULL;
+    }
+  else
+    return NULL;
+}
+
+
+gfc_constructor *
+gfc_constructor_next (gfc_constructor *ctor)
+{
+  if (ctor)
+    {
+      splay_tree_node node = splay_tree_successor (ctor->base,
+						   mpz_get_si (ctor->offset));
+      return node ? (gfc_constructor*) node->value : NULL;
+    }
+  else
+    return NULL;
+}
+
+
+void
+gfc_constructor_remove (gfc_constructor *ctor)
+{
+  if (ctor)
+    splay_tree_remove (ctor->base, mpz_get_si (ctor->offset));
+}
+
+
+gfc_constructor *
+gfc_constructor_lookup_next (gfc_constructor_base base, int offset)
+{
+  splay_tree_node node;
+
+  if (!base)
+    return NULL;
+
+  node = splay_tree_successor (base, (splay_tree_key) offset);
+  if (!node)
+    return NULL;
+
+  return (gfc_constructor *) node->value;
+}
diff --git a/gcc/fortran/constructor.h b/gcc/fortran/constructor.h
new file mode 100644
index 000000000..6b4bab4dd
--- /dev/null
+++ b/gcc/fortran/constructor.h
@@ -0,0 +1,90 @@
+/* Array and structure constructors
+   Copyright (C) 2009, 2010, 2011
+   Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#ifndef GFC_CONSTRUCTOR_H
+#define GFC_CONSTRUCTOR_H
+
+/* Get a new constructor structure.  */
+gfc_constructor *gfc_constructor_get (void);
+
+gfc_constructor_base gfc_constructor_get_base (void);
+
+/* Copy a constructor structure.  */
+gfc_constructor_base gfc_constructor_copy (gfc_constructor_base base);
+
+
+/* Free a gfc_constructor structure.  */
+void gfc_constructor_free (gfc_constructor_base base);
+
+
+/* Given an constructor structure, append the expression node onto
+   the constructor. Returns the constructor node appended.  */
+gfc_constructor *gfc_constructor_append (gfc_constructor_base *base,
+					 gfc_constructor *c);
+
+gfc_constructor *gfc_constructor_append_expr (gfc_constructor_base *base,
+					      gfc_expr *e, locus *where);
+
+
+/* Given an constructor structure, place the expression node at position.
+   Returns the constructor node inserted.  */
+gfc_constructor *gfc_constructor_insert (gfc_constructor_base *base,
+					 gfc_constructor *c, int n);
+
+gfc_constructor *gfc_constructor_insert_expr (gfc_constructor_base *base,
+					      gfc_expr *e, locus *where,
+					      int n);
+
+/* Given an array constructor expression and an element number (starting
+   at zero), return a pointer to the array element.  NULL is returned if
+   the size of the array has been exceeded. The expression node returned
+   remains a part of the array and should not be freed.  */
+
+gfc_constructor *gfc_constructor_lookup (gfc_constructor_base base, int n);
+
+/* Convenience function. Same as ...
+     gfc_constructor *c = gfc_constructor_lookup (base, n);
+     gfc_expr *e = c ? c->expr : NULL;
+*/
+gfc_expr *gfc_constructor_lookup_expr (gfc_constructor_base base, int n);
+
+
+int gfc_constructor_expr_foreach (gfc_constructor *ctor, int(*)(gfc_expr *));
+
+
+void gfc_constructor_swap (gfc_constructor *ctor, int n, int m);
+
+
+
+/* Get the first constructor node in the constructure structure.
+   Returns NULL if there is no such expression.  */
+gfc_constructor *gfc_constructor_first (gfc_constructor_base base);
+
+/* Get the next constructor node in the constructure structure.
+   Returns NULL if there is no next expression.  */
+gfc_constructor *gfc_constructor_next (gfc_constructor *ctor);
+
+/* Remove the gfc_constructor node from the splay tree.  */
+void gfc_constructor_remove (gfc_constructor *);
+
+/* Return first constructor node after offset.  */
+gfc_constructor *gfc_constructor_lookup_next (gfc_constructor_base, int);
+
+#endif /* GFC_CONSTRUCTOR_H */
diff --git a/gcc/fortran/convert.c b/gcc/fortran/convert.c
new file mode 100644
index 000000000..96874fa65
--- /dev/null
+++ b/gcc/fortran/convert.c
@@ -0,0 +1,124 @@
+/* Language-level data type conversion for GNU C.
+   Copyright (C) 1987, 1988, 1991, 1998, 2002, 2007, 2008, 2010
+   Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+/* This file contains the functions for converting C expressions
+   to different data types.  The only entry point is `convert'.
+   Every language front end must have a `convert' function
+   but what kind of conversions it does will depend on the language.  */
+
+/* copied from the f77 frontend I think */
+
+/* copied from c-convert.c without significant modification*/
+/* Change of width--truncation and extension of integers or reals--
+   is represented with NOP_EXPR.  Proper functioning of many things
+   assumes that no other conversions can be NOP_EXPRs.
+*/
+
+/* I've added support for WITH_RECORD_EXPR.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "flags.h"
+#include "convert.h"
+#include "diagnostic-core.h"	/* For error.  */
+#include "gfortran.h"
+#include "trans.h"
+
+/*
+   Conversion between integer and pointer is represented with CONVERT_EXPR.
+   Converting integer to real uses FLOAT_EXPR
+   and real to integer uses FIX_TRUNC_EXPR.
+
+   Here is a list of all the functions that assume that widening and
+   narrowing is always done with a NOP_EXPR:
+     In convert.c, convert_to_integer.
+     In c-typeck.c, build_binary_op (boolean ops), and
+	c_common_truthvalue_conversion.
+     In expr.c: expand_expr, for operands of a MULT_EXPR.
+     In fold-const.c: fold.
+     In tree.c: get_narrower and get_unwidened.  */
+
+/* Subroutines of `convert'.  */
+
+
+/* Create an expression whose value is that of EXPR,
+   converted to type TYPE.  The TREE_TYPE of the value
+   is always TYPE.  This function implements all reasonable
+   conversions; callers should filter out those that are
+   not permitted by the language being compiled.  */
+/* We are assuming that given a SIMPLE val, the result will be a SIMPLE rhs.
+   If this is not the case, we will abort with an internal error.  */
+tree
+convert (tree type, tree expr)
+{
+  tree e = expr;
+  enum tree_code code = TREE_CODE (type);
+
+  if (type == TREE_TYPE (expr)
+      || TREE_CODE (expr) == ERROR_MARK
+      || code == ERROR_MARK || TREE_CODE (TREE_TYPE (expr)) == ERROR_MARK)
+    return expr;
+
+  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr)))
+    return fold_build1_loc (input_location, NOP_EXPR, type, expr);
+  if (TREE_CODE (TREE_TYPE (expr)) == ERROR_MARK)
+    return error_mark_node;
+  if (TREE_CODE (TREE_TYPE (expr)) == VOID_TYPE)
+    {
+      error ("void value not ignored as it ought to be");
+      return error_mark_node;
+    }
+  if (code == VOID_TYPE)
+    return fold_build1_loc (input_location, CONVERT_EXPR, type, e);
+#if 0
+  /* This is incorrect.  A truncation can't be stripped this way.
+     Extensions will be stripped by the use of get_unwidened.  */
+  if (TREE_CODE (expr) == NOP_EXPR)
+    return convert (type, TREE_OPERAND (expr, 0));
+#endif
+  if (code == INTEGER_TYPE || code == ENUMERAL_TYPE)
+    return fold (convert_to_integer (type, e));
+  if (code == BOOLEAN_TYPE)
+    {
+      e = gfc_truthvalue_conversion (e);
+
+      /* If we have a NOP_EXPR, we must fold it here to avoid
+	 infinite recursion between fold () and convert ().  */
+      if (TREE_CODE (e) == NOP_EXPR)
+	return fold_build1_loc (input_location, NOP_EXPR, type,
+				TREE_OPERAND (e, 0));
+      else
+	return fold_build1_loc (input_location, NOP_EXPR, type, e);
+    }
+  if (code == POINTER_TYPE || code == REFERENCE_TYPE)
+    return fold (convert_to_pointer (type, e));
+  if (code == REAL_TYPE)
+    return fold (convert_to_real (type, e));
+  if (code == COMPLEX_TYPE)
+    return fold (convert_to_complex (type, e));
+  if (code == VECTOR_TYPE)
+    return fold (convert_to_vector (type, e));
+
+  error ("conversion to non-scalar type requested");
+  return error_mark_node;
+}
diff --git a/gcc/fortran/cpp.c b/gcc/fortran/cpp.c
new file mode 100644
index 000000000..4c1307c84
--- /dev/null
+++ b/gcc/fortran/cpp.c
@@ -0,0 +1,1127 @@
+/* Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "tree.h"
+#include "version.h"
+#include "flags.h"
+
+
+#include "options.h"
+#include "gfortran.h"
+#include "tm_p.h"		/* Target prototypes.  */
+#include "target.h"
+#include "toplev.h"
+#include "diagnostic.h"
+
+#include "../../libcpp/internal.h"
+#include "cpp.h"
+#include "incpath.h"
+#include "cppbuiltin.h"
+#include "mkdeps.h"
+
+#ifndef TARGET_CPU_CPP_BUILTINS
+# define TARGET_CPU_CPP_BUILTINS()
+#endif
+
+#ifndef TARGET_OS_CPP_BUILTINS
+# define TARGET_OS_CPP_BUILTINS()
+#endif
+
+#ifndef TARGET_OBJFMT_CPP_BUILTINS
+# define TARGET_OBJFMT_CPP_BUILTINS()
+#endif
+
+
+/* Holds switches parsed by gfc_cpp_handle_option (), but whose
+   handling is deferred to gfc_cpp_init ().  */
+typedef struct
+{
+    enum opt_code code;
+    const char *arg;
+}
+gfc_cpp_deferred_opt_t;
+
+
+/* Defined and undefined macros being queued for output with -dU at
+   the next newline.  */
+typedef struct gfc_cpp_macro_queue
+{
+  struct gfc_cpp_macro_queue *next;	/* Next macro in the list.  */
+  char *macro;				/* The name of the macro if not
+					   defined, the full definition if
+					   defined.  */
+} gfc_cpp_macro_queue;
+static gfc_cpp_macro_queue *cpp_define_queue, *cpp_undefine_queue;
+
+struct gfc_cpp_option_data
+{
+  /* Argument of -cpp, implied by SPEC;
+     if NULL, preprocessing disabled.  */
+  const char *temporary_filename;
+
+  const char *output_filename;          /* -o <arg>  */
+  int preprocess_only;                  /* -E  */
+  int discard_comments;                 /* -C  */
+  int discard_comments_in_macro_exp;    /* -CC  */
+  int print_include_names;              /* -H  */
+  int no_line_commands;                 /* -P  */
+  char dump_macros;                     /* -d[DMNU]  */
+  int dump_includes;                    /* -dI  */
+  int working_directory;                /* -fworking-directory  */
+  int no_predefined;                    /* -undef */
+  int standard_include_paths;           /* -nostdinc */
+  int verbose;                          /* -v */
+  int deps;                             /* -M */
+  int deps_skip_system;                 /* -MM */
+  const char *deps_filename;            /* -M[M]D */
+  const char *deps_filename_user;       /* -MF <arg> */
+  int deps_missing_are_generated;       /* -MG */
+  int deps_phony;                       /* -MP */
+
+  const char *multilib;                 /* -imultilib <dir>  */
+  const char *prefix;                   /* -iprefix <dir>  */
+  const char *sysroot;                  /* -isysroot <dir>  */
+
+  /* Options whose handling needs to be deferred until the
+     appropriate cpp-objects are created:
+      -A predicate=answer
+      -D <macro>[=<val>]
+      -U <macro>  */
+  gfc_cpp_deferred_opt_t *deferred_opt;
+  int deferred_opt_count;
+}
+gfc_cpp_option;
+
+/* Structures used with libcpp:  */
+static cpp_options *cpp_option = NULL;
+static cpp_reader *cpp_in = NULL;
+
+/* Encapsulates state used to convert a stream of cpp-tokens into
+   a text file.  */
+static struct
+{
+  FILE *outf;			/* Stream to write to.  */
+  const cpp_token *prev;	/* Previous token.  */
+  const cpp_token *source;	/* Source token for spacing.  */
+  int src_line;			/* Line number currently being written.  */
+  unsigned char printed;	/* Nonzero if something output at line.  */
+  bool first_time;		/* cb_file_change hasn't been called yet.  */
+} print;
+
+/* General output routines.  */
+static void scan_translation_unit (cpp_reader *);
+static void scan_translation_unit_trad (cpp_reader *);
+
+/* Callback routines for the parser. Most of these are active only
+   in specific modes.  */
+static void cb_file_change (cpp_reader *, const struct line_map *);
+static void cb_line_change (cpp_reader *, const cpp_token *, int);
+static void cb_define (cpp_reader *, source_location, cpp_hashnode *);
+static void cb_undef (cpp_reader *, source_location, cpp_hashnode *);
+static void cb_def_pragma (cpp_reader *, source_location);
+static void cb_include (cpp_reader *, source_location, const unsigned char *,
+			const char *, int, const cpp_token **);
+static void cb_ident (cpp_reader *, source_location, const cpp_string *);
+static void cb_used_define (cpp_reader *, source_location, cpp_hashnode *);
+static void cb_used_undef (cpp_reader *, source_location, cpp_hashnode *);
+static bool cb_cpp_error (cpp_reader *, int, int, location_t, unsigned int,
+			  const char *, va_list *)
+     ATTRIBUTE_GCC_DIAG(6,0);
+void pp_dir_change (cpp_reader *, const char *);
+
+static int dump_macro (cpp_reader *, cpp_hashnode *, void *);
+static void dump_queued_macros (cpp_reader *);
+
+
+static void
+cpp_define_builtins (cpp_reader *pfile)
+{
+  /* Initialize CPP built-ins; '1' corresponds to 'flag_hosted'
+     in C, defines __STDC_HOSTED__?!  */
+  cpp_init_builtins (pfile, 0);
+
+  /* Initialize GFORTRAN specific builtins.
+     These are documented.  */
+  define_language_independent_builtin_macros (pfile);
+  cpp_define (pfile, "__GFORTRAN__=1");
+  cpp_define (pfile, "_LANGUAGE_FORTRAN=1");
+
+  if (gfc_option.gfc_flag_openmp)
+    cpp_define (pfile, "_OPENMP=200805");
+
+  /* The defines below are necessary for the TARGET_* macros.
+
+     FIXME:  Note that builtin_define_std() actually is a function
+     in c-cppbuiltin.c which uses flags undefined for Fortran.
+     Let's skip this for now. If needed, one needs to look into it
+     once more.  */
+
+# define builtin_define(TXT) cpp_define (pfile, TXT)
+# define builtin_define_std(TXT)
+# define builtin_assert(TXT) cpp_assert (pfile, TXT)
+
+  /* FIXME: Pandora's Box
+    Using the macros below results in multiple breakages:
+     - mingw will fail to compile this file as dependent macros
+       assume to be used in c-cppbuiltin.c only. Further, they use
+       flags only valid/defined in C (same as noted above).
+       [config/i386/mingw32.h, config/i386/cygming.h]
+     - other platforms (not as popular) break similarly
+       [grep for 'builtin_define_with_int_value' in gcc/config/]
+
+  TARGET_CPU_CPP_BUILTINS ();
+  TARGET_OS_CPP_BUILTINS ();
+  TARGET_OBJFMT_CPP_BUILTINS (); */
+
+#undef builtin_define
+#undef builtin_define_std
+#undef builtin_assert
+}
+
+bool
+gfc_cpp_enabled (void)
+{
+  return gfc_cpp_option.temporary_filename != NULL;
+}
+
+bool
+gfc_cpp_preprocess_only (void)
+{
+  return gfc_cpp_option.preprocess_only;
+}
+
+bool
+gfc_cpp_makedep (void)
+{
+  return gfc_cpp_option.deps;
+}
+
+void
+gfc_cpp_add_dep (const char *name, bool system)
+{
+  if (!gfc_cpp_option.deps_skip_system || !system)
+    deps_add_dep (cpp_get_deps (cpp_in), name);
+}
+
+void
+gfc_cpp_add_target (const char *name)
+{
+  deps_add_target (cpp_get_deps (cpp_in), name, 0);
+}
+
+
+const char *
+gfc_cpp_temporary_file (void)
+{
+  return gfc_cpp_option.temporary_filename;
+}
+
+void
+gfc_cpp_init_options (unsigned int decoded_options_count,
+		      struct cl_decoded_option *decoded_options ATTRIBUTE_UNUSED)
+{
+  /* Do not create any objects from libcpp here. If no
+     preprocessing is requested, this would be wasted
+     time and effort.
+
+     See gfc_cpp_post_options() instead.  */
+
+  gfc_cpp_option.temporary_filename = NULL;
+  gfc_cpp_option.output_filename = NULL;
+  gfc_cpp_option.preprocess_only = 0;
+  gfc_cpp_option.discard_comments = 1;
+  gfc_cpp_option.discard_comments_in_macro_exp = 1;
+  gfc_cpp_option.print_include_names = 0;
+  gfc_cpp_option.no_line_commands = 0;
+  gfc_cpp_option.dump_macros = '\0';
+  gfc_cpp_option.dump_includes = 0;
+  gfc_cpp_option.working_directory = -1;
+  gfc_cpp_option.no_predefined = 0;
+  gfc_cpp_option.standard_include_paths = 1;
+  gfc_cpp_option.verbose = 0;
+  gfc_cpp_option.deps = 0;
+  gfc_cpp_option.deps_skip_system = 0;
+  gfc_cpp_option.deps_phony = 0;
+  gfc_cpp_option.deps_missing_are_generated = 0;
+  gfc_cpp_option.deps_filename = NULL;
+  gfc_cpp_option.deps_filename_user = NULL;
+
+  gfc_cpp_option.multilib = NULL;
+  gfc_cpp_option.prefix = NULL;
+  gfc_cpp_option.sysroot = NULL;
+
+  gfc_cpp_option.deferred_opt = XNEWVEC (gfc_cpp_deferred_opt_t,
+					 decoded_options_count);
+  gfc_cpp_option.deferred_opt_count = 0;
+}
+
+int
+gfc_cpp_handle_option (size_t scode, const char *arg, int value ATTRIBUTE_UNUSED)
+{
+  int result = 1;
+  enum opt_code code = (enum opt_code) scode;
+
+  switch (code)
+  {
+    default:
+      result = 0;
+      break;
+
+    case OPT_cpp_:
+      gfc_cpp_option.temporary_filename = arg;
+      break;
+
+    case OPT_nocpp:
+      gfc_cpp_option.temporary_filename = 0L;
+      break;
+
+    case OPT_d:
+      for ( ; *arg; ++arg)
+        switch (*arg)
+	{
+	  case 'D':
+	  case 'M':
+	  case 'N':
+	  case 'U':
+	    gfc_cpp_option.dump_macros = *arg;
+	    break;
+
+	  case 'I':
+	    gfc_cpp_option.dump_includes = 1;
+	    break;
+	}
+      break;
+
+    case OPT_fworking_directory:
+      gfc_cpp_option.working_directory = value;
+      break;
+
+    case OPT_idirafter:
+      gfc_cpp_add_include_path_after (xstrdup(arg), true);
+      break;
+
+    case OPT_imultilib:
+      gfc_cpp_option.multilib = arg;
+      break;
+
+    case OPT_iprefix:
+      gfc_cpp_option.prefix = arg;
+      break;
+
+    case OPT_isysroot:
+      gfc_cpp_option.sysroot = arg;
+      break;
+
+    case OPT_iquote:
+    case OPT_isystem:
+      gfc_cpp_add_include_path (xstrdup(arg), true);
+      break;
+
+    case OPT_nostdinc:
+      gfc_cpp_option.standard_include_paths = value;
+      break;
+
+    case OPT_o:
+      if (!gfc_cpp_option.output_filename)
+	gfc_cpp_option.output_filename = arg;
+      else
+	gfc_fatal_error ("output filename specified twice");
+      break;
+
+    case OPT_undef:
+      gfc_cpp_option.no_predefined = value;
+      break;
+
+    case OPT_v:
+      gfc_cpp_option.verbose = value;
+      break;
+
+    case OPT_A:
+    case OPT_D:
+    case OPT_U:
+      gfc_cpp_option.deferred_opt[gfc_cpp_option.deferred_opt_count].code = code;
+      gfc_cpp_option.deferred_opt[gfc_cpp_option.deferred_opt_count].arg = arg;
+      gfc_cpp_option.deferred_opt_count++;
+      break;
+
+    case OPT_C:
+      gfc_cpp_option.discard_comments = 0;
+      break;
+
+    case OPT_CC:
+      gfc_cpp_option.discard_comments = 0;
+      gfc_cpp_option.discard_comments_in_macro_exp = 0;
+      break;
+
+    case OPT_E:
+      gfc_cpp_option.preprocess_only = 1;
+      break;
+
+    case OPT_H:
+      gfc_cpp_option.print_include_names = 1;
+      break;
+
+    case OPT_MM:
+      gfc_cpp_option.deps_skip_system = 1;
+      /* fall through */
+
+    case OPT_M:
+      gfc_cpp_option.deps = 1;
+      break;
+
+    case OPT_MMD:
+      gfc_cpp_option.deps_skip_system = 1;
+      /* fall through */
+
+    case OPT_MD:
+      gfc_cpp_option.deps = 1;
+      gfc_cpp_option.deps_filename = arg;
+      break;
+
+    case OPT_MF:
+      /* If specified multiple times, last one wins.  */
+      gfc_cpp_option.deps_filename_user = arg;
+      break;
+
+    case OPT_MG:
+      gfc_cpp_option.deps_missing_are_generated = 1;
+      break;
+
+    case OPT_MP:
+      gfc_cpp_option.deps_phony = 1;
+      break;
+
+    case OPT_MQ:
+    case OPT_MT:
+      gfc_cpp_option.deferred_opt[gfc_cpp_option.deferred_opt_count].code = code;
+      gfc_cpp_option.deferred_opt[gfc_cpp_option.deferred_opt_count].arg = arg;
+      gfc_cpp_option.deferred_opt_count++;
+      break;
+
+    case OPT_P:
+      gfc_cpp_option.no_line_commands = 1;
+      break;
+  }
+
+  return result;
+}
+
+
+void
+gfc_cpp_post_options (void)
+{
+  /* Any preprocessing-related option without '-cpp' is considered
+     an error.  */
+  if (!gfc_cpp_enabled ()
+      && (gfc_cpp_preprocess_only ()
+	  || gfc_cpp_makedep ()
+	  || !gfc_cpp_option.discard_comments
+	  || !gfc_cpp_option.discard_comments_in_macro_exp
+	  || gfc_cpp_option.print_include_names
+	  || gfc_cpp_option.no_line_commands
+	  || gfc_cpp_option.dump_macros
+	  || gfc_cpp_option.dump_includes))
+    gfc_fatal_error("To enable preprocessing, use -cpp");
+
+  if (!gfc_cpp_enabled ())
+    return;
+
+  cpp_in = cpp_create_reader (CLK_GNUC89, NULL, line_table);
+  gcc_assert (cpp_in);
+
+  /* The cpp_options-structure defines far more flags than those set here.
+     If any other is implemented, see c-opt.c (sanitize_cpp_opts) for
+     inter-option dependencies that may need to be enforced.  */
+  cpp_option = cpp_get_options (cpp_in);
+  gcc_assert (cpp_option);
+
+  /* TODO: allow non-traditional modes, e.g. by -cpp-std=...?  */
+  cpp_option->traditional = 1;
+  cpp_option->cplusplus_comments = 0;
+
+  cpp_option->cpp_pedantic = pedantic;
+
+  cpp_option->dollars_in_ident = gfc_option.flag_dollar_ok;
+  cpp_option->discard_comments = gfc_cpp_option.discard_comments;
+  cpp_option->discard_comments_in_macro_exp = gfc_cpp_option.discard_comments_in_macro_exp;
+  cpp_option->print_include_names = gfc_cpp_option.print_include_names;
+  cpp_option->preprocessed = gfc_option.flag_preprocessed;
+
+  if (gfc_cpp_makedep ())
+    {
+      cpp_option->deps.style = DEPS_USER;
+      cpp_option->deps.phony_targets = gfc_cpp_option.deps_phony;
+      cpp_option->deps.missing_files = gfc_cpp_option.deps_missing_are_generated;
+
+      /* -MF <arg> overrides -M[M]D.  */
+      if (gfc_cpp_option.deps_filename_user)
+	gfc_cpp_option.deps_filename = gfc_cpp_option.deps_filename_user;
+  }
+
+  if (gfc_cpp_option.working_directory == -1)
+    gfc_cpp_option.working_directory = (debug_info_level != DINFO_LEVEL_NONE);
+
+  cpp_post_options (cpp_in);
+
+  gfc_cpp_register_include_paths ();
+}
+
+
+void
+gfc_cpp_init_0 (void)
+{
+  struct cpp_callbacks *cb;
+
+  cb = cpp_get_callbacks (cpp_in);
+  cb->file_change = cb_file_change;
+  cb->line_change = cb_line_change;
+  cb->ident = cb_ident;
+  cb->def_pragma = cb_def_pragma;
+  cb->error = cb_cpp_error;
+
+  if (gfc_cpp_option.dump_includes)
+    cb->include = cb_include;
+
+  if ((gfc_cpp_option.dump_macros == 'D')
+      || (gfc_cpp_option.dump_macros == 'N'))
+    {
+      cb->define = cb_define;
+      cb->undef  = cb_undef;
+    }
+
+  if (gfc_cpp_option.dump_macros == 'U')
+    {
+      cb->before_define = dump_queued_macros;
+      cb->used_define = cb_used_define;
+      cb->used_undef = cb_used_undef;
+    }
+
+  /* Initialize the print structure.  Setting print.src_line to -1 here is
+     a trick to guarantee that the first token of the file will cause
+     a linemarker to be output by maybe_print_line.  */
+  print.src_line = -1;
+  print.printed = 0;
+  print.prev = 0;
+  print.first_time = 1;
+
+  if (gfc_cpp_preprocess_only ())
+    {
+      if (gfc_cpp_option.output_filename)
+	{
+	  /* This needs cheating: with "-E -o <file>", the user wants the
+	     preprocessed output in <file>. However, if nothing is done
+	     about it <file> is also used for assembler output. Hence, it
+	     is necessary to redirect assembler output (actually nothing
+	     as -E implies -fsyntax-only) to another file, otherwise the
+	     output from preprocessing is lost.  */
+	  asm_file_name = gfc_cpp_option.temporary_filename;
+
+	  print.outf = fopen (gfc_cpp_option.output_filename, "w");
+	  if (print.outf == NULL)
+	    gfc_fatal_error ("opening output file %s: %s",
+			     gfc_cpp_option.output_filename,
+			     xstrerror (errno));
+	}
+      else
+	print.outf = stdout;
+    }
+  else
+    {
+      print.outf = fopen (gfc_cpp_option.temporary_filename, "w");
+      if (print.outf == NULL)
+	gfc_fatal_error ("opening output file %s: %s",
+			 gfc_cpp_option.temporary_filename, xstrerror (errno));
+    }
+
+  gcc_assert(cpp_in);
+  if (!cpp_read_main_file (cpp_in, gfc_source_file))
+    errorcount++;
+}
+
+void
+gfc_cpp_init (void)
+{
+  int i;
+
+  if (gfc_option.flag_preprocessed)
+    return;
+
+  cpp_change_file (cpp_in, LC_RENAME, _("<built-in>"));
+  if (!gfc_cpp_option.no_predefined)
+    cpp_define_builtins (cpp_in);
+
+  /* Handle deferred options from command-line.  */
+  cpp_change_file (cpp_in, LC_RENAME, _("<command-line>"));
+
+  for (i = 0; i < gfc_cpp_option.deferred_opt_count; i++)
+    {
+      gfc_cpp_deferred_opt_t *opt = &gfc_cpp_option.deferred_opt[i];
+
+      if (opt->code == OPT_D)
+	cpp_define (cpp_in, opt->arg);
+      else if (opt->code == OPT_U)
+	cpp_undef (cpp_in, opt->arg);
+      else if (opt->code == OPT_A)
+	{
+	  if (opt->arg[0] == '-')
+	    cpp_unassert (cpp_in, opt->arg + 1);
+	  else
+	    cpp_assert (cpp_in, opt->arg);
+	}
+      else if (opt->code == OPT_MT || opt->code == OPT_MQ)
+	deps_add_target (cpp_get_deps (cpp_in),
+			 opt->arg, opt->code == OPT_MQ);
+    }
+
+  if (gfc_cpp_option.working_directory
+      && gfc_cpp_option.preprocess_only && !gfc_cpp_option.no_line_commands)
+    pp_dir_change (cpp_in, get_src_pwd ());
+}
+
+gfc_try
+gfc_cpp_preprocess (const char *source_file)
+{
+  if (!gfc_cpp_enabled ())
+    return FAILURE;
+
+  cpp_change_file (cpp_in, LC_RENAME, source_file);
+
+  if (cpp_option->traditional)
+    scan_translation_unit_trad (cpp_in);
+  else
+    scan_translation_unit (cpp_in);
+
+  /* -dM command line option.  */
+  if (gfc_cpp_preprocess_only () &&
+      gfc_cpp_option.dump_macros == 'M')
+    {
+      putc ('\n', print.outf);
+      cpp_forall_identifiers (cpp_in, dump_macro, NULL);
+    }
+
+  putc ('\n', print.outf);
+
+  if (!gfc_cpp_preprocess_only ()
+      || (gfc_cpp_preprocess_only () && gfc_cpp_option.output_filename))
+    fclose (print.outf);
+
+  return SUCCESS;
+}
+
+void
+gfc_cpp_done (void)
+{
+  if (!gfc_cpp_enabled ())
+    return;
+
+  gcc_assert (cpp_in);
+
+  if (gfc_cpp_makedep ())
+    {
+      if (gfc_cpp_option.deps_filename)
+	{
+	  FILE *f = fopen (gfc_cpp_option.deps_filename, "w");
+	  if (f)
+	    {
+	      cpp_finish (cpp_in, f);
+	      fclose (f);
+	    }
+	  else
+	    gfc_fatal_error ("opening output file %s: %s",
+			     gfc_cpp_option.deps_filename,
+			     xstrerror (errno));
+	}
+      else
+	cpp_finish (cpp_in, stdout);
+    }
+
+  cpp_undef_all (cpp_in);
+  cpp_clear_file_cache (cpp_in);
+}
+
+/* PATH must be malloc-ed and NULL-terminated.  */
+void
+gfc_cpp_add_include_path (char *path, bool user_supplied)
+{
+  /* CHAIN sets cpp_dir->sysp which differs from 0 if PATH is a system
+     include path. Fortran does not define any system include paths.  */
+  int cxx_aware = 0;
+
+  add_path (path, BRACKET, cxx_aware, user_supplied);
+}
+
+void
+gfc_cpp_add_include_path_after (char *path, bool user_supplied)
+{
+  int cxx_aware = 0;
+  add_path (path, AFTER, cxx_aware, user_supplied);
+}
+
+void
+gfc_cpp_register_include_paths (void)
+{
+  int cxx_stdinc = 0;
+  register_include_chains (cpp_in, gfc_cpp_option.sysroot,
+			   gfc_cpp_option.prefix, gfc_cpp_option.multilib,
+			   gfc_cpp_option.standard_include_paths, cxx_stdinc,
+			   gfc_cpp_option.verbose);
+}
+
+
+
+static void scan_translation_unit_trad (cpp_reader *);
+static void account_for_newlines (const unsigned char *, size_t);
+static int dump_macro (cpp_reader *, cpp_hashnode *, void *);
+
+static void print_line (source_location, const char *);
+static void maybe_print_line (source_location);
+
+
+/* Writes out the preprocessed file, handling spacing and paste
+   avoidance issues.  */
+static void
+scan_translation_unit (cpp_reader *pfile)
+{
+  bool avoid_paste = false;
+
+  print.source = NULL;
+  for (;;)
+    {
+      const cpp_token *token = cpp_get_token (pfile);
+
+      if (token->type == CPP_PADDING)
+	{
+	  avoid_paste = true;
+	  if (print.source == NULL
+	      || (!(print.source->flags & PREV_WHITE)
+		  && token->val.source == NULL))
+	    print.source = token->val.source;
+	  continue;
+	}
+
+      if (token->type == CPP_EOF)
+	break;
+
+      /* Subtle logic to output a space if and only if necessary.  */
+      if (avoid_paste)
+	{
+	  if (print.source == NULL)
+	    print.source = token;
+	  if (print.source->flags & PREV_WHITE
+	      || (print.prev
+		  && cpp_avoid_paste (pfile, print.prev, token))
+	      || (print.prev == NULL && token->type == CPP_HASH))
+	    putc (' ', print.outf);
+	}
+      else if (token->flags & PREV_WHITE)
+	putc (' ', print.outf);
+
+      avoid_paste = false;
+      print.source = NULL;
+      print.prev = token;
+      cpp_output_token (token, print.outf);
+
+      if (token->type == CPP_COMMENT)
+	account_for_newlines (token->val.str.text, token->val.str.len);
+    }
+}
+
+/* Adjust print.src_line for newlines embedded in output.  */
+static void
+account_for_newlines (const unsigned char *str, size_t len)
+{
+  while (len--)
+    if (*str++ == '\n')
+      print.src_line++;
+}
+
+/* Writes out a traditionally preprocessed file.  */
+static void
+scan_translation_unit_trad (cpp_reader *pfile)
+{
+  while (_cpp_read_logical_line_trad (pfile))
+    {
+      size_t len = pfile->out.cur - pfile->out.base;
+      maybe_print_line (pfile->out.first_line);
+      fwrite (pfile->out.base, 1, len, print.outf);
+      print.printed = 1;
+      if (!CPP_OPTION (pfile, discard_comments))
+	account_for_newlines (pfile->out.base, len);
+    }
+}
+
+/* If the token read on logical line LINE needs to be output on a
+   different line to the current one, output the required newlines or
+   a line marker.  */
+static void
+maybe_print_line (source_location src_loc)
+{
+  const struct line_map *map = linemap_lookup (line_table, src_loc);
+  int src_line = SOURCE_LINE (map, src_loc);
+
+  /* End the previous line of text.  */
+  if (print.printed)
+    {
+      putc ('\n', print.outf);
+      print.src_line++;
+      print.printed = 0;
+    }
+
+  if (src_line >= print.src_line && src_line < print.src_line + 8)
+    {
+      while (src_line > print.src_line)
+	{
+	  putc ('\n', print.outf);
+	  print.src_line++;
+	}
+    }
+  else
+    print_line (src_loc, "");
+}
+
+/* Output a line marker for logical line LINE.  Special flags are "1"
+   or "2" indicating entering or leaving a file.  */
+static void
+print_line (source_location src_loc, const char *special_flags)
+{
+  /* End any previous line of text.  */
+  if (print.printed)
+    putc ('\n', print.outf);
+  print.printed = 0;
+
+  if (!gfc_cpp_option.no_line_commands)
+    {
+      const struct line_map *map = linemap_lookup (line_table, src_loc);
+
+      size_t to_file_len = strlen (map->to_file);
+      unsigned char *to_file_quoted =
+         (unsigned char *) alloca (to_file_len * 4 + 1);
+      unsigned char *p;
+
+      print.src_line = SOURCE_LINE (map, src_loc);
+
+      /* cpp_quote_string does not nul-terminate, so we have to do it
+	 ourselves.  */
+      p = cpp_quote_string (to_file_quoted,
+			    (const unsigned char *) map->to_file, to_file_len);
+      *p = '\0';
+      fprintf (print.outf, "# %u \"%s\"%s",
+	       print.src_line == 0 ? 1 : print.src_line,
+	       to_file_quoted, special_flags);
+
+      if (map->sysp == 2)
+	fputs (" 3 4", print.outf);
+      else if (map->sysp == 1)
+	fputs (" 3", print.outf);
+
+      putc ('\n', print.outf);
+    }
+}
+
+static void
+cb_file_change (cpp_reader * ARG_UNUSED (pfile), const struct line_map *map)
+{
+  const char *flags = "";
+
+  if (gfc_cpp_option.no_line_commands)
+    return;
+
+  if (!map)
+    return;
+
+      if (print.first_time)
+	{
+	  /* Avoid printing foo.i when the main file is foo.c.  */
+	  if (!cpp_get_options (cpp_in)->preprocessed)
+	    print_line (map->start_location, flags);
+	  print.first_time = 0;
+	}
+      else
+	{
+	  /* Bring current file to correct line when entering a new file.  */
+	  if (map->reason == LC_ENTER)
+	    {
+	      const struct line_map *from = INCLUDED_FROM (line_table, map);
+	      maybe_print_line (LAST_SOURCE_LINE_LOCATION (from));
+	    }
+	  if (map->reason == LC_ENTER)
+	    flags = " 1";
+	  else if (map->reason == LC_LEAVE)
+	    flags = " 2";
+	  print_line (map->start_location, flags);
+	}
+
+}
+
+/* Called when a line of output is started.  TOKEN is the first token
+   of the line, and at end of file will be CPP_EOF.  */
+static void
+cb_line_change (cpp_reader *pfile, const cpp_token *token,
+		int parsing_args)
+{
+  source_location src_loc = token->src_loc;
+
+  if (token->type == CPP_EOF || parsing_args)
+    return;
+
+  maybe_print_line (src_loc);
+  print.prev = 0;
+  print.source = 0;
+
+  /* Supply enough spaces to put this token in its original column,
+     one space per column greater than 2, since scan_translation_unit
+     will provide a space if PREV_WHITE.  Don't bother trying to
+     reconstruct tabs; we can't get it right in general, and nothing
+     ought to care.  Some things do care; the fault lies with them.  */
+  if (!CPP_OPTION (pfile, traditional))
+    {
+      const struct line_map *map = linemap_lookup (line_table, src_loc);
+      int spaces = SOURCE_COLUMN (map, src_loc) - 2;
+      print.printed = 1;
+
+      while (-- spaces >= 0)
+	putc (' ', print.outf);
+    }
+}
+
+static void
+cb_ident (cpp_reader *pfile ATTRIBUTE_UNUSED, source_location line,
+	  const cpp_string *str)
+{
+  maybe_print_line (line);
+  fprintf (print.outf, "#ident %s\n", str->text);
+  print.src_line++;
+}
+
+static void
+cb_define (cpp_reader *pfile ATTRIBUTE_UNUSED, source_location line,
+           cpp_hashnode *node ATTRIBUTE_UNUSED)
+{
+  maybe_print_line (line);
+  fputs ("#define ", print.outf);
+
+  /* 'D' is whole definition; 'N' is name only.  */
+  if (gfc_cpp_option.dump_macros == 'D')
+    fputs ((const char *) cpp_macro_definition (pfile, node),
+	   print.outf);
+  else
+    fputs ((const char *) NODE_NAME (node), print.outf);
+
+  putc ('\n', print.outf);
+  if (linemap_lookup (line_table, line)->to_line != 0)
+    print.src_line++;
+}
+
+static void
+cb_undef (cpp_reader *pfile ATTRIBUTE_UNUSED, source_location line,
+	  cpp_hashnode *node)
+{
+  maybe_print_line (line);
+  fprintf (print.outf, "#undef %s\n", NODE_NAME (node));
+  print.src_line++;
+}
+
+static void
+cb_include (cpp_reader *pfile ATTRIBUTE_UNUSED, source_location line,
+	    const unsigned char *dir, const char *header, int angle_brackets,
+	    const cpp_token **comments)
+{
+  maybe_print_line (line);
+  if (angle_brackets)
+    fprintf (print.outf, "#%s <%s>", dir, header);
+  else
+    fprintf (print.outf, "#%s \"%s\"", dir, header);
+
+  if (comments != NULL)
+    {
+      while (*comments != NULL)
+	{
+	  if ((*comments)->flags & PREV_WHITE)
+	    putc (' ', print.outf);
+	  cpp_output_token (*comments, print.outf);
+	  ++comments;
+	}
+    }
+
+  putc ('\n', print.outf);
+  print.src_line++;
+}
+
+/* Dump out the hash table.  */
+static int
+dump_macro (cpp_reader *pfile, cpp_hashnode *node, void *v ATTRIBUTE_UNUSED)
+{
+  if (node->type == NT_MACRO && !(node->flags & NODE_BUILTIN))
+    {
+      fputs ("#define ", print.outf);
+      fputs ((const char *) cpp_macro_definition (pfile, node),
+	     print.outf);
+      putc ('\n', print.outf);
+      print.src_line++;
+    }
+
+  return 1;
+}
+
+static void
+cb_used_define (cpp_reader *pfile, source_location line ATTRIBUTE_UNUSED,
+		cpp_hashnode *node)
+{
+  gfc_cpp_macro_queue *q;
+  q = XNEW (gfc_cpp_macro_queue);
+  q->macro = xstrdup ((const char *) cpp_macro_definition (pfile, node));
+  q->next = cpp_define_queue;
+  cpp_define_queue = q;
+}
+
+/* Callback from cpp_error for PFILE to print diagnostics from the
+   preprocessor.  The diagnostic is of type LEVEL, with REASON set
+   to the reason code if LEVEL is represents a warning, at location
+   LOCATION, with column number possibly overridden by COLUMN_OVERRIDE
+   if not zero; MSG is the translated message and AP the arguments.
+   Returns true if a diagnostic was emitted, false otherwise.  */
+
+static bool
+cb_cpp_error (cpp_reader *pfile ATTRIBUTE_UNUSED, int level, int reason,
+	      location_t location, unsigned int column_override,
+	      const char *msg, va_list *ap)
+{
+  diagnostic_info diagnostic;
+  diagnostic_t dlevel;
+  bool save_warn_system_headers = global_dc->dc_warn_system_headers;
+  bool ret;
+
+  switch (level)
+    {
+    case CPP_DL_WARNING_SYSHDR:
+      global_dc->dc_warn_system_headers = 1;
+      /* Fall through.  */
+    case CPP_DL_WARNING:
+      dlevel = DK_WARNING;
+      break;
+    case CPP_DL_PEDWARN:
+      dlevel = DK_PEDWARN;
+      break;
+    case CPP_DL_ERROR:
+      dlevel = DK_ERROR;
+      break;
+    case CPP_DL_ICE:
+      dlevel = DK_ICE;
+      break;
+    case CPP_DL_NOTE:
+      dlevel = DK_NOTE;
+      break;
+    case CPP_DL_FATAL:
+      dlevel = DK_FATAL;
+      break;
+    default:
+      gcc_unreachable ();
+    }
+  diagnostic_set_info_translated (&diagnostic, msg, ap,
+				  location, dlevel);
+  if (column_override)
+    diagnostic_override_column (&diagnostic, column_override);
+  if (reason == CPP_W_WARNING_DIRECTIVE)
+    diagnostic_override_option_index (&diagnostic, OPT_Wcpp);
+  ret = report_diagnostic (&diagnostic);
+  if (level == CPP_DL_WARNING_SYSHDR)
+    global_dc->dc_warn_system_headers = save_warn_system_headers;
+  return ret;
+}
+
+/* Callback called when -fworking-director and -E to emit working
+   directory in cpp output file.  */
+
+void
+pp_dir_change (cpp_reader *pfile ATTRIBUTE_UNUSED, const char *dir)
+{
+  size_t to_file_len = strlen (dir);
+  unsigned char *to_file_quoted =
+     (unsigned char *) alloca (to_file_len * 4 + 1);
+  unsigned char *p;
+
+  /* cpp_quote_string does not nul-terminate, so we have to do it ourselves.  */
+  p = cpp_quote_string (to_file_quoted, (const unsigned char *) dir, to_file_len);
+  *p = '\0';
+  fprintf (print.outf, "# 1 \"%s//\"\n", to_file_quoted);
+}
+
+/* Copy a #pragma directive to the preprocessed output.  */
+static void
+cb_def_pragma (cpp_reader *pfile, source_location line)
+{
+  maybe_print_line (line);
+  fputs ("#pragma ", print.outf);
+  cpp_output_line (pfile, print.outf);
+  print.src_line++;
+}
+
+static void
+cb_used_undef (cpp_reader *pfile ATTRIBUTE_UNUSED,
+	       source_location line ATTRIBUTE_UNUSED,
+	       cpp_hashnode *node)
+{
+  gfc_cpp_macro_queue *q;
+  q = XNEW (gfc_cpp_macro_queue);
+  q->macro = xstrdup ((const char *) NODE_NAME (node));
+  q->next = cpp_undefine_queue;
+  cpp_undefine_queue = q;
+}
+
+static void
+dump_queued_macros (cpp_reader *pfile ATTRIBUTE_UNUSED)
+{
+  gfc_cpp_macro_queue *q;
+
+  /* End the previous line of text.  */
+  if (print.printed)
+    {
+      putc ('\n', print.outf);
+      print.src_line++;
+      print.printed = 0;
+    }
+
+  for (q = cpp_define_queue; q;)
+    {
+      gfc_cpp_macro_queue *oq;
+      fputs ("#define ", print.outf);
+      fputs (q->macro, print.outf);
+      putc ('\n', print.outf);
+      print.src_line++;
+      oq = q;
+      q = q->next;
+      gfc_free (oq->macro);
+      gfc_free (oq);
+    }
+  cpp_define_queue = NULL;
+  for (q = cpp_undefine_queue; q;)
+    {
+      gfc_cpp_macro_queue *oq;
+      fprintf (print.outf, "#undef %s\n", q->macro);
+      print.src_line++;
+      oq = q;
+      q = q->next;
+      gfc_free (oq->macro);
+      gfc_free (oq);
+    }
+  cpp_undefine_queue = NULL;
+}
diff --git a/gcc/fortran/cpp.h b/gcc/fortran/cpp.h
new file mode 100644
index 000000000..fa4383aef
--- /dev/null
+++ b/gcc/fortran/cpp.h
@@ -0,0 +1,55 @@
+/* Copyright (C) 2008, 2010 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#ifndef GFC_CPP_H
+#define GFC_CPP_H
+
+/* Returns true if preprocessing is enabled, false otherwise.  */
+bool gfc_cpp_enabled (void);
+
+bool gfc_cpp_preprocess_only (void);
+
+bool gfc_cpp_makedep (void);
+
+void gfc_cpp_add_dep (const char *name, bool system);
+
+void gfc_cpp_add_target (const char *name);
+
+const char *gfc_cpp_temporary_file (void);
+
+
+void gfc_cpp_init_0 (void);
+void gfc_cpp_init (void);
+
+void gfc_cpp_init_options (unsigned int decoded_options_count,
+			   struct cl_decoded_option *decoded_options);
+
+int gfc_cpp_handle_option(size_t scode, const char *arg, int value);
+
+void gfc_cpp_post_options (void);
+
+gfc_try gfc_cpp_preprocess (const char *source_file);
+
+void gfc_cpp_done (void);
+
+void gfc_cpp_add_include_path (char *path, bool user_supplied);
+void gfc_cpp_add_include_path_after (char *path, bool user_supplied);
+
+void gfc_cpp_register_include_paths (void);
+
+#endif /* GFC_CPP_H */
diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
new file mode 100644
index 000000000..0cbf67dc6
--- /dev/null
+++ b/gcc/fortran/data.c
@@ -0,0 +1,697 @@
+/* Supporting functions for resolving DATA statement.
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+   Free Software Foundation, Inc.
+   Contributed by Lifang Zeng <zlf605@hotmail.com>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+/* Notes for DATA statement implementation:
+									       
+   We first assign initial value to each symbol by gfc_assign_data_value
+   during resolving DATA statement. Refer to check_data_variable and
+   traverse_data_list in resolve.c.
+									       
+   The complexity exists in the handling of array section, implied do
+   and array of struct appeared in DATA statement.
+									       
+   We call gfc_conv_structure, gfc_con_array_array_initializer,
+   etc., to convert the initial value. Refer to trans-expr.c and
+   trans-array.c.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+#include "data.h"
+#include "constructor.h"
+
+static void formalize_init_expr (gfc_expr *);
+
+/* Calculate the array element offset.  */
+
+static void
+get_array_index (gfc_array_ref *ar, mpz_t *offset)
+{
+  gfc_expr *e;
+  int i;
+  mpz_t delta;
+  mpz_t tmp;
+
+  mpz_init (tmp);
+  mpz_set_si (*offset, 0);
+  mpz_init_set_si (delta, 1);
+  for (i = 0; i < ar->dimen; i++)
+    {
+      e = gfc_copy_expr (ar->start[i]);
+      gfc_simplify_expr (e, 1);
+
+      if ((gfc_is_constant_expr (ar->as->lower[i]) == 0)
+	  || (gfc_is_constant_expr (ar->as->upper[i]) == 0)
+	  || (gfc_is_constant_expr (e) == 0))
+	gfc_error ("non-constant array in DATA statement %L", &ar->where);
+
+      mpz_set (tmp, e->value.integer);
+      mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
+      mpz_mul (tmp, tmp, delta);
+      mpz_add (*offset, tmp, *offset);
+
+      mpz_sub (tmp, ar->as->upper[i]->value.integer,
+	       ar->as->lower[i]->value.integer);
+      mpz_add_ui (tmp, tmp, 1);
+      mpz_mul (delta, tmp, delta);
+    }
+  mpz_clear (delta);
+  mpz_clear (tmp);
+}
+
+/* Find if there is a constructor which component is equal to COM.
+   TODO: remove this, use symbol.c(gfc_find_component) instead.  */
+
+static gfc_constructor *
+find_con_by_component (gfc_component *com, gfc_constructor_base base)
+{
+  gfc_constructor *c;
+
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+    if (com == c->n.component)
+      return c;
+
+  return NULL;
+}
+
+
+/* Create a character type initialization expression from RVALUE.
+   TS [and REF] describe [the substring of] the variable being initialized.
+   INIT is the existing initializer, not NULL.  Initialization is performed
+   according to normal assignment rules.  */
+
+static gfc_expr *
+create_character_initializer (gfc_expr *init, gfc_typespec *ts,
+			      gfc_ref *ref, gfc_expr *rvalue)
+{
+  int len, start, end;
+  gfc_char_t *dest;
+	    
+  gfc_extract_int (ts->u.cl->length, &len);
+
+  if (init == NULL)
+    {
+      /* Create a new initializer.  */
+      init = gfc_get_character_expr (ts->kind, NULL, NULL, len);
+      init->ts = *ts;
+    }
+
+  dest = init->value.character.string;
+
+  if (ref)
+    {
+      gfc_expr *start_expr, *end_expr;
+
+      gcc_assert (ref->type == REF_SUBSTRING);
+
+      /* Only set a substring of the destination.  Fortran substring bounds
+	 are one-based [start, end], we want zero based [start, end).  */
+      start_expr = gfc_copy_expr (ref->u.ss.start);
+      end_expr = gfc_copy_expr (ref->u.ss.end);
+
+      if ((gfc_simplify_expr (start_expr, 1) == FAILURE)
+	  || (gfc_simplify_expr (end_expr, 1)) == FAILURE)
+	{
+	  gfc_error ("failure to simplify substring reference in DATA "
+		     "statement at %L", &ref->u.ss.start->where);
+	  return NULL;
+	}
+
+      gfc_extract_int (start_expr, &start);
+      start--;
+      gfc_extract_int (end_expr, &end);
+    }
+  else
+    {
+      /* Set the whole string.  */
+      start = 0;
+      end = len;
+    }
+
+  /* Copy the initial value.  */
+  if (rvalue->ts.type == BT_HOLLERITH)
+    len = rvalue->representation.length - rvalue->ts.u.pad;
+  else
+    len = rvalue->value.character.length;
+
+  if (len > end - start)
+    {
+      gfc_warning_now ("Initialization string starting at %L was "
+		       "truncated to fit the variable (%d/%d)",
+		       &rvalue->where, end - start, len);
+      len = end - start;
+    }
+
+  if (rvalue->ts.type == BT_HOLLERITH)
+    {
+      int i;
+      for (i = 0; i < len; i++)
+	dest[start+i] = rvalue->representation.string[i];
+    }
+  else
+    memcpy (&dest[start], rvalue->value.character.string,
+	    len * sizeof (gfc_char_t));
+
+  /* Pad with spaces.  Substrings will already be blanked.  */
+  if (len < end - start && ref == NULL)
+    gfc_wide_memset (&dest[start + len], ' ', end - (start + len));
+
+  if (rvalue->ts.type == BT_HOLLERITH)
+    {
+      init->representation.length = init->value.character.length;
+      init->representation.string
+	= gfc_widechar_to_char (init->value.character.string,
+				init->value.character.length);
+    }
+
+  return init;
+}
+
+
+/* Assign the initial value RVALUE to  LVALUE's symbol->value. If the
+   LVALUE already has an initialization, we extend this, otherwise we
+   create a new one.  If REPEAT is non-NULL, initialize *REPEAT
+   consecutive values in LVALUE the same value in RVALUE.  In that case,
+   LVALUE must refer to a full array, not an array section.  */
+
+gfc_try
+gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
+		       mpz_t *repeat)
+{
+  gfc_ref *ref;
+  gfc_expr *init;
+  gfc_expr *expr;
+  gfc_constructor *con;
+  gfc_constructor *last_con;
+  gfc_symbol *symbol;
+  gfc_typespec *last_ts;
+  mpz_t offset;
+
+  symbol = lvalue->symtree->n.sym;
+  init = symbol->value;
+  last_ts = &symbol->ts;
+  last_con = NULL;
+  mpz_init_set_si (offset, 0);
+
+  /* Find/create the parent expressions for subobject references.  */
+  for (ref = lvalue->ref; ref; ref = ref->next)
+    {
+      /* Break out of the loop if we find a substring.  */
+      if (ref->type == REF_SUBSTRING)
+	{
+	  /* A substring should always be the last subobject reference.  */
+	  gcc_assert (ref->next == NULL);
+	  break;
+	}
+
+      /* Use the existing initializer expression if it exists.  Otherwise
+	 create a new one.  */
+      if (init == NULL)
+	expr = gfc_get_expr ();
+      else
+	expr = init;
+
+      /* Find or create this element.  */
+      switch (ref->type)
+	{
+	case REF_ARRAY:
+	  if (ref->u.ar.as->rank == 0)
+	    {
+	      gcc_assert (ref->u.ar.as->corank > 0);
+	      if (init == NULL)
+		gfc_free (expr);
+	      continue;
+	    }
+
+	  if (init && expr->expr_type != EXPR_ARRAY)
+	    {
+	      gfc_error ("'%s' at %L already is initialized at %L",
+			 lvalue->symtree->n.sym->name, &lvalue->where,
+			 &init->where);
+	      goto abort;
+	    }
+
+	  if (init == NULL)
+	    {
+	      /* The element typespec will be the same as the array
+		 typespec.  */
+	      expr->ts = *last_ts;
+	      /* Setup the expression to hold the constructor.  */
+	      expr->expr_type = EXPR_ARRAY;
+	      expr->rank = ref->u.ar.as->rank;
+	    }
+
+	  if (ref->u.ar.type == AR_ELEMENT)
+	    get_array_index (&ref->u.ar, &offset);
+	  else
+	    mpz_set (offset, index);
+
+	  /* Check the bounds.  */
+	  if (mpz_cmp_si (offset, 0) < 0)
+	    {
+	      gfc_error ("Data element below array lower bound at %L",
+			 &lvalue->where);
+	      goto abort;
+	    }
+	  else if (repeat != NULL
+		   && ref->u.ar.type != AR_ELEMENT)
+	    {
+	      mpz_t size, end;
+	      gcc_assert (ref->u.ar.type == AR_FULL
+			  && ref->next == NULL);
+	      mpz_init_set (end, offset);
+	      mpz_add (end, end, *repeat);
+	      if (spec_size (ref->u.ar.as, &size) == SUCCESS)
+		{
+		  if (mpz_cmp (end, size) > 0)
+		    {
+		      mpz_clear (size);
+		      gfc_error ("Data element above array upper bound at %L",
+				 &lvalue->where);
+		      goto abort;
+		    }
+		  mpz_clear (size);
+		}
+
+	      con = gfc_constructor_lookup (expr->value.constructor,
+					    mpz_get_si (offset));
+	      if (!con)
+		{
+		  con = gfc_constructor_lookup_next (expr->value.constructor,
+						     mpz_get_si (offset));
+		  if (con != NULL && mpz_cmp (con->offset, end) >= 0)
+		    con = NULL;
+		}
+
+	      /* Overwriting an existing initializer is non-standard but
+		 usually only provokes a warning from other compilers.  */
+	      if (con != NULL && con->expr != NULL)
+		{
+		  /* Order in which the expressions arrive here depends on
+		     whether they are from data statements or F95 style
+		     declarations.  Therefore, check which is the most
+		     recent.  */
+		  gfc_expr *exprd;
+		  exprd = (LOCATION_LINE (con->expr->where.lb->location)
+			   > LOCATION_LINE (rvalue->where.lb->location))
+			  ? con->expr : rvalue;
+		  if (gfc_notify_std (GFC_STD_GNU,"Extension: "
+				      "re-initialization of '%s' at %L",
+				      symbol->name, &exprd->where) == FAILURE)
+		    return FAILURE;
+		}
+
+	      while (con != NULL)
+		{
+		  gfc_constructor *next_con = gfc_constructor_next (con);
+
+		  if (mpz_cmp (con->offset, end) >= 0)
+		    break;
+		  if (mpz_cmp (con->offset, offset) < 0)
+		    {
+		      gcc_assert (mpz_cmp_si (con->repeat, 1) > 0);
+		      mpz_sub (con->repeat, offset, con->offset);
+		    }
+		  else if (mpz_cmp_si (con->repeat, 1) > 0
+			   && mpz_get_si (con->offset)
+			      + mpz_get_si (con->repeat) > mpz_get_si (end))
+		    {
+		      int endi;
+		      splay_tree_node node
+			= splay_tree_lookup (con->base,
+					     mpz_get_si (con->offset));
+		      gcc_assert (node
+				  && con == (gfc_constructor *) node->value
+				  && node->key == (splay_tree_key)
+						  mpz_get_si (con->offset));
+		      endi = mpz_get_si (con->offset)
+			     + mpz_get_si (con->repeat);
+		      if (endi > mpz_get_si (end) + 1)
+			mpz_set_si (con->repeat, endi - mpz_get_si (end));
+		      else
+			mpz_set_si (con->repeat, 1);
+		      mpz_set (con->offset, end);
+		      node->key = (splay_tree_key) mpz_get_si (end);
+		      break;
+		    }
+		  else
+		    gfc_constructor_remove (con);
+		  con = next_con;
+		}
+
+	      con = gfc_constructor_insert_expr (&expr->value.constructor,
+						 NULL, &rvalue->where,
+						 mpz_get_si (offset));
+	      mpz_set (con->repeat, *repeat);
+	      repeat = NULL;
+	      mpz_clear (end);
+	      break;
+	    }
+	  else
+	    {
+	      mpz_t size;
+	      if (spec_size (ref->u.ar.as, &size) == SUCCESS)
+		{
+		  if (mpz_cmp (offset, size) >= 0)
+		    {
+		      mpz_clear (size);
+		      gfc_error ("Data element above array upper bound at %L",
+		                 &lvalue->where);
+		      goto abort;
+		    }
+		  mpz_clear (size);
+		}
+	    }
+
+	  con = gfc_constructor_lookup (expr->value.constructor,
+					mpz_get_si (offset));
+	  if (!con)
+	    {
+	      con = gfc_constructor_insert_expr (&expr->value.constructor,
+						 NULL, &rvalue->where,
+						 mpz_get_si (offset));
+	    }
+	  else if (mpz_cmp_si (con->repeat, 1) > 0)
+	    {
+	      /* Need to split a range.  */
+	      if (mpz_cmp (con->offset, offset) < 0)
+		{
+		  gfc_constructor *pred_con = con;
+		  con = gfc_constructor_insert_expr (&expr->value.constructor,
+						     NULL, &con->where,
+						     mpz_get_si (offset));
+		  con->expr = gfc_copy_expr (pred_con->expr);
+		  mpz_add (con->repeat, pred_con->offset, pred_con->repeat);
+		  mpz_sub (con->repeat, con->repeat, offset);
+		  mpz_sub (pred_con->repeat, offset, pred_con->offset);
+		}
+	      if (mpz_cmp_si (con->repeat, 1) > 0)
+		{
+		  gfc_constructor *succ_con;
+		  succ_con
+		    = gfc_constructor_insert_expr (&expr->value.constructor,
+						   NULL, &con->where,
+						   mpz_get_si (offset) + 1);
+		  succ_con->expr = gfc_copy_expr (con->expr);
+		  mpz_sub_ui (succ_con->repeat, con->repeat, 1);
+		  mpz_set_si (con->repeat, 1);
+		}
+	    }
+	  break;
+
+	case REF_COMPONENT:
+	  if (init == NULL)
+	    {
+	      /* Setup the expression to hold the constructor.  */
+	      expr->expr_type = EXPR_STRUCTURE;
+	      expr->ts.type = BT_DERIVED;
+	      expr->ts.u.derived = ref->u.c.sym;
+	    }
+	  else
+	    gcc_assert (expr->expr_type == EXPR_STRUCTURE);
+	  last_ts = &ref->u.c.component->ts;
+
+	  /* Find the same element in the existing constructor.  */
+	  con = find_con_by_component (ref->u.c.component,
+				       expr->value.constructor);
+
+	  if (con == NULL)
+	    {
+	      /* Create a new constructor.  */
+	      con = gfc_constructor_append_expr (&expr->value.constructor,
+						 NULL, NULL);
+	      con->n.component = ref->u.c.component;
+	    }
+	  break;
+
+	default:
+	  gcc_unreachable ();
+	}
+
+      if (init == NULL)
+	{
+	  /* Point the container at the new expression.  */
+	  if (last_con == NULL)
+	    symbol->value = expr;
+	  else
+	    last_con->expr = expr;
+	}
+      init = con->expr;
+      last_con = con;
+    }
+
+  mpz_clear (offset);
+  gcc_assert (repeat == NULL);
+
+  if (ref || last_ts->type == BT_CHARACTER)
+    {
+      if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL))
+	return FAILURE;
+      expr = create_character_initializer (init, last_ts, ref, rvalue);
+    }
+  else
+    {
+      /* Overwriting an existing initializer is non-standard but usually only
+	 provokes a warning from other compilers.  */
+      if (init != NULL)
+	{
+	  /* Order in which the expressions arrive here depends on whether
+	     they are from data statements or F95 style declarations.
+	     Therefore, check which is the most recent.  */
+	  expr = (LOCATION_LINE (init->where.lb->location)
+		  > LOCATION_LINE (rvalue->where.lb->location))
+	       ? init : rvalue;
+	  if (gfc_notify_std (GFC_STD_GNU,"Extension: "
+			      "re-initialization of '%s' at %L",
+			      symbol->name, &expr->where) == FAILURE)
+	    return FAILURE;
+	}
+
+      expr = gfc_copy_expr (rvalue);
+      if (!gfc_compare_types (&lvalue->ts, &expr->ts))
+	gfc_convert_type (expr, &lvalue->ts, 0);
+    }
+
+  if (last_con == NULL)
+    symbol->value = expr;
+  else
+    last_con->expr = expr;
+
+  return SUCCESS;
+
+abort:
+  mpz_clear (offset);
+  return FAILURE;
+}
+
+
+/* Modify the index of array section and re-calculate the array offset.  */
+
+void 
+gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
+		     mpz_t *offset_ret)
+{
+  int i;
+  mpz_t delta;
+  mpz_t tmp; 
+  bool forwards;
+  int cmp;
+
+  for (i = 0; i < ar->dimen; i++)
+    {
+      if (ar->dimen_type[i] != DIMEN_RANGE)
+	continue;
+
+      if (ar->stride[i])
+	{
+	  mpz_add (section_index[i], section_index[i],
+		   ar->stride[i]->value.integer);
+	if (mpz_cmp_si (ar->stride[i]->value.integer, 0) >= 0)
+	  forwards = true;
+	else
+	  forwards = false;
+	}
+      else
+	{
+	  mpz_add_ui (section_index[i], section_index[i], 1);
+	  forwards = true;
+	}
+      
+      if (ar->end[i])
+	cmp = mpz_cmp (section_index[i], ar->end[i]->value.integer);
+      else
+	cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer);
+
+      if ((cmp > 0 && forwards) || (cmp < 0 && !forwards))
+	{
+	  /* Reset index to start, then loop to advance the next index.  */
+	  if (ar->start[i])
+	    mpz_set (section_index[i], ar->start[i]->value.integer);
+	  else
+	    mpz_set (section_index[i], ar->as->lower[i]->value.integer);
+	}
+      else
+	break;
+    }
+
+  mpz_set_si (*offset_ret, 0);
+  mpz_init_set_si (delta, 1);
+  mpz_init (tmp);
+  for (i = 0; i < ar->dimen; i++)
+    {
+      mpz_sub (tmp, section_index[i], ar->as->lower[i]->value.integer);
+      mpz_mul (tmp, tmp, delta);
+      mpz_add (*offset_ret, tmp, *offset_ret);
+
+      mpz_sub (tmp, ar->as->upper[i]->value.integer, 
+	       ar->as->lower[i]->value.integer);
+      mpz_add_ui (tmp, tmp, 1);
+      mpz_mul (delta, tmp, delta);
+    }
+  mpz_clear (tmp);
+  mpz_clear (delta);
+}
+
+
+/* Rearrange a structure constructor so the elements are in the specified
+   order.  Also insert NULL entries if necessary.  */
+
+static void
+formalize_structure_cons (gfc_expr *expr)
+{
+  gfc_constructor_base base = NULL;
+  gfc_constructor *cur;
+  gfc_component *order;
+
+  /* Constructor is already formalized.  */
+  cur = gfc_constructor_first (expr->value.constructor);
+  if (!cur || cur->n.component == NULL)
+    return;
+
+  for (order = expr->ts.u.derived->components; order; order = order->next)
+    {
+      cur = find_con_by_component (order, expr->value.constructor);
+      if (cur)
+	gfc_constructor_append_expr (&base, cur->expr, &cur->expr->where);
+      else
+	gfc_constructor_append_expr (&base, NULL, NULL);
+    }
+
+  /* For all what it's worth, one would expect
+       gfc_constructor_free (expr->value.constructor);
+     here. However, if the constructor is actually free'd,
+     hell breaks loose in the testsuite?!  */
+
+  expr->value.constructor = base;
+}
+
+
+/* Make sure an initialization expression is in normalized form, i.e., all
+   elements of the constructors are in the correct order.  */
+
+static void
+formalize_init_expr (gfc_expr *expr)
+{
+  expr_t type;
+  gfc_constructor *c;
+
+  if (expr == NULL)
+    return;
+
+  type = expr->expr_type;
+  switch (type)
+    {
+    case EXPR_ARRAY:
+      for (c = gfc_constructor_first (expr->value.constructor);
+	   c; c = gfc_constructor_next (c))
+	formalize_init_expr (c->expr);
+
+    break;
+
+    case EXPR_STRUCTURE:
+      formalize_structure_cons (expr);
+      break;
+
+    default:
+      break;
+    }
+}
+
+
+/* Resolve symbol's initial value after all data statement.  */
+
+void
+gfc_formalize_init_value (gfc_symbol *sym)
+{
+  formalize_init_expr (sym->value);
+}
+
+
+/* Get the integer value into RET_AS and SECTION from AS and AR, and return
+   offset.  */
+ 
+void
+gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset)
+{
+  int i;
+  mpz_t delta;
+  mpz_t tmp;
+
+  mpz_set_si (*offset, 0);
+  mpz_init (tmp);
+  mpz_init_set_si (delta, 1);
+  for (i = 0; i < ar->dimen; i++)
+    {
+      mpz_init (section_index[i]);
+      switch (ar->dimen_type[i])
+	{
+	case DIMEN_ELEMENT:
+	case DIMEN_RANGE:
+	  if (ar->start[i])
+	    {
+	      mpz_sub (tmp, ar->start[i]->value.integer,
+		       ar->as->lower[i]->value.integer);
+	      mpz_mul (tmp, tmp, delta);
+	      mpz_add (*offset, tmp, *offset);
+	      mpz_set (section_index[i], ar->start[i]->value.integer);
+	    }
+	  else
+	      mpz_set (section_index[i], ar->as->lower[i]->value.integer);
+	  break;
+
+	case DIMEN_VECTOR:
+	  gfc_internal_error ("TODO: Vector sections in data statements");
+
+	default:
+	  gcc_unreachable ();
+	}
+
+      mpz_sub (tmp, ar->as->upper[i]->value.integer, 
+	       ar->as->lower[i]->value.integer);
+      mpz_add_ui (tmp, tmp, 1);
+      mpz_mul (delta, tmp, delta);
+    }
+
+  mpz_clear (tmp);
+  mpz_clear (delta);
+}
+
diff --git a/gcc/fortran/data.h b/gcc/fortran/data.h
new file mode 100644
index 000000000..a9687c454
--- /dev/null
+++ b/gcc/fortran/data.h
@@ -0,0 +1,23 @@
+/* Header for functions resolving DATA statements.
+   Copyright (C) 2007, 2008, 2010, 2011 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+void gfc_formalize_init_value (gfc_symbol *);
+void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *);
+gfc_try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t, mpz_t *);
+void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *);
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
new file mode 100644
index 000000000..32d689709
--- /dev/null
+++ b/gcc/fortran/decl.c
@@ -0,0 +1,8439 @@
+/* Declaration statement matcher
+   Copyright (C) 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+#include "match.h"
+#include "parse.h"
+#include "flags.h"
+#include "constructor.h"
+
+/* Macros to access allocate memory for gfc_data_variable,
+   gfc_data_value and gfc_data.  */
+#define gfc_get_data_variable() XCNEW (gfc_data_variable)
+#define gfc_get_data_value() XCNEW (gfc_data_value)
+#define gfc_get_data() XCNEW (gfc_data)
+
+
+/* This flag is set if an old-style length selector is matched
+   during a type-declaration statement.  */
+
+static int old_char_selector;
+
+/* When variables acquire types and attributes from a declaration
+   statement, they get them from the following static variables.  The
+   first part of a declaration sets these variables and the second
+   part copies these into symbol structures.  */
+
+static gfc_typespec current_ts;
+
+static symbol_attribute current_attr;
+static gfc_array_spec *current_as;
+static int colon_seen;
+
+/* The current binding label (if any).  */
+static char curr_binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
+/* Need to know how many identifiers are on the current data declaration
+   line in case we're given the BIND(C) attribute with a NAME= specifier.  */
+static int num_idents_on_line;
+/* Need to know if a NAME= specifier was found during gfc_match_bind_c so we
+   can supply a name if the curr_binding_label is nil and NAME= was not.  */
+static int has_name_equals = 0;
+
+/* Initializer of the previous enumerator.  */
+
+static gfc_expr *last_initializer;
+
+/* History of all the enumerators is maintained, so that
+   kind values of all the enumerators could be updated depending
+   upon the maximum initialized value.  */
+
+typedef struct enumerator_history
+{
+  gfc_symbol *sym;
+  gfc_expr *initializer;
+  struct enumerator_history *next;
+}
+enumerator_history;
+
+/* Header of enum history chain.  */
+
+static enumerator_history *enum_history = NULL;
+
+/* Pointer of enum history node containing largest initializer.  */
+
+static enumerator_history *max_enum = NULL;
+
+/* gfc_new_block points to the symbol of a newly matched block.  */
+
+gfc_symbol *gfc_new_block;
+
+bool gfc_matching_function;
+
+
+/********************* DATA statement subroutines *********************/
+
+static bool in_match_data = false;
+
+bool
+gfc_in_match_data (void)
+{
+  return in_match_data;
+}
+
+static void
+set_in_match_data (bool set_value)
+{
+  in_match_data = set_value;
+}
+
+/* Free a gfc_data_variable structure and everything beneath it.  */
+
+static void
+free_variable (gfc_data_variable *p)
+{
+  gfc_data_variable *q;
+
+  for (; p; p = q)
+    {
+      q = p->next;
+      gfc_free_expr (p->expr);
+      gfc_free_iterator (&p->iter, 0);
+      free_variable (p->list);
+      gfc_free (p);
+    }
+}
+
+
+/* Free a gfc_data_value structure and everything beneath it.  */
+
+static void
+free_value (gfc_data_value *p)
+{
+  gfc_data_value *q;
+
+  for (; p; p = q)
+    {
+      q = p->next;
+      mpz_clear (p->repeat);
+      gfc_free_expr (p->expr);
+      gfc_free (p);
+    }
+}
+
+
+/* Free a list of gfc_data structures.  */
+
+void
+gfc_free_data (gfc_data *p)
+{
+  gfc_data *q;
+
+  for (; p; p = q)
+    {
+      q = p->next;
+      free_variable (p->var);
+      free_value (p->value);
+      gfc_free (p);
+    }
+}
+
+
+/* Free all data in a namespace.  */
+
+static void
+gfc_free_data_all (gfc_namespace *ns)
+{
+  gfc_data *d;
+
+  for (;ns->data;)
+    {
+      d = ns->data->next;
+      gfc_free (ns->data);
+      ns->data = d;
+    }
+}
+
+
+static match var_element (gfc_data_variable *);
+
+/* Match a list of variables terminated by an iterator and a right
+   parenthesis.  */
+
+static match
+var_list (gfc_data_variable *parent)
+{
+  gfc_data_variable *tail, var;
+  match m;
+
+  m = var_element (&var);
+  if (m == MATCH_ERROR)
+    return MATCH_ERROR;
+  if (m == MATCH_NO)
+    goto syntax;
+
+  tail = gfc_get_data_variable ();
+  *tail = var;
+
+  parent->list = tail;
+
+  for (;;)
+    {
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+
+      m = gfc_match_iterator (&parent->iter, 1);
+      if (m == MATCH_YES)
+	break;
+      if (m == MATCH_ERROR)
+	return MATCH_ERROR;
+
+      m = var_element (&var);
+      if (m == MATCH_ERROR)
+	return MATCH_ERROR;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      tail->next = gfc_get_data_variable ();
+      tail = tail->next;
+
+      *tail = var;
+    }
+
+  if (gfc_match_char (')') != MATCH_YES)
+    goto syntax;
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_DATA);
+  return MATCH_ERROR;
+}
+
+
+/* Match a single element in a data variable list, which can be a
+   variable-iterator list.  */
+
+static match
+var_element (gfc_data_variable *new_var)
+{
+  match m;
+  gfc_symbol *sym;
+
+  memset (new_var, 0, sizeof (gfc_data_variable));
+
+  if (gfc_match_char ('(') == MATCH_YES)
+    return var_list (new_var);
+
+  m = gfc_match_variable (&new_var->expr, 0);
+  if (m != MATCH_YES)
+    return m;
+
+  sym = new_var->expr->symtree->n.sym;
+
+  /* Symbol should already have an associated type.  */
+  if (gfc_check_symbol_typed (sym, gfc_current_ns,
+			      false, gfc_current_locus) == FAILURE)
+    return MATCH_ERROR;
+
+  if (!sym->attr.function && gfc_current_ns->parent
+      && gfc_current_ns->parent == sym->ns)
+    {
+      gfc_error ("Host associated variable '%s' may not be in the DATA "
+		 "statement at %C", sym->name);
+      return MATCH_ERROR;
+    }
+
+  if (gfc_current_state () != COMP_BLOCK_DATA
+      && sym->attr.in_common
+      && gfc_notify_std (GFC_STD_GNU, "Extension: initialization of "
+			 "common block variable '%s' in DATA statement at %C",
+			 sym->name) == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_add_data (&sym->attr, sym->name, &new_var->expr->where) == FAILURE)
+    return MATCH_ERROR;
+
+  return MATCH_YES;
+}
+
+
+/* Match the top-level list of data variables.  */
+
+static match
+top_var_list (gfc_data *d)
+{
+  gfc_data_variable var, *tail, *new_var;
+  match m;
+
+  tail = NULL;
+
+  for (;;)
+    {
+      m = var_element (&var);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	return MATCH_ERROR;
+
+      new_var = gfc_get_data_variable ();
+      *new_var = var;
+
+      if (tail == NULL)
+	d->var = new_var;
+      else
+	tail->next = new_var;
+
+      tail = new_var;
+
+      if (gfc_match_char ('/') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_DATA);
+  gfc_free_data_all (gfc_current_ns);
+  return MATCH_ERROR;
+}
+
+
+static match
+match_data_constant (gfc_expr **result)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symbol *sym;
+  gfc_expr *expr;
+  match m;
+  locus old_loc;
+
+  m = gfc_match_literal_constant (&expr, 1);
+  if (m == MATCH_YES)
+    {
+      *result = expr;
+      return MATCH_YES;
+    }
+
+  if (m == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  m = gfc_match_null (result);
+  if (m != MATCH_NO)
+    return m;
+
+  old_loc = gfc_current_locus;
+
+  /* Should this be a structure component, try to match it
+     before matching a name.  */
+  m = gfc_match_rvalue (result);
+  if (m == MATCH_ERROR)
+    return m;
+
+  if (m == MATCH_YES && (*result)->expr_type == EXPR_STRUCTURE)
+    {
+      if (gfc_simplify_expr (*result, 0) == FAILURE)
+	m = MATCH_ERROR;
+      return m;
+    }
+
+  gfc_current_locus = old_loc;
+
+  m = gfc_match_name (name);
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_find_symbol (name, NULL, 1, &sym))
+    return MATCH_ERROR;
+
+  if (sym == NULL
+      || (sym->attr.flavor != FL_PARAMETER && sym->attr.flavor != FL_DERIVED))
+    {
+      gfc_error ("Symbol '%s' must be a PARAMETER in DATA statement at %C",
+		 name);
+      return MATCH_ERROR;
+    }
+  else if (sym->attr.flavor == FL_DERIVED)
+    return gfc_match_structure_constructor (sym, result, false);
+
+  /* Check to see if the value is an initialization array expression.  */
+  if (sym->value->expr_type == EXPR_ARRAY)
+    {
+      gfc_current_locus = old_loc;
+
+      m = gfc_match_init_expr (result);
+      if (m == MATCH_ERROR)
+	return m;
+
+      if (m == MATCH_YES)
+	{
+	  if (gfc_simplify_expr (*result, 0) == FAILURE)
+	    m = MATCH_ERROR;
+
+	  if ((*result)->expr_type == EXPR_CONSTANT)
+	    return m;
+          else
+	    {
+	      gfc_error ("Invalid initializer %s in Data statement at %C", name);
+	      return MATCH_ERROR;
+	    }
+	}
+    }
+
+  *result = gfc_copy_expr (sym->value);
+  return MATCH_YES;
+}
+
+
+/* Match a list of values in a DATA statement.  The leading '/' has
+   already been seen at this point.  */
+
+static match
+top_val_list (gfc_data *data)
+{
+  gfc_data_value *new_val, *tail;
+  gfc_expr *expr;
+  match m;
+
+  tail = NULL;
+
+  for (;;)
+    {
+      m = match_data_constant (&expr);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	return MATCH_ERROR;
+
+      new_val = gfc_get_data_value ();
+      mpz_init (new_val->repeat);
+
+      if (tail == NULL)
+	data->value = new_val;
+      else
+	tail->next = new_val;
+
+      tail = new_val;
+
+      if (expr->ts.type != BT_INTEGER || gfc_match_char ('*') != MATCH_YES)
+	{
+	  tail->expr = expr;
+	  mpz_set_ui (tail->repeat, 1);
+	}
+      else
+	{
+	  if (expr->ts.type == BT_INTEGER)
+	    mpz_set (tail->repeat, expr->value.integer);
+	  gfc_free_expr (expr);
+
+	  m = match_data_constant (&tail->expr);
+	  if (m == MATCH_NO)
+	    goto syntax;
+	  if (m == MATCH_ERROR)
+	    return MATCH_ERROR;
+	}
+
+      if (gfc_match_char ('/') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') == MATCH_NO)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_DATA);
+  gfc_free_data_all (gfc_current_ns);
+  return MATCH_ERROR;
+}
+
+
+/* Matches an old style initialization.  */
+
+static match
+match_old_style_init (const char *name)
+{
+  match m;
+  gfc_symtree *st;
+  gfc_symbol *sym;
+  gfc_data *newdata;
+
+  /* Set up data structure to hold initializers.  */
+  gfc_find_sym_tree (name, NULL, 0, &st);
+  sym = st->n.sym;
+
+  newdata = gfc_get_data ();
+  newdata->var = gfc_get_data_variable ();
+  newdata->var->expr = gfc_get_variable_expr (st);
+  newdata->where = gfc_current_locus;
+
+  /* Match initial value list. This also eats the terminal '/'.  */
+  m = top_val_list (newdata);
+  if (m != MATCH_YES)
+    {
+      gfc_free (newdata);
+      return m;
+    }
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("Initialization at %C is not allowed in a PURE procedure");
+      gfc_free (newdata);
+      return MATCH_ERROR;
+    }
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  /* Mark the variable as having appeared in a data statement.  */
+  if (gfc_add_data (&sym->attr, sym->name, &sym->declared_at) == FAILURE)
+    {
+      gfc_free (newdata);
+      return MATCH_ERROR;
+    }
+
+  /* Chain in namespace list of DATA initializers.  */
+  newdata->next = gfc_current_ns->data;
+  gfc_current_ns->data = newdata;
+
+  return m;
+}
+
+
+/* Match the stuff following a DATA statement. If ERROR_FLAG is set,
+   we are matching a DATA statement and are therefore issuing an error
+   if we encounter something unexpected, if not, we're trying to match
+   an old-style initialization expression of the form INTEGER I /2/.  */
+
+match
+gfc_match_data (void)
+{
+  gfc_data *new_data;
+  match m;
+
+  set_in_match_data (true);
+
+  for (;;)
+    {
+      new_data = gfc_get_data ();
+      new_data->where = gfc_current_locus;
+
+      m = top_var_list (new_data);
+      if (m != MATCH_YES)
+	goto cleanup;
+
+      m = top_val_list (new_data);
+      if (m != MATCH_YES)
+	goto cleanup;
+
+      new_data->next = gfc_current_ns->data;
+      gfc_current_ns->data = new_data;
+
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+
+      gfc_match_char (',');	/* Optional comma */
+    }
+
+  set_in_match_data (false);
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("DATA statement at %C is not allowed in a PURE procedure");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  return MATCH_YES;
+
+cleanup:
+  set_in_match_data (false);
+  gfc_free_data (new_data);
+  return MATCH_ERROR;
+}
+
+
+/************************ Declaration statements *********************/
+
+
+/* Auxilliary function to merge DIMENSION and CODIMENSION array specs.  */
+
+static void
+merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy)
+{
+  int i;
+
+  if (to->rank == 0 && from->rank > 0)
+    {
+      to->rank = from->rank;
+      to->type = from->type;
+      to->cray_pointee = from->cray_pointee;
+      to->cp_was_assumed = from->cp_was_assumed;
+
+      for (i = 0; i < to->corank; i++)
+	{
+	  to->lower[from->rank + i] = to->lower[i];
+	  to->upper[from->rank + i] = to->upper[i];
+	}
+      for (i = 0; i < from->rank; i++)
+	{
+	  if (copy)
+	    {
+	      to->lower[i] = gfc_copy_expr (from->lower[i]);
+	      to->upper[i] = gfc_copy_expr (from->upper[i]);
+	    }
+	  else
+	    {
+	      to->lower[i] = from->lower[i];
+	      to->upper[i] = from->upper[i];
+	    }
+	}
+    }
+  else if (to->corank == 0 && from->corank > 0)
+    {
+      to->corank = from->corank;
+      to->cotype = from->cotype;
+
+      for (i = 0; i < from->corank; i++)
+	{
+	  if (copy)
+	    {
+	      to->lower[to->rank + i] = gfc_copy_expr (from->lower[i]);
+	      to->upper[to->rank + i] = gfc_copy_expr (from->upper[i]);
+	    }
+	  else
+	    {
+	      to->lower[to->rank + i] = from->lower[i];
+	      to->upper[to->rank + i] = from->upper[i];
+	    }
+	}
+    }
+}
+
+
+/* Match an intent specification.  Since this can only happen after an
+   INTENT word, a legal intent-spec must follow.  */
+
+static sym_intent
+match_intent_spec (void)
+{
+
+  if (gfc_match (" ( in out )") == MATCH_YES)
+    return INTENT_INOUT;
+  if (gfc_match (" ( in )") == MATCH_YES)
+    return INTENT_IN;
+  if (gfc_match (" ( out )") == MATCH_YES)
+    return INTENT_OUT;
+
+  gfc_error ("Bad INTENT specification at %C");
+  return INTENT_UNKNOWN;
+}
+
+
+/* Matches a character length specification, which is either a
+   specification expression, '*', or ':'.  */
+
+static match
+char_len_param_value (gfc_expr **expr, bool *deferred)
+{
+  match m;
+
+  *expr = NULL;
+  *deferred = false;
+
+  if (gfc_match_char ('*') == MATCH_YES)
+    return MATCH_YES;
+
+  if (gfc_match_char (':') == MATCH_YES)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: deferred type "
+			  "parameter at %C") == FAILURE)
+	return MATCH_ERROR;
+
+      *deferred = true;
+
+      return MATCH_YES;
+    }
+
+  m = gfc_match_expr (expr);
+
+  if (m == MATCH_YES
+      && gfc_expr_check_typed (*expr, gfc_current_ns, false) == FAILURE)
+    return MATCH_ERROR;
+
+  if (m == MATCH_YES && (*expr)->expr_type == EXPR_FUNCTION)
+    {
+      if ((*expr)->value.function.actual
+	  && (*expr)->value.function.actual->expr->symtree)
+	{
+	  gfc_expr *e;
+	  e = (*expr)->value.function.actual->expr;
+	  if (e->symtree->n.sym->attr.flavor == FL_PROCEDURE
+	      && e->expr_type == EXPR_VARIABLE)
+	    {
+	      if (e->symtree->n.sym->ts.type == BT_UNKNOWN)
+		goto syntax;
+	      if (e->symtree->n.sym->ts.type == BT_CHARACTER
+		  && e->symtree->n.sym->ts.u.cl
+		  && e->symtree->n.sym->ts.u.cl->length->ts.type == BT_UNKNOWN)
+	        goto syntax;
+	    }
+	}
+    }
+  return m;
+
+syntax:
+  gfc_error ("Conflict in attributes of function argument at %C");
+  return MATCH_ERROR;
+}
+
+
+/* A character length is a '*' followed by a literal integer or a
+   char_len_param_value in parenthesis.  */
+
+static match
+match_char_length (gfc_expr **expr, bool *deferred)
+{
+  int length;
+  match m;
+
+  *deferred = false; 
+  m = gfc_match_char ('*');
+  if (m != MATCH_YES)
+    return m;
+
+  m = gfc_match_small_literal_int (&length, NULL);
+  if (m == MATCH_ERROR)
+    return m;
+
+  if (m == MATCH_YES)
+    {
+      if (gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: "
+			  "Old-style character length at %C") == FAILURE)
+	return MATCH_ERROR;
+      *expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, length);
+      return m;
+    }
+
+  if (gfc_match_char ('(') == MATCH_NO)
+    goto syntax;
+
+  m = char_len_param_value (expr, deferred);
+  if (m != MATCH_YES && gfc_matching_function)
+    {
+      gfc_undo_symbols ();
+      m = MATCH_YES;
+    }
+
+  if (m == MATCH_ERROR)
+    return m;
+  if (m == MATCH_NO)
+    goto syntax;
+
+  if (gfc_match_char (')') == MATCH_NO)
+    {
+      gfc_free_expr (*expr);
+      *expr = NULL;
+      goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in character length specification at %C");
+  return MATCH_ERROR;
+}
+
+
+/* Special subroutine for finding a symbol.  Check if the name is found
+   in the current name space.  If not, and we're compiling a function or
+   subroutine and the parent compilation unit is an interface, then check
+   to see if the name we've been given is the name of the interface
+   (located in another namespace).  */
+
+static int
+find_special (const char *name, gfc_symbol **result, bool allow_subroutine)
+{
+  gfc_state_data *s;
+  gfc_symtree *st;
+  int i;
+
+  i = gfc_get_sym_tree (name, NULL, &st, allow_subroutine);
+  if (i == 0)
+    {
+      *result = st ? st->n.sym : NULL;
+      goto end;
+    }
+
+  if (gfc_current_state () != COMP_SUBROUTINE
+      && gfc_current_state () != COMP_FUNCTION)
+    goto end;
+
+  s = gfc_state_stack->previous;
+  if (s == NULL)
+    goto end;
+
+  if (s->state != COMP_INTERFACE)
+    goto end;
+  if (s->sym == NULL)
+    goto end;		  /* Nameless interface.  */
+
+  if (strcmp (name, s->sym->name) == 0)
+    {
+      *result = s->sym;
+      return 0;
+    }
+
+end:
+  return i;
+}
+
+
+/* Special subroutine for getting a symbol node associated with a
+   procedure name, used in SUBROUTINE and FUNCTION statements.  The
+   symbol is created in the parent using with symtree node in the
+   child unit pointing to the symbol.  If the current namespace has no
+   parent, then the symbol is just created in the current unit.  */
+
+static int
+get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
+{
+  gfc_symtree *st;
+  gfc_symbol *sym;
+  int rc = 0;
+
+  /* Module functions have to be left in their own namespace because
+     they have potentially (almost certainly!) already been referenced.
+     In this sense, they are rather like external functions.  This is
+     fixed up in resolve.c(resolve_entries), where the symbol name-
+     space is set to point to the master function, so that the fake
+     result mechanism can work.  */
+  if (module_fcn_entry)
+    {
+      /* Present if entry is declared to be a module procedure.  */
+      rc = gfc_find_symbol (name, gfc_current_ns->parent, 0, result);
+
+      if (*result == NULL)
+	rc = gfc_get_symbol (name, NULL, result);
+      else if (!gfc_get_symbol (name, NULL, &sym) && sym
+		 && (*result)->ts.type == BT_UNKNOWN
+		 && sym->attr.flavor == FL_UNKNOWN)
+	/* Pick up the typespec for the entry, if declared in the function
+	   body.  Note that this symbol is FL_UNKNOWN because it will
+	   only have appeared in a type declaration.  The local symtree
+	   is set to point to the module symbol and a unique symtree
+	   to the local version.  This latter ensures a correct clearing
+	   of the symbols.  */
+	{
+	  /* If the ENTRY proceeds its specification, we need to ensure
+	     that this does not raise a "has no IMPLICIT type" error.  */
+	  if (sym->ts.type == BT_UNKNOWN)
+	    sym->attr.untyped = 1;
+
+	  (*result)->ts = sym->ts;
+
+	  /* Put the symbol in the procedure namespace so that, should
+	     the ENTRY precede its specification, the specification
+	     can be applied.  */
+	  (*result)->ns = gfc_current_ns;
+
+	  gfc_find_sym_tree (name, gfc_current_ns, 0, &st);
+	  st->n.sym = *result;
+	  st = gfc_get_unique_symtree (gfc_current_ns);
+	  st->n.sym = sym;
+	}
+    }
+  else
+    rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
+
+  if (rc)
+    return rc;
+
+  sym = *result;
+  gfc_current_ns->refs++;
+
+  if (sym && !sym->gfc_new && gfc_current_state () != COMP_INTERFACE)
+    {
+      /* Trap another encompassed procedure with the same name.  All
+	 these conditions are necessary to avoid picking up an entry
+	 whose name clashes with that of the encompassing procedure;
+	 this is handled using gsymbols to register unique,globally
+	 accessible names.  */
+      if (sym->attr.flavor != 0
+	  && sym->attr.proc != 0
+	  && (sym->attr.subroutine || sym->attr.function)
+	  && sym->attr.if_source != IFSRC_UNKNOWN)
+	gfc_error_now ("Procedure '%s' at %C is already defined at %L",
+		       name, &sym->declared_at);
+
+      /* Trap a procedure with a name the same as interface in the
+	 encompassing scope.  */
+      if (sym->attr.generic != 0
+	  && (sym->attr.subroutine || sym->attr.function)
+	  && !sym->attr.mod_proc)
+	gfc_error_now ("Name '%s' at %C is already defined"
+		       " as a generic interface at %L",
+		       name, &sym->declared_at);
+
+      /* Trap declarations of attributes in encompassing scope.  The
+	 signature for this is that ts.kind is set.  Legitimate
+	 references only set ts.type.  */
+      if (sym->ts.kind != 0
+	  && !sym->attr.implicit_type
+	  && sym->attr.proc == 0
+	  && gfc_current_ns->parent != NULL
+	  && sym->attr.access == 0
+	  && !module_fcn_entry)
+	gfc_error_now ("Procedure '%s' at %C has an explicit interface "
+		       "and must not have attributes declared at %L",
+		       name, &sym->declared_at);
+    }
+
+  if (gfc_current_ns->parent == NULL || *result == NULL)
+    return rc;
+
+  /* Module function entries will already have a symtree in
+     the current namespace but will need one at module level.  */
+  if (module_fcn_entry)
+    {
+      /* Present if entry is declared to be a module procedure.  */
+      rc = gfc_find_sym_tree (name, gfc_current_ns->parent, 0, &st);
+      if (st == NULL)
+	st = gfc_new_symtree (&gfc_current_ns->parent->sym_root, name);
+    }
+  else
+    st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
+
+  st->n.sym = sym;
+  sym->refs++;
+
+  /* See if the procedure should be a module procedure.  */
+
+  if (((sym->ns->proc_name != NULL
+		&& sym->ns->proc_name->attr.flavor == FL_MODULE
+		&& sym->attr.proc != PROC_MODULE)
+	    || (module_fcn_entry && sym->attr.proc != PROC_MODULE))
+	&& gfc_add_procedure (&sym->attr, PROC_MODULE,
+			      sym->name, NULL) == FAILURE)
+    rc = 2;
+
+  return rc;
+}
+
+
+/* Verify that the given symbol representing a parameter is C
+   interoperable, by checking to see if it was marked as such after
+   its declaration.  If the given symbol is not interoperable, a
+   warning is reported, thus removing the need to return the status to
+   the calling function.  The standard does not require the user use
+   one of the iso_c_binding named constants to declare an
+   interoperable parameter, but we can't be sure if the param is C
+   interop or not if the user doesn't.  For example, integer(4) may be
+   legal Fortran, but doesn't have meaning in C.  It may interop with
+   a number of the C types, which causes a problem because the
+   compiler can't know which one.  This code is almost certainly not
+   portable, and the user will get what they deserve if the C type
+   across platforms isn't always interoperable with integer(4).  If
+   the user had used something like integer(c_int) or integer(c_long),
+   the compiler could have automatically handled the varying sizes
+   across platforms.  */
+
+gfc_try
+verify_c_interop_param (gfc_symbol *sym)
+{
+  int is_c_interop = 0;
+  gfc_try retval = SUCCESS;
+
+  /* We check implicitly typed variables in symbol.c:gfc_set_default_type().
+     Don't repeat the checks here.  */
+  if (sym->attr.implicit_type)
+    return SUCCESS;
+  
+  /* For subroutines or functions that are passed to a BIND(C) procedure,
+     they're interoperable if they're BIND(C) and their params are all
+     interoperable.  */
+  if (sym->attr.flavor == FL_PROCEDURE)
+    {
+      if (sym->attr.is_bind_c == 0)
+        {
+          gfc_error_now ("Procedure '%s' at %L must have the BIND(C) "
+                         "attribute to be C interoperable", sym->name,
+                         &(sym->declared_at));
+                         
+          return FAILURE;
+        }
+      else
+        {
+          if (sym->attr.is_c_interop == 1)
+            /* We've already checked this procedure; don't check it again.  */
+            return SUCCESS;
+          else
+            return verify_bind_c_sym (sym, &(sym->ts), sym->attr.in_common,
+                                      sym->common_block);
+        }
+    }
+  
+  /* See if we've stored a reference to a procedure that owns sym.  */
+  if (sym->ns != NULL && sym->ns->proc_name != NULL)
+    {
+      if (sym->ns->proc_name->attr.is_bind_c == 1)
+	{
+	  is_c_interop =
+	    (verify_c_interop (&(sym->ts))
+	     == SUCCESS ? 1 : 0);
+
+	  if (is_c_interop != 1)
+	    {
+	      /* Make personalized messages to give better feedback.  */
+	      if (sym->ts.type == BT_DERIVED)
+		gfc_error ("Type '%s' at %L is a parameter to the BIND(C) "
+			   "procedure '%s' but is not C interoperable "
+			   "because derived type '%s' is not C interoperable",
+			   sym->name, &(sym->declared_at),
+			   sym->ns->proc_name->name, 
+			   sym->ts.u.derived->name);
+	      else
+		gfc_warning ("Variable '%s' at %L is a parameter to the "
+			     "BIND(C) procedure '%s' but may not be C "
+			     "interoperable",
+			     sym->name, &(sym->declared_at),
+			     sym->ns->proc_name->name);
+	    }
+
+          /* Character strings are only C interoperable if they have a
+             length of 1.  */
+          if (sym->ts.type == BT_CHARACTER)
+	    {
+	      gfc_charlen *cl = sym->ts.u.cl;
+	      if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT
+                  || mpz_cmp_si (cl->length->value.integer, 1) != 0)
+		{
+		  gfc_error ("Character argument '%s' at %L "
+			     "must be length 1 because "
+                             "procedure '%s' is BIND(C)",
+			     sym->name, &sym->declared_at,
+                             sym->ns->proc_name->name);
+		  retval = FAILURE;
+		}
+	    }
+
+	  /* We have to make sure that any param to a bind(c) routine does
+	     not have the allocatable, pointer, or optional attributes,
+	     according to J3/04-007, section 5.1.  */
+	  if (sym->attr.allocatable == 1)
+	    {
+	      gfc_error ("Variable '%s' at %L cannot have the "
+			 "ALLOCATABLE attribute because procedure '%s'"
+			 " is BIND(C)", sym->name, &(sym->declared_at),
+			 sym->ns->proc_name->name);
+	      retval = FAILURE;
+	    }
+
+	  if (sym->attr.pointer == 1)
+	    {
+	      gfc_error ("Variable '%s' at %L cannot have the "
+			 "POINTER attribute because procedure '%s'"
+			 " is BIND(C)", sym->name, &(sym->declared_at),
+			 sym->ns->proc_name->name);
+	      retval = FAILURE;
+	    }
+
+	  if (sym->attr.optional == 1)
+	    {
+	      gfc_error ("Variable '%s' at %L cannot have the "
+			 "OPTIONAL attribute because procedure '%s'"
+			 " is BIND(C)", sym->name, &(sym->declared_at),
+			 sym->ns->proc_name->name);
+	      retval = FAILURE;
+	    }
+
+          /* Make sure that if it has the dimension attribute, that it is
+	     either assumed size or explicit shape.  */
+	  if (sym->as != NULL)
+	    {
+	      if (sym->as->type == AS_ASSUMED_SHAPE)
+		{
+		  gfc_error ("Assumed-shape array '%s' at %L cannot be an "
+			     "argument to the procedure '%s' at %L because "
+			     "the procedure is BIND(C)", sym->name,
+			     &(sym->declared_at), sym->ns->proc_name->name,
+			     &(sym->ns->proc_name->declared_at));
+		  retval = FAILURE;
+		}
+
+	      if (sym->as->type == AS_DEFERRED)
+		{
+		  gfc_error ("Deferred-shape array '%s' at %L cannot be an "
+			     "argument to the procedure '%s' at %L because "
+			     "the procedure is BIND(C)", sym->name,
+			     &(sym->declared_at), sym->ns->proc_name->name,
+ 			     &(sym->ns->proc_name->declared_at));
+		  retval = FAILURE;
+		}
+	  }
+	}
+    }
+
+  return retval;
+}
+
+
+
+/* Function called by variable_decl() that adds a name to the symbol table.  */
+
+static gfc_try
+build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
+	   gfc_array_spec **as, locus *var_locus)
+{
+  symbol_attribute attr;
+  gfc_symbol *sym;
+
+  if (gfc_get_symbol (name, NULL, &sym))
+    return FAILURE;
+
+  /* Start updating the symbol table.  Add basic type attribute if present.  */
+  if (current_ts.type != BT_UNKNOWN
+      && (sym->attr.implicit_type == 0
+	  || !gfc_compare_types (&sym->ts, &current_ts))
+      && gfc_add_type (sym, &current_ts, var_locus) == FAILURE)
+    return FAILURE;
+
+  if (sym->ts.type == BT_CHARACTER)
+    {
+      sym->ts.u.cl = cl;
+      sym->ts.deferred = cl_deferred;
+    }
+
+  /* Add dimension attribute if present.  */
+  if (gfc_set_array_spec (sym, *as, var_locus) == FAILURE)
+    return FAILURE;
+  *as = NULL;
+
+  /* Add attribute to symbol.  The copy is so that we can reset the
+     dimension attribute.  */
+  attr = current_attr;
+  attr.dimension = 0;
+  attr.codimension = 0;
+
+  if (gfc_copy_attr (&sym->attr, &attr, var_locus) == FAILURE)
+    return FAILURE;
+
+  /* Finish any work that may need to be done for the binding label,
+     if it's a bind(c).  The bind(c) attr is found before the symbol
+     is made, and before the symbol name (for data decls), so the
+     current_ts is holding the binding label, or nothing if the
+     name= attr wasn't given.  Therefore, test here if we're dealing
+     with a bind(c) and make sure the binding label is set correctly.  */
+  if (sym->attr.is_bind_c == 1)
+    {
+      if (sym->binding_label[0] == '\0')
+        {
+	  /* Set the binding label and verify that if a NAME= was specified
+	     then only one identifier was in the entity-decl-list.  */
+	  if (set_binding_label (sym->binding_label, sym->name,
+				 num_idents_on_line) == FAILURE)
+            return FAILURE;
+        }
+    }
+
+  /* See if we know we're in a common block, and if it's a bind(c)
+     common then we need to make sure we're an interoperable type.  */
+  if (sym->attr.in_common == 1)
+    {
+      /* Test the common block object.  */
+      if (sym->common_block != NULL && sym->common_block->is_bind_c == 1
+          && sym->ts.is_c_interop != 1)
+        {
+          gfc_error_now ("Variable '%s' in common block '%s' at %C "
+                         "must be declared with a C interoperable "
+                         "kind since common block '%s' is BIND(C)",
+                         sym->name, sym->common_block->name,
+                         sym->common_block->name);
+          gfc_clear_error ();
+        }
+    }
+
+  sym->attr.implied_index = 0;
+
+  if (sym->ts.type == BT_CLASS)
+    return gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false);
+
+  return SUCCESS;
+}
+
+
+/* Set character constant to the given length. The constant will be padded or
+   truncated.  If we're inside an array constructor without a typespec, we
+   additionally check that all elements have the same length; check_len -1
+   means no checking.  */
+
+void
+gfc_set_constant_character_len (int len, gfc_expr *expr, int check_len)
+{
+  gfc_char_t *s;
+  int slen;
+
+  gcc_assert (expr->expr_type == EXPR_CONSTANT);
+  gcc_assert (expr->ts.type == BT_CHARACTER);
+
+  slen = expr->value.character.length;
+  if (len != slen)
+    {
+      s = gfc_get_wide_string (len + 1);
+      memcpy (s, expr->value.character.string,
+	      MIN (len, slen) * sizeof (gfc_char_t));
+      if (len > slen)
+	gfc_wide_memset (&s[slen], ' ', len - slen);
+
+      if (gfc_option.warn_character_truncation && slen > len)
+	gfc_warning_now ("CHARACTER expression at %L is being truncated "
+			 "(%d/%d)", &expr->where, slen, len);
+
+      /* Apply the standard by 'hand' otherwise it gets cleared for
+	 initializers.  */
+      if (check_len != -1 && slen != check_len
+          && !(gfc_option.allow_std & GFC_STD_GNU))
+	gfc_error_now ("The CHARACTER elements of the array constructor "
+		       "at %L must have the same length (%d/%d)",
+			&expr->where, slen, check_len);
+
+      s[len] = '\0';
+      gfc_free (expr->value.character.string);
+      expr->value.character.string = s;
+      expr->value.character.length = len;
+    }
+}
+
+
+/* Function to create and update the enumerator history
+   using the information passed as arguments.
+   Pointer "max_enum" is also updated, to point to
+   enum history node containing largest initializer.
+
+   SYM points to the symbol node of enumerator.
+   INIT points to its enumerator value.  */
+
+static void
+create_enum_history (gfc_symbol *sym, gfc_expr *init)
+{
+  enumerator_history *new_enum_history;
+  gcc_assert (sym != NULL && init != NULL);
+
+  new_enum_history = XCNEW (enumerator_history);
+
+  new_enum_history->sym = sym;
+  new_enum_history->initializer = init;
+  new_enum_history->next = NULL;
+
+  if (enum_history == NULL)
+    {
+      enum_history = new_enum_history;
+      max_enum = enum_history;
+    }
+  else
+    {
+      new_enum_history->next = enum_history;
+      enum_history = new_enum_history;
+
+      if (mpz_cmp (max_enum->initializer->value.integer,
+		   new_enum_history->initializer->value.integer) < 0)
+	max_enum = new_enum_history;
+    }
+}
+
+
+/* Function to free enum kind history.  */
+
+void
+gfc_free_enum_history (void)
+{
+  enumerator_history *current = enum_history;
+  enumerator_history *next;
+
+  while (current != NULL)
+    {
+      next = current->next;
+      gfc_free (current);
+      current = next;
+    }
+  max_enum = NULL;
+  enum_history = NULL;
+}
+
+
+/* Function called by variable_decl() that adds an initialization
+   expression to a symbol.  */
+
+static gfc_try
+add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
+{
+  symbol_attribute attr;
+  gfc_symbol *sym;
+  gfc_expr *init;
+
+  init = *initp;
+  if (find_special (name, &sym, false))
+    return FAILURE;
+
+  attr = sym->attr;
+
+  /* If this symbol is confirming an implicit parameter type,
+     then an initialization expression is not allowed.  */
+  if (attr.flavor == FL_PARAMETER
+      && sym->value != NULL
+      && *initp != NULL)
+    {
+      gfc_error ("Initializer not allowed for PARAMETER '%s' at %C",
+		 sym->name);
+      return FAILURE;
+    }
+
+  if (init == NULL)
+    {
+      /* An initializer is required for PARAMETER declarations.  */
+      if (attr.flavor == FL_PARAMETER)
+	{
+	  gfc_error ("PARAMETER at %L is missing an initializer", var_locus);
+	  return FAILURE;
+	}
+    }
+  else
+    {
+      /* If a variable appears in a DATA block, it cannot have an
+	 initializer.  */
+      if (sym->attr.data)
+	{
+	  gfc_error ("Variable '%s' at %C with an initializer already "
+		     "appears in a DATA statement", sym->name);
+	  return FAILURE;
+	}
+
+      /* Check if the assignment can happen. This has to be put off
+	 until later for derived type variables and procedure pointers.  */
+      if (sym->ts.type != BT_DERIVED && init->ts.type != BT_DERIVED
+	  && sym->ts.type != BT_CLASS && init->ts.type != BT_CLASS
+	  && !sym->attr.proc_pointer 
+	  && gfc_check_assign_symbol (sym, init) == FAILURE)
+	return FAILURE;
+
+      if (sym->ts.type == BT_CHARACTER && sym->ts.u.cl
+	    && init->ts.type == BT_CHARACTER)
+	{
+	  /* Update symbol character length according initializer.  */
+	  if (gfc_check_assign_symbol (sym, init) == FAILURE)
+	    return FAILURE;
+
+	  if (sym->ts.u.cl->length == NULL)
+	    {
+	      int clen;
+	      /* If there are multiple CHARACTER variables declared on the
+		 same line, we don't want them to share the same length.  */
+	      sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+
+	      if (sym->attr.flavor == FL_PARAMETER)
+		{
+		  if (init->expr_type == EXPR_CONSTANT)
+		    {
+		      clen = init->value.character.length;
+		      sym->ts.u.cl->length
+				= gfc_get_int_expr (gfc_default_integer_kind,
+						    NULL, clen);
+		    }
+		  else if (init->expr_type == EXPR_ARRAY)
+		    {
+		      gfc_constructor *c;
+		      c = gfc_constructor_first (init->value.constructor);
+		      clen = c->expr->value.character.length;
+		      sym->ts.u.cl->length
+				= gfc_get_int_expr (gfc_default_integer_kind,
+						    NULL, clen);
+		    }
+		  else if (init->ts.u.cl && init->ts.u.cl->length)
+		    sym->ts.u.cl->length =
+				gfc_copy_expr (sym->value->ts.u.cl->length);
+		}
+	    }
+	  /* Update initializer character length according symbol.  */
+	  else if (sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+	    {
+	      int len = mpz_get_si (sym->ts.u.cl->length->value.integer);
+
+	      if (init->expr_type == EXPR_CONSTANT)
+		gfc_set_constant_character_len (len, init, -1);
+	      else if (init->expr_type == EXPR_ARRAY)
+		{
+		  gfc_constructor *c;
+
+		  /* Build a new charlen to prevent simplification from
+		     deleting the length before it is resolved.  */
+		  init->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+		  init->ts.u.cl->length = gfc_copy_expr (sym->ts.u.cl->length);
+
+		  for (c = gfc_constructor_first (init->value.constructor);
+		       c; c = gfc_constructor_next (c))
+		    gfc_set_constant_character_len (len, c->expr, -1);
+		}
+	    }
+	}
+
+      /* If sym is implied-shape, set its upper bounds from init.  */
+      if (sym->attr.flavor == FL_PARAMETER && sym->attr.dimension
+	  && sym->as->type == AS_IMPLIED_SHAPE)
+	{
+	  int dim;
+
+	  if (init->rank == 0)
+	    {
+	      gfc_error ("Can't initialize implied-shape array at %L"
+			 " with scalar", &sym->declared_at);
+	      return FAILURE;
+	    }
+	  gcc_assert (sym->as->rank == init->rank);
+
+	  /* Shape should be present, we get an initialization expression.  */
+	  gcc_assert (init->shape);
+
+	  for (dim = 0; dim < sym->as->rank; ++dim)
+	    {
+	      int k;
+	      gfc_expr* lower;
+	      gfc_expr* e;
+	      
+	      lower = sym->as->lower[dim];
+	      if (lower->expr_type != EXPR_CONSTANT)
+		{
+		  gfc_error ("Non-constant lower bound in implied-shape"
+			     " declaration at %L", &lower->where);
+		  return FAILURE;
+		}
+
+	      /* All dimensions must be without upper bound.  */
+	      gcc_assert (!sym->as->upper[dim]);
+
+	      k = lower->ts.kind;
+	      e = gfc_get_constant_expr (BT_INTEGER, k, &sym->declared_at);
+	      mpz_add (e->value.integer,
+		       lower->value.integer, init->shape[dim]);
+	      mpz_sub_ui (e->value.integer, e->value.integer, 1);
+	      sym->as->upper[dim] = e;
+	    }
+
+	  sym->as->type = AS_EXPLICIT;
+	}
+
+      /* Need to check if the expression we initialized this
+	 to was one of the iso_c_binding named constants.  If so,
+	 and we're a parameter (constant), let it be iso_c.
+	 For example:
+	 integer(c_int), parameter :: my_int = c_int
+	 integer(my_int) :: my_int_2
+	 If we mark my_int as iso_c (since we can see it's value
+	 is equal to one of the named constants), then my_int_2
+	 will be considered C interoperable.  */
+      if (sym->ts.type != BT_CHARACTER && sym->ts.type != BT_DERIVED)
+	{
+	  sym->ts.is_iso_c |= init->ts.is_iso_c;
+	  sym->ts.is_c_interop |= init->ts.is_c_interop;
+	  /* attr bits needed for module files.  */
+	  sym->attr.is_iso_c |= init->ts.is_iso_c;
+	  sym->attr.is_c_interop |= init->ts.is_c_interop;
+	  if (init->ts.is_iso_c)
+	    sym->ts.f90_type = init->ts.f90_type;
+	}
+
+      /* Add initializer.  Make sure we keep the ranks sane.  */
+      if (sym->attr.dimension && init->rank == 0)
+	{
+	  mpz_t size;
+	  gfc_expr *array;
+	  int n;
+	  if (sym->attr.flavor == FL_PARAMETER
+		&& init->expr_type == EXPR_CONSTANT
+		&& spec_size (sym->as, &size) == SUCCESS
+		&& mpz_cmp_si (size, 0) > 0)
+	    {
+	      array = gfc_get_array_expr (init->ts.type, init->ts.kind,
+					  &init->where);
+	      for (n = 0; n < (int)mpz_get_si (size); n++)
+		gfc_constructor_append_expr (&array->value.constructor,
+					     n == 0
+						? init
+						: gfc_copy_expr (init),
+					     &init->where);
+		
+	      array->shape = gfc_get_shape (sym->as->rank);
+	      for (n = 0; n < sym->as->rank; n++)
+		spec_dimen_size (sym->as, n, &array->shape[n]);
+
+	      init = array;
+	      mpz_clear (size);
+	    }
+	  init->rank = sym->as->rank;
+	}
+
+      sym->value = init;
+      if (sym->attr.save == SAVE_NONE)
+	sym->attr.save = SAVE_IMPLICIT;
+      *initp = NULL;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Function called by variable_decl() that adds a name to a structure
+   being built.  */
+
+static gfc_try
+build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
+	      gfc_array_spec **as)
+{
+  gfc_component *c;
+  gfc_try t = SUCCESS;
+
+  /* F03:C438/C439. If the current symbol is of the same derived type that we're
+     constructing, it must have the pointer attribute.  */
+  if ((current_ts.type == BT_DERIVED || current_ts.type == BT_CLASS)
+      && current_ts.u.derived == gfc_current_block ()
+      && current_attr.pointer == 0)
+    {
+      gfc_error ("Component at %C must have the POINTER attribute");
+      return FAILURE;
+    }
+
+  if (gfc_current_block ()->attr.pointer && (*as)->rank != 0)
+    {
+      if ((*as)->type != AS_DEFERRED && (*as)->type != AS_EXPLICIT)
+	{
+	  gfc_error ("Array component of structure at %C must have explicit "
+		     "or deferred shape");
+	  return FAILURE;
+	}
+    }
+
+  if (gfc_add_component (gfc_current_block (), name, &c) == FAILURE)
+    return FAILURE;
+
+  c->ts = current_ts;
+  if (c->ts.type == BT_CHARACTER)
+    c->ts.u.cl = cl;
+  c->attr = current_attr;
+
+  c->initializer = *init;
+  *init = NULL;
+
+  c->as = *as;
+  if (c->as != NULL)
+    {
+      if (c->as->corank)
+	c->attr.codimension = 1;
+      if (c->as->rank)
+	c->attr.dimension = 1;
+    }
+  *as = NULL;
+
+  /* Should this ever get more complicated, combine with similar section
+     in add_init_expr_to_sym into a separate function.  */
+  if (c->ts.type == BT_CHARACTER && !c->attr.pointer && c->initializer && c->ts.u.cl
+      && c->ts.u.cl->length && c->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+    {
+      int len;
+
+      gcc_assert (c->ts.u.cl && c->ts.u.cl->length);
+      gcc_assert (c->ts.u.cl->length->expr_type == EXPR_CONSTANT);
+      gcc_assert (c->ts.u.cl->length->ts.type == BT_INTEGER);
+
+      len = mpz_get_si (c->ts.u.cl->length->value.integer);
+
+      if (c->initializer->expr_type == EXPR_CONSTANT)
+	gfc_set_constant_character_len (len, c->initializer, -1);
+      else if (mpz_cmp (c->ts.u.cl->length->value.integer,
+			c->initializer->ts.u.cl->length->value.integer))
+	{
+	  gfc_constructor *ctor;
+	  ctor = gfc_constructor_first (c->initializer->value.constructor);
+
+	  if (ctor)
+	    {
+	      int first_len;
+	      bool has_ts = (c->initializer->ts.u.cl
+			     && c->initializer->ts.u.cl->length_from_typespec);
+
+	      /* Remember the length of the first element for checking
+		 that all elements *in the constructor* have the same
+		 length.  This need not be the length of the LHS!  */
+	      gcc_assert (ctor->expr->expr_type == EXPR_CONSTANT);
+	      gcc_assert (ctor->expr->ts.type == BT_CHARACTER);
+	      first_len = ctor->expr->value.character.length;
+
+	      for ( ; ctor; ctor = gfc_constructor_next (ctor))
+		if (ctor->expr->expr_type == EXPR_CONSTANT)
+		{
+		  gfc_set_constant_character_len (len, ctor->expr,
+						  has_ts ? -1 : first_len);
+		  ctor->expr->ts.u.cl->length = gfc_copy_expr (c->ts.u.cl->length);
+		}
+	    }
+	}
+    }
+
+  /* Check array components.  */
+  if (!c->attr.dimension)
+    goto scalar;
+
+  if (c->attr.pointer)
+    {
+      if (c->as->type != AS_DEFERRED)
+	{
+	  gfc_error ("Pointer array component of structure at %C must have a "
+		     "deferred shape");
+	  t = FAILURE;
+	}
+    }
+  else if (c->attr.allocatable)
+    {
+      if (c->as->type != AS_DEFERRED)
+	{
+	  gfc_error ("Allocatable component of structure at %C must have a "
+		     "deferred shape");
+	  t = FAILURE;
+	}
+    }
+  else
+    {
+      if (c->as->type != AS_EXPLICIT)
+	{
+	  gfc_error ("Array component of structure at %C must have an "
+		     "explicit shape");
+	  t = FAILURE;
+	}
+    }
+
+scalar:
+  if (c->ts.type == BT_CLASS)
+    {
+      bool delayed = (gfc_state_stack->sym == c->ts.u.derived)
+		     || (!c->ts.u.derived->components
+			 && !c->ts.u.derived->attr.zero_comp);
+      return gfc_build_class_symbol (&c->ts, &c->attr, &c->as, delayed);
+    }
+
+  return t;
+}
+
+
+/* Match a 'NULL()', and possibly take care of some side effects.  */
+
+match
+gfc_match_null (gfc_expr **result)
+{
+  gfc_symbol *sym;
+  match m;
+
+  m = gfc_match (" null ( )");
+  if (m != MATCH_YES)
+    return m;
+
+  /* The NULL symbol now has to be/become an intrinsic function.  */
+  if (gfc_get_symbol ("null", NULL, &sym))
+    {
+      gfc_error ("NULL() initialization at %C is ambiguous");
+      return MATCH_ERROR;
+    }
+
+  gfc_intrinsic_symbol (sym);
+
+  if (sym->attr.proc != PROC_INTRINSIC
+      && (gfc_add_procedure (&sym->attr, PROC_INTRINSIC,
+			     sym->name, NULL) == FAILURE
+	  || gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE))
+    return MATCH_ERROR;
+
+  *result = gfc_get_null_expr (&gfc_current_locus);
+
+  return MATCH_YES;
+}
+
+
+/* Match the initialization expr for a data pointer or procedure pointer.  */
+
+static match
+match_pointer_init (gfc_expr **init, int procptr)
+{
+  match m;
+
+  if (gfc_pure (NULL) && gfc_state_stack->state != COMP_DERIVED)
+    {
+      gfc_error ("Initialization of pointer at %C is not allowed in "
+		 "a PURE procedure");
+      return MATCH_ERROR;
+    }
+
+  /* Match NULL() initilization.  */
+  m = gfc_match_null (init);
+  if (m != MATCH_NO)
+    return m;
+
+  /* Match non-NULL initialization.  */
+  gfc_matching_ptr_assignment = !procptr;
+  gfc_matching_procptr_assignment = procptr;
+  m = gfc_match_rvalue (init);
+  gfc_matching_ptr_assignment = 0;
+  gfc_matching_procptr_assignment = 0;
+  if (m == MATCH_ERROR)
+    return MATCH_ERROR;
+  else if (m == MATCH_NO)
+    {
+      gfc_error ("Error in pointer initialization at %C");
+      return MATCH_ERROR;
+    }
+
+  if (!procptr)
+    gfc_resolve_expr (*init);
+  
+  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: non-NULL pointer "
+		      "initialization at %C") == FAILURE)
+    return MATCH_ERROR;
+
+  return MATCH_YES;
+}
+
+
+/* Match a variable name with an optional initializer.  When this
+   subroutine is called, a variable is expected to be parsed next.
+   Depending on what is happening at the moment, updates either the
+   symbol table or the current interface.  */
+
+static match
+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;
+  bool cl_deferred;
+  locus var_locus;
+  match m;
+  gfc_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
+     is the name of the symbol.  */
+  m = gfc_match_name (name);
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  var_locus = gfc_current_locus;
+
+  /* Now we could see the optional array spec. or character length.  */
+  m = gfc_match_array_spec (&as, true, true);
+  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);
+  else if (current_as)
+    merge_array_spec (current_as, as, true);
+
+  /* At this point, we know for sure if the symbol is PARAMETER and can thus
+     determine (and check) whether it can be implied-shape.  If it
+     was parsed as assumed-size, change it because PARAMETERs can not
+     be assumed-size.  */
+  if (as)
+    {
+      if (as->type == AS_IMPLIED_SHAPE && current_attr.flavor != FL_PARAMETER)
+	{
+	  m = MATCH_ERROR;
+	  gfc_error ("Non-PARAMETER symbol '%s' at %L can't be implied-shape",
+		     name, &var_locus);
+	  goto cleanup;
+	}
+
+      if (as->type == AS_ASSUMED_SIZE && as->rank == 1
+	  && current_attr.flavor == FL_PARAMETER)
+	as->type = AS_IMPLIED_SHAPE;
+
+      if (as->type == AS_IMPLIED_SHAPE
+	  && gfc_notify_std (GFC_STD_F2008,
+			     "Fortran 2008: Implied-shape array at %L",
+			     &var_locus) == FAILURE)
+	{
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+    }
+
+  char_len = NULL;
+  cl = NULL;
+  cl_deferred = false;
+
+  if (current_ts.type == BT_CHARACTER)
+    {
+      switch (match_char_length (&char_len, &cl_deferred))
+	{
+	case MATCH_YES:
+	  cl = gfc_new_charlen (gfc_current_ns, NULL);
+
+	  cl->length = char_len;
+	  break;
+
+	/* Non-constant lengths need to be copied after the first
+	   element.  Also copy assumed lengths.  */
+	case MATCH_NO:
+	  if (elem > 1
+	      && (current_ts.u.cl->length == NULL
+		  || current_ts.u.cl->length->expr_type != EXPR_CONSTANT))
+	    {
+	      cl = gfc_new_charlen (gfc_current_ns, NULL);
+	      cl->length = gfc_copy_expr (current_ts.u.cl->length);
+	    }
+	  else
+	    cl = current_ts.u.cl;
+
+	  cl_deferred = current_ts.deferred;
+
+	  break;
+
+	case MATCH_ERROR:
+	  goto cleanup;
+	}
+    }
+
+  /*  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.u.cl = cl;
+	  sym->ts.u.derived = current_ts.u.derived;
+	  sym->ts.is_c_interop = current_ts.is_c_interop;
+	  sym->ts.is_iso_c = current_ts.is_iso_c;
+	  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);
+	}
+    }
+
+  /* Procedure pointer as function result.  */
+  if (gfc_current_state () == COMP_FUNCTION
+      && strcmp ("ppr@", gfc_current_block ()->name) == 0
+      && strcmp (name, gfc_current_block ()->ns->proc_name->name) == 0)
+    strcpy (name, "ppr@");
+
+  if (gfc_current_state () == COMP_FUNCTION
+      && strcmp (name, gfc_current_block ()->name) == 0
+      && gfc_current_block ()->result
+      && strcmp ("ppr@", gfc_current_block ()->result->name) == 0)
+    strcpy (name, "ppr@");
+
+  /* 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
+     perfectly legal:
+
+     integer, parameter :: i = huge(i)
+
+     This is only true for parameters or variables of a basic type.
+     For components of derived types, it is not true, so we don't
+     create a symbol for those yet.  If we fail to create the symbol,
+     bail out.  */
+  if (gfc_current_state () != COMP_DERIVED
+      && build_sym (name, cl, cl_deferred, &as, &var_locus) == FAILURE)
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  /* An interface body specifies all of the procedure's
+     characteristics and these shall be consistent with those
+     specified in the procedure definition, except that the interface
+     may specify a procedure that is not pure if the procedure is
+     defined to be pure(12.3.2).  */
+  if ((current_ts.type == BT_DERIVED || current_ts.type == BT_CLASS)
+      && gfc_current_ns->proc_name
+      && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
+      && current_ts.u.derived->ns != gfc_current_ns)
+    {
+      gfc_symtree *st;
+      st = gfc_find_symtree (gfc_current_ns->sym_root, current_ts.u.derived->name);
+      if (!(current_ts.u.derived->attr.imported
+		&& st != NULL
+		&& st->n.sym == current_ts.u.derived)
+	    && !gfc_current_ns->has_import_set)
+	{
+	    gfc_error ("the type of '%s' at %C has not been declared within the "
+		       "interface", name);
+	    m = MATCH_ERROR;
+	    goto cleanup;
+	}
+    }
+
+  /* In functions that have a RESULT variable defined, the function
+     name always refers to function calls.  Therefore, the name is
+     not allowed to appear in specification statements.  */
+  if (gfc_current_state () == COMP_FUNCTION
+      && gfc_current_block () != NULL
+      && gfc_current_block ()->result != NULL
+      && gfc_current_block ()->result != gfc_current_block ()
+      && strcmp (gfc_current_block ()->name, name) == 0)
+    {
+      gfc_error ("Function name '%s' not allowed at %C", name);
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  /* We allow old-style initializations of the form
+       integer i /2/, j(4) /3*3, 1/
+     (if no colon has been seen). These are different from data
+     statements in that initializers are only allowed to apply to the
+     variable immediately preceding, i.e.
+       integer i, j /1, 2/
+     is not allowed. Therefore we have to do some work manually, that
+     could otherwise be left to the matchers for DATA statements.  */
+
+  if (!colon_seen && gfc_match (" /") == MATCH_YES)
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: Old-style "
+			  "initialization at %C") == FAILURE)
+	return MATCH_ERROR;
+ 
+      return match_old_style_init (name);
+    }
+
+  /* The double colon must be present in order to have initializers.
+     Otherwise the statement is ambiguous with an assignment statement.  */
+  if (colon_seen)
+    {
+      if (gfc_match (" =>") == MATCH_YES)
+	{
+	  if (!current_attr.pointer)
+	    {
+	      gfc_error ("Initialization at %C isn't for a pointer variable");
+	      m = MATCH_ERROR;
+	      goto cleanup;
+	    }
+
+	  m = match_pointer_init (&initializer, 0);
+	  if (m != MATCH_YES)
+	    goto cleanup;
+	}
+      else if (gfc_match_char ('=') == MATCH_YES)
+	{
+	  if (current_attr.pointer)
+	    {
+	      gfc_error ("Pointer initialization at %C requires '=>', "
+			 "not '='");
+	      m = MATCH_ERROR;
+	      goto cleanup;
+	    }
+
+	  m = gfc_match_init_expr (&initializer);
+	  if (m == MATCH_NO)
+	    {
+	      gfc_error ("Expected an initialization expression at %C");
+	      m = MATCH_ERROR;
+	    }
+
+	  if (current_attr.flavor != FL_PARAMETER && gfc_pure (NULL)
+	      && gfc_state_stack->state != COMP_DERIVED)
+	    {
+	      gfc_error ("Initialization of variable at %C is not allowed in "
+			 "a PURE procedure");
+	      m = MATCH_ERROR;
+	    }
+
+	  if (m != MATCH_YES)
+	    goto cleanup;
+	}
+    }
+
+  if (initializer != NULL && current_attr.allocatable
+	&& gfc_current_state () == COMP_DERIVED)
+    {
+      gfc_error ("Initialization of allocatable component at %C is not "
+		 "allowed");
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  /* Add the initializer.  Note that it is fine if initializer is
+     NULL here, because we sometimes also need to check if a
+     declaration *must* have an initialization expression.  */
+  if (gfc_current_state () != COMP_DERIVED)
+    t = add_init_expr_to_sym (name, &initializer, &var_locus);
+  else
+    {
+      if (current_ts.type == BT_DERIVED
+	  && !current_attr.pointer && !initializer)
+	initializer = gfc_default_initializer (&current_ts);
+      t = build_struct (name, cl, &initializer, &as);
+    }
+
+  m = (t == SUCCESS) ? MATCH_YES : MATCH_ERROR;
+
+cleanup:
+  /* Free stuff up and return.  */
+  gfc_free_expr (initializer);
+  gfc_free_array_spec (as);
+
+  return m;
+}
+
+
+/* Match an extended-f77 "TYPESPEC*bytesize"-style kind specification.
+   This assumes that the byte size is equal to the kind number for
+   non-COMPLEX types, and equal to twice the kind number for COMPLEX.  */
+
+match
+gfc_match_old_kind_spec (gfc_typespec *ts)
+{
+  match m;
+  int original_kind;
+
+  if (gfc_match_char ('*') != MATCH_YES)
+    return MATCH_NO;
+
+  m = gfc_match_small_literal_int (&ts->kind, NULL);
+  if (m != MATCH_YES)
+    return MATCH_ERROR;
+
+  original_kind = ts->kind;
+
+  /* Massage the kind numbers for complex types.  */
+  if (ts->type == BT_COMPLEX)
+    {
+      if (ts->kind % 2)
+	{
+	  gfc_error ("Old-style type declaration %s*%d not supported at %C",
+		     gfc_basic_typename (ts->type), original_kind);
+	  return MATCH_ERROR;
+	}
+      ts->kind /= 2;
+    }
+
+  if (gfc_validate_kind (ts->type, ts->kind, true) < 0)
+    {
+      gfc_error ("Old-style type declaration %s*%d not supported at %C",
+		 gfc_basic_typename (ts->type), original_kind);
+      return MATCH_ERROR;
+    }
+
+  if (gfc_notify_std (GFC_STD_GNU, "Nonstandard type declaration %s*%d at %C",
+		      gfc_basic_typename (ts->type), original_kind) == FAILURE)
+    return MATCH_ERROR;
+
+  return MATCH_YES;
+}
+
+
+/* Match a kind specification.  Since kinds are generally optional, we
+   usually return MATCH_NO if something goes wrong.  If a "kind="
+   string is found, then we know we have an error.  */
+
+match
+gfc_match_kind_spec (gfc_typespec *ts, bool kind_expr_only)
+{
+  locus where, loc;
+  gfc_expr *e;
+  match m, n;
+  char c;
+  const char *msg;
+
+  m = MATCH_NO;
+  n = MATCH_YES;
+  e = NULL;
+
+  where = loc = gfc_current_locus;
+
+  if (kind_expr_only)
+    goto kind_expr;
+
+  if (gfc_match_char ('(') == MATCH_NO)
+    return MATCH_NO;
+
+  /* Also gobbles optional text.  */
+  if (gfc_match (" kind = ") == MATCH_YES)
+    m = MATCH_ERROR;
+
+  loc = gfc_current_locus;
+
+kind_expr:
+  n = gfc_match_init_expr (&e);
+
+  if (n != MATCH_YES)
+    {
+      if (gfc_matching_function)
+	{
+	  /* The function kind expression might include use associated or 
+	     imported parameters and try again after the specification
+	     expressions.....  */
+	  if (gfc_match_char (')') != MATCH_YES)
+	    {
+	      gfc_error ("Missing right parenthesis at %C");
+	      m = MATCH_ERROR;
+	      goto no_match;
+	    }
+
+	  gfc_free_expr (e);
+	  gfc_undo_symbols ();
+	  return MATCH_YES;
+	}
+      else
+	{
+	  /* ....or else, the match is real.  */
+	  if (n == MATCH_NO)
+	    gfc_error ("Expected initialization expression at %C");
+	  if (n != MATCH_YES)
+	    return MATCH_ERROR;
+	}
+    }
+
+  if (e->rank != 0)
+    {
+      gfc_error ("Expected scalar initialization expression at %C");
+      m = MATCH_ERROR;
+      goto no_match;
+    }
+
+  msg = gfc_extract_int (e, &ts->kind);
+
+  if (msg != NULL)
+    {
+      gfc_error (msg);
+      m = MATCH_ERROR;
+      goto no_match;
+    }
+
+  /* Before throwing away the expression, let's see if we had a
+     C interoperable kind (and store the fact).	 */
+  if (e->ts.is_c_interop == 1)
+    {
+      /* Mark this as c interoperable if being declared with one
+	 of the named constants from iso_c_binding.  */
+      ts->is_c_interop = e->ts.is_iso_c;
+      ts->f90_type = e->ts.f90_type;
+    }
+  
+  gfc_free_expr (e);
+  e = NULL;
+
+  /* Ignore errors to this point, if we've gotten here.  This means
+     we ignore the m=MATCH_ERROR from above.  */
+  if (gfc_validate_kind (ts->type, ts->kind, true) < 0)
+    {
+      gfc_error ("Kind %d not supported for type %s at %C", ts->kind,
+		 gfc_basic_typename (ts->type));
+      gfc_current_locus = where;
+      return MATCH_ERROR;
+    }
+
+  /* Warn if, e.g., c_int is used for a REAL variable, but not
+     if, e.g., c_double is used for COMPLEX as the standard
+     explicitly says that the kind type parameter for complex and real
+     variable is the same, i.e. c_float == c_float_complex.  */
+  if (ts->f90_type != BT_UNKNOWN && ts->f90_type != ts->type
+      && !((ts->f90_type == BT_REAL && ts->type == BT_COMPLEX)
+	   || (ts->f90_type == BT_COMPLEX && ts->type == BT_REAL)))
+    gfc_warning_now ("C kind type parameter is for type %s but type at %L "
+		     "is %s", gfc_basic_typename (ts->f90_type), &where,
+		     gfc_basic_typename (ts->type));
+
+  gfc_gobble_whitespace ();
+  if ((c = gfc_next_ascii_char ()) != ')'
+      && (ts->type != BT_CHARACTER || c != ','))
+    {
+      if (ts->type == BT_CHARACTER)
+	gfc_error ("Missing right parenthesis or comma at %C");
+      else
+	gfc_error ("Missing right parenthesis at %C");
+      m = MATCH_ERROR;
+    }
+  else
+     /* All tests passed.  */
+     m = MATCH_YES;
+
+  if(m == MATCH_ERROR)
+     gfc_current_locus = where;
+  
+  /* Return what we know from the test(s).  */
+  return m;
+
+no_match:
+  gfc_free_expr (e);
+  gfc_current_locus = where;
+  return m;
+}
+
+
+static match
+match_char_kind (int * kind, int * is_iso_c)
+{
+  locus where;
+  gfc_expr *e;
+  match m, n;
+  const char *msg;
+
+  m = MATCH_NO;
+  e = NULL;
+  where = gfc_current_locus;
+
+  n = gfc_match_init_expr (&e);
+
+  if (n != MATCH_YES && gfc_matching_function)
+    {
+      /* The expression might include use-associated or imported
+	 parameters and try again after the specification 
+	 expressions.  */
+      gfc_free_expr (e);
+      gfc_undo_symbols ();
+      return MATCH_YES;
+    }
+
+  if (n == MATCH_NO)
+    gfc_error ("Expected initialization expression at %C");
+  if (n != MATCH_YES)
+    return MATCH_ERROR;
+
+  if (e->rank != 0)
+    {
+      gfc_error ("Expected scalar initialization expression at %C");
+      m = MATCH_ERROR;
+      goto no_match;
+    }
+
+  msg = gfc_extract_int (e, kind);
+  *is_iso_c = e->ts.is_iso_c;
+  if (msg != NULL)
+    {
+      gfc_error (msg);
+      m = MATCH_ERROR;
+      goto no_match;
+    }
+
+  gfc_free_expr (e);
+
+  /* Ignore errors to this point, if we've gotten here.  This means
+     we ignore the m=MATCH_ERROR from above.  */
+  if (gfc_validate_kind (BT_CHARACTER, *kind, true) < 0)
+    {
+      gfc_error ("Kind %d is not supported for CHARACTER at %C", *kind);
+      m = MATCH_ERROR;
+    }
+  else
+     /* All tests passed.  */
+     m = MATCH_YES;
+
+  if (m == MATCH_ERROR)
+     gfc_current_locus = where;
+  
+  /* Return what we know from the test(s).  */
+  return m;
+
+no_match:
+  gfc_free_expr (e);
+  gfc_current_locus = where;
+  return m;
+}
+
+
+/* Match the various kind/length specifications in a CHARACTER
+   declaration.  We don't return MATCH_NO.  */
+
+match
+gfc_match_char_spec (gfc_typespec *ts)
+{
+  int kind, seen_length, is_iso_c;
+  gfc_charlen *cl;
+  gfc_expr *len;
+  match m;
+  bool deferred;
+
+  len = NULL;
+  seen_length = 0;
+  kind = 0;
+  is_iso_c = 0;
+  deferred = false;
+
+  /* Try the old-style specification first.  */
+  old_char_selector = 0;
+
+  m = match_char_length (&len, &deferred);
+  if (m != MATCH_NO)
+    {
+      if (m == MATCH_YES)
+	old_char_selector = 1;
+      seen_length = 1;
+      goto done;
+    }
+
+  m = gfc_match_char ('(');
+  if (m != MATCH_YES)
+    {
+      m = MATCH_YES;	/* Character without length is a single char.  */
+      goto done;
+    }
+
+  /* Try the weird case:  ( KIND = <int> [ , LEN = <len-param> ] ).  */
+  if (gfc_match (" kind =") == MATCH_YES)
+    {
+      m = match_char_kind (&kind, &is_iso_c);
+       
+      if (m == MATCH_ERROR)
+	goto done;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      if (gfc_match (" , len =") == MATCH_NO)
+	goto rparen;
+
+      m = char_len_param_value (&len, &deferred);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	goto done;
+      seen_length = 1;
+
+      goto rparen;
+    }
+
+  /* Try to match "LEN = <len-param>" or "LEN = <len-param>, KIND = <int>".  */
+  if (gfc_match (" len =") == MATCH_YES)
+    {
+      m = char_len_param_value (&len, &deferred);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	goto done;
+      seen_length = 1;
+
+      if (gfc_match_char (')') == MATCH_YES)
+	goto done;
+
+      if (gfc_match (" , kind =") != MATCH_YES)
+	goto syntax;
+
+      if (match_char_kind (&kind, &is_iso_c) == MATCH_ERROR)
+	goto done;
+
+      goto rparen;
+    }
+
+  /* Try to match ( <len-param> ) or ( <len-param> , [ KIND = ] <int> ).  */
+  m = char_len_param_value (&len, &deferred);
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
+    goto done;
+  seen_length = 1;
+
+  m = gfc_match_char (')');
+  if (m == MATCH_YES)
+    goto done;
+
+  if (gfc_match_char (',') != MATCH_YES)
+    goto syntax;
+
+  gfc_match (" kind =");	/* Gobble optional text.  */
+
+  m = match_char_kind (&kind, &is_iso_c);
+  if (m == MATCH_ERROR)
+    goto done;
+  if (m == MATCH_NO)
+    goto syntax;
+
+rparen:
+  /* Require a right-paren at this point.  */
+  m = gfc_match_char (')');
+  if (m == MATCH_YES)
+    goto done;
+
+syntax:
+  gfc_error ("Syntax error in CHARACTER declaration at %C");
+  m = MATCH_ERROR;
+  gfc_free_expr (len);
+  return m;
+
+done:
+  /* Deal with character functions after USE and IMPORT statements.  */
+  if (gfc_matching_function)
+    {
+      gfc_free_expr (len);
+      gfc_undo_symbols ();
+      return MATCH_YES;
+    }
+
+  if (m != MATCH_YES)
+    {
+      gfc_free_expr (len);
+      return m;
+    }
+
+  /* Do some final massaging of the length values.  */
+  cl = gfc_new_charlen (gfc_current_ns, NULL);
+
+  if (seen_length == 0)
+    cl->length = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+  else
+    cl->length = len;
+
+  ts->u.cl = cl;
+  ts->kind = kind == 0 ? gfc_default_character_kind : kind;
+  ts->deferred = deferred;
+
+  /* We have to know if it was a c interoperable kind so we can
+     do accurate type checking of bind(c) procs, etc.  */
+  if (kind != 0)
+    /* Mark this as c interoperable if being declared with one
+       of the named constants from iso_c_binding.  */
+    ts->is_c_interop = is_iso_c;
+  else if (len != NULL)
+    /* Here, we might have parsed something such as: character(c_char)
+       In this case, the parsing code above grabs the c_char when
+       looking for the length (line 1690, roughly).  it's the last
+       testcase for parsing the kind params of a character variable.
+       However, it's not actually the length.	 this seems like it
+       could be an error.  
+       To see if the user used a C interop kind, test the expr
+       of the so called length, and see if it's C interoperable.  */
+    ts->is_c_interop = len->ts.is_iso_c;
+  
+  return MATCH_YES;
+}
+
+
+/* Matches a declaration-type-spec (F03:R502).  If successful, sets the ts
+   structure to the matched specification.  This is necessary for FUNCTION and
+   IMPLICIT statements.
+
+   If implicit_flag is nonzero, then we don't check for the optional
+   kind specification.  Not doing so is needed for matching an IMPLICIT
+   statement correctly.  */
+
+match
+gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symbol *sym;
+  match m;
+  char c;
+  bool seen_deferred_kind, matched_type;
+
+  /* A belt and braces check that the typespec is correctly being treated
+     as a deferred characteristic association.  */
+  seen_deferred_kind = (gfc_current_state () == COMP_FUNCTION)
+			  && (gfc_current_block ()->result->ts.kind == -1)
+			  && (ts->kind == -1);
+  gfc_clear_ts (ts);
+  if (seen_deferred_kind)
+    ts->kind = -1;
+
+  /* Clear the current binding label, in case one is given.  */
+  curr_binding_label[0] = '\0';
+
+  if (gfc_match (" byte") == MATCH_YES)
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: BYTE type at %C")
+	  == FAILURE)
+	return MATCH_ERROR;
+
+      if (gfc_validate_kind (BT_INTEGER, 1, true) < 0)
+	{
+	  gfc_error ("BYTE type used at %C "
+		     "is not available on the target machine");
+	  return MATCH_ERROR;
+	}
+
+      ts->type = BT_INTEGER;
+      ts->kind = 1;
+      return MATCH_YES;
+    }
+
+
+  m = gfc_match (" type ( %n", name);
+  matched_type = (m == MATCH_YES);
+  
+  if ((matched_type && strcmp ("integer", name) == 0)
+      || (!matched_type && gfc_match (" integer") == MATCH_YES))
+    {
+      ts->type = BT_INTEGER;
+      ts->kind = gfc_default_integer_kind;
+      goto get_kind;
+    }
+
+  if ((matched_type && strcmp ("character", name) == 0)
+      || (!matched_type && gfc_match (" character") == MATCH_YES))
+    {
+      if (matched_type
+	  && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: TYPE with "
+			  "intrinsic-type-spec at %C") == FAILURE)
+	return MATCH_ERROR;
+
+      ts->type = BT_CHARACTER;
+      if (implicit_flag == 0)
+	m = gfc_match_char_spec (ts);
+      else
+	m = MATCH_YES;
+
+      if (matched_type && m == MATCH_YES && gfc_match_char (')') != MATCH_YES)
+	m = MATCH_ERROR;
+
+      return m;
+    }
+
+  if ((matched_type && strcmp ("real", name) == 0)
+      || (!matched_type && gfc_match (" real") == MATCH_YES))
+    {
+      ts->type = BT_REAL;
+      ts->kind = gfc_default_real_kind;
+      goto get_kind;
+    }
+
+  if ((matched_type
+       && (strcmp ("doubleprecision", name) == 0
+	   || (strcmp ("double", name) == 0
+	       && gfc_match (" precision") == MATCH_YES)))
+      || (!matched_type && gfc_match (" double precision") == MATCH_YES))
+    {
+      if (matched_type
+	  && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: TYPE with "
+			  "intrinsic-type-spec at %C") == FAILURE)
+	return MATCH_ERROR;
+      if (matched_type && gfc_match_char (')') != MATCH_YES)
+	return MATCH_ERROR;
+
+      ts->type = BT_REAL;
+      ts->kind = gfc_default_double_kind;
+      return MATCH_YES;
+    }
+
+  if ((matched_type && strcmp ("complex", name) == 0)
+      || (!matched_type && gfc_match (" complex") == MATCH_YES))
+    {
+      ts->type = BT_COMPLEX;
+      ts->kind = gfc_default_complex_kind;
+      goto get_kind;
+    }
+
+  if ((matched_type
+       && (strcmp ("doublecomplex", name) == 0
+	   || (strcmp ("double", name) == 0
+	       && gfc_match (" complex") == MATCH_YES)))
+      || (!matched_type && gfc_match (" double complex") == MATCH_YES))
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: DOUBLE COMPLEX at %C")
+	  == FAILURE)
+	return MATCH_ERROR;
+
+      if (matched_type
+	  && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: TYPE with "
+			  "intrinsic-type-spec at %C") == FAILURE)
+	return MATCH_ERROR;
+
+      if (matched_type && gfc_match_char (')') != MATCH_YES)
+	return MATCH_ERROR;
+
+      ts->type = BT_COMPLEX;
+      ts->kind = gfc_default_double_kind;
+      return MATCH_YES;
+    }
+
+  if ((matched_type && strcmp ("logical", name) == 0)
+      || (!matched_type && gfc_match (" logical") == MATCH_YES))
+    {
+      ts->type = BT_LOGICAL;
+      ts->kind = gfc_default_logical_kind;
+      goto get_kind;
+    }
+
+  if (matched_type)
+    m = gfc_match_char (')');
+
+  if (m == MATCH_YES)
+    ts->type = BT_DERIVED;
+  else
+    {
+      /* Match CLASS declarations.  */
+      m = gfc_match (" class ( * )");
+      if (m == MATCH_ERROR)
+	return MATCH_ERROR;
+      else if (m == MATCH_YES)
+	{
+	  gfc_fatal_error ("Unlimited polymorphism at %C not yet supported");
+	  return MATCH_ERROR;
+	}
+
+      m = gfc_match (" class ( %n )", name);
+      if (m != MATCH_YES)
+	return m;
+      ts->type = BT_CLASS;
+
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: CLASS statement at %C")
+			  == FAILURE)
+	return MATCH_ERROR;
+    }
+
+  /* Defer association of the derived type until the end of the
+     specification block.  However, if the derived type can be
+     found, add it to the typespec.  */  
+  if (gfc_matching_function)
+    {
+      ts->u.derived = NULL;
+      if (gfc_current_state () != COMP_INTERFACE
+	    && !gfc_find_symbol (name, NULL, 1, &sym) && sym)
+	ts->u.derived = sym;
+      return MATCH_YES;
+    }
+
+  /* Search for the name but allow the components to be defined later.  If
+     type = -1, this typespec has been seen in a function declaration but
+     the type could not be accessed at that point.  */
+  sym = NULL;
+  if (ts->kind != -1 && gfc_get_ha_symbol (name, &sym))
+    {
+      gfc_error ("Type name '%s' at %C is ambiguous", name);
+      return MATCH_ERROR;
+    }
+  else if (ts->kind == -1)
+    {
+      int iface = gfc_state_stack->previous->state != COMP_INTERFACE
+		    || gfc_current_ns->has_import_set;
+      if (gfc_find_symbol (name, NULL, iface, &sym))
+	{       
+	  gfc_error ("Type name '%s' at %C is ambiguous", name);
+	  return MATCH_ERROR;
+	}
+
+      ts->kind = 0;
+      if (sym == NULL)
+	return MATCH_NO;
+    }
+
+  if (sym->attr.flavor != FL_DERIVED
+      && gfc_add_flavor (&sym->attr, FL_DERIVED, sym->name, NULL) == FAILURE)
+    return MATCH_ERROR;
+
+  gfc_set_sym_referenced (sym);
+  ts->u.derived = sym;
+
+  return MATCH_YES;
+
+get_kind:
+  if (matched_type
+      && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: TYPE with "
+			 "intrinsic-type-spec at %C") == FAILURE)
+    return MATCH_ERROR;
+
+  /* For all types except double, derived and character, look for an
+     optional kind specifier.  MATCH_NO is actually OK at this point.  */
+  if (implicit_flag == 1)
+    {
+	if (matched_type && gfc_match_char (')') != MATCH_YES)
+	  return MATCH_ERROR;
+
+	return MATCH_YES;
+    }
+
+  if (gfc_current_form == FORM_FREE)
+    {
+      c = gfc_peek_ascii_char ();
+      if (!gfc_is_whitespace (c) && c != '*' && c != '('
+	  && c != ':' && c != ',')
+        {
+	  if (matched_type && c == ')')
+	    {
+	      gfc_next_ascii_char ();
+	      return MATCH_YES;
+	    }
+	  return MATCH_NO;
+	}
+    }
+
+  m = gfc_match_kind_spec (ts, false);
+  if (m == MATCH_NO && ts->type != BT_CHARACTER)
+    m = gfc_match_old_kind_spec (ts);
+
+  if (matched_type && gfc_match_char (')') != MATCH_YES)
+    return MATCH_ERROR;
+
+  /* Defer association of the KIND expression of function results
+     until after USE and IMPORT statements.  */
+  if ((gfc_current_state () == COMP_NONE && gfc_error_flag_test ())
+	 || gfc_matching_function)
+    return MATCH_YES;
+
+  if (m == MATCH_NO)
+    m = MATCH_YES;		/* No kind specifier found.  */
+
+  return m;
+}
+
+
+/* Match an IMPLICIT NONE statement.  Actually, this statement is
+   already matched in parse.c, or we would not end up here in the
+   first place.  So the only thing we need to check, is if there is
+   trailing garbage.  If not, the match is successful.  */
+
+match
+gfc_match_implicit_none (void)
+{
+  return (gfc_match_eos () == MATCH_YES) ? MATCH_YES : MATCH_NO;
+}
+
+
+/* Match the letter range(s) of an IMPLICIT statement.  */
+
+static match
+match_implicit_range (void)
+{
+  char c, c1, c2;
+  int inner;
+  locus cur_loc;
+
+  cur_loc = gfc_current_locus;
+
+  gfc_gobble_whitespace ();
+  c = gfc_next_ascii_char ();
+  if (c != '(')
+    {
+      gfc_error ("Missing character range in IMPLICIT at %C");
+      goto bad;
+    }
+
+  inner = 1;
+  while (inner)
+    {
+      gfc_gobble_whitespace ();
+      c1 = gfc_next_ascii_char ();
+      if (!ISALPHA (c1))
+	goto bad;
+
+      gfc_gobble_whitespace ();
+      c = gfc_next_ascii_char ();
+
+      switch (c)
+	{
+	case ')':
+	  inner = 0;		/* Fall through.  */
+
+	case ',':
+	  c2 = c1;
+	  break;
+
+	case '-':
+	  gfc_gobble_whitespace ();
+	  c2 = gfc_next_ascii_char ();
+	  if (!ISALPHA (c2))
+	    goto bad;
+
+	  gfc_gobble_whitespace ();
+	  c = gfc_next_ascii_char ();
+
+	  if ((c != ',') && (c != ')'))
+	    goto bad;
+	  if (c == ')')
+	    inner = 0;
+
+	  break;
+
+	default:
+	  goto bad;
+	}
+
+      if (c1 > c2)
+	{
+	  gfc_error ("Letters must be in alphabetic order in "
+		     "IMPLICIT statement at %C");
+	  goto bad;
+	}
+
+      /* See if we can add the newly matched range to the pending
+	 implicits from this IMPLICIT statement.  We do not check for
+	 conflicts with whatever earlier IMPLICIT statements may have
+	 set.  This is done when we've successfully finished matching
+	 the current one.  */
+      if (gfc_add_new_implicit_range (c1, c2) != SUCCESS)
+	goto bad;
+    }
+
+  return MATCH_YES;
+
+bad:
+  gfc_syntax_error (ST_IMPLICIT);
+
+  gfc_current_locus = cur_loc;
+  return MATCH_ERROR;
+}
+
+
+/* Match an IMPLICIT statement, storing the types for
+   gfc_set_implicit() if the statement is accepted by the parser.
+   There is a strange looking, but legal syntactic construction
+   possible.  It looks like:
+
+     IMPLICIT INTEGER (a-b) (c-d)
+
+   This is legal if "a-b" is a constant expression that happens to
+   equal one of the legal kinds for integers.  The real problem
+   happens with an implicit specification that looks like:
+
+     IMPLICIT INTEGER (a-b)
+
+   In this case, a typespec matcher that is "greedy" (as most of the
+   matchers are) gobbles the character range as a kindspec, leaving
+   nothing left.  We therefore have to go a bit more slowly in the
+   matching process by inhibiting the kindspec checking during
+   typespec matching and checking for a kind later.  */
+
+match
+gfc_match_implicit (void)
+{
+  gfc_typespec ts;
+  locus cur_loc;
+  char c;
+  match m;
+
+  gfc_clear_ts (&ts);
+
+  /* We don't allow empty implicit statements.  */
+  if (gfc_match_eos () == MATCH_YES)
+    {
+      gfc_error ("Empty IMPLICIT statement at %C");
+      return MATCH_ERROR;
+    }
+
+  do
+    {
+      /* First cleanup.  */
+      gfc_clear_new_implicit ();
+
+      /* A basic type is mandatory here.  */
+      m = gfc_match_decl_type_spec (&ts, 1);
+      if (m == MATCH_ERROR)
+	goto error;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      cur_loc = gfc_current_locus;
+      m = match_implicit_range ();
+
+      if (m == MATCH_YES)
+	{
+	  /* We may have <TYPE> (<RANGE>).  */
+	  gfc_gobble_whitespace ();
+	  c = gfc_next_ascii_char ();
+	  if ((c == '\n') || (c == ','))
+	    {
+	      /* Check for CHARACTER with no length parameter.  */
+	      if (ts.type == BT_CHARACTER && !ts.u.cl)
+		{
+		  ts.kind = gfc_default_character_kind;
+		  ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+		  ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+						      NULL, 1);
+		}
+
+	      /* Record the Successful match.  */
+	      if (gfc_merge_new_implicit (&ts) != SUCCESS)
+		return MATCH_ERROR;
+	      continue;
+	    }
+
+	  gfc_current_locus = cur_loc;
+	}
+
+      /* Discard the (incorrectly) matched range.  */
+      gfc_clear_new_implicit ();
+
+      /* Last chance -- check <TYPE> <SELECTOR> (<RANGE>).  */
+      if (ts.type == BT_CHARACTER)
+	m = gfc_match_char_spec (&ts);
+      else
+	{
+	  m = gfc_match_kind_spec (&ts, false);
+	  if (m == MATCH_NO)
+	    {
+	      m = gfc_match_old_kind_spec (&ts);
+	      if (m == MATCH_ERROR)
+		goto error;
+	      if (m == MATCH_NO)
+		goto syntax;
+	    }
+	}
+      if (m == MATCH_ERROR)
+	goto error;
+
+      m = match_implicit_range ();
+      if (m == MATCH_ERROR)
+	goto error;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      gfc_gobble_whitespace ();
+      c = gfc_next_ascii_char ();
+      if ((c != '\n') && (c != ','))
+	goto syntax;
+
+      if (gfc_merge_new_implicit (&ts) != SUCCESS)
+	return MATCH_ERROR;
+    }
+  while (c == ',');
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_IMPLICIT);
+
+error:
+  return MATCH_ERROR;
+}
+
+
+match
+gfc_match_import (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  match m;
+  gfc_symbol *sym;
+  gfc_symtree *st;
+
+  if (gfc_current_ns->proc_name == NULL
+      || gfc_current_ns->proc_name->attr.if_source != IFSRC_IFBODY)
+    {
+      gfc_error ("IMPORT statement at %C only permitted in "
+		 "an INTERFACE body");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: IMPORT statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_match_eos () == MATCH_YES)
+    {
+      /* All host variables should be imported.  */
+      gfc_current_ns->has_import_set = 1;
+      return MATCH_YES;
+    }
+
+  if (gfc_match (" ::") == MATCH_YES)
+    {
+      if (gfc_match_eos () == MATCH_YES)
+	{
+	   gfc_error ("Expecting list of named entities at %C");
+	   return MATCH_ERROR;
+	}
+    }
+
+  for(;;)
+    {
+      m = gfc_match (" %n", name);
+      switch (m)
+	{
+	case MATCH_YES:
+	  if (gfc_current_ns->parent !=  NULL
+	      && gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym))
+	    {
+	       gfc_error ("Type name '%s' at %C is ambiguous", name);
+	       return MATCH_ERROR;
+	    }
+	  else if (gfc_current_ns->proc_name->ns->parent !=  NULL
+		   && gfc_find_symbol (name,
+				       gfc_current_ns->proc_name->ns->parent,
+				       1, &sym))
+	    {
+	       gfc_error ("Type name '%s' at %C is ambiguous", name);
+	       return MATCH_ERROR;
+	    }
+
+	  if (sym == NULL)
+	    {
+	      gfc_error ("Cannot IMPORT '%s' from host scoping unit "
+			 "at %C - does not exist.", name);
+	      return MATCH_ERROR;
+	    }
+
+	  if (gfc_find_symtree (gfc_current_ns->sym_root,name))
+	    {
+	      gfc_warning ("'%s' is already IMPORTed from host scoping unit "
+			   "at %C.", name);
+	      goto next_item;
+	    }
+
+	  st = gfc_new_symtree (&gfc_current_ns->sym_root, sym->name);
+	  st->n.sym = sym;
+	  sym->refs++;
+	  sym->attr.imported = 1;
+
+	  goto next_item;
+
+	case MATCH_NO:
+	  break;
+
+	case MATCH_ERROR:
+	  return MATCH_ERROR;
+	}
+
+    next_item:
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in IMPORT statement at %C");
+  return MATCH_ERROR;
+}
+
+
+/* A minimal implementation of gfc_match without whitespace, escape
+   characters or variable arguments.  Returns true if the next
+   characters match the TARGET template exactly.  */
+
+static bool
+match_string_p (const char *target)
+{
+  const char *p;
+
+  for (p = target; *p; p++)
+    if ((char) gfc_next_ascii_char () != *p)
+      return false;
+  return true;
+}
+
+/* Matches an attribute specification including array specs.  If
+   successful, leaves the variables current_attr and current_as
+   holding the specification.  Also sets the colon_seen variable for
+   later use by matchers associated with initializations.
+
+   This subroutine is a little tricky in the sense that we don't know
+   if we really have an attr-spec until we hit the double colon.
+   Until that time, we can only return MATCH_NO.  This forces us to
+   check for duplicate specification at this level.  */
+
+static match
+match_attr_spec (void)
+{
+  /* Modifiers that can exist in a type statement.  */
+  typedef enum
+  { GFC_DECL_BEGIN = 0,
+    DECL_ALLOCATABLE = GFC_DECL_BEGIN, DECL_DIMENSION, DECL_EXTERNAL,
+    DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
+    DECL_PARAMETER, DECL_POINTER, DECL_PROTECTED, DECL_PRIVATE,
+    DECL_PUBLIC, DECL_SAVE, DECL_TARGET, DECL_VALUE, DECL_VOLATILE,
+    DECL_IS_BIND_C, DECL_CODIMENSION, DECL_ASYNCHRONOUS, DECL_CONTIGUOUS,
+    DECL_NONE, GFC_DECL_END /* Sentinel */
+  }
+  decl_types;
+
+/* GFC_DECL_END is the sentinel, index starts at 0.  */
+#define NUM_DECL GFC_DECL_END
+
+  locus start, seen_at[NUM_DECL];
+  int seen[NUM_DECL];
+  unsigned int d;
+  const char *attr;
+  match m;
+  gfc_try t;
+
+  gfc_clear_attr (&current_attr);
+  start = gfc_current_locus;
+
+  current_as = NULL;
+  colon_seen = 0;
+
+  /* See if we get all of the keywords up to the final double colon.  */
+  for (d = GFC_DECL_BEGIN; d != GFC_DECL_END; d++)
+    seen[d] = 0;
+
+  for (;;)
+    {
+      char ch;
+
+      d = DECL_NONE;
+      gfc_gobble_whitespace ();
+
+      ch = gfc_next_ascii_char ();
+      if (ch == ':')
+	{
+	  /* This is the successful exit condition for the loop.  */
+	  if (gfc_next_ascii_char () == ':')
+	    break;
+	}
+      else if (ch == ',')
+	{
+	  gfc_gobble_whitespace ();
+	  switch (gfc_peek_ascii_char ())
+	    {
+	    case 'a':
+	      gfc_next_ascii_char ();
+	      switch (gfc_next_ascii_char ())
+		{
+		case 'l':
+		  if (match_string_p ("locatable"))
+		    {
+		      /* Matched "allocatable".  */
+		      d = DECL_ALLOCATABLE;
+		    }
+		  break;
+
+		case 's':
+		  if (match_string_p ("ynchronous"))
+		    {
+		      /* Matched "asynchronous".  */
+		      d = DECL_ASYNCHRONOUS;
+		    }
+		  break;
+		}
+	      break;
+
+	    case 'b':
+	      /* Try and match the bind(c).  */
+	      m = gfc_match_bind_c (NULL, true);
+	      if (m == MATCH_YES)
+		d = DECL_IS_BIND_C;
+	      else if (m == MATCH_ERROR)
+		goto cleanup;
+	      break;
+
+	    case 'c':
+	      gfc_next_ascii_char ();
+	      if ('o' != gfc_next_ascii_char ())
+		break;
+	      switch (gfc_next_ascii_char ())
+		{
+		case 'd':
+		  if (match_string_p ("imension"))
+		    {
+		      d = DECL_CODIMENSION;
+		      break;
+		    }
+		case 'n':
+		  if (match_string_p ("tiguous"))
+		    {
+		      d = DECL_CONTIGUOUS;
+		      break;
+		    }
+		}
+	      break;
+
+	    case 'd':
+	      if (match_string_p ("dimension"))
+		d = DECL_DIMENSION;
+	      break;
+
+	    case 'e':
+	      if (match_string_p ("external"))
+		d = DECL_EXTERNAL;
+	      break;
+
+	    case 'i':
+	      if (match_string_p ("int"))
+		{
+		  ch = gfc_next_ascii_char ();
+		  if (ch == 'e')
+		    {
+		      if (match_string_p ("nt"))
+			{
+			  /* Matched "intent".  */
+			  /* TODO: Call match_intent_spec from here.  */
+			  if (gfc_match (" ( in out )") == MATCH_YES)
+			    d = DECL_INOUT;
+			  else if (gfc_match (" ( in )") == MATCH_YES)
+			    d = DECL_IN;
+			  else if (gfc_match (" ( out )") == MATCH_YES)
+			    d = DECL_OUT;
+			}
+		    }
+		  else if (ch == 'r')
+		    {
+		      if (match_string_p ("insic"))
+			{
+			  /* Matched "intrinsic".  */
+			  d = DECL_INTRINSIC;
+			}
+		    }
+		}
+	      break;
+
+	    case 'o':
+	      if (match_string_p ("optional"))
+		d = DECL_OPTIONAL;
+	      break;
+
+	    case 'p':
+	      gfc_next_ascii_char ();
+	      switch (gfc_next_ascii_char ())
+		{
+		case 'a':
+		  if (match_string_p ("rameter"))
+		    {
+		      /* Matched "parameter".  */
+		      d = DECL_PARAMETER;
+		    }
+		  break;
+
+		case 'o':
+		  if (match_string_p ("inter"))
+		    {
+		      /* Matched "pointer".  */
+		      d = DECL_POINTER;
+		    }
+		  break;
+
+		case 'r':
+		  ch = gfc_next_ascii_char ();
+		  if (ch == 'i')
+		    {
+		      if (match_string_p ("vate"))
+			{
+			  /* Matched "private".  */
+			  d = DECL_PRIVATE;
+			}
+		    }
+		  else if (ch == 'o')
+		    {
+		      if (match_string_p ("tected"))
+			{
+			  /* Matched "protected".  */
+			  d = DECL_PROTECTED;
+			}
+		    }
+		  break;
+
+		case 'u':
+		  if (match_string_p ("blic"))
+		    {
+		      /* Matched "public".  */
+		      d = DECL_PUBLIC;
+		    }
+		  break;
+		}
+	      break;
+
+	    case 's':
+	      if (match_string_p ("save"))
+		d = DECL_SAVE;
+	      break;
+
+	    case 't':
+	      if (match_string_p ("target"))
+		d = DECL_TARGET;
+	      break;
+
+	    case 'v':
+	      gfc_next_ascii_char ();
+	      ch = gfc_next_ascii_char ();
+	      if (ch == 'a')
+		{
+		  if (match_string_p ("lue"))
+		    {
+		      /* Matched "value".  */
+		      d = DECL_VALUE;
+		    }
+		}
+	      else if (ch == 'o')
+		{
+		  if (match_string_p ("latile"))
+		    {
+		      /* Matched "volatile".  */
+		      d = DECL_VOLATILE;
+		    }
+		}
+	      break;
+	    }
+	}
+
+      /* No double colon and no recognizable decl_type, so assume that
+	 we've been looking at something else the whole time.  */
+      if (d == DECL_NONE)
+	{
+	  m = MATCH_NO;
+	  goto cleanup;
+	}
+
+      /* Check to make sure any parens are paired up correctly.  */
+      if (gfc_match_parens () == MATCH_ERROR)
+	{
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+
+      seen[d]++;
+      seen_at[d] = gfc_current_locus;
+
+      if (d == DECL_DIMENSION || d == DECL_CODIMENSION)
+	{
+	  gfc_array_spec *as = NULL;
+
+	  m = gfc_match_array_spec (&as, d == DECL_DIMENSION,
+				    d == DECL_CODIMENSION);
+
+	  if (current_as == NULL)
+	    current_as = as;
+	  else if (m == MATCH_YES)
+	    {
+	      merge_array_spec (as, current_as, false);
+	      gfc_free (as);
+	    }
+
+	  if (m == MATCH_NO)
+	    {
+	      if (d == DECL_CODIMENSION)
+		gfc_error ("Missing codimension specification at %C");
+	      else
+		gfc_error ("Missing dimension specification at %C");
+	      m = MATCH_ERROR;
+	    }
+
+	  if (m == MATCH_ERROR)
+	    goto cleanup;
+	}
+    }
+
+  /* Since we've seen a double colon, we have to be looking at an
+     attr-spec.  This means that we can now issue errors.  */
+  for (d = GFC_DECL_BEGIN; d != GFC_DECL_END; d++)
+    if (seen[d] > 1)
+      {
+	switch (d)
+	  {
+	  case DECL_ALLOCATABLE:
+	    attr = "ALLOCATABLE";
+	    break;
+	  case DECL_ASYNCHRONOUS:
+	    attr = "ASYNCHRONOUS";
+	    break;
+	  case DECL_CODIMENSION:
+	    attr = "CODIMENSION";
+	    break;
+	  case DECL_CONTIGUOUS:
+	    attr = "CONTIGUOUS";
+	    break;
+	  case DECL_DIMENSION:
+	    attr = "DIMENSION";
+	    break;
+	  case DECL_EXTERNAL:
+	    attr = "EXTERNAL";
+	    break;
+	  case DECL_IN:
+	    attr = "INTENT (IN)";
+	    break;
+	  case DECL_OUT:
+	    attr = "INTENT (OUT)";
+	    break;
+	  case DECL_INOUT:
+	    attr = "INTENT (IN OUT)";
+	    break;
+	  case DECL_INTRINSIC:
+	    attr = "INTRINSIC";
+	    break;
+	  case DECL_OPTIONAL:
+	    attr = "OPTIONAL";
+	    break;
+	  case DECL_PARAMETER:
+	    attr = "PARAMETER";
+	    break;
+	  case DECL_POINTER:
+	    attr = "POINTER";
+	    break;
+	  case DECL_PROTECTED:
+	    attr = "PROTECTED";
+	    break;
+	  case DECL_PRIVATE:
+	    attr = "PRIVATE";
+	    break;
+	  case DECL_PUBLIC:
+	    attr = "PUBLIC";
+	    break;
+	  case DECL_SAVE:
+	    attr = "SAVE";
+	    break;
+	  case DECL_TARGET:
+	    attr = "TARGET";
+	    break;
+          case DECL_IS_BIND_C:
+            attr = "IS_BIND_C";
+            break;
+          case DECL_VALUE:
+            attr = "VALUE";
+            break;
+	  case DECL_VOLATILE:
+	    attr = "VOLATILE";
+	    break;
+	  default:
+	    attr = NULL;	/* This shouldn't happen.  */
+	  }
+
+	gfc_error ("Duplicate %s attribute at %L", attr, &seen_at[d]);
+	m = MATCH_ERROR;
+	goto cleanup;
+      }
+
+  /* Now that we've dealt with duplicate attributes, add the attributes
+     to the current attribute.  */
+  for (d = GFC_DECL_BEGIN; d != GFC_DECL_END; d++)
+    {
+      if (seen[d] == 0)
+	continue;
+
+      if (gfc_current_state () == COMP_DERIVED
+	  && d != DECL_DIMENSION && d != DECL_CODIMENSION
+	  && d != DECL_POINTER   && d != DECL_PRIVATE
+	  && d != DECL_PUBLIC && d != DECL_CONTIGUOUS && d != DECL_NONE)
+	{
+	  if (d == DECL_ALLOCATABLE)
+	    {
+	      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ALLOCATABLE "
+				  "attribute at %C in a TYPE definition")
+		  == FAILURE)
+		{
+		  m = MATCH_ERROR;
+		  goto cleanup;
+		}
+	    }
+	  else
+	    {
+	      gfc_error ("Attribute at %L is not allowed in a TYPE definition",
+			 &seen_at[d]);
+	      m = MATCH_ERROR;
+	      goto cleanup;
+	    }
+	}
+
+      if ((d == DECL_PRIVATE || d == DECL_PUBLIC)
+	  && gfc_current_state () != COMP_MODULE)
+	{
+	  if (d == DECL_PRIVATE)
+	    attr = "PRIVATE";
+	  else
+	    attr = "PUBLIC";
+	  if (gfc_current_state () == COMP_DERIVED
+	      && gfc_state_stack->previous
+	      && gfc_state_stack->previous->state == COMP_MODULE)
+	    {
+	      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Attribute %s "
+				  "at %L in a TYPE definition", attr,
+				  &seen_at[d])
+		  == FAILURE)
+		{
+		  m = MATCH_ERROR;
+		  goto cleanup;
+		}
+	    }
+	  else
+	    {
+	      gfc_error ("%s attribute at %L is not allowed outside of the "
+			 "specification part of a module", attr, &seen_at[d]);
+	      m = MATCH_ERROR;
+	      goto cleanup;
+	    }
+	}
+
+      switch (d)
+	{
+	case DECL_ALLOCATABLE:
+	  t = gfc_add_allocatable (&current_attr, &seen_at[d]);
+	  break;
+
+	case DECL_ASYNCHRONOUS:
+	  if (gfc_notify_std (GFC_STD_F2003,
+			      "Fortran 2003: ASYNCHRONOUS attribute at %C")
+	      == FAILURE)
+	    t = FAILURE;
+	  else
+	    t = gfc_add_asynchronous (&current_attr, NULL, &seen_at[d]);
+	  break;
+
+	case DECL_CODIMENSION:
+	  t = gfc_add_codimension (&current_attr, NULL, &seen_at[d]);
+	  break;
+
+	case DECL_CONTIGUOUS:
+	  if (gfc_notify_std (GFC_STD_F2008,
+			      "Fortran 2008: CONTIGUOUS attribute at %C")
+	      == FAILURE)
+	    t = FAILURE;
+	  else
+	    t = gfc_add_contiguous (&current_attr, NULL, &seen_at[d]);
+	  break;
+
+	case DECL_DIMENSION:
+	  t = gfc_add_dimension (&current_attr, NULL, &seen_at[d]);
+	  break;
+
+	case DECL_EXTERNAL:
+	  t = gfc_add_external (&current_attr, &seen_at[d]);
+	  break;
+
+	case DECL_IN:
+	  t = gfc_add_intent (&current_attr, INTENT_IN, &seen_at[d]);
+	  break;
+
+	case DECL_OUT:
+	  t = gfc_add_intent (&current_attr, INTENT_OUT, &seen_at[d]);
+	  break;
+
+	case DECL_INOUT:
+	  t = gfc_add_intent (&current_attr, INTENT_INOUT, &seen_at[d]);
+	  break;
+
+	case DECL_INTRINSIC:
+	  t = gfc_add_intrinsic (&current_attr, &seen_at[d]);
+	  break;
+
+	case DECL_OPTIONAL:
+	  t = gfc_add_optional (&current_attr, &seen_at[d]);
+	  break;
+
+	case DECL_PARAMETER:
+	  t = gfc_add_flavor (&current_attr, FL_PARAMETER, NULL, &seen_at[d]);
+	  break;
+
+	case DECL_POINTER:
+	  t = gfc_add_pointer (&current_attr, &seen_at[d]);
+	  break;
+
+	case DECL_PROTECTED:
+	  if (gfc_current_ns->proc_name->attr.flavor != FL_MODULE)
+	    {
+	       gfc_error ("PROTECTED at %C only allowed in specification "
+			  "part of a module");
+	       t = FAILURE;
+	       break;
+	    }
+
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PROTECTED "
+			      "attribute at %C")
+	      == FAILURE)
+	    t = FAILURE;
+	  else
+	    t = gfc_add_protected (&current_attr, NULL, &seen_at[d]);
+	  break;
+
+	case DECL_PRIVATE:
+	  t = gfc_add_access (&current_attr, ACCESS_PRIVATE, NULL,
+			      &seen_at[d]);
+	  break;
+
+	case DECL_PUBLIC:
+	  t = gfc_add_access (&current_attr, ACCESS_PUBLIC, NULL,
+			      &seen_at[d]);
+	  break;
+
+	case DECL_SAVE:
+	  t = gfc_add_save (&current_attr, SAVE_EXPLICIT, NULL, &seen_at[d]);
+	  break;
+
+	case DECL_TARGET:
+	  t = gfc_add_target (&current_attr, &seen_at[d]);
+	  break;
+
+        case DECL_IS_BIND_C:
+           t = gfc_add_is_bind_c(&current_attr, NULL, &seen_at[d], 0);
+           break;
+           
+	case DECL_VALUE:
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: VALUE attribute "
+			      "at %C")
+	      == FAILURE)
+	    t = FAILURE;
+	  else
+	    t = gfc_add_value (&current_attr, NULL, &seen_at[d]);
+	  break;
+
+	case DECL_VOLATILE:
+	  if (gfc_notify_std (GFC_STD_F2003,
+			      "Fortran 2003: VOLATILE attribute at %C")
+	      == FAILURE)
+	    t = FAILURE;
+	  else
+	    t = gfc_add_volatile (&current_attr, NULL, &seen_at[d]);
+	  break;
+
+	default:
+	  gfc_internal_error ("match_attr_spec(): Bad attribute");
+	}
+
+      if (t == FAILURE)
+	{
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+    }
+
+  /* Since Fortran 2008 module variables implicitly have the SAVE attribute.  */
+  if (gfc_current_state () == COMP_MODULE && !current_attr.save
+      && (gfc_option.allow_std & GFC_STD_F2008) != 0)
+    current_attr.save = SAVE_IMPLICIT;
+
+  colon_seen = 1;
+  return MATCH_YES;
+
+cleanup:
+  gfc_current_locus = start;
+  gfc_free_array_spec (current_as);
+  current_as = NULL;
+  return m;
+}
+
+
+/* Set the binding label, dest_label, either with the binding label
+   stored in the given gfc_typespec, ts, or if none was provided, it
+   will be the symbol name in all lower case, as required by the draft
+   (J3/04-007, section 15.4.1).  If a binding label was given and
+   there is more than one argument (num_idents), it is an error.  */
+
+gfc_try
+set_binding_label (char *dest_label, const char *sym_name, int num_idents)
+{
+  if (num_idents > 1 && has_name_equals)
+    {
+      gfc_error ("Multiple identifiers provided with "
+		 "single NAME= specifier at %C");
+      return FAILURE;
+    }
+
+  if (curr_binding_label[0] != '\0')
+    {
+      /* Binding label given; store in temp holder til have sym.  */
+      strcpy (dest_label, curr_binding_label);
+    }
+  else
+    {
+      /* No binding label given, and the NAME= specifier did not exist,
+         which means there was no NAME="".  */
+      if (sym_name != NULL && has_name_equals == 0)
+        strcpy (dest_label, sym_name);
+    }
+   
+  return SUCCESS;
+}
+
+
+/* Set the status of the given common block as being BIND(C) or not,
+   depending on the given parameter, is_bind_c.  */
+
+void
+set_com_block_bind_c (gfc_common_head *com_block, int is_bind_c)
+{
+  com_block->is_bind_c = is_bind_c;
+  return;
+}
+
+
+/* Verify that the given gfc_typespec is for a C interoperable type.  */
+
+gfc_try
+verify_c_interop (gfc_typespec *ts)
+{
+  if (ts->type == BT_DERIVED && ts->u.derived != NULL)
+    return (ts->u.derived->ts.is_c_interop || ts->u.derived->attr.is_bind_c)
+	   ? SUCCESS : FAILURE;
+  else if (ts->is_c_interop != 1)
+    return FAILURE;
+  
+  return SUCCESS;
+}
+
+
+/* Verify that the variables of a given common block, which has been
+   defined with the attribute specifier bind(c), to be of a C
+   interoperable type.  Errors will be reported here, if
+   encountered.  */
+
+gfc_try
+verify_com_block_vars_c_interop (gfc_common_head *com_block)
+{
+  gfc_symbol *curr_sym = NULL;
+  gfc_try retval = SUCCESS;
+
+  curr_sym = com_block->head;
+  
+  /* Make sure we have at least one symbol.  */
+  if (curr_sym == NULL)
+    return retval;
+
+  /* Here we know we have a symbol, so we'll execute this loop
+     at least once.  */
+  do
+    {
+      /* The second to last param, 1, says this is in a common block.  */
+      retval = verify_bind_c_sym (curr_sym, &(curr_sym->ts), 1, com_block);
+      curr_sym = curr_sym->common_next;
+    } while (curr_sym != NULL); 
+
+  return retval;
+}
+
+
+/* Verify that a given BIND(C) symbol is C interoperable.  If it is not,
+   an appropriate error message is reported.  */
+
+gfc_try
+verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
+                   int is_in_common, gfc_common_head *com_block)
+{
+  bool bind_c_function = false;
+  gfc_try retval = SUCCESS;
+
+  if (tmp_sym->attr.function && tmp_sym->attr.is_bind_c)
+    bind_c_function = true;
+
+  if (tmp_sym->attr.function && tmp_sym->result != NULL)
+    {
+      tmp_sym = tmp_sym->result;
+      /* Make sure it wasn't an implicitly typed result.  */
+      if (tmp_sym->attr.implicit_type)
+	{
+	  gfc_warning ("Implicitly declared BIND(C) function '%s' at "
+                       "%L may not be C interoperable", tmp_sym->name,
+                       &tmp_sym->declared_at);
+	  tmp_sym->ts.f90_type = tmp_sym->ts.type;
+	  /* Mark it as C interoperable to prevent duplicate warnings.	*/
+	  tmp_sym->ts.is_c_interop = 1;
+	  tmp_sym->attr.is_c_interop = 1;
+	}
+    }
+
+  /* Here, we know we have the bind(c) attribute, so if we have
+     enough type info, then verify that it's a C interop kind.
+     The info could be in the symbol already, or possibly still in
+     the given ts (current_ts), so look in both.  */
+  if (tmp_sym->ts.type != BT_UNKNOWN || ts->type != BT_UNKNOWN) 
+    {
+      if (verify_c_interop (&(tmp_sym->ts)) != SUCCESS)
+	{
+	  /* See if we're dealing with a sym in a common block or not.	*/
+	  if (is_in_common == 1)
+	    {
+	      gfc_warning ("Variable '%s' in common block '%s' at %L "
+                           "may not be a C interoperable "
+                           "kind though common block '%s' is BIND(C)",
+                           tmp_sym->name, com_block->name,
+                           &(tmp_sym->declared_at), com_block->name);
+	    }
+	  else
+	    {
+              if (tmp_sym->ts.type == BT_DERIVED || ts->type == BT_DERIVED)
+                gfc_error ("Type declaration '%s' at %L is not C "
+                           "interoperable but it is BIND(C)",
+                           tmp_sym->name, &(tmp_sym->declared_at));
+              else
+                gfc_warning ("Variable '%s' at %L "
+                             "may not be a C interoperable "
+                             "kind but it is bind(c)",
+                             tmp_sym->name, &(tmp_sym->declared_at));
+	    }
+	}
+      
+      /* Variables declared w/in a common block can't be bind(c)
+	 since there's no way for C to see these variables, so there's
+	 semantically no reason for the attribute.  */
+      if (is_in_common == 1 && tmp_sym->attr.is_bind_c == 1)
+	{
+	  gfc_error ("Variable '%s' in common block '%s' at "
+		     "%L cannot be declared with BIND(C) "
+		     "since it is not a global",
+		     tmp_sym->name, com_block->name,
+		     &(tmp_sym->declared_at));
+	  retval = FAILURE;
+	}
+      
+      /* Scalar variables that are bind(c) can not have the pointer
+	 or allocatable attributes.  */
+      if (tmp_sym->attr.is_bind_c == 1)
+	{
+	  if (tmp_sym->attr.pointer == 1)
+	    {
+	      gfc_error ("Variable '%s' at %L cannot have both the "
+			 "POINTER and BIND(C) attributes",
+			 tmp_sym->name, &(tmp_sym->declared_at));
+	      retval = FAILURE;
+	    }
+
+	  if (tmp_sym->attr.allocatable == 1)
+	    {
+	      gfc_error ("Variable '%s' at %L cannot have both the "
+			 "ALLOCATABLE and BIND(C) attributes",
+			 tmp_sym->name, &(tmp_sym->declared_at));
+	      retval = FAILURE;
+	    }
+
+        }
+
+      /* If it is a BIND(C) function, make sure the return value is a
+	 scalar value.  The previous tests in this function made sure
+	 the type is interoperable.  */
+      if (bind_c_function && tmp_sym->as != NULL)
+	gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
+		   "be an array", tmp_sym->name, &(tmp_sym->declared_at));
+
+      /* BIND(C) functions can not return a character string.  */
+      if (bind_c_function && tmp_sym->ts.type == BT_CHARACTER)
+	if (tmp_sym->ts.u.cl == NULL || tmp_sym->ts.u.cl->length == NULL
+	    || tmp_sym->ts.u.cl->length->expr_type != EXPR_CONSTANT
+	    || mpz_cmp_si (tmp_sym->ts.u.cl->length->value.integer, 1) != 0)
+	  gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
+			 "be a character string", tmp_sym->name,
+			 &(tmp_sym->declared_at));
+    }
+
+  /* See if the symbol has been marked as private.  If it has, make sure
+     there is no binding label and warn the user if there is one.  */
+  if (tmp_sym->attr.access == ACCESS_PRIVATE
+      && tmp_sym->binding_label[0] != '\0')
+      /* Use gfc_warning_now because we won't say that the symbol fails
+	 just because of this.	*/
+      gfc_warning_now ("Symbol '%s' at %L is marked PRIVATE but has been "
+		       "given the binding label '%s'", tmp_sym->name,
+		       &(tmp_sym->declared_at), tmp_sym->binding_label);
+
+  return retval;
+}
+
+
+/* Set the appropriate fields for a symbol that's been declared as
+   BIND(C) (the is_bind_c flag and the binding label), and verify that
+   the type is C interoperable.  Errors are reported by the functions
+   used to set/test these fields.  */
+
+gfc_try
+set_verify_bind_c_sym (gfc_symbol *tmp_sym, int num_idents)
+{
+  gfc_try retval = SUCCESS;
+  
+  /* TODO: Do we need to make sure the vars aren't marked private?  */
+
+  /* Set the is_bind_c bit in symbol_attribute.  */
+  gfc_add_is_bind_c (&(tmp_sym->attr), tmp_sym->name, &gfc_current_locus, 0);
+
+  if (set_binding_label (tmp_sym->binding_label, tmp_sym->name, 
+			 num_idents) != SUCCESS)
+    return FAILURE;
+
+  return retval;
+}
+
+
+/* Set the fields marking the given common block as BIND(C), including
+   a binding label, and report any errors encountered.  */
+
+gfc_try
+set_verify_bind_c_com_block (gfc_common_head *com_block, int num_idents)
+{
+  gfc_try retval = SUCCESS;
+  
+  /* destLabel, common name, typespec (which may have binding label).  */
+  if (set_binding_label (com_block->binding_label, com_block->name, num_idents)
+      != SUCCESS)
+    return FAILURE;
+
+  /* Set the given common block (com_block) to being bind(c) (1).  */
+  set_com_block_bind_c (com_block, 1);
+
+  return retval;
+}
+
+
+/* Retrieve the list of one or more identifiers that the given bind(c)
+   attribute applies to.  */
+
+gfc_try
+get_bind_c_idents (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  int num_idents = 0;
+  gfc_symbol *tmp_sym = NULL;
+  match found_id;
+  gfc_common_head *com_block = NULL;
+  
+  if (gfc_match_name (name) == MATCH_YES)
+    {
+      found_id = MATCH_YES;
+      gfc_get_ha_symbol (name, &tmp_sym);
+    }
+  else if (match_common_name (name) == MATCH_YES)
+    {
+      found_id = MATCH_YES;
+      com_block = gfc_get_common (name, 0);
+    }
+  else
+    {
+      gfc_error ("Need either entity or common block name for "
+		 "attribute specification statement at %C");
+      return FAILURE;
+    }
+   
+  /* Save the current identifier and look for more.  */
+  do
+    {
+      /* Increment the number of identifiers found for this spec stmt.  */
+      num_idents++;
+
+      /* Make sure we have a sym or com block, and verify that it can
+	 be bind(c).  Set the appropriate field(s) and look for more
+	 identifiers.  */
+      if (tmp_sym != NULL || com_block != NULL)		
+        {
+	  if (tmp_sym != NULL)
+	    {
+	      if (set_verify_bind_c_sym (tmp_sym, num_idents)
+		  != SUCCESS)
+		return FAILURE;
+	    }
+	  else
+	    {
+	      if (set_verify_bind_c_com_block(com_block, num_idents)
+		  != SUCCESS)
+		return FAILURE;
+	    }
+	 
+	  /* Look to see if we have another identifier.  */
+	  tmp_sym = NULL;
+	  if (gfc_match_eos () == MATCH_YES)
+	    found_id = MATCH_NO;
+	  else if (gfc_match_char (',') != MATCH_YES)
+	    found_id = MATCH_NO;
+	  else if (gfc_match_name (name) == MATCH_YES)
+	    {
+	      found_id = MATCH_YES;
+	      gfc_get_ha_symbol (name, &tmp_sym);
+	    }
+	  else if (match_common_name (name) == MATCH_YES)
+	    {
+	      found_id = MATCH_YES;
+	      com_block = gfc_get_common (name, 0);
+	    }
+	  else
+	    {
+	      gfc_error ("Missing entity or common block name for "
+			 "attribute specification statement at %C");
+	      return FAILURE;
+	    }
+	}
+      else
+	{
+	  gfc_internal_error ("Missing symbol");
+	}
+    } while (found_id == MATCH_YES);
+
+  /* if we get here we were successful */
+  return SUCCESS;
+}
+
+
+/* Try and match a BIND(C) attribute specification statement.  */
+   
+match
+gfc_match_bind_c_stmt (void)
+{
+  match found_match = MATCH_NO;
+  gfc_typespec *ts;
+
+  ts = &current_ts;
+  
+  /* This may not be necessary.  */
+  gfc_clear_ts (ts);
+  /* Clear the temporary binding label holder.  */
+  curr_binding_label[0] = '\0';
+
+  /* Look for the bind(c).  */
+  found_match = gfc_match_bind_c (NULL, true);
+
+  if (found_match == MATCH_YES)
+    {
+      /* Look for the :: now, but it is not required.  */
+      gfc_match (" :: ");
+
+      /* Get the identifier(s) that needs to be updated.  This may need to
+	 change to hand the flag(s) for the attr specified so all identifiers
+	 found can have all appropriate parts updated (assuming that the same
+	 spec stmt can have multiple attrs, such as both bind(c) and
+	 allocatable...).  */
+      if (get_bind_c_idents () != SUCCESS)
+	/* Error message should have printed already.  */
+	return MATCH_ERROR;
+    }
+
+  return found_match;
+}
+
+
+/* Match a data declaration statement.  */
+
+match
+gfc_match_data_decl (void)
+{
+  gfc_symbol *sym;
+  match m;
+  int elem;
+
+  num_idents_on_line = 0;
+  
+  m = gfc_match_decl_type_spec (&current_ts, 0);
+  if (m != MATCH_YES)
+    return m;
+
+  if ((current_ts.type == BT_DERIVED || current_ts.type == BT_CLASS)
+	&& gfc_current_state () != COMP_DERIVED)
+    {
+      sym = gfc_use_derived (current_ts.u.derived);
+
+      if (sym == NULL)
+	{
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+
+      current_ts.u.derived = sym;
+    }
+
+  m = match_attr_spec ();
+  if (m == MATCH_ERROR)
+    {
+      m = MATCH_NO;
+      goto cleanup;
+    }
+
+  if ((current_ts.type == BT_DERIVED || current_ts.type == BT_CLASS)
+      && current_ts.u.derived->components == NULL
+      && !current_ts.u.derived->attr.zero_comp)
+    {
+
+      if (current_attr.pointer && gfc_current_state () == COMP_DERIVED)
+	goto ok;
+
+      gfc_find_symbol (current_ts.u.derived->name,
+		       current_ts.u.derived->ns->parent, 1, &sym);
+
+      /* Any symbol that we find had better be a type definition
+	 which has its components defined.  */
+      if (sym != NULL && sym->attr.flavor == FL_DERIVED
+	  && (current_ts.u.derived->components != NULL
+	      || current_ts.u.derived->attr.zero_comp))
+	goto ok;
+
+      /* Now we have an error, which we signal, and then fix up
+	 because the knock-on is plain and simple confusing.  */
+      gfc_error_now ("Derived type at %C has not been previously defined "
+		     "and so cannot appear in a derived type definition");
+      current_attr.pointer = 1;
+      goto ok;
+    }
+
+ok:
+  /* If we have an old-style character declaration, and no new-style
+     attribute specifications, then there a comma is optional between
+     the type specification and the variable list.  */
+  if (m == MATCH_NO && current_ts.type == BT_CHARACTER && old_char_selector)
+    gfc_match_char (',');
+
+  /* Give the types/attributes to symbols that follow. Give the element
+     a number so that repeat character length expressions can be copied.  */
+  elem = 1;
+  for (;;)
+    {
+      num_idents_on_line++;
+      m = variable_decl (elem++);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	break;
+
+      if (gfc_match_eos () == MATCH_YES)
+	goto cleanup;
+      if (gfc_match_char (',') != MATCH_YES)
+	break;
+    }
+
+  if (gfc_error_flag_test () == 0)
+    gfc_error ("Syntax error in data declaration at %C");
+  m = MATCH_ERROR;
+
+  gfc_free_data_all (gfc_current_ns);
+
+cleanup:
+  gfc_free_array_spec (current_as);
+  current_as = NULL;
+  return m;
+}
+
+
+/* Match a prefix associated with a function or subroutine
+   declaration.  If the typespec pointer is nonnull, then a typespec
+   can be matched.  Note that if nothing matches, MATCH_YES is
+   returned (the null string was matched).  */
+
+match
+gfc_match_prefix (gfc_typespec *ts)
+{
+  bool seen_type;
+  bool seen_impure;
+  bool found_prefix;
+
+  gfc_clear_attr (&current_attr);
+  seen_type = false;
+  seen_impure = false;
+
+  gcc_assert (!gfc_matching_prefix);
+  gfc_matching_prefix = true;
+
+  do
+    {
+      found_prefix = false;
+
+      if (!seen_type && ts != NULL
+	  && gfc_match_decl_type_spec (ts, 0) == MATCH_YES
+	  && gfc_match_space () == MATCH_YES)
+	{
+
+	  seen_type = true;
+	  found_prefix = true;
+	}
+
+      if (gfc_match ("elemental% ") == MATCH_YES)
+	{
+	  if (gfc_add_elemental (&current_attr, NULL) == FAILURE)
+	    goto error;
+
+	  found_prefix = true;
+	}
+
+      if (gfc_match ("pure% ") == MATCH_YES)
+	{
+	  if (gfc_add_pure (&current_attr, NULL) == FAILURE)
+	    goto error;
+
+	  found_prefix = true;
+	}
+
+      if (gfc_match ("recursive% ") == MATCH_YES)
+	{
+	  if (gfc_add_recursive (&current_attr, NULL) == FAILURE)
+	    goto error;
+
+	  found_prefix = true;
+	}
+
+      /* IMPURE is a somewhat special case, as it needs not set an actual
+	 attribute but rather only prevents ELEMENTAL routines from being
+	 automatically PURE.  */
+      if (gfc_match ("impure% ") == MATCH_YES)
+	{
+	  if (gfc_notify_std (GFC_STD_F2008,
+			      "Fortran 2008: IMPURE procedure at %C")
+		== FAILURE)
+	    goto error;
+
+	  seen_impure = true;
+	  found_prefix = true;
+	}
+    }
+  while (found_prefix);
+
+  /* IMPURE and PURE must not both appear, of course.  */
+  if (seen_impure && current_attr.pure)
+    {
+      gfc_error ("PURE and IMPURE must not appear both at %C");
+      goto error;
+    }
+
+  /* If IMPURE it not seen but the procedure is ELEMENTAL, mark it as PURE.  */
+  if (!seen_impure && current_attr.elemental && !current_attr.pure)
+    {
+      if (gfc_add_pure (&current_attr, NULL) == FAILURE)
+	goto error;
+    }
+
+  /* At this point, the next item is not a prefix.  */
+  gcc_assert (gfc_matching_prefix);
+  gfc_matching_prefix = false;
+  return MATCH_YES;
+
+error:
+  gcc_assert (gfc_matching_prefix);
+  gfc_matching_prefix = false;
+  return MATCH_ERROR;
+}
+
+
+/* Copy attributes matched by gfc_match_prefix() to attributes on a symbol.  */
+
+static gfc_try
+copy_prefix (symbol_attribute *dest, locus *where)
+{
+  if (current_attr.pure && gfc_add_pure (dest, where) == FAILURE)
+    return FAILURE;
+
+  if (current_attr.elemental && gfc_add_elemental (dest, where) == FAILURE)
+    return FAILURE;
+
+  if (current_attr.recursive && gfc_add_recursive (dest, where) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Match a formal argument list.  */
+
+match
+gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, int null_flag)
+{
+  gfc_formal_arglist *head, *tail, *p, *q;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symbol *sym;
+  match m;
+
+  head = tail = NULL;
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    {
+      if (null_flag)
+	goto ok;
+      return MATCH_NO;
+    }
+
+  if (gfc_match_char (')') == MATCH_YES)
+    goto ok;
+
+  for (;;)
+    {
+      if (gfc_match_char ('*') == MATCH_YES)
+	sym = NULL;
+      else
+	{
+	  m = gfc_match_name (name);
+	  if (m != MATCH_YES)
+	    goto cleanup;
+
+	  if (gfc_get_symbol (name, NULL, &sym))
+	    goto cleanup;
+	}
+
+      p = gfc_get_formal_arglist ();
+
+      if (head == NULL)
+	head = tail = p;
+      else
+	{
+	  tail->next = p;
+	  tail = p;
+	}
+
+      tail->sym = sym;
+
+      /* We don't add the VARIABLE flavor because the name could be a
+	 dummy procedure.  We don't apply these attributes to formal
+	 arguments of statement functions.  */
+      if (sym != NULL && !st_flag
+	  && (gfc_add_dummy (&sym->attr, sym->name, NULL) == FAILURE
+	      || gfc_missing_attr (&sym->attr, NULL) == FAILURE))
+	{
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+
+      /* The name of a program unit can be in a different namespace,
+	 so check for it explicitly.  After the statement is accepted,
+	 the name is checked for especially in gfc_get_symbol().  */
+      if (gfc_new_block != NULL && sym != NULL
+	  && strcmp (sym->name, gfc_new_block->name) == 0)
+	{
+	  gfc_error ("Name '%s' at %C is the name of the procedure",
+		     sym->name);
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+
+      if (gfc_match_char (')') == MATCH_YES)
+	goto ok;
+
+      m = gfc_match_char (',');
+      if (m != MATCH_YES)
+	{
+	  gfc_error ("Unexpected junk in formal argument list at %C");
+	  goto cleanup;
+	}
+    }
+
+ok:
+  /* Check for duplicate symbols in the formal argument list.  */
+  if (head != NULL)
+    {
+      for (p = head; p->next; p = p->next)
+	{
+	  if (p->sym == NULL)
+	    continue;
+
+	  for (q = p->next; q; q = q->next)
+	    if (p->sym == q->sym)
+	      {
+		gfc_error ("Duplicate symbol '%s' in formal argument list "
+			   "at %C", p->sym->name);
+
+		m = MATCH_ERROR;
+		goto cleanup;
+	      }
+	}
+    }
+
+  if (gfc_add_explicit_interface (progname, IFSRC_DECL, head, NULL)
+      == FAILURE)
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  return MATCH_YES;
+
+cleanup:
+  gfc_free_formal_arglist (head);
+  return m;
+}
+
+
+/* Match a RESULT specification following a function declaration or
+   ENTRY statement.  Also matches the end-of-statement.  */
+
+static match
+match_result (gfc_symbol *function, gfc_symbol **result)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symbol *r;
+  match m;
+
+  if (gfc_match (" result (") != MATCH_YES)
+    return MATCH_NO;
+
+  m = gfc_match_name (name);
+  if (m != MATCH_YES)
+    return m;
+
+  /* Get the right paren, and that's it because there could be the
+     bind(c) attribute after the result clause.  */
+  if (gfc_match_char(')') != MATCH_YES)
+    {
+     /* TODO: should report the missing right paren here.  */
+      return MATCH_ERROR;
+    }
+
+  if (strcmp (function->name, name) == 0)
+    {
+      gfc_error ("RESULT variable at %C must be different than function name");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_get_symbol (name, NULL, &r))
+    return MATCH_ERROR;
+
+  if (gfc_add_result (&r->attr, r->name, NULL) == FAILURE)
+    return MATCH_ERROR;
+
+  *result = r;
+
+  return MATCH_YES;
+}
+
+
+/* Match a function suffix, which could be a combination of a result
+   clause and BIND(C), either one, or neither.  The draft does not
+   require them to come in a specific order.  */
+
+match
+gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result)
+{
+  match is_bind_c;   /* Found bind(c).  */
+  match is_result;   /* Found result clause.  */
+  match found_match; /* Status of whether we've found a good match.  */
+  char peek_char;    /* Character we're going to peek at.  */
+  bool allow_binding_name;
+
+  /* Initialize to having found nothing.  */
+  found_match = MATCH_NO;
+  is_bind_c = MATCH_NO; 
+  is_result = MATCH_NO;
+
+  /* Get the next char to narrow between result and bind(c).  */
+  gfc_gobble_whitespace ();
+  peek_char = gfc_peek_ascii_char ();
+
+  /* C binding names are not allowed for internal procedures.  */
+  if (gfc_current_state () == COMP_CONTAINS
+      && sym->ns->proc_name->attr.flavor != FL_MODULE)
+    allow_binding_name = false;
+  else
+    allow_binding_name = true;
+
+  switch (peek_char)
+    {
+    case 'r':
+      /* Look for result clause.  */
+      is_result = match_result (sym, result);
+      if (is_result == MATCH_YES)
+	{
+	  /* Now see if there is a bind(c) after it.  */
+	  is_bind_c = gfc_match_bind_c (sym, allow_binding_name);
+	  /* We've found the result clause and possibly bind(c).  */
+	  found_match = MATCH_YES;
+	}
+      else
+	/* This should only be MATCH_ERROR.  */
+	found_match = is_result; 
+      break;
+    case 'b':
+      /* Look for bind(c) first.  */
+      is_bind_c = gfc_match_bind_c (sym, allow_binding_name);
+      if (is_bind_c == MATCH_YES)
+	{
+	  /* Now see if a result clause followed it.  */
+	  is_result = match_result (sym, result);
+	  found_match = MATCH_YES;
+	}
+      else
+	{
+	  /* Should only be a MATCH_ERROR if we get here after seeing 'b'.  */
+	  found_match = MATCH_ERROR;
+	}
+      break;
+    default:
+      gfc_error ("Unexpected junk after function declaration at %C");
+      found_match = MATCH_ERROR;
+      break;
+    }
+
+  if (is_bind_c == MATCH_YES)
+    {
+      /* Fortran 2008 draft allows BIND(C) for internal procedures.  */
+      if (gfc_current_state () == COMP_CONTAINS
+	  && sym->ns->proc_name->attr.flavor != FL_MODULE
+	  && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BIND(C) attribute "
+			     "at %L may not be specified for an internal "
+			     "procedure", &gfc_current_locus)
+	     == FAILURE)
+	return MATCH_ERROR;
+
+      if (gfc_add_is_bind_c (&(sym->attr), sym->name, &gfc_current_locus, 1)
+	  == FAILURE)
+     	return MATCH_ERROR;
+    }
+  
+  return found_match;
+}
+
+
+/* Procedure pointer return value without RESULT statement:
+   Add "hidden" result variable named "ppr@".  */
+
+static gfc_try
+add_hidden_procptr_result (gfc_symbol *sym)
+{
+  bool case1,case2;
+
+  if (gfc_notification_std (GFC_STD_F2003) == ERROR)
+    return FAILURE;
+
+  /* First usage case: PROCEDURE and EXTERNAL statements.  */
+  case1 = gfc_current_state () == COMP_FUNCTION && gfc_current_block ()
+	  && strcmp (gfc_current_block ()->name, sym->name) == 0
+	  && sym->attr.external;
+  /* Second usage case: INTERFACE statements.  */
+  case2 = gfc_current_state () == COMP_INTERFACE && gfc_state_stack->previous
+	  && gfc_state_stack->previous->state == COMP_FUNCTION
+	  && strcmp (gfc_state_stack->previous->sym->name, sym->name) == 0;
+
+  if (case1 || case2)
+    {
+      gfc_symtree *stree;
+      if (case1)
+	gfc_get_sym_tree ("ppr@", gfc_current_ns, &stree, false);
+      else if (case2)
+	{
+	  gfc_symtree *st2;
+	  gfc_get_sym_tree ("ppr@", gfc_current_ns->parent, &stree, false);
+	  st2 = gfc_new_symtree (&gfc_current_ns->sym_root, "ppr@");
+	  st2->n.sym = stree->n.sym;
+	}
+      sym->result = stree->n.sym;
+
+      sym->result->attr.proc_pointer = sym->attr.proc_pointer;
+      sym->result->attr.pointer = sym->attr.pointer;
+      sym->result->attr.external = sym->attr.external;
+      sym->result->attr.referenced = sym->attr.referenced;
+      sym->result->ts = sym->ts;
+      sym->attr.proc_pointer = 0;
+      sym->attr.pointer = 0;
+      sym->attr.external = 0;
+      if (sym->result->attr.external && sym->result->attr.pointer)
+	{
+	  sym->result->attr.pointer = 0;
+	  sym->result->attr.proc_pointer = 1;
+	}
+
+      return gfc_add_result (&sym->result->attr, sym->result->name, NULL);
+    }
+  /* POINTER after PROCEDURE/EXTERNAL/INTERFACE statement.  */
+  else if (sym->attr.function && !sym->attr.external && sym->attr.pointer
+	   && sym->result && sym->result != sym && sym->result->attr.external
+	   && sym == gfc_current_ns->proc_name
+	   && sym == sym->result->ns->proc_name
+	   && strcmp ("ppr@", sym->result->name) == 0)
+    {
+      sym->result->attr.proc_pointer = 1;
+      sym->attr.pointer = 0;
+      return SUCCESS;
+    }
+  else
+    return FAILURE;
+}
+
+
+/* Match the interface for a PROCEDURE declaration,
+   including brackets (R1212).  */
+
+static match
+match_procedure_interface (gfc_symbol **proc_if)
+{
+  match m;
+  gfc_symtree *st;
+  locus old_loc, entry_loc;
+  gfc_namespace *old_ns = gfc_current_ns;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+
+  old_loc = entry_loc = gfc_current_locus;
+  gfc_clear_ts (&current_ts);
+
+  if (gfc_match (" (") != MATCH_YES)
+    {
+      gfc_current_locus = entry_loc;
+      return MATCH_NO;
+    }
+
+  /* Get the type spec. for the procedure interface.  */
+  old_loc = gfc_current_locus;
+  m = gfc_match_decl_type_spec (&current_ts, 0);
+  gfc_gobble_whitespace ();
+  if (m == MATCH_YES || (m == MATCH_NO && gfc_peek_ascii_char () == ')'))
+    goto got_ts;
+
+  if (m == MATCH_ERROR)
+    return m;
+
+  /* Procedure interface is itself a procedure.  */
+  gfc_current_locus = old_loc;
+  m = gfc_match_name (name);
+
+  /* First look to see if it is already accessible in the current
+     namespace because it is use associated or contained.  */
+  st = NULL;
+  if (gfc_find_sym_tree (name, NULL, 0, &st))
+    return MATCH_ERROR;
+
+  /* If it is still not found, then try the parent namespace, if it
+     exists and create the symbol there if it is still not found.  */
+  if (gfc_current_ns->parent)
+    gfc_current_ns = gfc_current_ns->parent;
+  if (st == NULL && gfc_get_ha_sym_tree (name, &st))
+    return MATCH_ERROR;
+
+  gfc_current_ns = old_ns;
+  *proc_if = st->n.sym;
+
+  /* Various interface checks.  */
+  if (*proc_if)
+    {
+      (*proc_if)->refs++;
+      /* Resolve interface if possible. That way, attr.procedure is only set
+	 if it is declared by a later procedure-declaration-stmt, which is
+	 invalid per C1212.  */
+      while ((*proc_if)->ts.interface)
+	*proc_if = (*proc_if)->ts.interface;
+
+      if ((*proc_if)->generic)
+	{
+	  gfc_error ("Interface '%s' at %C may not be generic",
+		     (*proc_if)->name);
+	  return MATCH_ERROR;
+	}
+      if ((*proc_if)->attr.proc == PROC_ST_FUNCTION)
+	{
+	  gfc_error ("Interface '%s' at %C may not be a statement function",
+		     (*proc_if)->name);
+	  return MATCH_ERROR;
+	}
+      /* Handle intrinsic procedures.  */
+      if (!((*proc_if)->attr.external || (*proc_if)->attr.use_assoc
+	    || (*proc_if)->attr.if_source == IFSRC_IFBODY)
+	  && (gfc_is_intrinsic ((*proc_if), 0, gfc_current_locus)
+	      || gfc_is_intrinsic ((*proc_if), 1, gfc_current_locus)))
+	(*proc_if)->attr.intrinsic = 1;
+      if ((*proc_if)->attr.intrinsic
+	  && !gfc_intrinsic_actual_ok ((*proc_if)->name, 0))
+	{
+	  gfc_error ("Intrinsic procedure '%s' not allowed "
+		    "in PROCEDURE statement at %C", (*proc_if)->name);
+	  return MATCH_ERROR;
+	}
+    }
+
+got_ts:
+  if (gfc_match (" )") != MATCH_YES)
+    {
+      gfc_current_locus = entry_loc;
+      return MATCH_NO;
+    }
+
+  return MATCH_YES;
+}
+
+
+/* Match a PROCEDURE declaration (R1211).  */
+
+static match
+match_procedure_decl (void)
+{
+  match m;
+  gfc_symbol *sym, *proc_if = NULL;
+  int num;
+  gfc_expr *initializer = NULL;
+
+  /* Parse interface (with brackets). */
+  m = match_procedure_interface (&proc_if);
+  if (m != MATCH_YES)
+    return m;
+
+  /* Parse attributes (with colons).  */
+  m = match_attr_spec();
+  if (m == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  /* Get procedure symbols.  */
+  for(num=1;;num++)
+    {
+      m = gfc_match_symbol (&sym, 0);
+      if (m == MATCH_NO)
+	goto syntax;
+      else if (m == MATCH_ERROR)
+	return m;
+
+      /* Add current_attr to the symbol attributes.  */
+      if (gfc_copy_attr (&sym->attr, &current_attr, NULL) == FAILURE)
+	return MATCH_ERROR;
+
+      if (sym->attr.is_bind_c)
+	{
+	  /* Check for C1218.  */
+	  if (!proc_if || !proc_if->attr.is_bind_c)
+	    {
+	      gfc_error ("BIND(C) attribute at %C requires "
+			"an interface with BIND(C)");
+	      return MATCH_ERROR;
+	    }
+	  /* Check for C1217.  */
+	  if (has_name_equals && sym->attr.pointer)
+	    {
+	      gfc_error ("BIND(C) procedure with NAME may not have "
+			"POINTER attribute at %C");
+	      return MATCH_ERROR;
+	    }
+	  if (has_name_equals && sym->attr.dummy)
+	    {
+	      gfc_error ("Dummy procedure at %C may not have "
+			"BIND(C) attribute with NAME");
+	      return MATCH_ERROR;
+	    }
+	  /* Set binding label for BIND(C).  */
+	  if (set_binding_label (sym->binding_label, sym->name, num) != SUCCESS)
+	    return MATCH_ERROR;
+	}
+
+      if (gfc_add_external (&sym->attr, NULL) == FAILURE)
+	return MATCH_ERROR;
+
+      if (add_hidden_procptr_result (sym) == SUCCESS)
+	sym = sym->result;
+
+      if (gfc_add_proc (&sym->attr, sym->name, NULL) == FAILURE)
+	return MATCH_ERROR;
+
+      /* Set interface.  */
+      if (proc_if != NULL)
+	{
+          if (sym->ts.type != BT_UNKNOWN)
+	    {
+	      gfc_error ("Procedure '%s' at %L already has basic type of %s",
+			 sym->name, &gfc_current_locus,
+			 gfc_basic_typename (sym->ts.type));
+	      return MATCH_ERROR;
+	    }
+	  sym->ts.interface = proc_if;
+	  sym->attr.untyped = 1;
+	  sym->attr.if_source = IFSRC_IFBODY;
+	}
+      else if (current_ts.type != BT_UNKNOWN)
+	{
+	  if (gfc_add_type (sym, &current_ts, &gfc_current_locus) == FAILURE)
+	    return MATCH_ERROR;
+	  sym->ts.interface = gfc_new_symbol ("", gfc_current_ns);
+	  sym->ts.interface->ts = current_ts;
+	  sym->ts.interface->attr.function = 1;
+	  sym->attr.function = sym->ts.interface->attr.function;
+	  sym->attr.if_source = IFSRC_UNKNOWN;
+	}
+
+      if (gfc_match (" =>") == MATCH_YES)
+	{
+	  if (!current_attr.pointer)
+	    {
+	      gfc_error ("Initialization at %C isn't for a pointer variable");
+	      m = MATCH_ERROR;
+	      goto cleanup;
+	    }
+
+	  m = match_pointer_init (&initializer, 1);
+	  if (m != MATCH_YES)
+	    goto cleanup;
+
+	  if (add_init_expr_to_sym (sym->name, &initializer, &gfc_current_locus)
+	      != SUCCESS)
+	    goto cleanup;
+
+	}
+
+      gfc_set_sym_referenced (sym);
+
+      if (gfc_match_eos () == MATCH_YES)
+	return MATCH_YES;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+syntax:
+  gfc_error ("Syntax error in PROCEDURE statement at %C");
+  return MATCH_ERROR;
+
+cleanup:
+  /* Free stuff up and return.  */
+  gfc_free_expr (initializer);
+  return m;
+}
+
+
+static match
+match_binding_attributes (gfc_typebound_proc* ba, bool generic, bool ppc);
+
+
+/* Match a procedure pointer component declaration (R445).  */
+
+static match
+match_ppc_decl (void)
+{
+  match m;
+  gfc_symbol *proc_if = NULL;
+  gfc_typespec ts;
+  int num;
+  gfc_component *c;
+  gfc_expr *initializer = NULL;
+  gfc_typebound_proc* tb;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+
+  /* Parse interface (with brackets).  */
+  m = match_procedure_interface (&proc_if);
+  if (m != MATCH_YES)
+    goto syntax;
+
+  /* Parse attributes.  */
+  tb = XCNEW (gfc_typebound_proc);
+  tb->where = gfc_current_locus;
+  m = match_binding_attributes (tb, false, true);
+  if (m == MATCH_ERROR)
+    return m;
+
+  gfc_clear_attr (&current_attr);
+  current_attr.procedure = 1;
+  current_attr.proc_pointer = 1;
+  current_attr.access = tb->access;
+  current_attr.flavor = FL_PROCEDURE;
+
+  /* Match the colons (required).  */
+  if (gfc_match (" ::") != MATCH_YES)
+    {
+      gfc_error ("Expected '::' after binding-attributes at %C");
+      return MATCH_ERROR;
+    }
+
+  /* Check for C450.  */
+  if (!tb->nopass && proc_if == NULL)
+    {
+      gfc_error("NOPASS or explicit interface required at %C");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure pointer "
+                     "component at %C") == FAILURE)
+    return MATCH_ERROR;
+
+  /* Match PPC names.  */
+  ts = current_ts;
+  for(num=1;;num++)
+    {
+      m = gfc_match_name (name);
+      if (m == MATCH_NO)
+	goto syntax;
+      else if (m == MATCH_ERROR)
+	return m;
+
+      if (gfc_add_component (gfc_current_block (), name, &c) == FAILURE)
+	return MATCH_ERROR;
+
+      /* Add current_attr to the symbol attributes.  */
+      if (gfc_copy_attr (&c->attr, &current_attr, NULL) == FAILURE)
+	return MATCH_ERROR;
+
+      if (gfc_add_external (&c->attr, NULL) == FAILURE)
+	return MATCH_ERROR;
+
+      if (gfc_add_proc (&c->attr, name, NULL) == FAILURE)
+	return MATCH_ERROR;
+
+      c->tb = tb;
+
+      /* Set interface.  */
+      if (proc_if != NULL)
+	{
+	  c->ts.interface = proc_if;
+	  c->attr.untyped = 1;
+	  c->attr.if_source = IFSRC_IFBODY;
+	}
+      else if (ts.type != BT_UNKNOWN)
+	{
+	  c->ts = ts;
+	  c->ts.interface = gfc_new_symbol ("", gfc_current_ns);
+	  c->ts.interface->ts = ts;
+	  c->ts.interface->attr.function = 1;
+	  c->attr.function = c->ts.interface->attr.function;
+	  c->attr.if_source = IFSRC_UNKNOWN;
+	}
+
+      if (gfc_match (" =>") == MATCH_YES)
+	{
+	  m = match_pointer_init (&initializer, 1);
+	  if (m != MATCH_YES)
+	    {
+	      gfc_free_expr (initializer);
+	      return m;
+	    }
+	  c->initializer = initializer;
+	}
+
+      if (gfc_match_eos () == MATCH_YES)
+	return MATCH_YES;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+syntax:
+  gfc_error ("Syntax error in procedure pointer component at %C");
+  return MATCH_ERROR;
+}
+
+
+/* Match a PROCEDURE declaration inside an interface (R1206).  */
+
+static match
+match_procedure_in_interface (void)
+{
+  match m;
+  gfc_symbol *sym;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+
+  if (current_interface.type == INTERFACE_NAMELESS
+      || current_interface.type == INTERFACE_ABSTRACT)
+    {
+      gfc_error ("PROCEDURE at %C must be in a generic interface");
+      return MATCH_ERROR;
+    }
+
+  for(;;)
+    {
+      m = gfc_match_name (name);
+      if (m == MATCH_NO)
+	goto syntax;
+      else if (m == MATCH_ERROR)
+	return m;
+      if (gfc_get_symbol (name, gfc_current_ns->parent, &sym))
+	return MATCH_ERROR;
+
+      if (gfc_add_interface (sym) == FAILURE)
+	return MATCH_ERROR;
+
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in PROCEDURE statement at %C");
+  return MATCH_ERROR;
+}
+
+
+/* General matcher for PROCEDURE declarations.  */
+
+static match match_procedure_in_type (void);
+
+match
+gfc_match_procedure (void)
+{
+  match m;
+
+  switch (gfc_current_state ())
+    {
+    case COMP_NONE:
+    case COMP_PROGRAM:
+    case COMP_MODULE:
+    case COMP_SUBROUTINE:
+    case COMP_FUNCTION:
+      m = match_procedure_decl ();
+      break;
+    case COMP_INTERFACE:
+      m = match_procedure_in_interface ();
+      break;
+    case COMP_DERIVED:
+      m = match_ppc_decl ();
+      break;
+    case COMP_DERIVED_CONTAINS:
+      m = match_procedure_in_type ();
+      break;
+    default:
+      return MATCH_NO;
+    }
+
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PROCEDURE statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  return m;
+}
+
+
+/* Warn if a matched procedure has the same name as an intrinsic; this is
+   simply a wrapper around gfc_warn_intrinsic_shadow that interprets the current
+   parser-state-stack to find out whether we're in a module.  */
+
+static void
+warn_intrinsic_shadow (const gfc_symbol* sym, bool func)
+{
+  bool in_module;
+
+  in_module = (gfc_state_stack->previous
+	       && gfc_state_stack->previous->state == COMP_MODULE);
+
+  gfc_warn_intrinsic_shadow (sym, in_module, func);
+}
+
+
+/* Match a function declaration.  */
+
+match
+gfc_match_function_decl (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symbol *sym, *result;
+  locus old_loc;
+  match m;
+  match suffix_match;
+  match found_match; /* Status returned by match func.  */  
+
+  if (gfc_current_state () != COMP_NONE
+      && gfc_current_state () != COMP_INTERFACE
+      && gfc_current_state () != COMP_CONTAINS)
+    return MATCH_NO;
+
+  gfc_clear_ts (&current_ts);
+
+  old_loc = gfc_current_locus;
+
+  m = gfc_match_prefix (&current_ts);
+  if (m != MATCH_YES)
+    {
+      gfc_current_locus = old_loc;
+      return m;
+    }
+
+  if (gfc_match ("function% %n", name) != MATCH_YES)
+    {
+      gfc_current_locus = old_loc;
+      return MATCH_NO;
+    }
+  if (get_proc_name (name, &sym, false))
+    return MATCH_ERROR;
+
+  if (add_hidden_procptr_result (sym) == SUCCESS)
+    sym = sym->result;
+
+  gfc_new_block = sym;
+
+  m = gfc_match_formal_arglist (sym, 0, 0);
+  if (m == MATCH_NO)
+    {
+      gfc_error ("Expected formal argument list in function "
+		 "definition at %C");
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+  else if (m == MATCH_ERROR)
+    goto cleanup;
+
+  result = NULL;
+
+  /* According to the draft, the bind(c) and result clause can
+     come in either order after the formal_arg_list (i.e., either
+     can be first, both can exist together or by themselves or neither
+     one).  Therefore, the match_result can't match the end of the
+     string, and check for the bind(c) or result clause in either order.  */
+  found_match = gfc_match_eos ();
+
+  /* Make sure that it isn't already declared as BIND(C).  If it is, it
+     must have been marked BIND(C) with a BIND(C) attribute and that is
+     not allowed for procedures.  */
+  if (sym->attr.is_bind_c == 1)
+    {
+      sym->attr.is_bind_c = 0;
+      if (sym->old_symbol != NULL)
+        gfc_error_now ("BIND(C) attribute at %L can only be used for "
+                       "variables or common blocks",
+                       &(sym->old_symbol->declared_at));
+      else
+        gfc_error_now ("BIND(C) attribute at %L can only be used for "
+                       "variables or common blocks", &gfc_current_locus);
+    }
+
+  if (found_match != MATCH_YES)
+    {
+      /* If we haven't found the end-of-statement, look for a suffix.  */
+      suffix_match = gfc_match_suffix (sym, &result);
+      if (suffix_match == MATCH_YES)
+        /* Need to get the eos now.  */
+        found_match = gfc_match_eos ();
+      else
+	found_match = suffix_match;
+    }
+
+  if(found_match != MATCH_YES)
+    m = MATCH_ERROR;
+  else
+    {
+      /* Make changes to the symbol.  */
+      m = MATCH_ERROR;
+      
+      if (gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
+	goto cleanup;
+      
+      if (gfc_missing_attr (&sym->attr, NULL) == FAILURE
+	  || copy_prefix (&sym->attr, &sym->declared_at) == FAILURE)
+	goto cleanup;
+
+      /* Delay matching the function characteristics until after the
+	 specification block by signalling kind=-1.  */
+      sym->declared_at = old_loc;
+      if (current_ts.type != BT_UNKNOWN)
+	current_ts.kind = -1;
+      else
+	current_ts.kind = 0;
+
+      if (result == NULL)
+	{
+          if (current_ts.type != BT_UNKNOWN
+	      && gfc_add_type (sym, &current_ts, &gfc_current_locus) == FAILURE)
+	    goto cleanup;
+	  sym->result = sym;
+	}
+      else
+	{
+          if (current_ts.type != BT_UNKNOWN
+	      && gfc_add_type (result, &current_ts, &gfc_current_locus)
+		 == FAILURE)
+	    goto cleanup;
+	  sym->result = result;
+	}
+
+      /* Warn if this procedure has the same name as an intrinsic.  */
+      warn_intrinsic_shadow (sym, true);
+
+      return MATCH_YES;
+    }
+
+cleanup:
+  gfc_current_locus = old_loc;
+  return m;
+}
+
+
+/* This is mostly a copy of parse.c(add_global_procedure) but modified to
+   pass the name of the entry, rather than the gfc_current_block name, and
+   to return false upon finding an existing global entry.  */
+
+static bool
+add_global_entry (const char *name, int sub)
+{
+  gfc_gsymbol *s;
+  enum gfc_symbol_type type;
+
+  s = gfc_get_gsymbol(name);
+  type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
+
+  if (s->defined
+      || (s->type != GSYM_UNKNOWN
+	  && s->type != type))
+    gfc_global_used(s, NULL);
+  else
+    {
+      s->type = type;
+      s->where = gfc_current_locus;
+      s->defined = 1;
+      s->ns = gfc_current_ns;
+      return true;
+    }
+  return false;
+}
+
+
+/* Match an ENTRY statement.  */
+
+match
+gfc_match_entry (void)
+{
+  gfc_symbol *proc;
+  gfc_symbol *result;
+  gfc_symbol *entry;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_compile_state state;
+  match m;
+  gfc_entry_list *el;
+  locus old_loc;
+  bool module_procedure;
+  char peek_char;
+  match is_bind_c;
+
+  m = gfc_match_name (name);
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_notify_std (GFC_STD_F2008_OBS, "Fortran 2008 obsolescent feature: "
+		      "ENTRY statement at %C") == FAILURE)
+    return MATCH_ERROR;
+
+  state = gfc_current_state ();
+  if (state != COMP_SUBROUTINE && state != COMP_FUNCTION)
+    {
+      switch (state)
+	{
+	  case COMP_PROGRAM:
+	    gfc_error ("ENTRY statement at %C cannot appear within a PROGRAM");
+	    break;
+	  case COMP_MODULE:
+	    gfc_error ("ENTRY statement at %C cannot appear within a MODULE");
+	    break;
+	  case COMP_BLOCK_DATA:
+	    gfc_error ("ENTRY statement at %C cannot appear within "
+		       "a BLOCK DATA");
+	    break;
+	  case COMP_INTERFACE:
+	    gfc_error ("ENTRY statement at %C cannot appear within "
+		       "an INTERFACE");
+	    break;
+	  case COMP_DERIVED:
+	    gfc_error ("ENTRY statement at %C cannot appear within "
+		       "a DERIVED TYPE block");
+	    break;
+	  case COMP_IF:
+	    gfc_error ("ENTRY statement at %C cannot appear within "
+		       "an IF-THEN block");
+	    break;
+	  case COMP_DO:
+	    gfc_error ("ENTRY statement at %C cannot appear within "
+		       "a DO block");
+	    break;
+	  case COMP_SELECT:
+	    gfc_error ("ENTRY statement at %C cannot appear within "
+		       "a SELECT block");
+	    break;
+	  case COMP_FORALL:
+	    gfc_error ("ENTRY statement at %C cannot appear within "
+		       "a FORALL block");
+	    break;
+	  case COMP_WHERE:
+	    gfc_error ("ENTRY statement at %C cannot appear within "
+		       "a WHERE block");
+	    break;
+	  case COMP_CONTAINS:
+	    gfc_error ("ENTRY statement at %C cannot appear within "
+		       "a contained subprogram");
+	    break;
+	  default:
+	    gfc_internal_error ("gfc_match_entry(): Bad state");
+	}
+      return MATCH_ERROR;
+    }
+
+  module_procedure = gfc_current_ns->parent != NULL
+		   && gfc_current_ns->parent->proc_name
+		   && gfc_current_ns->parent->proc_name->attr.flavor
+		      == FL_MODULE;
+
+  if (gfc_current_ns->parent != NULL
+      && gfc_current_ns->parent->proc_name
+      && !module_procedure)
+    {
+      gfc_error("ENTRY statement at %C cannot appear in a "
+		"contained procedure");
+      return MATCH_ERROR;
+    }
+
+  /* Module function entries need special care in get_proc_name
+     because previous references within the function will have
+     created symbols attached to the current namespace.  */
+  if (get_proc_name (name, &entry,
+		     gfc_current_ns->parent != NULL
+		     && module_procedure))
+    return MATCH_ERROR;
+
+  proc = gfc_current_block ();
+
+  /* Make sure that it isn't already declared as BIND(C).  If it is, it
+     must have been marked BIND(C) with a BIND(C) attribute and that is
+     not allowed for procedures.  */
+  if (entry->attr.is_bind_c == 1)
+    {
+      entry->attr.is_bind_c = 0;
+      if (entry->old_symbol != NULL)
+        gfc_error_now ("BIND(C) attribute at %L can only be used for "
+                       "variables or common blocks",
+                       &(entry->old_symbol->declared_at));
+      else
+        gfc_error_now ("BIND(C) attribute at %L can only be used for "
+                       "variables or common blocks", &gfc_current_locus);
+    }
+  
+  /* Check what next non-whitespace character is so we can tell if there
+     is the required parens if we have a BIND(C).  */
+  gfc_gobble_whitespace ();
+  peek_char = gfc_peek_ascii_char ();
+
+  if (state == COMP_SUBROUTINE)
+    {
+      /* An entry in a subroutine.  */
+      if (!gfc_current_ns->parent && !add_global_entry (name, 1))
+	return MATCH_ERROR;
+
+      m = gfc_match_formal_arglist (entry, 0, 1);
+      if (m != MATCH_YES)
+	return MATCH_ERROR;
+
+      /* Call gfc_match_bind_c with allow_binding_name = true as ENTRY can
+	 never be an internal procedure.  */
+      is_bind_c = gfc_match_bind_c (entry, true);
+      if (is_bind_c == MATCH_ERROR)
+	return MATCH_ERROR;
+      if (is_bind_c == MATCH_YES)
+	{
+	  if (peek_char != '(')
+	    {
+	      gfc_error ("Missing required parentheses before BIND(C) at %C");
+	      return MATCH_ERROR;
+	    }
+	    if (gfc_add_is_bind_c (&(entry->attr), entry->name, &(entry->declared_at), 1)
+		== FAILURE)
+	      return MATCH_ERROR;
+	}
+
+      if (gfc_add_entry (&entry->attr, entry->name, NULL) == FAILURE
+	  || gfc_add_subroutine (&entry->attr, entry->name, NULL) == FAILURE)
+	return MATCH_ERROR;
+    }
+  else
+    {
+      /* An entry in a function.
+	 We need to take special care because writing
+	    ENTRY f()
+	 as
+	    ENTRY f
+	 is allowed, whereas
+	    ENTRY f() RESULT (r)
+	 can't be written as
+	    ENTRY f RESULT (r).  */
+      if (!gfc_current_ns->parent && !add_global_entry (name, 0))
+	return MATCH_ERROR;
+
+      old_loc = gfc_current_locus;
+      if (gfc_match_eos () == MATCH_YES)
+	{
+	  gfc_current_locus = old_loc;
+	  /* Match the empty argument list, and add the interface to
+	     the symbol.  */
+	  m = gfc_match_formal_arglist (entry, 0, 1);
+	}
+      else
+	m = gfc_match_formal_arglist (entry, 0, 0);
+
+      if (m != MATCH_YES)
+	return MATCH_ERROR;
+
+      result = NULL;
+
+      if (gfc_match_eos () == MATCH_YES)
+	{
+	  if (gfc_add_entry (&entry->attr, entry->name, NULL) == FAILURE
+	      || gfc_add_function (&entry->attr, entry->name, NULL) == FAILURE)
+	    return MATCH_ERROR;
+
+	  entry->result = entry;
+	}
+      else
+	{
+	  m = gfc_match_suffix (entry, &result);
+	  if (m == MATCH_NO)
+	    gfc_syntax_error (ST_ENTRY);
+	  if (m != MATCH_YES)
+	    return MATCH_ERROR;
+
+          if (result)
+	    {
+	      if (gfc_add_result (&result->attr, result->name, NULL) == FAILURE
+		  || gfc_add_entry (&entry->attr, result->name, NULL) == FAILURE
+		  || gfc_add_function (&entry->attr, result->name, NULL)
+		  == FAILURE)
+	        return MATCH_ERROR;
+	      entry->result = result;
+	    }
+	  else
+	    {
+	      if (gfc_add_entry (&entry->attr, entry->name, NULL) == FAILURE
+		  || gfc_add_function (&entry->attr, entry->name, NULL) == FAILURE)
+		return MATCH_ERROR;
+	      entry->result = entry;
+	    }
+	}
+    }
+
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      gfc_syntax_error (ST_ENTRY);
+      return MATCH_ERROR;
+    }
+
+  entry->attr.recursive = proc->attr.recursive;
+  entry->attr.elemental = proc->attr.elemental;
+  entry->attr.pure = proc->attr.pure;
+
+  el = gfc_get_entry_list ();
+  el->sym = entry;
+  el->next = gfc_current_ns->entries;
+  gfc_current_ns->entries = el;
+  if (el->next)
+    el->id = el->next->id + 1;
+  else
+    el->id = 1;
+
+  new_st.op = EXEC_ENTRY;
+  new_st.ext.entry = el;
+
+  return MATCH_YES;
+}
+
+
+/* Match a subroutine statement, including optional prefixes.  */
+
+match
+gfc_match_subroutine (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symbol *sym;
+  match m;
+  match is_bind_c;
+  char peek_char;
+  bool allow_binding_name;
+
+  if (gfc_current_state () != COMP_NONE
+      && gfc_current_state () != COMP_INTERFACE
+      && gfc_current_state () != COMP_CONTAINS)
+    return MATCH_NO;
+
+  m = gfc_match_prefix (NULL);
+  if (m != MATCH_YES)
+    return m;
+
+  m = gfc_match ("subroutine% %n", name);
+  if (m != MATCH_YES)
+    return m;
+
+  if (get_proc_name (name, &sym, false))
+    return MATCH_ERROR;
+
+  /* Set declared_at as it might point to, e.g., a PUBLIC statement, if
+     the symbol existed before. */
+  sym->declared_at = gfc_current_locus;
+
+  if (add_hidden_procptr_result (sym) == SUCCESS)
+    sym = sym->result;
+
+  gfc_new_block = sym;
+
+  /* Check what next non-whitespace character is so we can tell if there
+     is the required parens if we have a BIND(C).  */
+  gfc_gobble_whitespace ();
+  peek_char = gfc_peek_ascii_char ();
+  
+  if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_match_formal_arglist (sym, 0, 1) != MATCH_YES)
+    return MATCH_ERROR;
+
+  /* Make sure that it isn't already declared as BIND(C).  If it is, it
+     must have been marked BIND(C) with a BIND(C) attribute and that is
+     not allowed for procedures.  */
+  if (sym->attr.is_bind_c == 1)
+    {
+      sym->attr.is_bind_c = 0;
+      if (sym->old_symbol != NULL)
+        gfc_error_now ("BIND(C) attribute at %L can only be used for "
+                       "variables or common blocks",
+                       &(sym->old_symbol->declared_at));
+      else
+        gfc_error_now ("BIND(C) attribute at %L can only be used for "
+                       "variables or common blocks", &gfc_current_locus);
+    }
+
+  /* C binding names are not allowed for internal procedures.  */
+  if (gfc_current_state () == COMP_CONTAINS
+      && sym->ns->proc_name->attr.flavor != FL_MODULE)
+    allow_binding_name = false;
+  else
+    allow_binding_name = true;
+
+  /* Here, we are just checking if it has the bind(c) attribute, and if
+     so, then we need to make sure it's all correct.  If it doesn't,
+     we still need to continue matching the rest of the subroutine line.  */
+  is_bind_c = gfc_match_bind_c (sym, allow_binding_name);
+  if (is_bind_c == MATCH_ERROR)
+    {
+      /* There was an attempt at the bind(c), but it was wrong.	 An
+	 error message should have been printed w/in the gfc_match_bind_c
+	 so here we'll just return the MATCH_ERROR.  */
+      return MATCH_ERROR;
+    }
+
+  if (is_bind_c == MATCH_YES)
+    {
+      /* The following is allowed in the Fortran 2008 draft.  */
+      if (gfc_current_state () == COMP_CONTAINS
+	  && sym->ns->proc_name->attr.flavor != FL_MODULE
+	  && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BIND(C) attribute "
+			     "at %L may not be specified for an internal "
+			     "procedure", &gfc_current_locus)
+	     == FAILURE)
+	return MATCH_ERROR;
+
+      if (peek_char != '(')
+        {
+          gfc_error ("Missing required parentheses before BIND(C) at %C");
+          return MATCH_ERROR;
+        }
+      if (gfc_add_is_bind_c (&(sym->attr), sym->name, &(sym->declared_at), 1)
+	  == FAILURE)
+        return MATCH_ERROR;
+    }
+  
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      gfc_syntax_error (ST_SUBROUTINE);
+      return MATCH_ERROR;
+    }
+
+  if (copy_prefix (&sym->attr, &sym->declared_at) == FAILURE)
+    return MATCH_ERROR;
+
+  /* Warn if it has the same name as an intrinsic.  */
+  warn_intrinsic_shadow (sym, false);
+
+  return MATCH_YES;
+}
+
+
+/* Match a BIND(C) specifier, with the optional 'name=' specifier if
+   given, and set the binding label in either the given symbol (if not
+   NULL), or in the current_ts.  The symbol may be NULL because we may
+   encounter the BIND(C) before the declaration itself.  Return
+   MATCH_NO if what we're looking at isn't a BIND(C) specifier,
+   MATCH_ERROR if it is a BIND(C) clause but an error was encountered,
+   or MATCH_YES if the specifier was correct and the binding label and
+   bind(c) fields were set correctly for the given symbol or the
+   current_ts. If allow_binding_name is false, no binding name may be
+   given.  */
+
+match
+gfc_match_bind_c (gfc_symbol *sym, bool allow_binding_name)
+{
+  /* binding label, if exists */   
+  char binding_label[GFC_MAX_SYMBOL_LEN + 1];
+  match double_quote;
+  match single_quote;
+
+  /* Initialize the flag that specifies whether we encountered a NAME= 
+     specifier or not.  */
+  has_name_equals = 0;
+
+  /* Init the first char to nil so we can catch if we don't have
+     the label (name attr) or the symbol name yet.  */
+  binding_label[0] = '\0';
+   
+  /* This much we have to be able to match, in this order, if
+     there is a bind(c) label.	*/
+  if (gfc_match (" bind ( c ") != MATCH_YES)
+    return MATCH_NO;
+
+  /* Now see if there is a binding label, or if we've reached the
+     end of the bind(c) attribute without one.	*/
+  if (gfc_match_char (',') == MATCH_YES)
+    {
+      if (gfc_match (" name = ") != MATCH_YES)
+        {
+          gfc_error ("Syntax error in NAME= specifier for binding label "
+                     "at %C");
+          /* should give an error message here */
+          return MATCH_ERROR;
+        }
+
+      has_name_equals = 1;
+
+      /* Get the opening quote.  */
+      double_quote = MATCH_YES;
+      single_quote = MATCH_YES;
+      double_quote = gfc_match_char ('"');
+      if (double_quote != MATCH_YES)
+	single_quote = gfc_match_char ('\'');
+      if (double_quote != MATCH_YES && single_quote != MATCH_YES)
+        {
+          gfc_error ("Syntax error in NAME= specifier for binding label "
+                     "at %C");
+          return MATCH_ERROR;
+        }
+      
+      /* Grab the binding label, using functions that will not lower
+	 case the names automatically.	*/
+      if (gfc_match_name_C (binding_label) != MATCH_YES)
+	 return MATCH_ERROR;
+      
+      /* Get the closing quotation.  */
+      if (double_quote == MATCH_YES)
+	{
+	  if (gfc_match_char ('"') != MATCH_YES)
+            {
+              gfc_error ("Missing closing quote '\"' for binding label at %C");
+              /* User started string with '"' so looked to match it.  */
+              return MATCH_ERROR;
+            }
+	}
+      else
+	{
+	  if (gfc_match_char ('\'') != MATCH_YES)
+            {
+              gfc_error ("Missing closing quote '\'' for binding label at %C");
+              /* User started string with "'" char.  */
+              return MATCH_ERROR;
+            }
+	}
+   }
+
+  /* Get the required right paren.  */
+  if (gfc_match_char (')') != MATCH_YES)
+    {
+      gfc_error ("Missing closing paren for binding label at %C");
+      return MATCH_ERROR;
+    }
+
+  if (has_name_equals && !allow_binding_name)
+    {
+      gfc_error ("No binding name is allowed in BIND(C) at %C");
+      return MATCH_ERROR;
+    }
+
+  if (has_name_equals && sym != NULL && sym->attr.dummy)
+    {
+      gfc_error ("For dummy procedure %s, no binding name is "
+		 "allowed in BIND(C) at %C", sym->name);
+      return MATCH_ERROR;
+    }
+
+
+  /* Save the binding label to the symbol.  If sym is null, we're
+     probably matching the typespec attributes of a declaration and
+     haven't gotten the name yet, and therefore, no symbol yet.	 */
+  if (binding_label[0] != '\0')
+    {
+      if (sym != NULL)
+      {
+	strcpy (sym->binding_label, binding_label);
+      }
+      else
+	strcpy (curr_binding_label, binding_label);
+    }
+  else if (allow_binding_name)
+    {
+      /* No binding label, but if symbol isn't null, we
+	 can set the label for it here.
+	 If name="" or allow_binding_name is false, no C binding name is
+	 created. */
+      if (sym != NULL && sym->name != NULL && has_name_equals == 0)
+	strncpy (sym->binding_label, sym->name, strlen (sym->name) + 1);
+    }
+
+  if (has_name_equals && gfc_current_state () == COMP_INTERFACE
+      && current_interface.type == INTERFACE_ABSTRACT)
+    {
+      gfc_error ("NAME not allowed on BIND(C) for ABSTRACT INTERFACE at %C");
+      return MATCH_ERROR;
+    }
+
+  return MATCH_YES;
+}
+
+
+/* Return nonzero if we're currently compiling a contained procedure.  */
+
+static int
+contained_procedure (void)
+{
+  gfc_state_data *s = gfc_state_stack;
+
+  if ((s->state == COMP_SUBROUTINE || s->state == COMP_FUNCTION)
+      && s->previous != NULL && s->previous->state == COMP_CONTAINS)
+    return 1;
+
+  return 0;
+}
+
+/* Set the kind of each enumerator.  The kind is selected such that it is
+   interoperable with the corresponding C enumeration type, making
+   sure that -fshort-enums is honored.  */
+
+static void
+set_enum_kind(void)
+{
+  enumerator_history *current_history = NULL;
+  int kind;
+  int i;
+
+  if (max_enum == NULL || enum_history == NULL)
+    return;
+
+  if (!flag_short_enums)
+    return;
+
+  i = 0;
+  do
+    {
+      kind = gfc_integer_kinds[i++].kind;
+    }
+  while (kind < gfc_c_int_kind
+	 && gfc_check_integer_range (max_enum->initializer->value.integer,
+				     kind) != ARITH_OK);
+
+  current_history = enum_history;
+  while (current_history != NULL)
+    {
+      current_history->sym->ts.kind = kind;
+      current_history = current_history->next;
+    }
+}
+
+
+/* Match any of the various end-block statements.  Returns the type of
+   END to the caller.  The END INTERFACE, END IF, END DO, END SELECT
+   and END BLOCK statements cannot be replaced by a single END statement.  */
+
+match
+gfc_match_end (gfc_statement *st)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_compile_state state;
+  locus old_loc;
+  const char *block_name;
+  const char *target;
+  int eos_ok;
+  match m;
+  gfc_namespace *parent_ns, *ns, *prev_ns;
+  gfc_namespace **nsp;
+
+  old_loc = gfc_current_locus;
+  if (gfc_match ("end") != MATCH_YES)
+    return MATCH_NO;
+
+  state = gfc_current_state ();
+  block_name = gfc_current_block () == NULL
+	     ? NULL : gfc_current_block ()->name;
+
+  switch (state)
+    {
+    case COMP_ASSOCIATE:
+    case COMP_BLOCK:
+      if (!strcmp (block_name, "block@"))
+	block_name = NULL;
+      break;
+
+    case COMP_CONTAINS:
+    case COMP_DERIVED_CONTAINS:
+      state = gfc_state_stack->previous->state;
+      block_name = gfc_state_stack->previous->sym == NULL
+		 ? NULL : gfc_state_stack->previous->sym->name;
+      break;
+
+    default:
+      break;
+    }
+
+  switch (state)
+    {
+    case COMP_NONE:
+    case COMP_PROGRAM:
+      *st = ST_END_PROGRAM;
+      target = " program";
+      eos_ok = 1;
+      break;
+
+    case COMP_SUBROUTINE:
+      *st = ST_END_SUBROUTINE;
+      target = " subroutine";
+      eos_ok = !contained_procedure ();
+      break;
+
+    case COMP_FUNCTION:
+      *st = ST_END_FUNCTION;
+      target = " function";
+      eos_ok = !contained_procedure ();
+      break;
+
+    case COMP_BLOCK_DATA:
+      *st = ST_END_BLOCK_DATA;
+      target = " block data";
+      eos_ok = 1;
+      break;
+
+    case COMP_MODULE:
+      *st = ST_END_MODULE;
+      target = " module";
+      eos_ok = 1;
+      break;
+
+    case COMP_INTERFACE:
+      *st = ST_END_INTERFACE;
+      target = " interface";
+      eos_ok = 0;
+      break;
+
+    case COMP_DERIVED:
+    case COMP_DERIVED_CONTAINS:
+      *st = ST_END_TYPE;
+      target = " type";
+      eos_ok = 0;
+      break;
+
+    case COMP_ASSOCIATE:
+      *st = ST_END_ASSOCIATE;
+      target = " associate";
+      eos_ok = 0;
+      break;
+
+    case COMP_BLOCK:
+      *st = ST_END_BLOCK;
+      target = " block";
+      eos_ok = 0;
+      break;
+
+    case COMP_IF:
+      *st = ST_ENDIF;
+      target = " if";
+      eos_ok = 0;
+      break;
+
+    case COMP_DO:
+      *st = ST_ENDDO;
+      target = " do";
+      eos_ok = 0;
+      break;
+
+    case COMP_CRITICAL:
+      *st = ST_END_CRITICAL;
+      target = " critical";
+      eos_ok = 0;
+      break;
+
+    case COMP_SELECT:
+    case COMP_SELECT_TYPE:
+      *st = ST_END_SELECT;
+      target = " select";
+      eos_ok = 0;
+      break;
+
+    case COMP_FORALL:
+      *st = ST_END_FORALL;
+      target = " forall";
+      eos_ok = 0;
+      break;
+
+    case COMP_WHERE:
+      *st = ST_END_WHERE;
+      target = " where";
+      eos_ok = 0;
+      break;
+
+    case COMP_ENUM:
+      *st = ST_END_ENUM;
+      target = " enum";
+      eos_ok = 0;
+      last_initializer = NULL;
+      set_enum_kind ();
+      gfc_free_enum_history ();
+      break;
+
+    default:
+      gfc_error ("Unexpected END statement at %C");
+      goto cleanup;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    {
+      if (!eos_ok && (*st == ST_END_SUBROUTINE || *st == ST_END_FUNCTION))
+	{
+	  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: END statement "
+			      "instead of %s statement at %L",
+			      gfc_ascii_statement (*st), &old_loc) == FAILURE)
+	    goto cleanup;
+	}
+      else if (!eos_ok)
+	{
+	  /* We would have required END [something].  */
+	  gfc_error ("%s statement expected at %L",
+		     gfc_ascii_statement (*st), &old_loc);
+	  goto cleanup;
+	}
+
+      return MATCH_YES;
+    }
+
+  /* Verify that we've got the sort of end-block that we're expecting.  */
+  if (gfc_match (target) != MATCH_YES)
+    {
+      gfc_error ("Expecting %s statement at %C", gfc_ascii_statement (*st));
+      goto cleanup;
+    }
+
+  /* If we're at the end, make sure a block name wasn't required.  */
+  if (gfc_match_eos () == MATCH_YES)
+    {
+
+      if (*st != ST_ENDDO && *st != ST_ENDIF && *st != ST_END_SELECT
+	  && *st != ST_END_FORALL && *st != ST_END_WHERE && *st != ST_END_BLOCK
+	  && *st != ST_END_ASSOCIATE && *st != ST_END_CRITICAL)
+	return MATCH_YES;
+
+      if (!block_name)
+	return MATCH_YES;
+
+      gfc_error ("Expected block name of '%s' in %s statement at %C",
+		 block_name, gfc_ascii_statement (*st));
+
+      return MATCH_ERROR;
+    }
+
+  /* END INTERFACE has a special handler for its several possible endings.  */
+  if (*st == ST_END_INTERFACE)
+    return gfc_match_end_interface ();
+
+  /* We haven't hit the end of statement, so what is left must be an
+     end-name.  */
+  m = gfc_match_space ();
+  if (m == MATCH_YES)
+    m = gfc_match_name (name);
+
+  if (m == MATCH_NO)
+    gfc_error ("Expected terminating name at %C");
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  if (block_name == NULL)
+    goto syntax;
+
+  if (strcmp (name, block_name) != 0 && strcmp (block_name, "ppr@") != 0)
+    {
+      gfc_error ("Expected label '%s' for %s statement at %C", block_name,
+		 gfc_ascii_statement (*st));
+      goto cleanup;
+    }
+  /* Procedure pointer as function result.  */
+  else if (strcmp (block_name, "ppr@") == 0
+	   && strcmp (name, gfc_current_block ()->ns->proc_name->name) != 0)
+    {
+      gfc_error ("Expected label '%s' for %s statement at %C",
+		 gfc_current_block ()->ns->proc_name->name,
+		 gfc_ascii_statement (*st));
+      goto cleanup;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (*st);
+
+cleanup:
+  gfc_current_locus = old_loc;
+
+  /* If we are missing an END BLOCK, we created a half-ready namespace.
+     Remove it from the parent namespace's sibling list.  */
+
+  if (state == COMP_BLOCK)
+    {
+      parent_ns = gfc_current_ns->parent;
+
+      nsp = &(gfc_state_stack->previous->tail->ext.block.ns);
+
+      prev_ns = NULL;
+      ns = *nsp;
+      while (ns)
+	{
+	  if (ns == gfc_current_ns)
+	    {
+	      if (prev_ns == NULL)
+		*nsp = NULL;
+	      else
+		prev_ns->sibling = ns->sibling;
+	    }
+	  prev_ns = ns;
+	  ns = ns->sibling;
+	}
+  
+      gfc_free_namespace (gfc_current_ns);
+      gfc_current_ns = parent_ns;
+    }
+
+  return MATCH_ERROR;
+}
+
+
+
+/***************** Attribute declaration statements ****************/
+
+/* Set the attribute of a single variable.  */
+
+static match
+attr_decl1 (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_array_spec *as;
+  gfc_symbol *sym;
+  locus var_locus;
+  match m;
+
+  as = NULL;
+
+  m = gfc_match_name (name);
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  if (find_special (name, &sym, false))
+    return MATCH_ERROR;
+
+  var_locus = gfc_current_locus;
+
+  /* Deal with possible array specification for certain attributes.  */
+  if (current_attr.dimension
+      || current_attr.codimension
+      || current_attr.allocatable
+      || current_attr.pointer
+      || current_attr.target)
+    {
+      m = gfc_match_array_spec (&as, !current_attr.codimension,
+				!current_attr.dimension
+				&& !current_attr.pointer
+				&& !current_attr.target);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+
+      if (current_attr.dimension && m == MATCH_NO)
+	{
+	  gfc_error ("Missing array specification at %L in DIMENSION "
+		     "statement", &var_locus);
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+
+      if (current_attr.dimension && sym->value)
+	{
+	  gfc_error ("Dimensions specified for %s at %L after its "
+		     "initialisation", sym->name, &var_locus);
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+
+      if (current_attr.codimension && m == MATCH_NO)
+	{
+	  gfc_error ("Missing array specification at %L in CODIMENSION "
+		     "statement", &var_locus);
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+
+      if ((current_attr.allocatable || current_attr.pointer)
+	  && (m == MATCH_YES) && (as->type != AS_DEFERRED))
+	{
+	  gfc_error ("Array specification must be deferred at %L", &var_locus);
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+    }
+
+  /* Update symbol table.  DIMENSION attribute is set in
+     gfc_set_array_spec().  For CLASS variables, this must be applied
+     to the first component, or '_data' field.  */
+  if (sym->ts.type == BT_CLASS && sym->ts.u.derived->attr.is_class)
+    {
+      if (gfc_copy_attr (&CLASS_DATA (sym)->attr, &current_attr, &var_locus)
+	  == FAILURE)
+	{
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+    }
+  else
+    {
+      if (current_attr.dimension == 0 && current_attr.codimension == 0
+	  && gfc_copy_attr (&sym->attr, &current_attr, &var_locus) == FAILURE)
+	{
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+    }
+    
+  if (sym->ts.type == BT_CLASS
+      && gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false) == FAILURE)
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  if (gfc_set_array_spec (sym, as, &var_locus) == FAILURE)
+    {
+      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 (gfc_add_attribute (&sym->attr, &var_locus) == FAILURE)
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  if ((current_attr.external || current_attr.intrinsic)
+      && sym->attr.flavor != FL_PROCEDURE
+      && gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, NULL) == FAILURE)
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  add_hidden_procptr_result (sym);
+
+  return MATCH_YES;
+
+cleanup:
+  gfc_free_array_spec (as);
+  return m;
+}
+
+
+/* Generic attribute declaration subroutine.  Used for attributes that
+   just have a list of names.  */
+
+static match
+attr_decl (void)
+{
+  match m;
+
+  /* Gobble the optional double colon, by simply ignoring the result
+     of gfc_match().  */
+  gfc_match (" ::");
+
+  for (;;)
+    {
+      m = attr_decl1 ();
+      if (m != MATCH_YES)
+	break;
+
+      if (gfc_match_eos () == MATCH_YES)
+	{
+	  m = MATCH_YES;
+	  break;
+	}
+
+      if (gfc_match_char (',') != MATCH_YES)
+	{
+	  gfc_error ("Unexpected character in variable list at %C");
+	  m = MATCH_ERROR;
+	  break;
+	}
+    }
+
+  return m;
+}
+
+
+/* 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)
+   After gimplification, pointee variable will disappear in the code.  */
+
+static match
+cray_pointer_decl (void)
+{
+  match m;
+  gfc_array_spec *as = NULL;
+  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, true, false);
+      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)
+{
+
+  gfc_clear_attr (&current_attr);
+  current_attr.external = 1;
+
+  return attr_decl ();
+}
+
+
+match
+gfc_match_intent (void)
+{
+  sym_intent intent;
+
+  /* This is not allowed within a BLOCK construct!  */
+  if (gfc_current_state () == COMP_BLOCK)
+    {
+      gfc_error ("INTENT is not allowed inside of BLOCK at %C");
+      return MATCH_ERROR;
+    }
+
+  intent = match_intent_spec ();
+  if (intent == INTENT_UNKNOWN)
+    return MATCH_ERROR;
+
+  gfc_clear_attr (&current_attr);
+  current_attr.intent = intent;
+
+  return attr_decl ();
+}
+
+
+match
+gfc_match_intrinsic (void)
+{
+
+  gfc_clear_attr (&current_attr);
+  current_attr.intrinsic = 1;
+
+  return attr_decl ();
+}
+
+
+match
+gfc_match_optional (void)
+{
+  /* This is not allowed within a BLOCK construct!  */
+  if (gfc_current_state () == COMP_BLOCK)
+    {
+      gfc_error ("OPTIONAL is not allowed inside of BLOCK at %C");
+      return MATCH_ERROR;
+    }
+
+  gfc_clear_attr (&current_attr);
+  current_attr.optional = 1;
+
+  return attr_decl ();
+}
+
+
+match
+gfc_match_pointer (void)
+{
+  gfc_gobble_whitespace ();
+  if (gfc_peek_ascii_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);
+      current_attr.pointer = 1;
+    
+      return attr_decl ();
+    }
+}
+
+
+match
+gfc_match_allocatable (void)
+{
+  gfc_clear_attr (&current_attr);
+  current_attr.allocatable = 1;
+
+  return attr_decl ();
+}
+
+
+match
+gfc_match_codimension (void)
+{
+  gfc_clear_attr (&current_attr);
+  current_attr.codimension = 1;
+
+  return attr_decl ();
+}
+
+
+match
+gfc_match_contiguous (void)
+{
+  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: CONTIGUOUS statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  gfc_clear_attr (&current_attr);
+  current_attr.contiguous = 1;
+
+  return attr_decl ();
+}
+
+
+match
+gfc_match_dimension (void)
+{
+  gfc_clear_attr (&current_attr);
+  current_attr.dimension = 1;
+
+  return attr_decl ();
+}
+
+
+match
+gfc_match_target (void)
+{
+  gfc_clear_attr (&current_attr);
+  current_attr.target = 1;
+
+  return attr_decl ();
+}
+
+
+/* Match the list of entities being specified in a PUBLIC or PRIVATE
+   statement.  */
+
+static match
+access_attr_decl (gfc_statement st)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  interface_type type;
+  gfc_user_op *uop;
+  gfc_symbol *sym;
+  gfc_intrinsic_op op;
+  match m;
+
+  if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
+    goto done;
+
+  for (;;)
+    {
+      m = gfc_match_generic_spec (&type, name, &op);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	return MATCH_ERROR;
+
+      switch (type)
+	{
+	case INTERFACE_NAMELESS:
+	case INTERFACE_ABSTRACT:
+	  goto syntax;
+
+	case INTERFACE_GENERIC:
+	  if (gfc_get_symbol (name, NULL, &sym))
+	    goto done;
+
+	  if (gfc_add_access (&sym->attr, (st == ST_PUBLIC)
+					  ? ACCESS_PUBLIC : ACCESS_PRIVATE,
+			      sym->name, NULL) == FAILURE)
+	    return MATCH_ERROR;
+
+	  break;
+
+	case INTERFACE_INTRINSIC_OP:
+	  if (gfc_current_ns->operator_access[op] == ACCESS_UNKNOWN)
+	    {
+	      gfc_intrinsic_op other_op;
+
+	      gfc_current_ns->operator_access[op] =
+		(st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
+
+	      /* Handle the case if there is another op with the same
+		 function, for INTRINSIC_EQ vs. INTRINSIC_EQ_OS and so on.  */
+	      other_op = gfc_equivalent_op (op);
+
+	      if (other_op != INTRINSIC_NONE)
+		gfc_current_ns->operator_access[other_op] =
+		  (st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
+
+	    }
+	  else
+	    {
+	      gfc_error ("Access specification of the %s operator at %C has "
+			 "already been specified", gfc_op2string (op));
+	      goto done;
+	    }
+
+	  break;
+
+	case INTERFACE_USER_OP:
+	  uop = gfc_get_uop (name);
+
+	  if (uop->access == ACCESS_UNKNOWN)
+	    {
+	      uop->access = (st == ST_PUBLIC)
+			  ? ACCESS_PUBLIC : ACCESS_PRIVATE;
+	    }
+	  else
+	    {
+	      gfc_error ("Access specification of the .%s. operator at %C "
+			 "has already been specified", sym->name);
+	      goto done;
+	    }
+
+	  break;
+	}
+
+      if (gfc_match_char (',') == MATCH_NO)
+	break;
+    }
+
+  if (gfc_match_eos () != MATCH_YES)
+    goto syntax;
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (st);
+
+done:
+  return MATCH_ERROR;
+}
+
+
+match
+gfc_match_protected (void)
+{
+  gfc_symbol *sym;
+  match m;
+
+  if (gfc_current_ns->proc_name->attr.flavor != FL_MODULE)
+    {
+       gfc_error ("PROTECTED at %C only allowed in specification "
+		  "part of a module");
+       return MATCH_ERROR;
+
+    }
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PROTECTED statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
+    {
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    goto syntax;
+
+  for(;;)
+    {
+      m = gfc_match_symbol (&sym, 0);
+      switch (m)
+	{
+	case MATCH_YES:
+	  if (gfc_add_protected (&sym->attr, sym->name, &gfc_current_locus)
+	      == FAILURE)
+	    return MATCH_ERROR;
+	  goto next_item;
+
+	case MATCH_NO:
+	  break;
+
+	case MATCH_ERROR:
+	  return MATCH_ERROR;
+	}
+
+    next_item:
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in PROTECTED statement at %C");
+  return MATCH_ERROR;
+}
+
+
+/* The PRIVATE statement is a bit weird in that it can be an attribute
+   declaration, but also works as a standalone statement inside of a
+   type declaration or a module.  */
+
+match
+gfc_match_private (gfc_statement *st)
+{
+
+  if (gfc_match ("private") != MATCH_YES)
+    return MATCH_NO;
+
+  if (gfc_current_state () != COMP_MODULE
+      && !(gfc_current_state () == COMP_DERIVED
+	   && gfc_state_stack->previous
+	   && gfc_state_stack->previous->state == COMP_MODULE)
+      && !(gfc_current_state () == COMP_DERIVED_CONTAINS
+	   && gfc_state_stack->previous && gfc_state_stack->previous->previous
+	   && gfc_state_stack->previous->previous->state == COMP_MODULE))
+    {
+      gfc_error ("PRIVATE statement at %C is only allowed in the "
+		 "specification part of a module");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_current_state () == COMP_DERIVED)
+    {
+      if (gfc_match_eos () == MATCH_YES)
+	{
+	  *st = ST_PRIVATE;
+	  return MATCH_YES;
+	}
+
+      gfc_syntax_error (ST_PRIVATE);
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    {
+      *st = ST_PRIVATE;
+      return MATCH_YES;
+    }
+
+  *st = ST_ATTR_DECL;
+  return access_attr_decl (ST_PRIVATE);
+}
+
+
+match
+gfc_match_public (gfc_statement *st)
+{
+
+  if (gfc_match ("public") != MATCH_YES)
+    return MATCH_NO;
+
+  if (gfc_current_state () != COMP_MODULE)
+    {
+      gfc_error ("PUBLIC statement at %C is only allowed in the "
+		 "specification part of a module");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    {
+      *st = ST_PUBLIC;
+      return MATCH_YES;
+    }
+
+  *st = ST_ATTR_DECL;
+  return access_attr_decl (ST_PUBLIC);
+}
+
+
+/* Workhorse for gfc_match_parameter.  */
+
+static match
+do_parm (void)
+{
+  gfc_symbol *sym;
+  gfc_expr *init;
+  match m;
+  gfc_try t;
+
+  m = gfc_match_symbol (&sym, 0);
+  if (m == MATCH_NO)
+    gfc_error ("Expected variable name at %C in PARAMETER statement");
+
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_match_char ('=') == MATCH_NO)
+    {
+      gfc_error ("Expected = sign in PARAMETER statement at %C");
+      return MATCH_ERROR;
+    }
+
+  m = gfc_match_init_expr (&init);
+  if (m == MATCH_NO)
+    gfc_error ("Expected expression at %C in PARAMETER statement");
+  if (m != MATCH_YES)
+    return m;
+
+  if (sym->ts.type == BT_UNKNOWN
+      && gfc_set_default_type (sym, 1, NULL) == FAILURE)
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  if (gfc_check_assign_symbol (sym, init) == FAILURE
+      || gfc_add_flavor (&sym->attr, FL_PARAMETER, sym->name, NULL) == FAILURE)
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  if (sym->value)
+    {
+      gfc_error ("Initializing already initialized variable at %C");
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  t = add_init_expr_to_sym (sym->name, &init, &gfc_current_locus);
+  return (t == SUCCESS) ? MATCH_YES : MATCH_ERROR;
+
+cleanup:
+  gfc_free_expr (init);
+  return m;
+}
+
+
+/* Match a parameter statement, with the weird syntax that these have.  */
+
+match
+gfc_match_parameter (void)
+{
+  match m;
+
+  if (gfc_match_char ('(') == MATCH_NO)
+    return MATCH_NO;
+
+  for (;;)
+    {
+      m = do_parm ();
+      if (m != MATCH_YES)
+	break;
+
+      if (gfc_match (" )%t") == MATCH_YES)
+	break;
+
+      if (gfc_match_char (',') != MATCH_YES)
+	{
+	  gfc_error ("Unexpected characters in PARAMETER statement at %C");
+	  m = MATCH_ERROR;
+	  break;
+	}
+    }
+
+  return m;
+}
+
+
+/* Save statements have a special syntax.  */
+
+match
+gfc_match_save (void)
+{
+  char n[GFC_MAX_SYMBOL_LEN+1];
+  gfc_common_head *c;
+  gfc_symbol *sym;
+  match m;
+
+  if (gfc_match_eos () == MATCH_YES)
+    {
+      if (gfc_current_ns->seen_save)
+	{
+	  if (gfc_notify_std (GFC_STD_LEGACY, "Blanket SAVE statement at %C "
+			      "follows previous SAVE statement")
+	      == FAILURE)
+	    return MATCH_ERROR;
+	}
+
+      gfc_current_ns->save_all = gfc_current_ns->seen_save = 1;
+      return MATCH_YES;
+    }
+
+  if (gfc_current_ns->save_all)
+    {
+      if (gfc_notify_std (GFC_STD_LEGACY, "SAVE statement at %C follows "
+			  "blanket SAVE statement")
+	  == FAILURE)
+	return MATCH_ERROR;
+    }
+
+  gfc_match (" ::");
+
+  for (;;)
+    {
+      m = gfc_match_symbol (&sym, 0);
+      switch (m)
+	{
+	case MATCH_YES:
+	  if (gfc_add_save (&sym->attr, SAVE_EXPLICIT, sym->name,
+			    &gfc_current_locus) == FAILURE)
+	    return MATCH_ERROR;
+	  goto next_item;
+
+	case MATCH_NO:
+	  break;
+
+	case MATCH_ERROR:
+	  return MATCH_ERROR;
+	}
+
+      m = gfc_match (" / %n /", &n);
+      if (m == MATCH_ERROR)
+	return MATCH_ERROR;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      c = gfc_get_common (n, 0);
+      c->saved = 1;
+
+      gfc_current_ns->seen_save = 1;
+
+    next_item:
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in SAVE statement at %C");
+  return MATCH_ERROR;
+}
+
+
+match
+gfc_match_value (void)
+{
+  gfc_symbol *sym;
+  match m;
+
+  /* This is not allowed within a BLOCK construct!  */
+  if (gfc_current_state () == COMP_BLOCK)
+    {
+      gfc_error ("VALUE is not allowed inside of BLOCK at %C");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: VALUE statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
+    {
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    goto syntax;
+
+  for(;;)
+    {
+      m = gfc_match_symbol (&sym, 0);
+      switch (m)
+	{
+	case MATCH_YES:
+	  if (gfc_add_value (&sym->attr, sym->name, &gfc_current_locus)
+	      == FAILURE)
+	    return MATCH_ERROR;
+	  goto next_item;
+
+	case MATCH_NO:
+	  break;
+
+	case MATCH_ERROR:
+	  return MATCH_ERROR;
+	}
+
+    next_item:
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in VALUE statement at %C");
+  return MATCH_ERROR;
+}
+
+
+match
+gfc_match_volatile (void)
+{
+  gfc_symbol *sym;
+  match m;
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: VOLATILE statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
+    {
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    goto syntax;
+
+  for(;;)
+    {
+      /* VOLATILE is special because it can be added to host-associated 
+	 symbols locally. Except for coarrays. */
+      m = gfc_match_symbol (&sym, 1);
+      switch (m)
+	{
+	case MATCH_YES:
+	  /* F2008, C560+C561. VOLATILE for host-/use-associated variable or
+	     for variable in a BLOCK which is defined outside of the BLOCK.  */
+	  if (sym->ns != gfc_current_ns && sym->attr.codimension)
+	    {
+	      gfc_error ("Specifying VOLATILE for coarray variable '%s' at "
+			 "%C, which is use-/host-associated", sym->name);
+	      return MATCH_ERROR;
+	    }
+	  if (gfc_add_volatile (&sym->attr, sym->name, &gfc_current_locus)
+	      == FAILURE)
+	    return MATCH_ERROR;
+	  goto next_item;
+
+	case MATCH_NO:
+	  break;
+
+	case MATCH_ERROR:
+	  return MATCH_ERROR;
+	}
+
+    next_item:
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in VOLATILE statement at %C");
+  return MATCH_ERROR;
+}
+
+
+match
+gfc_match_asynchronous (void)
+{
+  gfc_symbol *sym;
+  match m;
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ASYNCHRONOUS statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
+    {
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    goto syntax;
+
+  for(;;)
+    {
+      /* ASYNCHRONOUS is special because it can be added to host-associated 
+	 symbols locally.  */
+      m = gfc_match_symbol (&sym, 1);
+      switch (m)
+	{
+	case MATCH_YES:
+	  if (gfc_add_asynchronous (&sym->attr, sym->name, &gfc_current_locus)
+	      == FAILURE)
+	    return MATCH_ERROR;
+	  goto next_item;
+
+	case MATCH_NO:
+	  break;
+
+	case MATCH_ERROR:
+	  return MATCH_ERROR;
+	}
+
+    next_item:
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in ASYNCHRONOUS statement at %C");
+  return MATCH_ERROR;
+}
+
+
+/* Match a module procedure statement.  Note that we have to modify
+   symbols in the parent's namespace because the current one was there
+   to receive symbols that are in an interface's formal argument list.  */
+
+match
+gfc_match_modproc (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symbol *sym;
+  match m;
+  locus old_locus;
+  gfc_namespace *module_ns;
+  gfc_interface *old_interface_head, *interface;
+
+  if (gfc_state_stack->state != COMP_INTERFACE
+      || gfc_state_stack->previous == NULL
+      || current_interface.type == INTERFACE_NAMELESS
+      || current_interface.type == INTERFACE_ABSTRACT)
+    {
+      gfc_error ("MODULE PROCEDURE at %C must be in a generic module "
+		 "interface");
+      return MATCH_ERROR;
+    }
+
+  module_ns = gfc_current_ns->parent;
+  for (; module_ns; module_ns = module_ns->parent)
+    if (module_ns->proc_name->attr.flavor == FL_MODULE
+	|| module_ns->proc_name->attr.flavor == FL_PROGRAM
+	|| (module_ns->proc_name->attr.flavor == FL_PROCEDURE
+	    && !module_ns->proc_name->attr.contained))
+      break;
+
+  if (module_ns == NULL)
+    return MATCH_ERROR;
+
+  /* Store the current state of the interface. We will need it if we
+     end up with a syntax error and need to recover.  */
+  old_interface_head = gfc_current_interface_head ();
+
+  /* Check if the F2008 optional double colon appears.  */
+  gfc_gobble_whitespace ();
+  old_locus = gfc_current_locus;
+  if (gfc_match ("::") == MATCH_YES)
+    {
+      if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: double colon in "
+			 "MODULE PROCEDURE statement at %L", &old_locus)
+	  == FAILURE)
+	return MATCH_ERROR;
+    }
+  else
+    gfc_current_locus = old_locus;
+      
+  for (;;)
+    {
+      bool last = false;
+      old_locus = gfc_current_locus;
+
+      m = gfc_match_name (name);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m != MATCH_YES)
+	return MATCH_ERROR;
+
+      /* Check for syntax error before starting to add symbols to the
+	 current namespace.  */
+      if (gfc_match_eos () == MATCH_YES)
+	last = true;
+
+      if (!last && gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+
+      /* Now we're sure the syntax is valid, we process this item
+	 further.  */
+      if (gfc_get_symbol (name, module_ns, &sym))
+	return MATCH_ERROR;
+
+      if (sym->attr.intrinsic)
+	{
+	  gfc_error ("Intrinsic procedure at %L cannot be a MODULE "
+		     "PROCEDURE", &old_locus);
+	  return MATCH_ERROR;
+	}
+
+      if (sym->attr.proc != PROC_MODULE
+	  && gfc_add_procedure (&sym->attr, PROC_MODULE,
+				sym->name, NULL) == FAILURE)
+	return MATCH_ERROR;
+
+      if (gfc_add_interface (sym) == FAILURE)
+	return MATCH_ERROR;
+
+      sym->attr.mod_proc = 1;
+      sym->declared_at = old_locus;
+
+      if (last)
+	break;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  /* Restore the previous state of the interface.  */
+  interface = gfc_current_interface_head ();
+  gfc_set_current_interface_head (old_interface_head);
+
+  /* Free the new interfaces.  */
+  while (interface != old_interface_head)
+  {
+    gfc_interface *i = interface->next;
+    gfc_free (interface);
+    interface = i;
+  }
+
+  /* And issue a syntax error.  */
+  gfc_syntax_error (ST_MODULE_PROC);
+  return MATCH_ERROR;
+}
+
+
+/* Check a derived type that is being extended.  */
+static gfc_symbol*
+check_extended_derived_type (char *name)
+{
+  gfc_symbol *extended;
+
+  if (gfc_find_symbol (name, gfc_current_ns, 1, &extended))
+    {
+      gfc_error ("Ambiguous symbol in TYPE definition at %C");
+      return NULL;
+    }
+
+  if (!extended)
+    {
+      gfc_error ("No such symbol in TYPE definition at %C");
+      return NULL;
+    }
+
+  if (extended->attr.flavor != FL_DERIVED)
+    {
+      gfc_error ("'%s' in EXTENDS expression at %C is not a "
+		 "derived type", name);
+      return NULL;
+    }
+
+  if (extended->attr.is_bind_c)
+    {
+      gfc_error ("'%s' cannot be extended at %C because it "
+		 "is BIND(C)", extended->name);
+      return NULL;
+    }
+
+  if (extended->attr.sequence)
+    {
+      gfc_error ("'%s' cannot be extended at %C because it "
+		 "is a SEQUENCE type", extended->name);
+      return NULL;
+    }
+
+  return extended;
+}
+
+
+/* Match the optional attribute specifiers for a type declaration.
+   Return MATCH_ERROR if an error is encountered in one of the handled
+   attributes (public, private, bind(c)), MATCH_NO if what's found is
+   not a handled attribute, and MATCH_YES otherwise.  TODO: More error
+   checking on attribute conflicts needs to be done.  */
+
+match
+gfc_get_type_attr_spec (symbol_attribute *attr, char *name)
+{
+  /* See if the derived type is marked as private.  */
+  if (gfc_match (" , private") == MATCH_YES)
+    {
+      if (gfc_current_state () != COMP_MODULE)
+	{
+	  gfc_error ("Derived type at %C can only be PRIVATE in the "
+		     "specification part of a module");
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_add_access (attr, ACCESS_PRIVATE, NULL, NULL) == FAILURE)
+	return MATCH_ERROR;
+    }
+  else if (gfc_match (" , public") == MATCH_YES)
+    {
+      if (gfc_current_state () != COMP_MODULE)
+	{
+	  gfc_error ("Derived type at %C can only be PUBLIC in the "
+		     "specification part of a module");
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_add_access (attr, ACCESS_PUBLIC, NULL, NULL) == FAILURE)
+	return MATCH_ERROR;
+    }
+  else if (gfc_match (" , bind ( c )") == MATCH_YES)
+    {
+      /* If the type is defined to be bind(c) it then needs to make
+	 sure that all fields are interoperable.  This will
+	 need to be a semantic check on the finished derived type.
+	 See 15.2.3 (lines 9-12) of F2003 draft.  */
+      if (gfc_add_is_bind_c (attr, NULL, &gfc_current_locus, 0) != SUCCESS)
+	return MATCH_ERROR;
+
+      /* TODO: attr conflicts need to be checked, probably in symbol.c.  */
+    }
+  else if (gfc_match (" , abstract") == MATCH_YES)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ABSTRACT type at %C")
+	    == FAILURE)
+	return MATCH_ERROR;
+
+      if (gfc_add_abstract (attr, &gfc_current_locus) == FAILURE)
+	return MATCH_ERROR;
+    }
+  else if (name && gfc_match(" , extends ( %n )", name) == MATCH_YES)
+    {
+      if (gfc_add_extension (attr, &gfc_current_locus) == FAILURE)
+	return MATCH_ERROR;
+    }
+  else
+    return MATCH_NO;
+
+  /* If we get here, something matched.  */
+  return MATCH_YES;
+}
+
+
+/* Match the beginning of a derived type declaration.  If a type name
+   was the result of a function, then it is possible to have a symbol
+   already to be known as a derived type yet have no components.  */
+
+match
+gfc_match_derived_decl (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  char parent[GFC_MAX_SYMBOL_LEN + 1];
+  symbol_attribute attr;
+  gfc_symbol *sym;
+  gfc_symbol *extended;
+  match m;
+  match is_type_attr_spec = MATCH_NO;
+  bool seen_attr = false;
+
+  if (gfc_current_state () == COMP_DERIVED)
+    return MATCH_NO;
+
+  name[0] = '\0';
+  parent[0] = '\0';
+  gfc_clear_attr (&attr);
+  extended = NULL;
+
+  do
+    {
+      is_type_attr_spec = gfc_get_type_attr_spec (&attr, parent);
+      if (is_type_attr_spec == MATCH_ERROR)
+	return MATCH_ERROR;
+      if (is_type_attr_spec == MATCH_YES)
+	seen_attr = true;
+    } while (is_type_attr_spec == MATCH_YES);
+
+  /* Deal with derived type extensions.  The extension attribute has
+     been added to 'attr' but now the parent type must be found and
+     checked.  */
+  if (parent[0])
+    extended = check_extended_derived_type (parent);
+
+  if (parent[0] && !extended)
+    return MATCH_ERROR;
+
+  if (gfc_match (" ::") != MATCH_YES && seen_attr)
+    {
+      gfc_error ("Expected :: in TYPE definition at %C");
+      return MATCH_ERROR;
+    }
+
+  m = gfc_match (" %n%t", name);
+  if (m != MATCH_YES)
+    return m;
+
+  /* Make sure the name is not the name of an intrinsic type.  */
+  if (gfc_is_intrinsic_typename (name))
+    {
+      gfc_error ("Type name '%s' at %C cannot be the same as an intrinsic "
+		 "type", name);
+      return MATCH_ERROR;
+    }
+
+  if (gfc_get_symbol (name, NULL, &sym))
+    return MATCH_ERROR;
+
+  if (sym->ts.type != BT_UNKNOWN)
+    {
+      gfc_error ("Derived type name '%s' at %C already has a basic type "
+		 "of %s", sym->name, gfc_typename (&sym->ts));
+      return MATCH_ERROR;
+    }
+
+  /* The symbol may already have the derived attribute without the
+     components.  The ways this can happen is via a function
+     definition, an INTRINSIC statement or a subtype in another
+     derived type that is a pointer.  The first part of the AND clause
+     is true if the symbol is not the return value of a function.  */
+  if (sym->attr.flavor != FL_DERIVED
+      && gfc_add_flavor (&sym->attr, FL_DERIVED, sym->name, NULL) == FAILURE)
+    return MATCH_ERROR;
+
+  if (sym->components != NULL || sym->attr.zero_comp)
+    {
+      gfc_error ("Derived type definition of '%s' at %C has already been "
+		 "defined", sym->name);
+      return MATCH_ERROR;
+    }
+
+  if (attr.access != ACCESS_UNKNOWN
+      && gfc_add_access (&sym->attr, attr.access, sym->name, NULL) == FAILURE)
+    return MATCH_ERROR;
+
+  /* See if the derived type was labeled as bind(c).  */
+  if (attr.is_bind_c != 0)
+    sym->attr.is_bind_c = attr.is_bind_c;
+
+  /* Construct the f2k_derived namespace if it is not yet there.  */
+  if (!sym->f2k_derived)
+    sym->f2k_derived = gfc_get_namespace (NULL, 0);
+  
+  if (extended && !sym->components)
+    {
+      gfc_component *p;
+      gfc_symtree *st;
+
+      /* Add the extended derived type as the first component.  */
+      gfc_add_component (sym, parent, &p);
+      extended->refs++;
+      gfc_set_sym_referenced (extended);
+
+      p->ts.type = BT_DERIVED;
+      p->ts.u.derived = extended;
+      p->initializer = gfc_default_initializer (&p->ts);
+      
+      /* Set extension level.  */
+      if (extended->attr.extension == 255)
+	{
+	  /* Since the extension field is 8 bit wide, we can only have
+	     up to 255 extension levels.  */
+	  gfc_error ("Maximum extension level reached with type '%s' at %L",
+		     extended->name, &extended->declared_at);
+	  return MATCH_ERROR;
+	}
+      sym->attr.extension = extended->attr.extension + 1;
+
+      /* Provide the links between the extended type and its extension.  */
+      if (!extended->f2k_derived)
+	extended->f2k_derived = gfc_get_namespace (NULL, 0);
+      st = gfc_new_symtree (&extended->f2k_derived->sym_root, sym->name);
+      st->n.sym = sym;
+    }
+
+  if (!sym->hash_value)
+    /* Set the hash for the compound name for this type.  */
+    sym->hash_value = gfc_hash_value (sym);
+
+  /* Take over the ABSTRACT attribute.  */
+  sym->attr.abstract = attr.abstract;
+
+  gfc_new_block = sym;
+
+  return MATCH_YES;
+}
+
+
+/* Cray Pointees can be declared as: 
+      pointer (ipt, a (n,m,...,*))  */
+
+match
+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->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;
+}
+
+
+/* Match the enum definition statement, here we are trying to match 
+   the first line of enum definition statement.  
+   Returns MATCH_YES if match is found.  */
+
+match
+gfc_match_enum (void)
+{
+  match m;
+  
+  m = gfc_match_eos ();
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ENUM and ENUMERATOR at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  return MATCH_YES;
+}
+
+
+/* Returns an initializer whose value is one higher than the value of the
+   LAST_INITIALIZER argument.  If the argument is NULL, the
+   initializers value will be set to zero.  The initializer's kind
+   will be set to gfc_c_int_kind.
+
+   If -fshort-enums is given, the appropriate kind will be selected
+   later after all enumerators have been parsed.  A warning is issued
+   here if an initializer exceeds gfc_c_int_kind.  */
+
+static gfc_expr *
+enum_initializer (gfc_expr *last_initializer, locus where)
+{
+  gfc_expr *result;
+  result = gfc_get_constant_expr (BT_INTEGER, gfc_c_int_kind, &where);
+
+  mpz_init (result->value.integer);
+
+  if (last_initializer != NULL)
+    {
+      mpz_add_ui (result->value.integer, last_initializer->value.integer, 1);
+      result->where = last_initializer->where;
+
+      if (gfc_check_integer_range (result->value.integer,
+	     gfc_c_int_kind) != ARITH_OK)
+	{
+	  gfc_error ("Enumerator exceeds the C integer type at %C");
+	  return NULL;
+	}
+    }
+  else
+    {
+      /* Control comes here, if it's the very first enumerator and no
+	 initializer has been given.  It will be initialized to zero.  */
+      mpz_set_si (result->value.integer, 0);
+    }
+
+  return result;
+}
+
+
+/* Match a variable name with an optional initializer.  When this
+   subroutine is called, a variable is expected to be parsed next.
+   Depending on what is happening at the moment, updates either the
+   symbol table or the current interface.  */
+
+static match
+enumerator_decl (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_expr *initializer;
+  gfc_array_spec *as = NULL;
+  gfc_symbol *sym;
+  locus var_locus;
+  match m;
+  gfc_try t;
+  locus old_locus;
+
+  initializer = NULL;
+  old_locus = gfc_current_locus;
+
+  /* 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
+     is the name of the symbol.  */
+  m = gfc_match_name (name);
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  var_locus = gfc_current_locus;
+
+  /* OK, we've successfully matched the declaration.  Now put the
+     symbol in the current namespace. If we fail to create the symbol,
+     bail out.  */
+  if (build_sym (name, NULL, false, &as, &var_locus) == FAILURE)
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  /* The double colon must be present in order to have initializers.
+     Otherwise the statement is ambiguous with an assignment statement.  */
+  if (colon_seen)
+    {
+      if (gfc_match_char ('=') == MATCH_YES)
+	{
+	  m = gfc_match_init_expr (&initializer);
+	  if (m == MATCH_NO)
+	    {
+	      gfc_error ("Expected an initialization expression at %C");
+	      m = MATCH_ERROR;
+	    }
+
+	  if (m != MATCH_YES)
+	    goto cleanup;
+	}
+    }
+
+  /* If we do not have an initializer, the initialization value of the
+     previous enumerator (stored in last_initializer) is incremented
+     by 1 and is used to initialize the current enumerator.  */
+  if (initializer == NULL)
+    initializer = enum_initializer (last_initializer, old_locus);
+
+  if (initializer == NULL || initializer->ts.type != BT_INTEGER)
+    {
+      gfc_error ("ENUMERATOR %L not initialized with integer expression",
+		 &var_locus);
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  /* Store this current initializer, for the next enumerator variable
+     to be parsed.  add_init_expr_to_sym() zeros initializer, so we
+     use last_initializer below.  */
+  last_initializer = initializer;
+  t = add_init_expr_to_sym (name, &initializer, &var_locus);
+
+  /* Maintain enumerator history.  */
+  gfc_find_symbol (name, NULL, 0, &sym);
+  create_enum_history (sym, last_initializer);
+
+  return (t == SUCCESS) ? MATCH_YES : MATCH_ERROR;
+
+cleanup:
+  /* Free stuff up and return.  */
+  gfc_free_expr (initializer);
+
+  return m;
+}
+
+
+/* Match the enumerator definition statement.  */
+
+match
+gfc_match_enumerator_def (void)
+{
+  match m;
+  gfc_try t;
+
+  gfc_clear_ts (&current_ts);
+
+  m = gfc_match (" enumerator");
+  if (m != MATCH_YES)
+    return m;
+
+  m = gfc_match (" :: ");
+  if (m == MATCH_ERROR)
+    return m;
+
+  colon_seen = (m == MATCH_YES);
+
+  if (gfc_current_state () != COMP_ENUM)
+    {
+      gfc_error ("ENUM definition statement expected before %C");
+      gfc_free_enum_history ();
+      return MATCH_ERROR;
+    }
+
+  (&current_ts)->type = BT_INTEGER;
+  (&current_ts)->kind = gfc_c_int_kind;
+
+  gfc_clear_attr (&current_attr);
+  t = gfc_add_flavor (&current_attr, FL_PARAMETER, NULL, NULL);
+  if (t == FAILURE)
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  for (;;)
+    {
+      m = enumerator_decl ();
+      if (m == MATCH_ERROR)
+	{
+	  gfc_free_enum_history ();
+	  goto cleanup;
+	}
+      if (m == MATCH_NO)
+	break;
+
+      if (gfc_match_eos () == MATCH_YES)
+	goto cleanup;
+      if (gfc_match_char (',') != MATCH_YES)
+	break;
+    }
+
+  if (gfc_current_state () == COMP_ENUM)
+    {
+      gfc_free_enum_history ();
+      gfc_error ("Syntax error in ENUMERATOR definition at %C");
+      m = MATCH_ERROR;
+    }
+
+cleanup:
+  gfc_free_array_spec (current_as);
+  current_as = NULL;
+  return m;
+
+}
+
+
+/* Match binding attributes.  */
+
+static match
+match_binding_attributes (gfc_typebound_proc* ba, bool generic, bool ppc)
+{
+  bool found_passing = false;
+  bool seen_ptr = false;
+  match m = MATCH_YES;
+
+  /* Intialize to defaults.  Do so even before the MATCH_NO check so that in
+     this case the defaults are in there.  */
+  ba->access = ACCESS_UNKNOWN;
+  ba->pass_arg = NULL;
+  ba->pass_arg_num = 0;
+  ba->nopass = 0;
+  ba->non_overridable = 0;
+  ba->deferred = 0;
+  ba->ppc = ppc;
+
+  /* If we find a comma, we believe there are binding attributes.  */
+  m = gfc_match_char (',');
+  if (m == MATCH_NO)
+    goto done;
+
+  do
+    {
+      /* Access specifier.  */
+
+      m = gfc_match (" public");
+      if (m == MATCH_ERROR)
+	goto error;
+      if (m == MATCH_YES)
+	{
+	  if (ba->access != ACCESS_UNKNOWN)
+	    {
+	      gfc_error ("Duplicate access-specifier at %C");
+	      goto error;
+	    }
+
+	  ba->access = ACCESS_PUBLIC;
+	  continue;
+	}
+
+      m = gfc_match (" private");
+      if (m == MATCH_ERROR)
+	goto error;
+      if (m == MATCH_YES)
+	{
+	  if (ba->access != ACCESS_UNKNOWN)
+	    {
+	      gfc_error ("Duplicate access-specifier at %C");
+	      goto error;
+	    }
+
+	  ba->access = ACCESS_PRIVATE;
+	  continue;
+	}
+
+      /* If inside GENERIC, the following is not allowed.  */
+      if (!generic)
+	{
+
+	  /* NOPASS flag.  */
+	  m = gfc_match (" nopass");
+	  if (m == MATCH_ERROR)
+	    goto error;
+	  if (m == MATCH_YES)
+	    {
+	      if (found_passing)
+		{
+		  gfc_error ("Binding attributes already specify passing,"
+			     " illegal NOPASS at %C");
+		  goto error;
+		}
+
+	      found_passing = true;
+	      ba->nopass = 1;
+	      continue;
+	    }
+
+	  /* PASS possibly including argument.  */
+	  m = gfc_match (" pass");
+	  if (m == MATCH_ERROR)
+	    goto error;
+	  if (m == MATCH_YES)
+	    {
+	      char arg[GFC_MAX_SYMBOL_LEN + 1];
+
+	      if (found_passing)
+		{
+		  gfc_error ("Binding attributes already specify passing,"
+			     " illegal PASS at %C");
+		  goto error;
+		}
+
+	      m = gfc_match (" ( %n )", arg);
+	      if (m == MATCH_ERROR)
+		goto error;
+	      if (m == MATCH_YES)
+		ba->pass_arg = gfc_get_string (arg);
+	      gcc_assert ((m == MATCH_YES) == (ba->pass_arg != NULL));
+
+	      found_passing = true;
+	      ba->nopass = 0;
+	      continue;
+	    }
+
+	  if (ppc)
+	    {
+	      /* POINTER flag.  */
+	      m = gfc_match (" pointer");
+	      if (m == MATCH_ERROR)
+		goto error;
+	      if (m == MATCH_YES)
+		{
+		  if (seen_ptr)
+		    {
+		      gfc_error ("Duplicate POINTER attribute at %C");
+		      goto error;
+		    }
+
+		  seen_ptr = true;
+        	  continue;
+		}
+	    }
+	  else
+	    {
+	      /* NON_OVERRIDABLE flag.  */
+	      m = gfc_match (" non_overridable");
+	      if (m == MATCH_ERROR)
+		goto error;
+	      if (m == MATCH_YES)
+		{
+		  if (ba->non_overridable)
+		    {
+		      gfc_error ("Duplicate NON_OVERRIDABLE at %C");
+		      goto error;
+		    }
+
+		  ba->non_overridable = 1;
+		  continue;
+		}
+
+	      /* DEFERRED flag.  */
+	      m = gfc_match (" deferred");
+	      if (m == MATCH_ERROR)
+		goto error;
+	      if (m == MATCH_YES)
+		{
+		  if (ba->deferred)
+		    {
+		      gfc_error ("Duplicate DEFERRED at %C");
+		      goto error;
+		    }
+
+		  ba->deferred = 1;
+		  continue;
+		}
+	    }
+
+	}
+
+      /* Nothing matching found.  */
+      if (generic)
+	gfc_error ("Expected access-specifier at %C");
+      else
+	gfc_error ("Expected binding attribute at %C");
+      goto error;
+    }
+  while (gfc_match_char (',') == MATCH_YES);
+
+  /* NON_OVERRIDABLE and DEFERRED exclude themselves.  */
+  if (ba->non_overridable && ba->deferred)
+    {
+      gfc_error ("NON_OVERRIDABLE and DEFERRED can't both appear at %C");
+      goto error;
+    }
+
+  m = MATCH_YES;
+
+done:
+  if (ba->access == ACCESS_UNKNOWN)
+    ba->access = gfc_typebound_default_access;
+
+  if (ppc && !seen_ptr)
+    {
+      gfc_error ("POINTER attribute is required for procedure pointer component"
+                 " at %C");
+      goto error;
+    }
+
+  return m;
+
+error:
+  return MATCH_ERROR;
+}
+
+
+/* Match a PROCEDURE specific binding inside a derived type.  */
+
+static match
+match_procedure_in_type (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  char target_buf[GFC_MAX_SYMBOL_LEN + 1];
+  char* target = NULL, *ifc = NULL;
+  gfc_typebound_proc tb;
+  bool seen_colons;
+  bool seen_attrs;
+  match m;
+  gfc_symtree* stree;
+  gfc_namespace* ns;
+  gfc_symbol* block;
+  int num;
+
+  /* Check current state.  */
+  gcc_assert (gfc_state_stack->state == COMP_DERIVED_CONTAINS);
+  block = gfc_state_stack->previous->sym;
+  gcc_assert (block);
+
+  /* Try to match PROCEDURE(interface).  */
+  if (gfc_match (" (") == MATCH_YES)
+    {
+      m = gfc_match_name (target_buf);
+      if (m == MATCH_ERROR)
+	return m;
+      if (m != MATCH_YES)
+	{
+	  gfc_error ("Interface-name expected after '(' at %C");
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_match (" )") != MATCH_YES)
+	{
+	  gfc_error ("')' expected at %C");
+	  return MATCH_ERROR;
+	}
+
+      ifc = target_buf;
+    }
+
+  /* Construct the data structure.  */
+  memset (&tb, 0, sizeof (tb));
+  tb.where = gfc_current_locus;
+
+  /* Match binding attributes.  */
+  m = match_binding_attributes (&tb, false, false);
+  if (m == MATCH_ERROR)
+    return m;
+  seen_attrs = (m == MATCH_YES);
+
+  /* Check that attribute DEFERRED is given if an interface is specified.  */
+  if (tb.deferred && !ifc)
+    {
+      gfc_error ("Interface must be specified for DEFERRED binding at %C");
+      return MATCH_ERROR;
+    }
+  if (ifc && !tb.deferred)
+    {
+      gfc_error ("PROCEDURE(interface) at %C should be declared DEFERRED");
+      return MATCH_ERROR;
+    }
+
+  /* Match the colons.  */
+  m = gfc_match (" ::");
+  if (m == MATCH_ERROR)
+    return m;
+  seen_colons = (m == MATCH_YES);
+  if (seen_attrs && !seen_colons)
+    {
+      gfc_error ("Expected '::' after binding-attributes at %C");
+      return MATCH_ERROR;
+    }
+
+  /* Match the binding names.  */ 
+  for(num=1;;num++)
+    {
+      m = gfc_match_name (name);
+      if (m == MATCH_ERROR)
+	return m;
+      if (m == MATCH_NO)
+	{
+	  gfc_error ("Expected binding name at %C");
+	  return MATCH_ERROR;
+	}
+
+      if (num>1 && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: PROCEDURE list"
+				   " at %C") == FAILURE)
+	return MATCH_ERROR;
+
+      /* Try to match the '=> target', if it's there.  */
+      target = ifc;
+      m = gfc_match (" =>");
+      if (m == MATCH_ERROR)
+	return m;
+      if (m == MATCH_YES)
+	{
+	  if (tb.deferred)
+	    {
+	      gfc_error ("'=> target' is invalid for DEFERRED binding at %C");
+	      return MATCH_ERROR;
+	    }
+
+	  if (!seen_colons)
+	    {
+	      gfc_error ("'::' needed in PROCEDURE binding with explicit target"
+			 " at %C");
+	      return MATCH_ERROR;
+	    }
+
+	  m = gfc_match_name (target_buf);
+	  if (m == MATCH_ERROR)
+	    return m;
+	  if (m == MATCH_NO)
+	    {
+	      gfc_error ("Expected binding target after '=>' at %C");
+	      return MATCH_ERROR;
+	    }
+	  target = target_buf;
+	}
+
+      /* If no target was found, it has the same name as the binding.  */
+      if (!target)
+	target = name;
+
+      /* Get the namespace to insert the symbols into.  */
+      ns = block->f2k_derived;
+      gcc_assert (ns);
+
+      /* If the binding is DEFERRED, check that the containing type is ABSTRACT.  */
+      if (tb.deferred && !block->attr.abstract)
+	{
+	  gfc_error ("Type '%s' containing DEFERRED binding at %C "
+		     "is not ABSTRACT", block->name);
+	  return MATCH_ERROR;
+	}
+
+      /* See if we already have a binding with this name in the symtree which
+	 would be an error.  If a GENERIC already targetted this binding, it may
+	 be already there but then typebound is still NULL.  */
+      stree = gfc_find_symtree (ns->tb_sym_root, name);
+      if (stree && stree->n.tb)
+	{
+	  gfc_error ("There is already a procedure with binding name '%s' for "
+		     "the derived type '%s' at %C", name, block->name);
+	  return MATCH_ERROR;
+	}
+
+      /* Insert it and set attributes.  */
+
+      if (!stree)
+	{
+	  stree = gfc_new_symtree (&ns->tb_sym_root, name);
+	  gcc_assert (stree);
+	}
+      stree->n.tb = gfc_get_typebound_proc (&tb);
+
+      if (gfc_get_sym_tree (target, gfc_current_ns, &stree->n.tb->u.specific,
+			    false))
+	return MATCH_ERROR;
+      gfc_set_sym_referenced (stree->n.tb->u.specific->n.sym);
+  
+      if (gfc_match_eos () == MATCH_YES)
+	return MATCH_YES;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+syntax:
+  gfc_error ("Syntax error in PROCEDURE statement at %C");
+  return MATCH_ERROR;
+}
+
+
+/* Match a GENERIC procedure binding inside a derived type.  */
+
+match
+gfc_match_generic (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  char bind_name[GFC_MAX_SYMBOL_LEN + 16]; /* Allow space for OPERATOR(...).  */
+  gfc_symbol* block;
+  gfc_typebound_proc tbattr; /* Used for match_binding_attributes.  */
+  gfc_typebound_proc* tb;
+  gfc_namespace* ns;
+  interface_type op_type;
+  gfc_intrinsic_op op;
+  match m;
+
+  /* Check current state.  */
+  if (gfc_current_state () == COMP_DERIVED)
+    {
+      gfc_error ("GENERIC at %C must be inside a derived-type CONTAINS");
+      return MATCH_ERROR;
+    }
+  if (gfc_current_state () != COMP_DERIVED_CONTAINS)
+    return MATCH_NO;
+  block = gfc_state_stack->previous->sym;
+  ns = block->f2k_derived;
+  gcc_assert (block && ns);
+
+  memset (&tbattr, 0, sizeof (tbattr));
+  tbattr.where = gfc_current_locus;
+
+  /* See if we get an access-specifier.  */
+  m = match_binding_attributes (&tbattr, true, false);
+  if (m == MATCH_ERROR)
+    goto error;
+
+  /* Now the colons, those are required.  */
+  if (gfc_match (" ::") != MATCH_YES)
+    {
+      gfc_error ("Expected '::' at %C");
+      goto error;
+    }
+
+  /* Match the binding name; depending on type (operator / generic) format
+     it for future error messages into bind_name.  */
+ 
+  m = gfc_match_generic_spec (&op_type, name, &op);
+  if (m == MATCH_ERROR)
+    return MATCH_ERROR;
+  if (m == MATCH_NO)
+    {
+      gfc_error ("Expected generic name or operator descriptor at %C");
+      goto error;
+    }
+
+  switch (op_type)
+    {
+    case INTERFACE_GENERIC:
+      snprintf (bind_name, sizeof (bind_name), "%s", name);
+      break;
+ 
+    case INTERFACE_USER_OP:
+      snprintf (bind_name, sizeof (bind_name), "OPERATOR(.%s.)", name);
+      break;
+ 
+    case INTERFACE_INTRINSIC_OP:
+      snprintf (bind_name, sizeof (bind_name), "OPERATOR(%s)",
+		gfc_op2string (op));
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+
+  /* Match the required =>.  */
+  if (gfc_match (" =>") != MATCH_YES)
+    {
+      gfc_error ("Expected '=>' at %C");
+      goto error;
+    }
+  
+  /* Try to find existing GENERIC binding with this name / for this operator;
+     if there is something, check that it is another GENERIC and then extend
+     it rather than building a new node.  Otherwise, create it and put it
+     at the right position.  */
+
+  switch (op_type)
+    {
+    case INTERFACE_USER_OP:
+    case INTERFACE_GENERIC:
+      {
+	const bool is_op = (op_type == INTERFACE_USER_OP);
+	gfc_symtree* st;
+
+	st = gfc_find_symtree (is_op ? ns->tb_uop_root : ns->tb_sym_root, name);
+	if (st)
+	  {
+	    tb = st->n.tb;
+	    gcc_assert (tb);
+	  }
+	else
+	  tb = NULL;
+
+	break;
+      }
+
+    case INTERFACE_INTRINSIC_OP:
+      tb = ns->tb_op[op];
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+
+  if (tb)
+    {
+      if (!tb->is_generic)
+	{
+	  gcc_assert (op_type == INTERFACE_GENERIC);
+	  gfc_error ("There's already a non-generic procedure with binding name"
+		     " '%s' for the derived type '%s' at %C",
+		     bind_name, block->name);
+	  goto error;
+	}
+
+      if (tb->access != tbattr.access)
+	{
+	  gfc_error ("Binding at %C must have the same access as already"
+		     " defined binding '%s'", bind_name);
+	  goto error;
+	}
+    }
+  else
+    {
+      tb = gfc_get_typebound_proc (NULL);
+      tb->where = gfc_current_locus;
+      tb->access = tbattr.access;
+      tb->is_generic = 1;
+      tb->u.generic = NULL;
+
+      switch (op_type)
+	{
+	case INTERFACE_GENERIC:
+	case INTERFACE_USER_OP:
+	  {
+	    const bool is_op = (op_type == INTERFACE_USER_OP);
+	    gfc_symtree* st;
+
+	    st = gfc_new_symtree (is_op ? &ns->tb_uop_root : &ns->tb_sym_root,
+				  name);
+	    gcc_assert (st);
+	    st->n.tb = tb;
+
+	    break;
+	  }
+	  
+	case INTERFACE_INTRINSIC_OP:
+	  ns->tb_op[op] = tb;
+	  break;
+
+	default:
+	  gcc_unreachable ();
+	}
+    }
+
+  /* Now, match all following names as specific targets.  */
+  do
+    {
+      gfc_symtree* target_st;
+      gfc_tbp_generic* target;
+
+      m = gfc_match_name (name);
+      if (m == MATCH_ERROR)
+	goto error;
+      if (m == MATCH_NO)
+	{
+	  gfc_error ("Expected specific binding name at %C");
+	  goto error;
+	}
+
+      target_st = gfc_get_tbp_symtree (&ns->tb_sym_root, name);
+
+      /* See if this is a duplicate specification.  */
+      for (target = tb->u.generic; target; target = target->next)
+	if (target_st == target->specific_st)
+	  {
+	    gfc_error ("'%s' already defined as specific binding for the"
+		       " generic '%s' at %C", name, bind_name);
+	    goto error;
+	  }
+
+      target = gfc_get_tbp_generic ();
+      target->specific_st = target_st;
+      target->specific = NULL;
+      target->next = tb->u.generic;
+      tb->u.generic = target;
+    }
+  while (gfc_match (" ,") == MATCH_YES);
+
+  /* Here should be the end.  */
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      gfc_error ("Junk after GENERIC binding at %C");
+      goto error;
+    }
+
+  return MATCH_YES;
+
+error:
+  return MATCH_ERROR;
+}
+
+
+/* Match a FINAL declaration inside a derived type.  */
+
+match
+gfc_match_final_decl (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symbol* sym;
+  match m;
+  gfc_namespace* module_ns;
+  bool first, last;
+  gfc_symbol* block;
+
+  if (gfc_current_form == FORM_FREE)
+    {
+      char c = gfc_peek_ascii_char ();
+      if (!gfc_is_whitespace (c) && c != ':')
+	return MATCH_NO;
+    }
+  
+  if (gfc_state_stack->state != COMP_DERIVED_CONTAINS)
+    {
+      if (gfc_current_form == FORM_FIXED)
+	return MATCH_NO;
+
+      gfc_error ("FINAL declaration at %C must be inside a derived type "
+		 "CONTAINS section");
+      return MATCH_ERROR;
+    }
+
+  block = gfc_state_stack->previous->sym;
+  gcc_assert (block);
+
+  if (!gfc_state_stack->previous || !gfc_state_stack->previous->previous
+      || gfc_state_stack->previous->previous->state != COMP_MODULE)
+    {
+      gfc_error ("Derived type declaration with FINAL at %C must be in the"
+		 " specification part of a MODULE");
+      return MATCH_ERROR;
+    }
+
+  module_ns = gfc_current_ns;
+  gcc_assert (module_ns);
+  gcc_assert (module_ns->proc_name->attr.flavor == FL_MODULE);
+
+  /* Match optional ::, don't care about MATCH_YES or MATCH_NO.  */
+  if (gfc_match (" ::") == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  /* Match the sequence of procedure names.  */
+  first = true;
+  last = false;
+  do
+    {
+      gfc_finalizer* f;
+
+      if (first && gfc_match_eos () == MATCH_YES)
+	{
+	  gfc_error ("Empty FINAL at %C");
+	  return MATCH_ERROR;
+	}
+
+      m = gfc_match_name (name);
+      if (m == MATCH_NO)
+	{
+	  gfc_error ("Expected module procedure name at %C");
+	  return MATCH_ERROR;
+	}
+      else if (m != MATCH_YES)
+	return MATCH_ERROR;
+
+      if (gfc_match_eos () == MATCH_YES)
+	last = true;
+      if (!last && gfc_match_char (',') != MATCH_YES)
+	{
+	  gfc_error ("Expected ',' at %C");
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_get_symbol (name, module_ns, &sym))
+	{
+	  gfc_error ("Unknown procedure name \"%s\" at %C", name);
+	  return MATCH_ERROR;
+	}
+
+      /* Mark the symbol as module procedure.  */
+      if (sym->attr.proc != PROC_MODULE
+	  && gfc_add_procedure (&sym->attr, PROC_MODULE,
+				sym->name, NULL) == FAILURE)
+	return MATCH_ERROR;
+
+      /* Check if we already have this symbol in the list, this is an error.  */
+      for (f = block->f2k_derived->finalizers; f; f = f->next)
+	if (f->proc_sym == sym)
+	  {
+	    gfc_error ("'%s' at %C is already defined as FINAL procedure!",
+		       name);
+	    return MATCH_ERROR;
+	  }
+
+      /* Add this symbol to the list of finalizers.  */
+      gcc_assert (block->f2k_derived);
+      ++sym->refs;
+      f = XCNEW (gfc_finalizer);
+      f->proc_sym = sym;
+      f->proc_tree = NULL;
+      f->where = gfc_current_locus;
+      f->next = block->f2k_derived->finalizers;
+      block->f2k_derived->finalizers = f;
+
+      first = false;
+    }
+  while (!last);
+
+  return MATCH_YES;
+}
+
+
+const ext_attr_t ext_attr_list[] = {
+  { "dllimport", EXT_ATTR_DLLIMPORT, "dllimport" },
+  { "dllexport", EXT_ATTR_DLLEXPORT, "dllexport" },
+  { "cdecl",     EXT_ATTR_CDECL,     "cdecl"     },
+  { "stdcall",   EXT_ATTR_STDCALL,   "stdcall"   },
+  { "fastcall",  EXT_ATTR_FASTCALL,  "fastcall"  },
+  { NULL,        EXT_ATTR_LAST,      NULL        }
+};
+
+/* Match a !GCC$ ATTRIBUTES statement of the form:
+      !GCC$ ATTRIBUTES attribute-list :: var-name [, var-name] ...
+   When we come here, we have already matched the !GCC$ ATTRIBUTES string.
+
+   TODO: We should support all GCC attributes using the same syntax for
+   the attribute list, i.e. the list in C
+      __attributes(( attribute-list ))
+   matches then
+      !GCC$ ATTRIBUTES attribute-list ::
+   Cf. c-parser.c's c_parser_attributes; the data can then directly be
+   saved into a TREE.
+
+   As there is absolutely no risk of confusion, we should never return
+   MATCH_NO.  */
+match
+gfc_match_gcc_attributes (void)
+{ 
+  symbol_attribute attr;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  unsigned id;
+  gfc_symbol *sym;
+  match m;
+
+  gfc_clear_attr (&attr);
+  for(;;)
+    {
+      char ch;
+
+      if (gfc_match_name (name) != MATCH_YES)
+	return MATCH_ERROR;
+
+      for (id = 0; id < EXT_ATTR_LAST; id++)
+	if (strcmp (name, ext_attr_list[id].name) == 0)
+	  break;
+
+      if (id == EXT_ATTR_LAST)
+	{
+	  gfc_error ("Unknown attribute in !GCC$ ATTRIBUTES statement at %C");
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_add_ext_attribute (&attr, (ext_attr_id_t) id, &gfc_current_locus)
+	  == FAILURE)
+	return MATCH_ERROR;
+
+      gfc_gobble_whitespace ();
+      ch = gfc_next_ascii_char ();
+      if (ch == ':')
+        {
+          /* This is the successful exit condition for the loop.  */
+          if (gfc_next_ascii_char () == ':')
+            break;
+        }
+
+      if (ch == ',')
+	continue;
+
+      goto syntax;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    goto syntax;
+
+  for(;;)
+    {
+      m = gfc_match_name (name);
+      if (m != MATCH_YES)
+	return m;
+
+      if (find_special (name, &sym, true))
+	return MATCH_ERROR;
+      
+      sym->attr.ext_attr |= attr.ext_attr;
+
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in !GCC$ ATTRIBUTES statement at %C");
+  return MATCH_ERROR;
+}
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
new file mode 100644
index 000000000..49e47fb48
--- /dev/null
+++ b/gcc/fortran/dependency.c
@@ -0,0 +1,1882 @@
+/* Dependency analysis
+   Copyright (C) 2000, 2001, 2002, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* dependency.c -- Expression dependency analysis code.  */
+/* There's probably quite a bit of duplication in this file.  We currently
+   have different dependency checking functions for different types
+   if dependencies.  Ideally these would probably be merged.  */
+   
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+#include "dependency.h"
+#include "constructor.h"
+#include "arith.h"
+
+/* static declarations */
+/* Enums  */
+enum range {LHS, RHS, MID};
+
+/* Dependency types.  These must be in reverse order of priority.  */
+typedef enum
+{
+  GFC_DEP_ERROR,
+  GFC_DEP_EQUAL,	/* Identical Ranges.  */
+  GFC_DEP_FORWARD,	/* e.g., a(1:3) = a(2:4).  */
+  GFC_DEP_BACKWARD,	/* e.g. a(2:4) = a(1:3).  */
+  GFC_DEP_OVERLAP,	/* May overlap in some other way.  */
+  GFC_DEP_NODEP		/* Distinct ranges.  */
+}
+gfc_dependency;
+
+/* Macros */
+#define IS_ARRAY_EXPLICIT(as) ((as->type == AS_EXPLICIT ? 1 : 0))
+
+/* Forward declarations */
+
+static gfc_dependency check_section_vs_section (gfc_array_ref *,
+						gfc_array_ref *, int);
+
+/* Returns 1 if the expr is an integer constant value 1, 0 if it is not or
+   def if the value could not be determined.  */
+
+int
+gfc_expr_is_one (gfc_expr *expr, int def)
+{
+  gcc_assert (expr != NULL);
+
+  if (expr->expr_type != EXPR_CONSTANT)
+    return def;
+
+  if (expr->ts.type != BT_INTEGER)
+    return def;
+
+  return mpz_cmp_si (expr->value.integer, 1) == 0;
+}
+
+/* Check if two array references are known to be identical.  Calls
+   gfc_dep_compare_expr if necessary for comparing array indices.  */
+
+static bool
+identical_array_ref (gfc_array_ref *a1, gfc_array_ref *a2)
+{
+  int i;
+
+  if (a1->type == AR_FULL && a2->type == AR_FULL)
+    return true;
+
+  if (a1->type == AR_SECTION && a2->type == AR_SECTION)
+    {
+      gcc_assert (a1->dimen == a2->dimen);
+
+      for ( i = 0; i < a1->dimen; i++)
+	{
+	  /* TODO: Currently, we punt on an integer array as an index.  */
+	  if (a1->dimen_type[i] != DIMEN_RANGE
+	      || a2->dimen_type[i] != DIMEN_RANGE)
+	    return false;
+
+	  if (check_section_vs_section (a1, a2, i) != GFC_DEP_EQUAL)
+	    return false;
+	}
+      return true;
+    }
+
+  if (a1->type == AR_ELEMENT && a2->type == AR_ELEMENT)
+    {
+      gcc_assert (a1->dimen == a2->dimen);
+      for (i = 0; i < a1->dimen; i++)
+	{
+	  if (gfc_dep_compare_expr (a1->start[i], a2->start[i]) != 0)
+	    return false;
+	}
+      return true;
+    }
+  return false;
+}
+
+
+
+/* Return true for identical variables, checking for references if
+   necessary.  Calls identical_array_ref for checking array sections.  */
+
+bool
+gfc_are_identical_variables (gfc_expr *e1, gfc_expr *e2)
+{
+  gfc_ref *r1, *r2;
+
+  if (e1->symtree->n.sym != e2->symtree->n.sym)
+    return false;
+
+  /* Volatile variables should never compare equal to themselves.  */
+
+  if (e1->symtree->n.sym->attr.volatile_)
+    return false;
+
+  r1 = e1->ref;
+  r2 = e2->ref;
+
+  while (r1 != NULL || r2 != NULL)
+    {
+
+      /* Assume the variables are not equal if one has a reference and the
+	 other doesn't.
+	 TODO: Handle full references like comparing a(:) to a.
+      */
+
+      if (r1 == NULL || r2 == NULL)
+	return false;
+
+      if (r1->type != r2->type)
+	return false;
+
+      switch (r1->type)
+	{
+
+	case REF_ARRAY:
+	  if (!identical_array_ref (&r1->u.ar,  &r2->u.ar))
+	    return false;
+
+	  break;
+
+	case REF_COMPONENT:
+	  if (r1->u.c.component != r2->u.c.component)
+	    return false;
+	  break;
+
+	case REF_SUBSTRING:
+	  if (gfc_dep_compare_expr (r1->u.ss.start, r2->u.ss.start) != 0)
+	    return false;
+
+	  /* If both are NULL, the end length compares equal, because we
+	     are looking at the same variable. This can only happen for
+	     assumed- or deferred-length character arguments.  */ 
+
+	  if (r1->u.ss.end == NULL && r2->u.ss.end == NULL)
+	    break;
+
+	  if (gfc_dep_compare_expr (r1->u.ss.end, r2->u.ss.end) != 0)
+	    return false;
+	  
+	  break;
+
+	default:
+	  gfc_internal_error ("gfc_are_identical_variables: Bad type");
+	}
+      r1 = r1->next;
+      r2 = r2->next;
+    }
+  return true;
+}
+
+/* Compare two values.  Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2,
+   and -2 if the relationship could not be determined.  */
+
+int
+gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
+{
+  gfc_actual_arglist *args1;
+  gfc_actual_arglist *args2;
+  int i;
+  gfc_expr *n1, *n2;
+
+  n1 = NULL;
+  n2 = NULL;
+
+  /* Remove any integer conversion functions to larger types.  */
+  if (e1->expr_type == EXPR_FUNCTION && e1->value.function.isym
+      && e1->value.function.isym->id == GFC_ISYM_CONVERSION
+      && e1->ts.type == BT_INTEGER)
+    {
+      args1 = e1->value.function.actual;
+      if (args1->expr->ts.type == BT_INTEGER
+	  && e1->ts.kind > args1->expr->ts.kind)
+	n1 = args1->expr;
+    }
+
+  if (e2->expr_type == EXPR_FUNCTION && e2->value.function.isym
+      && e2->value.function.isym->id == GFC_ISYM_CONVERSION
+      && e2->ts.type == BT_INTEGER)
+    {
+      args2 = e2->value.function.actual;
+      if (args2->expr->ts.type == BT_INTEGER
+	  && e2->ts.kind > args2->expr->ts.kind)
+	n2 = args2->expr;
+    }
+
+  if (n1 != NULL)
+    {
+      if (n2 != NULL)
+	return gfc_dep_compare_expr (n1, n2);
+      else
+	return gfc_dep_compare_expr (n1, e2);
+    }
+  else
+    {
+      if (n2 != NULL)
+	return gfc_dep_compare_expr (e1, n2);
+    }
+  
+  if (e1->expr_type == EXPR_OP
+      && (e1->value.op.op == INTRINSIC_UPLUS
+	  || e1->value.op.op == INTRINSIC_PARENTHESES))
+    return gfc_dep_compare_expr (e1->value.op.op1, e2);
+  if (e2->expr_type == EXPR_OP
+      && (e2->value.op.op == INTRINSIC_UPLUS
+	  || e2->value.op.op == INTRINSIC_PARENTHESES))
+    return gfc_dep_compare_expr (e1, e2->value.op.op1);
+
+  if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
+    {
+      /* Compare X+C vs. X.  */
+      if (e1->value.op.op2->expr_type == EXPR_CONSTANT
+	  && e1->value.op.op2->ts.type == BT_INTEGER
+	  && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
+	return mpz_sgn (e1->value.op.op2->value.integer);
+
+      /* Compare P+Q vs. R+S.  */
+      if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
+	{
+	  int l, r;
+
+	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+	  if (l == 0 && r == 0)
+	    return 0;
+	  if (l == 0 && r != -2)
+	    return r;
+	  if (l != -2 && r == 0)
+	    return l;
+	  if (l == 1 && r == 1)
+	    return 1;
+	  if (l == -1 && r == -1)
+	    return -1;
+
+	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2);
+	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1);
+	  if (l == 0 && r == 0)
+	    return 0;
+	  if (l == 0 && r != -2)
+	    return r;
+	  if (l != -2 && r == 0)
+	    return l;
+	  if (l == 1 && r == 1)
+	    return 1;
+	  if (l == -1 && r == -1)
+	    return -1;
+	}
+    }
+
+  /* Compare X vs. X+C.  */
+  if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
+    {
+      if (e2->value.op.op2->expr_type == EXPR_CONSTANT
+	  && e2->value.op.op2->ts.type == BT_INTEGER
+	  && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
+	return -mpz_sgn (e2->value.op.op2->value.integer);
+    }
+
+  /* Compare X-C vs. X.  */
+  if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_MINUS)
+    {
+      if (e1->value.op.op2->expr_type == EXPR_CONSTANT
+	  && e1->value.op.op2->ts.type == BT_INTEGER
+	  && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
+	return -mpz_sgn (e1->value.op.op2->value.integer);
+
+      /* Compare P-Q vs. R-S.  */
+      if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
+	{
+	  int l, r;
+
+	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+	  if (l == 0 && r == 0)
+	    return 0;
+	  if (l != -2 && r == 0)
+	    return l;
+	  if (l == 0 && r != -2)
+	    return -r;
+	  if (l == 1 && r == -1)
+	    return 1;
+	  if (l == -1 && r == 1)
+	    return -1;
+	}
+    }
+
+  /* Compare A // B vs. C // D.  */
+
+  if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_CONCAT
+      && e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_CONCAT)
+    {
+      int l, r;
+
+      l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+      r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+
+      if (l == -2)
+	return -2;
+
+      if (l == 0)
+	{
+	  /* Watch out for 'A ' // x vs. 'A' // x.  */
+	  gfc_expr *e1_left = e1->value.op.op1;
+	  gfc_expr *e2_left = e2->value.op.op1;
+
+	  if (e1_left->expr_type == EXPR_CONSTANT
+	      && e2_left->expr_type == EXPR_CONSTANT
+	      && e1_left->value.character.length
+	        != e2_left->value.character.length)
+	    return -2;
+	  else
+	    return r;
+	}
+      else
+	{
+	  if (l != 0)
+	    return l;
+	  else
+	    return r;
+	}
+    }
+
+  /* Compare X vs. X-C.  */
+  if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
+    {
+      if (e2->value.op.op2->expr_type == EXPR_CONSTANT
+	  && e2->value.op.op2->ts.type == BT_INTEGER
+	  && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
+	return mpz_sgn (e2->value.op.op2->value.integer);
+    }
+
+  if (e1->expr_type != e2->expr_type)
+    return -2;
+
+  switch (e1->expr_type)
+    {
+    case EXPR_CONSTANT:
+      /* Compare strings for equality.  */
+      if (e1->ts.type == BT_CHARACTER && e2->ts.type == BT_CHARACTER)
+	return gfc_compare_string (e1, e2);
+
+      if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
+	return -2;
+
+      i = mpz_cmp (e1->value.integer, e2->value.integer);
+      if (i == 0)
+	return 0;
+      else if (i < 0)
+	return -1;
+      return 1;
+
+    case EXPR_VARIABLE:
+      if (gfc_are_identical_variables (e1, e2))
+	return 0;
+      else
+	return -2;
+
+    case EXPR_OP:
+      /* Intrinsic operators are the same if their operands are the same.  */
+      if (e1->value.op.op != e2->value.op.op)
+	return -2;
+      if (e1->value.op.op2 == 0)
+	{
+	  i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+	  return i == 0 ? 0 : -2;
+	}
+      if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0
+	  && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0)
+	return 0;
+      /* TODO Handle commutative binary operators here?  */
+      return -2;
+
+    case EXPR_FUNCTION:
+
+      /* PURE functions can be compared for argument equality.  */
+      if ((e1->value.function.esym && e2->value.function.esym
+	   && e1->value.function.esym == e2->value.function.esym
+	   && e1->value.function.esym->result->attr.pure)
+	  || (e1->value.function.isym && e2->value.function.isym
+	      && e1->value.function.isym == e2->value.function.isym
+	      && e1->value.function.isym->pure))
+	{
+	  args1 = e1->value.function.actual;
+	  args2 = e2->value.function.actual;
+
+	  /* Compare the argument lists for equality.  */
+	  while (args1 && args2)
+	    {
+	      /*  Bitwise xor, since C has no non-bitwise xor operator.  */
+	      if ((args1->expr == NULL) ^ (args2->expr == NULL))
+		return -2;
+
+	      if (args1->expr != NULL && args2->expr != NULL
+		  && gfc_dep_compare_expr (args1->expr, args2->expr) != 0)
+		return -2;
+
+	      args1 = args1->next;
+	      args2 = args2->next;
+	    }
+	  return (args1 || args2) ? -2 : 0;
+	}
+      else
+	return -2;
+      break;
+
+    default:
+      return -2;
+    }
+}
+
+
+/* Returns 1 if the two ranges are the same, 0 if they are not, and def
+   if the results are indeterminate.  N is the dimension to compare.  */
+
+int
+gfc_is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n, int def)
+{
+  gfc_expr *e1;
+  gfc_expr *e2;
+  int i;
+
+  /* TODO: More sophisticated range comparison.  */
+  gcc_assert (ar1 && ar2);
+
+  gcc_assert (ar1->dimen_type[n] == ar2->dimen_type[n]);
+
+  e1 = ar1->stride[n];
+  e2 = ar2->stride[n];
+  /* Check for mismatching strides.  A NULL stride means a stride of 1.  */
+  if (e1 && !e2)
+    {
+      i = gfc_expr_is_one (e1, -1);
+      if (i == -1)
+	return def;
+      else if (i == 0)
+	return 0;
+    }
+  else if (e2 && !e1)
+    {
+      i = gfc_expr_is_one (e2, -1);
+      if (i == -1)
+	return def;
+      else if (i == 0)
+	return 0;
+    }
+  else if (e1 && e2)
+    {
+      i = gfc_dep_compare_expr (e1, e2);
+      if (i == -2)
+	return def;
+      else if (i != 0)
+	return 0;
+    }
+  /* The strides match.  */
+
+  /* Check the range start.  */
+  e1 = ar1->start[n];
+  e2 = ar2->start[n];
+  if (e1 || e2)
+    {
+      /* Use the bound of the array if no bound is specified.  */
+      if (ar1->as && !e1)
+	e1 = ar1->as->lower[n];
+
+      if (ar2->as && !e2)
+	e2 = ar2->as->lower[n];
+
+      /* Check we have values for both.  */
+      if (!(e1 && e2))
+	return def;
+
+      i = gfc_dep_compare_expr (e1, e2);
+      if (i == -2)
+	return def;
+      else if (i != 0)
+	return 0;
+    }
+
+  /* Check the range end.  */
+  e1 = ar1->end[n];
+  e2 = ar2->end[n];
+  if (e1 || e2)
+    {
+      /* Use the bound of the array if no bound is specified.  */
+      if (ar1->as && !e1)
+	e1 = ar1->as->upper[n];
+
+      if (ar2->as && !e2)
+	e2 = ar2->as->upper[n];
+
+      /* Check we have values for both.  */
+      if (!(e1 && e2))
+	return def;
+
+      i = gfc_dep_compare_expr (e1, e2);
+      if (i == -2)
+	return def;
+      else if (i != 0)
+	return 0;
+    }
+
+  return 1;
+}
+
+
+/* Some array-returning intrinsics can be implemented by reusing the
+   data from one of the array arguments.  For example, TRANSPOSE does
+   not necessarily need to allocate new data: it can be implemented
+   by copying the original array's descriptor and simply swapping the
+   two dimension specifications.
+
+   If EXPR is a call to such an intrinsic, return the argument
+   whose data can be reused, otherwise return NULL.  */
+
+gfc_expr *
+gfc_get_noncopying_intrinsic_argument (gfc_expr *expr)
+{
+  if (expr->expr_type != EXPR_FUNCTION || !expr->value.function.isym)
+    return NULL;
+
+  switch (expr->value.function.isym->id)
+    {
+    case GFC_ISYM_TRANSPOSE:
+      return expr->value.function.actual->expr;
+
+    default:
+      return NULL;
+    }
+}
+
+
+/* Return true if the result of reference REF can only be constructed
+   using a temporary array.  */
+
+bool
+gfc_ref_needs_temporary_p (gfc_ref *ref)
+{
+  int n;
+  bool subarray_p;
+
+  subarray_p = false;
+  for (; ref; ref = ref->next)
+    switch (ref->type)
+      {
+      case REF_ARRAY:
+	/* Vector dimensions are generally not monotonic and must be
+	   handled using a temporary.  */
+	if (ref->u.ar.type == AR_SECTION)
+	  for (n = 0; n < ref->u.ar.dimen; n++)
+	    if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR)
+	      return true;
+
+	subarray_p = true;
+	break;
+
+      case REF_SUBSTRING:
+	/* Within an array reference, character substrings generally
+	   need a temporary.  Character array strides are expressed as
+	   multiples of the element size (consistent with other array
+	   types), not in characters.  */
+	return subarray_p;
+
+      case REF_COMPONENT:
+	break;
+      }
+
+  return false;
+}
+
+
+static int
+gfc_is_data_pointer (gfc_expr *e)
+{
+  gfc_ref *ref;
+
+  if (e->expr_type != EXPR_VARIABLE && e->expr_type != EXPR_FUNCTION)
+    return 0;
+
+  /* No subreference if it is a function  */
+  gcc_assert (e->expr_type == EXPR_VARIABLE || !e->ref);
+
+  if (e->symtree->n.sym->attr.pointer)
+    return 1;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
+      return 1;
+
+  return 0;
+}
+
+
+/* Return true if array variable VAR could be passed to the same function
+   as argument EXPR without interfering with EXPR.  INTENT is the intent
+   of VAR.
+
+   This is considerably less conservative than other dependencies
+   because many function arguments will already be copied into a
+   temporary.  */
+
+static int
+gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
+				   gfc_expr *expr, gfc_dep_check elemental)
+{
+  gfc_expr *arg;
+
+  gcc_assert (var->expr_type == EXPR_VARIABLE);
+  gcc_assert (var->rank > 0);
+
+  switch (expr->expr_type)
+    {
+    case EXPR_VARIABLE:
+      /* In case of elemental subroutines, there is no dependency 
+         between two same-range array references.  */
+      if (gfc_ref_needs_temporary_p (expr->ref)
+	  || gfc_check_dependency (var, expr, elemental == NOT_ELEMENTAL))
+	{
+	  if (elemental == ELEM_DONT_CHECK_VARIABLE)
+	    {
+	      /* Too many false positive with pointers.  */
+	      if (!gfc_is_data_pointer (var) && !gfc_is_data_pointer (expr))
+		{
+		  /* Elemental procedures forbid unspecified intents, 
+		     and we don't check dependencies for INTENT_IN args.  */
+		  gcc_assert (intent == INTENT_OUT || intent == INTENT_INOUT);
+
+		  /* We are told not to check dependencies. 
+		     We do it, however, and issue a warning in case we find one.
+		     If a dependency is found in the case 
+		     elemental == ELEM_CHECK_VARIABLE, we will generate
+		     a temporary, so we don't need to bother the user.  */
+		  gfc_warning ("INTENT(%s) actual argument at %L might "
+			       "interfere with actual argument at %L.", 
+		   	       intent == INTENT_OUT ? "OUT" : "INOUT", 
+		   	       &var->where, &expr->where);
+		}
+	      return 0;
+	    }
+	  else
+	    return 1; 
+	}
+      return 0;
+
+    case EXPR_ARRAY:
+      return gfc_check_dependency (var, expr, 1);
+
+    case EXPR_FUNCTION:
+      if (intent != INTENT_IN)
+	{
+	  arg = gfc_get_noncopying_intrinsic_argument (expr);
+	  if (arg != NULL)
+	    return gfc_check_argument_var_dependency (var, intent, arg,
+						      NOT_ELEMENTAL);
+	}
+
+      if (elemental != NOT_ELEMENTAL)
+	{
+	  if ((expr->value.function.esym
+	       && expr->value.function.esym->attr.elemental)
+	      || (expr->value.function.isym
+		  && expr->value.function.isym->elemental))
+	    return gfc_check_fncall_dependency (var, intent, NULL,
+						expr->value.function.actual,
+						ELEM_CHECK_VARIABLE);
+	}
+      return 0;
+
+    case EXPR_OP:
+      /* In case of non-elemental procedures, there is no need to catch
+	 dependencies, as we will make a temporary anyway.  */
+      if (elemental)
+	{
+	  /* If the actual arg EXPR is an expression, we need to catch 
+	     a dependency between variables in EXPR and VAR, 
+	     an intent((IN)OUT) variable.  */
+	  if (expr->value.op.op1
+	      && gfc_check_argument_var_dependency (var, intent, 
+						    expr->value.op.op1, 
+						    ELEM_CHECK_VARIABLE))
+	    return 1;
+	  else if (expr->value.op.op2
+		   && gfc_check_argument_var_dependency (var, intent, 
+							 expr->value.op.op2, 
+							 ELEM_CHECK_VARIABLE))
+	    return 1;
+	}
+      return 0;
+
+    default:
+      return 0;
+    }
+}
+  
+  
+/* Like gfc_check_argument_var_dependency, but extended to any
+   array expression OTHER, not just variables.  */
+
+static int
+gfc_check_argument_dependency (gfc_expr *other, sym_intent intent,
+			       gfc_expr *expr, gfc_dep_check elemental)
+{
+  switch (other->expr_type)
+    {
+    case EXPR_VARIABLE:
+      return gfc_check_argument_var_dependency (other, intent, expr, elemental);
+
+    case EXPR_FUNCTION:
+      other = gfc_get_noncopying_intrinsic_argument (other);
+      if (other != NULL)
+	return gfc_check_argument_dependency (other, INTENT_IN, expr,
+					      NOT_ELEMENTAL);
+
+      return 0;
+
+    default:
+      return 0;
+    }
+}
+
+
+/* Like gfc_check_argument_dependency, but check all the arguments in ACTUAL.
+   FNSYM is the function being called, or NULL if not known.  */
+
+int
+gfc_check_fncall_dependency (gfc_expr *other, sym_intent intent,
+			     gfc_symbol *fnsym, gfc_actual_arglist *actual,
+			     gfc_dep_check elemental)
+{
+  gfc_formal_arglist *formal;
+  gfc_expr *expr;
+
+  formal = fnsym ? fnsym->formal : NULL;
+  for (; actual; actual = actual->next, formal = formal ? formal->next : NULL)
+    {
+      expr = actual->expr;
+
+      /* Skip args which are not present.  */
+      if (!expr)
+	continue;
+
+      /* Skip other itself.  */
+      if (expr == other)
+	continue;
+
+      /* Skip intent(in) arguments if OTHER itself is intent(in).  */
+      if (formal && intent == INTENT_IN
+	  && formal->sym->attr.intent == INTENT_IN)
+	continue;
+
+      if (gfc_check_argument_dependency (other, intent, expr, elemental))
+	return 1;
+    }
+
+  return 0;
+}
+
+
+/* Return 1 if e1 and e2 are equivalenced arrays, either
+   directly or indirectly; i.e., equivalence (a,b) for a and b
+   or equivalence (a,c),(b,c).  This function uses the equiv_
+   lists, generated in trans-common(add_equivalences), that are
+   guaranteed to pick up indirect equivalences.  We explicitly
+   check for overlap using the offset and length of the equivalence.
+   This function is symmetric.
+   TODO: This function only checks whether the full top-level
+   symbols overlap.  An improved implementation could inspect
+   e1->ref and e2->ref to determine whether the actually accessed
+   portions of these variables/arrays potentially overlap.  */
+
+int
+gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
+{
+  gfc_equiv_list *l;
+  gfc_equiv_info *s, *fl1, *fl2;
+
+  gcc_assert (e1->expr_type == EXPR_VARIABLE
+	      && e2->expr_type == EXPR_VARIABLE);
+
+  if (!e1->symtree->n.sym->attr.in_equivalence
+      || !e2->symtree->n.sym->attr.in_equivalence|| !e1->rank || !e2->rank)
+    return 0;
+
+  if (e1->symtree->n.sym->ns
+	&& e1->symtree->n.sym->ns != gfc_current_ns)
+    l = e1->symtree->n.sym->ns->equiv_lists;
+  else
+    l = gfc_current_ns->equiv_lists;
+
+  /* Go through the equiv_lists and return 1 if the variables
+     e1 and e2 are members of the same group and satisfy the
+     requirement on their relative offsets.  */
+  for (; l; l = l->next)
+    {
+      fl1 = NULL;
+      fl2 = NULL;
+      for (s = l->equiv; s; s = s->next)
+	{
+	  if (s->sym == e1->symtree->n.sym)
+	    {
+	      fl1 = s;
+	      if (fl2)
+		break;
+	    }
+	  if (s->sym == e2->symtree->n.sym)
+	    {
+	      fl2 = s;
+	      if (fl1)
+		break;
+	    }
+	}
+
+      if (s)
+	{
+	  /* Can these lengths be zero?  */
+	  if (fl1->length <= 0 || fl2->length <= 0)
+	    return 1;
+	  /* These can't overlap if [f11,fl1+length] is before 
+	     [fl2,fl2+length], or [fl2,fl2+length] is before
+	     [fl1,fl1+length], otherwise they do overlap.  */
+	  if (fl1->offset + fl1->length > fl2->offset
+	      && fl2->offset + fl2->length > fl1->offset)
+	    return 1;
+	}
+    }
+  return 0;
+}
+
+
+/* Return true if there is no possibility of aliasing because of a type
+   mismatch between all the possible pointer references and the
+   potential target.  Note that this function is asymmetric in the
+   arguments and so must be called twice with the arguments exchanged.  */
+
+static bool
+check_data_pointer_types (gfc_expr *expr1, gfc_expr *expr2)
+{
+  gfc_component *cm1;
+  gfc_symbol *sym1;
+  gfc_symbol *sym2;
+  gfc_ref *ref1;
+  bool seen_component_ref;
+
+  if (expr1->expr_type != EXPR_VARIABLE
+	|| expr1->expr_type != EXPR_VARIABLE)
+    return false;
+
+  sym1 = expr1->symtree->n.sym;
+  sym2 = expr2->symtree->n.sym;
+
+  /* Keep it simple for now.  */
+  if (sym1->ts.type == BT_DERIVED && sym2->ts.type == BT_DERIVED)
+    return false;
+
+  if (sym1->attr.pointer)
+    {
+      if (gfc_compare_types (&sym1->ts, &sym2->ts))
+	return false;
+    }
+
+  /* This is a conservative check on the components of the derived type
+     if no component references have been seen.  Since we will not dig
+     into the components of derived type components, we play it safe by
+     returning false.  First we check the reference chain and then, if
+     no component references have been seen, the components.  */
+  seen_component_ref = false;
+  if (sym1->ts.type == BT_DERIVED)
+    {
+      for (ref1 = expr1->ref; ref1; ref1 = ref1->next)
+	{
+	  if (ref1->type != REF_COMPONENT)
+	    continue;
+
+	  if (ref1->u.c.component->ts.type == BT_DERIVED)
+	    return false;
+
+	  if ((sym2->attr.pointer || ref1->u.c.component->attr.pointer)
+		&& gfc_compare_types (&ref1->u.c.component->ts, &sym2->ts))
+	    return false;
+
+	  seen_component_ref = true;
+	}
+    }
+
+  if (sym1->ts.type == BT_DERIVED && !seen_component_ref)
+    {
+      for (cm1 = sym1->ts.u.derived->components; cm1; cm1 = cm1->next)
+	{
+	  if (cm1->ts.type == BT_DERIVED)
+	    return false;
+
+	  if ((sym2->attr.pointer || cm1->attr.pointer)
+		&& gfc_compare_types (&cm1->ts, &sym2->ts))
+	    return false;
+	}
+    }
+
+  return true;
+}
+
+
+/* Return true if the statement body redefines the condition.  Returns
+   true if expr2 depends on expr1.  expr1 should be a single term
+   suitable for the lhs of an assignment.  The IDENTICAL flag indicates
+   whether array references to the same symbol with identical range
+   references count as a dependency or not.  Used for forall and where
+   statements.  Also used with functions returning arrays without a
+   temporary.  */
+
+int
+gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
+{
+  gfc_actual_arglist *actual;
+  gfc_constructor *c;
+  int n;
+
+  gcc_assert (expr1->expr_type == EXPR_VARIABLE);
+
+  switch (expr2->expr_type)
+    {
+    case EXPR_OP:
+      n = gfc_check_dependency (expr1, expr2->value.op.op1, identical);
+      if (n)
+	return n;
+      if (expr2->value.op.op2)
+	return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
+      return 0;
+
+    case EXPR_VARIABLE:
+      /* The interesting cases are when the symbols don't match.  */
+      if (expr1->symtree->n.sym != expr2->symtree->n.sym)
+	{
+	  gfc_typespec *ts1 = &expr1->symtree->n.sym->ts;
+	  gfc_typespec *ts2 = &expr2->symtree->n.sym->ts;
+
+	  /* Return 1 if expr1 and expr2 are equivalenced arrays.  */
+	  if (gfc_are_equivalenced_arrays (expr1, expr2))
+	    return 1;
+
+	  /* Symbols can only alias if they have the same type.  */
+	  if (ts1->type != BT_UNKNOWN && ts2->type != BT_UNKNOWN
+	      && ts1->type != BT_DERIVED && ts2->type != BT_DERIVED)
+	    {
+	      if (ts1->type != ts2->type || ts1->kind != ts2->kind)
+		return 0;
+	    }
+
+	  /* If either variable is a pointer, assume the worst.  */
+	  /* TODO: -fassume-no-pointer-aliasing */
+	  if (gfc_is_data_pointer (expr1) || gfc_is_data_pointer (expr2))
+	    {
+	      if (check_data_pointer_types (expr1, expr2)
+		    && check_data_pointer_types (expr2, expr1))
+		return 0;
+
+	      return 1;
+	    }
+	  else
+	    {
+	      gfc_symbol *sym1 = expr1->symtree->n.sym;
+	      gfc_symbol *sym2 = expr2->symtree->n.sym;
+	      if (sym1->attr.target && sym2->attr.target
+		  && ((sym1->attr.dummy && !sym1->attr.contiguous
+		       && (!sym1->attr.dimension
+		           || sym2->as->type == AS_ASSUMED_SHAPE))
+		      || (sym2->attr.dummy && !sym2->attr.contiguous
+			  && (!sym2->attr.dimension
+			      || sym2->as->type == AS_ASSUMED_SHAPE))))
+		return 1;
+	    }
+
+	  /* Otherwise distinct symbols have no dependencies.  */
+	  return 0;
+	}
+
+      if (identical)
+	return 1;
+
+      /* Identical and disjoint ranges return 0,
+	 overlapping ranges return 1.  */
+      if (expr1->ref && expr2->ref)
+	return gfc_dep_resolver (expr1->ref, expr2->ref, NULL);
+
+      return 1;
+
+    case EXPR_FUNCTION:
+      if (gfc_get_noncopying_intrinsic_argument (expr2) != NULL)
+	identical = 1;
+
+      /* Remember possible differences between elemental and
+	 transformational functions.  All functions inside a FORALL
+	 will be pure.  */
+      for (actual = expr2->value.function.actual;
+	   actual; actual = actual->next)
+	{
+	  if (!actual->expr)
+	    continue;
+	  n = gfc_check_dependency (expr1, actual->expr, identical);
+	  if (n)
+	    return n;
+	}
+      return 0;
+
+    case EXPR_CONSTANT:
+    case EXPR_NULL:
+      return 0;
+
+    case EXPR_ARRAY:
+      /* Loop through the array constructor's elements.  */
+      for (c = gfc_constructor_first (expr2->value.constructor);
+	   c; c = gfc_constructor_next (c))
+	{
+	  /* If this is an iterator, assume the worst.  */
+	  if (c->iterator)
+	    return 1;
+	  /* Avoid recursion in the common case.  */
+	  if (c->expr->expr_type == EXPR_CONSTANT)
+	    continue;
+	  if (gfc_check_dependency (expr1, c->expr, 1))
+	    return 1;
+	}
+      return 0;
+
+    default:
+      return 1;
+    }
+}
+
+
+/* Determines overlapping for two array sections.  */
+
+static gfc_dependency
+check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n)
+{
+  gfc_expr *l_start;
+  gfc_expr *l_end;
+  gfc_expr *l_stride;
+  gfc_expr *l_lower;
+  gfc_expr *l_upper;
+  int l_dir;
+
+  gfc_expr *r_start;
+  gfc_expr *r_end;
+  gfc_expr *r_stride;
+  gfc_expr *r_lower;
+  gfc_expr *r_upper;
+  gfc_expr *one_expr;
+  int r_dir;
+  int stride_comparison;
+  int start_comparison;
+
+  /* If they are the same range, return without more ado.  */
+  if (gfc_is_same_range (l_ar, r_ar, n, 0))
+    return GFC_DEP_EQUAL;
+
+  l_start = l_ar->start[n];
+  l_end = l_ar->end[n];
+  l_stride = l_ar->stride[n];
+
+  r_start = r_ar->start[n];
+  r_end = r_ar->end[n];
+  r_stride = r_ar->stride[n];
+
+  /* If l_start is NULL take it from array specifier.  */
+  if (NULL == l_start && IS_ARRAY_EXPLICIT (l_ar->as))
+    l_start = l_ar->as->lower[n];
+  /* If l_end is NULL take it from array specifier.  */
+  if (NULL == l_end && IS_ARRAY_EXPLICIT (l_ar->as))
+    l_end = l_ar->as->upper[n];
+
+  /* If r_start is NULL take it from array specifier.  */
+  if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar->as))
+    r_start = r_ar->as->lower[n];
+  /* If r_end is NULL take it from array specifier.  */
+  if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar->as))
+    r_end = r_ar->as->upper[n];
+
+  /* Determine whether the l_stride is positive or negative.  */
+  if (!l_stride)
+    l_dir = 1;
+  else if (l_stride->expr_type == EXPR_CONSTANT
+	   && l_stride->ts.type == BT_INTEGER)
+    l_dir = mpz_sgn (l_stride->value.integer);
+  else if (l_start && l_end)
+    l_dir = gfc_dep_compare_expr (l_end, l_start);
+  else
+    l_dir = -2;
+
+  /* Determine whether the r_stride is positive or negative.  */
+  if (!r_stride)
+    r_dir = 1;
+  else if (r_stride->expr_type == EXPR_CONSTANT
+	   && r_stride->ts.type == BT_INTEGER)
+    r_dir = mpz_sgn (r_stride->value.integer);
+  else if (r_start && r_end)
+    r_dir = gfc_dep_compare_expr (r_end, r_start);
+  else
+    r_dir = -2;
+
+  /* The strides should never be zero.  */
+  if (l_dir == 0 || r_dir == 0)
+    return GFC_DEP_OVERLAP;
+
+  /* Determine the relationship between the strides.  Set stride_comparison to
+     -2 if the dependency cannot be determined
+     -1 if l_stride < r_stride
+      0 if l_stride == r_stride
+      1 if l_stride > r_stride
+     as determined by gfc_dep_compare_expr.  */
+
+  one_expr = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
+
+  stride_comparison = gfc_dep_compare_expr (l_stride ? l_stride : one_expr,
+					    r_stride ? r_stride : one_expr);
+
+  if (l_start && r_start)
+    start_comparison = gfc_dep_compare_expr (l_start, r_start);
+  else
+    start_comparison = -2;
+      
+  gfc_free (one_expr);
+
+  /* Determine LHS upper and lower bounds.  */
+  if (l_dir == 1)
+    {
+      l_lower = l_start;
+      l_upper = l_end;
+    }
+  else if (l_dir == -1)
+    {
+      l_lower = l_end;
+      l_upper = l_start;
+    }
+  else
+    {
+      l_lower = NULL;
+      l_upper = NULL;
+    }
+
+  /* Determine RHS upper and lower bounds.  */
+  if (r_dir == 1)
+    {
+      r_lower = r_start;
+      r_upper = r_end;
+    }
+  else if (r_dir == -1)
+    {
+      r_lower = r_end;
+      r_upper = r_start;
+    }
+  else
+    {
+      r_lower = NULL;
+      r_upper = NULL;
+    }
+
+  /* Check whether the ranges are disjoint.  */
+  if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower) == -1)
+    return GFC_DEP_NODEP;
+  if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower) == -1)
+    return GFC_DEP_NODEP;
+
+  /* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL.  */
+  if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0)
+    {
+      if (l_dir == 1 && r_dir == -1)
+	return GFC_DEP_EQUAL;
+      if (l_dir == -1 && r_dir == 1)
+	return GFC_DEP_EQUAL;
+    }
+
+  /* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL.  */
+  if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 0)
+    {
+      if (l_dir == 1 && r_dir == -1)
+	return GFC_DEP_EQUAL;
+      if (l_dir == -1 && r_dir == 1)
+	return GFC_DEP_EQUAL;
+    }
+
+  /* Handle cases like x:y:2 vs. x+1:z:4 as GFC_DEP_NODEP.
+     There is no dependency if the remainder of
+     (l_start - r_start) / gcd(l_stride, r_stride) is
+     nonzero.
+     TODO:
+       - Handle cases where x is an expression.
+       - Cases like a(1:4:2) = a(2:3) are still not handled.
+  */
+
+#define IS_CONSTANT_INTEGER(a) ((a) && ((a)->expr_type == EXPR_CONSTANT) \
+			      && (a)->ts.type == BT_INTEGER)
+
+  if (IS_CONSTANT_INTEGER(l_start) && IS_CONSTANT_INTEGER(r_start)
+      && IS_CONSTANT_INTEGER(l_stride) && IS_CONSTANT_INTEGER(r_stride))
+    {
+      mpz_t gcd, tmp;
+      int result;
+
+      mpz_init (gcd);
+      mpz_init (tmp);
+
+      mpz_gcd (gcd, l_stride->value.integer, r_stride->value.integer);
+      mpz_sub (tmp, l_start->value.integer, r_start->value.integer);
+
+      mpz_fdiv_r (tmp, tmp, gcd);
+      result = mpz_cmp_si (tmp, 0L);
+
+      mpz_clear (gcd);
+      mpz_clear (tmp);
+
+      if (result != 0)
+	return GFC_DEP_NODEP;
+    }
+
+#undef IS_CONSTANT_INTEGER
+
+  /* Check for forward dependencies x:y vs. x+1:z and x:y:z vs. x:y:z+1. */
+
+  if (l_dir == 1 && r_dir == 1 &&
+      (start_comparison == 0 || start_comparison == -1)
+      && (stride_comparison == 0 || stride_comparison == -1))
+	  return GFC_DEP_FORWARD;
+
+  /* Check for forward dependencies x:y:-1 vs. x-1:z:-1 and
+     x:y:-1 vs. x:y:-2.  */
+  if (l_dir == -1 && r_dir == -1 && 
+      (start_comparison == 0 || start_comparison == 1)
+      && (stride_comparison == 0 || stride_comparison == 1))
+    return GFC_DEP_FORWARD;
+
+  if (stride_comparison == 0 || stride_comparison == -1)
+    {
+      if (l_start && IS_ARRAY_EXPLICIT (l_ar->as))
+	{
+
+	  /* Check for a(low:y:s) vs. a(z:x:s) or
+	     a(low:y:s) vs. a(z:x:s+1) where a has a lower bound
+	     of low, which is always at least a forward dependence.  */
+
+	  if (r_dir == 1
+	      && gfc_dep_compare_expr (l_start, l_ar->as->lower[n]) == 0)
+	    return GFC_DEP_FORWARD;
+	}
+    }
+
+  if (stride_comparison == 0 || stride_comparison == 1)
+    {
+      if (l_start && IS_ARRAY_EXPLICIT (l_ar->as))
+	{
+      
+	  /* Check for a(high:y:-s) vs. a(z:x:-s) or
+	     a(high:y:-s vs. a(z:x:-s-1) where a has a higher bound
+	     of high, which is always at least a forward dependence.  */
+
+	  if (r_dir == -1
+	      && gfc_dep_compare_expr (l_start, l_ar->as->upper[n]) == 0)
+	    return GFC_DEP_FORWARD;
+	}
+    }
+
+
+  if (stride_comparison == 0)
+    {
+      /* From here, check for backwards dependencies.  */
+      /* x+1:y vs. x:z.  */
+      if (l_dir == 1 && r_dir == 1  && start_comparison == 1)
+	return GFC_DEP_BACKWARD;
+
+      /* x-1:y:-1 vs. x:z:-1.  */
+      if (l_dir == -1 && r_dir == -1 && start_comparison == -1)
+	return GFC_DEP_BACKWARD;
+    }
+
+  return GFC_DEP_OVERLAP;
+}
+
+
+/* Determines overlapping for a single element and a section.  */
+
+static gfc_dependency
+gfc_check_element_vs_section( gfc_ref *lref, gfc_ref *rref, int n)
+{
+  gfc_array_ref *ref;
+  gfc_expr *elem;
+  gfc_expr *start;
+  gfc_expr *end;
+  gfc_expr *stride;
+  int s;
+
+  elem = lref->u.ar.start[n];
+  if (!elem)
+    return GFC_DEP_OVERLAP;
+
+  ref = &rref->u.ar;
+  start = ref->start[n] ;
+  end = ref->end[n] ;
+  stride = ref->stride[n];
+
+  if (!start && IS_ARRAY_EXPLICIT (ref->as))
+    start = ref->as->lower[n];
+  if (!end && IS_ARRAY_EXPLICIT (ref->as))
+    end = ref->as->upper[n];
+
+  /* Determine whether the stride is positive or negative.  */
+  if (!stride)
+    s = 1;
+  else if (stride->expr_type == EXPR_CONSTANT
+	   && stride->ts.type == BT_INTEGER)
+    s = mpz_sgn (stride->value.integer);
+  else
+    s = -2;
+
+  /* Stride should never be zero.  */
+  if (s == 0)
+    return GFC_DEP_OVERLAP;
+
+  /* Positive strides.  */
+  if (s == 1)
+    {
+      /* Check for elem < lower.  */
+      if (start && gfc_dep_compare_expr (elem, start) == -1)
+	return GFC_DEP_NODEP;
+      /* Check for elem > upper.  */
+      if (end && gfc_dep_compare_expr (elem, end) == 1)
+	return GFC_DEP_NODEP;
+
+      if (start && end)
+	{
+	  s = gfc_dep_compare_expr (start, end);
+	  /* Check for an empty range.  */
+	  if (s == 1)
+	    return GFC_DEP_NODEP;
+	  if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
+	    return GFC_DEP_EQUAL;
+	}
+    }
+  /* Negative strides.  */
+  else if (s == -1)
+    {
+      /* Check for elem > upper.  */
+      if (end && gfc_dep_compare_expr (elem, start) == 1)
+	return GFC_DEP_NODEP;
+      /* Check for elem < lower.  */
+      if (start && gfc_dep_compare_expr (elem, end) == -1)
+	return GFC_DEP_NODEP;
+
+      if (start && end)
+	{
+	  s = gfc_dep_compare_expr (start, end);
+	  /* Check for an empty range.  */
+	  if (s == -1)
+	    return GFC_DEP_NODEP;
+	  if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
+	    return GFC_DEP_EQUAL;
+	}
+    }
+  /* Unknown strides.  */
+  else
+    {
+      if (!start || !end)
+	return GFC_DEP_OVERLAP;
+      s = gfc_dep_compare_expr (start, end);
+      if (s == -2)
+	return GFC_DEP_OVERLAP;
+      /* Assume positive stride.  */
+      if (s == -1)
+	{
+	  /* Check for elem < lower.  */
+	  if (gfc_dep_compare_expr (elem, start) == -1)
+	    return GFC_DEP_NODEP;
+	  /* Check for elem > upper.  */
+	  if (gfc_dep_compare_expr (elem, end) == 1)
+	    return GFC_DEP_NODEP;
+	}
+      /* Assume negative stride.  */
+      else if (s == 1)
+	{
+	  /* Check for elem > upper.  */
+	  if (gfc_dep_compare_expr (elem, start) == 1)
+	    return GFC_DEP_NODEP;
+	  /* Check for elem < lower.  */
+	  if (gfc_dep_compare_expr (elem, end) == -1)
+	    return GFC_DEP_NODEP;
+	}
+      /* Equal bounds.  */
+      else if (s == 0)
+	{
+	  s = gfc_dep_compare_expr (elem, start);
+	  if (s == 0)
+	    return GFC_DEP_EQUAL;
+	  if (s == 1 || s == -1)
+	    return GFC_DEP_NODEP;
+	}
+    }
+
+  return GFC_DEP_OVERLAP;
+}
+
+
+/* Traverse expr, checking all EXPR_VARIABLE symbols for their
+   forall_index attribute.  Return true if any variable may be
+   being used as a FORALL index.  Its safe to pessimistically
+   return true, and assume a dependency.  */
+
+static bool
+contains_forall_index_p (gfc_expr *expr)
+{
+  gfc_actual_arglist *arg;
+  gfc_constructor *c;
+  gfc_ref *ref;
+  int i;
+
+  if (!expr)
+    return false;
+
+  switch (expr->expr_type)
+    {
+    case EXPR_VARIABLE:
+      if (expr->symtree->n.sym->forall_index)
+	return true;
+      break;
+
+    case EXPR_OP:
+      if (contains_forall_index_p (expr->value.op.op1)
+	  || contains_forall_index_p (expr->value.op.op2))
+	return true;
+      break;
+
+    case EXPR_FUNCTION:
+      for (arg = expr->value.function.actual; arg; arg = arg->next)
+	if (contains_forall_index_p (arg->expr))
+	  return true;
+      break;
+
+    case EXPR_CONSTANT:
+    case EXPR_NULL:
+    case EXPR_SUBSTRING:
+      break;
+
+    case EXPR_STRUCTURE:
+    case EXPR_ARRAY:
+      for (c = gfc_constructor_first (expr->value.constructor);
+	   c; gfc_constructor_next (c))
+	if (contains_forall_index_p (c->expr))
+	  return true;
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    switch (ref->type)
+      {
+      case REF_ARRAY:
+	for (i = 0; i < ref->u.ar.dimen; i++)
+	  if (contains_forall_index_p (ref->u.ar.start[i])
+	      || contains_forall_index_p (ref->u.ar.end[i])
+	      || contains_forall_index_p (ref->u.ar.stride[i]))
+	    return true;
+	break;
+
+      case REF_COMPONENT:
+	break;
+
+      case REF_SUBSTRING:
+	if (contains_forall_index_p (ref->u.ss.start)
+	    || contains_forall_index_p (ref->u.ss.end))
+	  return true;
+	break;
+
+      default:
+	gcc_unreachable ();
+      }
+
+  return false;
+}
+
+/* Determines overlapping for two single element array references.  */
+
+static gfc_dependency
+gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n)
+{
+  gfc_array_ref l_ar;
+  gfc_array_ref r_ar;
+  gfc_expr *l_start;
+  gfc_expr *r_start;
+  int i;
+
+  l_ar = lref->u.ar;
+  r_ar = rref->u.ar;
+  l_start = l_ar.start[n] ;
+  r_start = r_ar.start[n] ;
+  i = gfc_dep_compare_expr (r_start, l_start);
+  if (i == 0)
+    return GFC_DEP_EQUAL;
+
+  /* Treat two scalar variables as potentially equal.  This allows
+     us to prove that a(i,:) and a(j,:) have no dependency.  See
+     Gerald Roth, "Evaluation of Array Syntax Dependence Analysis",
+     Proceedings of the International Conference on Parallel and
+     Distributed Processing Techniques and Applications (PDPTA2001),
+     Las Vegas, Nevada, June 2001.  */
+  /* However, we need to be careful when either scalar expression
+     contains a FORALL index, as these can potentially change value
+     during the scalarization/traversal of this array reference.  */
+  if (contains_forall_index_p (r_start) || contains_forall_index_p (l_start))
+    return GFC_DEP_OVERLAP;
+
+  if (i != -2)
+    return GFC_DEP_NODEP;
+  return GFC_DEP_EQUAL;
+}
+
+
+/* Determine if an array ref, usually an array section specifies the
+   entire array.  In addition, if the second, pointer argument is
+   provided, the function will return true if the reference is
+   contiguous; eg. (:, 1) gives true but (1,:) gives false.  */
+
+bool
+gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
+{
+  int i;
+  int n;
+  bool lbound_OK = true;
+  bool ubound_OK = true;
+
+  if (contiguous)
+    *contiguous = false;
+
+  if (ref->type != REF_ARRAY)
+    return false;
+
+  if (ref->u.ar.type == AR_FULL)
+    {
+      if (contiguous)
+	*contiguous = true;
+      return true;
+    }
+
+  if (ref->u.ar.type != AR_SECTION)
+    return false;
+  if (ref->next)
+    return false;
+
+  for (i = 0; i < ref->u.ar.dimen; i++)
+    {
+      /* If we have a single element in the reference, for the reference
+	 to be full, we need to ascertain that the array has a single
+	 element in this dimension and that we actually reference the
+	 correct element.  */
+      if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
+	{
+	  /* This is unconditionally a contiguous reference if all the
+	     remaining dimensions are elements.  */
+	  if (contiguous)
+	    {
+	      *contiguous = true;
+	      for (n = i + 1; n < ref->u.ar.dimen; n++)
+		if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
+		  *contiguous = false;
+	    }
+
+	  if (!ref->u.ar.as
+	      || !ref->u.ar.as->lower[i]
+	      || !ref->u.ar.as->upper[i]
+	      || gfc_dep_compare_expr (ref->u.ar.as->lower[i],
+				       ref->u.ar.as->upper[i])
+	      || !ref->u.ar.start[i]
+	      || gfc_dep_compare_expr (ref->u.ar.start[i],
+				       ref->u.ar.as->lower[i]))
+	    return false;
+	  else
+	    continue;
+	}
+
+      /* Check the lower bound.  */
+      if (ref->u.ar.start[i]
+	  && (!ref->u.ar.as
+	      || !ref->u.ar.as->lower[i]
+	      || gfc_dep_compare_expr (ref->u.ar.start[i],
+				       ref->u.ar.as->lower[i])))
+	lbound_OK = false;
+      /* Check the upper bound.  */
+      if (ref->u.ar.end[i]
+	  && (!ref->u.ar.as
+	      || !ref->u.ar.as->upper[i]
+	      || gfc_dep_compare_expr (ref->u.ar.end[i],
+				       ref->u.ar.as->upper[i])))
+	ubound_OK = false;
+      /* Check the stride.  */
+      if (ref->u.ar.stride[i]
+	    && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
+	return false;
+
+      /* This is unconditionally a contiguous reference as long as all
+	 the subsequent dimensions are elements.  */
+      if (contiguous)
+	{
+	  *contiguous = true;
+	  for (n = i + 1; n < ref->u.ar.dimen; n++)
+	    if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
+	      *contiguous = false;
+	}
+
+      if (!lbound_OK || !ubound_OK)
+	return false;
+    }
+  return true;
+}
+
+
+/* Determine if a full array is the same as an array section with one
+   variable limit.  For this to be so, the strides must both be unity
+   and one of either start == lower or end == upper must be true.  */
+
+static bool
+ref_same_as_full_array (gfc_ref *full_ref, gfc_ref *ref)
+{
+  int i;
+  bool upper_or_lower;
+
+  if (full_ref->type != REF_ARRAY)
+    return false;
+  if (full_ref->u.ar.type != AR_FULL)
+    return false;
+  if (ref->type != REF_ARRAY)
+    return false;
+  if (ref->u.ar.type != AR_SECTION)
+    return false;
+
+  for (i = 0; i < ref->u.ar.dimen; i++)
+    {
+      /* If we have a single element in the reference, we need to check
+	 that the array has a single element and that we actually reference
+	 the correct element.  */
+      if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
+	{
+	  if (!full_ref->u.ar.as
+	      || !full_ref->u.ar.as->lower[i]
+	      || !full_ref->u.ar.as->upper[i]
+	      || gfc_dep_compare_expr (full_ref->u.ar.as->lower[i],
+				       full_ref->u.ar.as->upper[i])
+	      || !ref->u.ar.start[i]
+	      || gfc_dep_compare_expr (ref->u.ar.start[i],
+				       full_ref->u.ar.as->lower[i]))
+	    return false;
+	}
+
+      /* Check the strides.  */
+      if (full_ref->u.ar.stride[i] && !gfc_expr_is_one (full_ref->u.ar.stride[i], 0))
+	return false;
+      if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
+	return false;
+
+      upper_or_lower = false;
+      /* Check the lower bound.  */
+      if (ref->u.ar.start[i]
+	  && (ref->u.ar.as
+	        && full_ref->u.ar.as->lower[i]
+	        && gfc_dep_compare_expr (ref->u.ar.start[i],
+				         full_ref->u.ar.as->lower[i]) == 0))
+	upper_or_lower =  true;
+      /* Check the upper bound.  */
+      if (ref->u.ar.end[i]
+	  && (ref->u.ar.as
+	        && full_ref->u.ar.as->upper[i]
+	        && gfc_dep_compare_expr (ref->u.ar.end[i],
+				         full_ref->u.ar.as->upper[i]) == 0))
+	upper_or_lower =  true;
+      if (!upper_or_lower)
+	return false;
+    }
+  return true;
+}
+
+
+/* Finds if two array references are overlapping or not.
+   Return value
+   	2 : array references are overlapping but reversal of one or
+	    more dimensions will clear the dependency.
+   	1 : array references are overlapping.
+   	0 : array references are identical or not overlapping.  */
+
+int
+gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
+{
+  int n;
+  gfc_dependency fin_dep;
+  gfc_dependency this_dep;
+
+  this_dep = GFC_DEP_ERROR;
+  fin_dep = GFC_DEP_ERROR;
+  /* Dependencies due to pointers should already have been identified.
+     We only need to check for overlapping array references.  */
+
+  while (lref && rref)
+    {
+      /* We're resolving from the same base symbol, so both refs should be
+	 the same type.  We traverse the reference chain until we find ranges
+	 that are not equal.  */
+      gcc_assert (lref->type == rref->type);
+      switch (lref->type)
+	{
+	case REF_COMPONENT:
+	  /* The two ranges can't overlap if they are from different
+	     components.  */
+	  if (lref->u.c.component != rref->u.c.component)
+	    return 0;
+	  break;
+	  
+	case REF_SUBSTRING:
+	  /* Substring overlaps are handled by the string assignment code
+	     if there is not an underlying dependency.  */
+	  return (fin_dep == GFC_DEP_OVERLAP) ? 1 : 0;
+	
+	case REF_ARRAY:
+
+	  if (ref_same_as_full_array (lref, rref))
+	    return 0;
+
+	  if (ref_same_as_full_array (rref, lref))
+	    return 0;
+
+	  if (lref->u.ar.dimen != rref->u.ar.dimen)
+	    {
+	      if (lref->u.ar.type == AR_FULL)
+		fin_dep = gfc_full_array_ref_p (rref, NULL) ? GFC_DEP_EQUAL
+							    : GFC_DEP_OVERLAP;
+	      else if (rref->u.ar.type == AR_FULL)
+		fin_dep = gfc_full_array_ref_p (lref, NULL) ? GFC_DEP_EQUAL
+							    : GFC_DEP_OVERLAP;
+	      else
+		return 1;
+	      break;
+	    }
+
+	  for (n=0; n < lref->u.ar.dimen; n++)
+	    {
+	      /* Assume dependency when either of array reference is vector
+		 subscript.  */
+	      if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR
+		  || rref->u.ar.dimen_type[n] == DIMEN_VECTOR)
+		return 1;
+
+	      if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
+		  && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
+		this_dep = check_section_vs_section (&lref->u.ar, &rref->u.ar, n);
+	      else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
+		       && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
+		this_dep = gfc_check_element_vs_section (lref, rref, n);
+	      else if (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
+		       && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
+		this_dep = gfc_check_element_vs_section (rref, lref, n);
+	      else 
+		{
+		  gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
+			      && lref->u.ar.dimen_type[n] == DIMEN_ELEMENT);
+		  this_dep = gfc_check_element_vs_element (rref, lref, n);
+		}
+
+	      /* If any dimension doesn't overlap, we have no dependency.  */
+	      if (this_dep == GFC_DEP_NODEP)
+		return 0;
+
+	      /* Now deal with the loop reversal logic:  This only works on
+		 ranges and is activated by setting
+				reverse[n] == GFC_ENABLE_REVERSE
+		 The ability to reverse or not is set by previous conditions
+		 in this dimension.  If reversal is not activated, the
+		 value GFC_DEP_BACKWARD is reset to GFC_DEP_OVERLAP.  */
+	      if (rref->u.ar.dimen_type[n] == DIMEN_RANGE
+		    && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
+		{
+		  /* Set reverse if backward dependence and not inhibited.  */
+		  if (reverse && reverse[n] == GFC_ENABLE_REVERSE)
+		    reverse[n] = (this_dep == GFC_DEP_BACKWARD) ?
+			         GFC_REVERSE_SET : reverse[n];
+
+		  /* Set forward if forward dependence and not inhibited.  */
+		  if (reverse && reverse[n] == GFC_ENABLE_REVERSE)
+		    reverse[n] = (this_dep == GFC_DEP_FORWARD) ?
+			         GFC_FORWARD_SET : reverse[n];
+
+		  /* Flag up overlap if dependence not compatible with
+		     the overall state of the expression.  */
+		  if (reverse && reverse[n] == GFC_REVERSE_SET
+		        && this_dep == GFC_DEP_FORWARD)
+		    {
+	              reverse[n] = GFC_INHIBIT_REVERSE;
+		      this_dep = GFC_DEP_OVERLAP;
+		    }
+		  else if (reverse && reverse[n] == GFC_FORWARD_SET
+		        && this_dep == GFC_DEP_BACKWARD)
+		    {
+	              reverse[n] = GFC_INHIBIT_REVERSE;
+		      this_dep = GFC_DEP_OVERLAP;
+		    }
+
+		  /* If no intention of reversing or reversing is explicitly
+		     inhibited, convert backward dependence to overlap.  */
+		  if ((reverse == NULL && this_dep == GFC_DEP_BACKWARD)
+		      || (reverse != NULL && reverse[n] == GFC_INHIBIT_REVERSE))
+		    this_dep = GFC_DEP_OVERLAP;
+		}
+
+	      /* Overlap codes are in order of priority.  We only need to
+		 know the worst one.*/
+	      if (this_dep > fin_dep)
+		fin_dep = this_dep;
+	    }
+
+	  /* If this is an equal element, we have to keep going until we find
+	     the "real" array reference.  */
+	  if (lref->u.ar.type == AR_ELEMENT
+		&& rref->u.ar.type == AR_ELEMENT
+		&& fin_dep == GFC_DEP_EQUAL)
+	    break;
+
+	  /* Exactly matching and forward overlapping ranges don't cause a
+	     dependency.  */
+	  if (fin_dep < GFC_DEP_BACKWARD)
+	    return 0;
+
+	  /* Keep checking.  We only have a dependency if
+	     subsequent references also overlap.  */
+	  break;
+
+	default:
+	  gcc_unreachable ();
+	}
+      lref = lref->next;
+      rref = rref->next;
+    }
+
+  /* If we haven't seen any array refs then something went wrong.  */
+  gcc_assert (fin_dep != GFC_DEP_ERROR);
+
+  /* Assume the worst if we nest to different depths.  */
+  if (lref || rref)
+    return 1;
+
+  return fin_dep == GFC_DEP_OVERLAP;
+}
diff --git a/gcc/fortran/dependency.h b/gcc/fortran/dependency.h
new file mode 100644
index 000000000..d58287d10
--- /dev/null
+++ b/gcc/fortran/dependency.h
@@ -0,0 +1,47 @@
+/* Header for dependency analysis
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/****************************** Enums *********************************/
+typedef enum
+{
+  NOT_ELEMENTAL,        /* Not elemental case: normal dependency check.  */
+  ELEM_CHECK_VARIABLE,  /* Test whether variables overlap.  */
+  ELEM_DONT_CHECK_VARIABLE  /* Test whether variables overlap only if used 
+			       in an expression.  */
+}
+gfc_dep_check;
+
+/*********************** Functions prototypes **************************/
+
+bool gfc_ref_needs_temporary_p (gfc_ref *);
+bool gfc_full_array_ref_p (gfc_ref *, bool *);
+gfc_expr *gfc_get_noncopying_intrinsic_argument (gfc_expr *);
+int gfc_check_fncall_dependency (gfc_expr *, sym_intent, gfc_symbol *,
+				 gfc_actual_arglist *, gfc_dep_check);
+int gfc_check_dependency (gfc_expr *, gfc_expr *, bool);
+int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, int);
+int gfc_expr_is_one (gfc_expr *, int);
+
+int gfc_dep_resolver(gfc_ref *, gfc_ref *, gfc_reverse *);
+int gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
+
+bool gfc_are_identical_variables (gfc_expr *, gfc_expr *);
+
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
new file mode 100644
index 000000000..424feb1e6
--- /dev/null
+++ b/gcc/fortran/dump-parse-tree.c
@@ -0,0 +1,2266 @@
+/* Parse tree dumper
+   Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Steven Bosscher
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+/* Actually this is just a collection of routines that used to be
+   scattered around the sources.  Now that they are all in a single
+   file, almost all of them can be static, and the other files don't
+   have this mess in them.
+
+   As a nice side-effect, this file can act as documentation of the
+   gfc_code and gfc_expr structures and all their friends and
+   relatives.
+
+   TODO: Dump DATA.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+#include "constructor.h"
+
+/* Keep track of indentation for symbol tree dumps.  */
+static int show_level = 0;
+
+/* The file handle we're dumping to is kept in a static variable.  This
+   is not too cool, but it avoids a lot of passing it around.  */
+static FILE *dumpfile;
+
+/* Forward declaration of some of the functions.  */
+static void show_expr (gfc_expr *p);
+static void show_code_node (int, gfc_code *);
+static void show_namespace (gfc_namespace *ns);
+
+
+/* Allow dumping of an expression in the debugger.  */
+void gfc_debug_expr (gfc_expr *);
+
+void
+gfc_debug_expr (gfc_expr *e)
+{
+  FILE *tmp = dumpfile;
+  dumpfile = stderr;
+  show_expr (e);
+  fputc ('\n', dumpfile);
+  dumpfile = tmp;
+}
+
+
+/* Do indentation for a specific level.  */
+
+static inline void
+code_indent (int level, gfc_st_label *label)
+{
+  int i;
+
+  if (label != NULL)
+    fprintf (dumpfile, "%-5d ", label->value);
+
+  for (i = 0; i < (2 * level - (label ? 6 : 0)); i++)
+    fputc (' ', dumpfile);
+}
+
+
+/* Simple indentation at the current level.  This one
+   is used to show symbols.  */
+
+static inline void
+show_indent (void)
+{
+  fputc ('\n', dumpfile);
+  code_indent (show_level, NULL);
+}
+
+
+/* Show type-specific information.  */
+
+static void
+show_typespec (gfc_typespec *ts)
+{
+  fprintf (dumpfile, "(%s ", gfc_basic_typename (ts->type));
+
+  switch (ts->type)
+    {
+    case BT_DERIVED:
+    case BT_CLASS:
+      fprintf (dumpfile, "%s", ts->u.derived->name);
+      break;
+
+    case BT_CHARACTER:
+      show_expr (ts->u.cl->length);
+      fprintf(dumpfile, " %d", ts->kind);
+      break;
+
+    default:
+      fprintf (dumpfile, "%d", ts->kind);
+      break;
+    }
+
+  fputc (')', dumpfile);
+}
+
+
+/* Show an actual argument list.  */
+
+static void
+show_actual_arglist (gfc_actual_arglist *a)
+{
+  fputc ('(', dumpfile);
+
+  for (; a; a = a->next)
+    {
+      fputc ('(', dumpfile);
+      if (a->name != NULL)
+	fprintf (dumpfile, "%s = ", a->name);
+      if (a->expr != NULL)
+	show_expr (a->expr);
+      else
+	fputs ("(arg not-present)", dumpfile);
+
+      fputc (')', dumpfile);
+      if (a->next != NULL)
+	fputc (' ', dumpfile);
+    }
+
+  fputc (')', dumpfile);
+}
+
+
+/* Show a gfc_array_spec array specification structure.  */
+
+static void
+show_array_spec (gfc_array_spec *as)
+{
+  const char *c;
+  int i;
+
+  if (as == NULL)
+    {
+      fputs ("()", dumpfile);
+      return;
+    }
+
+  fprintf (dumpfile, "(%d [%d]", as->rank, as->corank);
+
+  if (as->rank + as->corank > 0)
+    {
+      switch (as->type)
+      {
+	case AS_EXPLICIT:      c = "AS_EXPLICIT";      break;
+	case AS_DEFERRED:      c = "AS_DEFERRED";      break;
+	case AS_ASSUMED_SIZE:  c = "AS_ASSUMED_SIZE";  break;
+	case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
+	default:
+	  gfc_internal_error ("show_array_spec(): Unhandled array shape "
+			      "type.");
+      }
+      fprintf (dumpfile, " %s ", c);
+
+      for (i = 0; i < as->rank + as->corank; i++)
+	{
+	  show_expr (as->lower[i]);
+	  fputc (' ', dumpfile);
+	  show_expr (as->upper[i]);
+	  fputc (' ', dumpfile);
+	}
+    }
+
+  fputc (')', dumpfile);
+}
+
+
+/* Show a gfc_array_ref array reference structure.  */
+
+static void
+show_array_ref (gfc_array_ref * ar)
+{
+  int i;
+
+  fputc ('(', dumpfile);
+
+  switch (ar->type)
+    {
+    case AR_FULL:
+      fputs ("FULL", dumpfile);
+      break;
+
+    case AR_SECTION:
+      for (i = 0; i < ar->dimen; i++)
+	{
+	  /* There are two types of array sections: either the
+	     elements are identified by an integer array ('vector'),
+	     or by an index range. In the former case we only have to
+	     print the start expression which contains the vector, in
+	     the latter case we have to print any of lower and upper
+	     bound and the stride, if they're present.  */
+  
+	  if (ar->start[i] != NULL)
+	    show_expr (ar->start[i]);
+
+	  if (ar->dimen_type[i] == DIMEN_RANGE)
+	    {
+	      fputc (':', dumpfile);
+
+	      if (ar->end[i] != NULL)
+		show_expr (ar->end[i]);
+
+	      if (ar->stride[i] != NULL)
+		{
+		  fputc (':', dumpfile);
+		  show_expr (ar->stride[i]);
+		}
+	    }
+
+	  if (i != ar->dimen - 1)
+	    fputs (" , ", dumpfile);
+	}
+      break;
+
+    case AR_ELEMENT:
+      for (i = 0; i < ar->dimen; i++)
+	{
+	  show_expr (ar->start[i]);
+	  if (i != ar->dimen - 1)
+	    fputs (" , ", dumpfile);
+	}
+      break;
+
+    case AR_UNKNOWN:
+      fputs ("UNKNOWN", dumpfile);
+      break;
+
+    default:
+      gfc_internal_error ("show_array_ref(): Unknown array reference");
+    }
+
+  fputc (')', dumpfile);
+}
+
+
+/* Show a list of gfc_ref structures.  */
+
+static void
+show_ref (gfc_ref *p)
+{
+  for (; p; p = p->next)
+    switch (p->type)
+      {
+      case REF_ARRAY:
+	show_array_ref (&p->u.ar);
+	break;
+
+      case REF_COMPONENT:
+	fprintf (dumpfile, " %% %s", p->u.c.component->name);
+	break;
+
+      case REF_SUBSTRING:
+	fputc ('(', dumpfile);
+	show_expr (p->u.ss.start);
+	fputc (':', dumpfile);
+	show_expr (p->u.ss.end);
+	fputc (')', dumpfile);
+	break;
+
+      default:
+	gfc_internal_error ("show_ref(): Bad component code");
+      }
+}
+
+
+/* Display a constructor.  Works recursively for array constructors.  */
+
+static void
+show_constructor (gfc_constructor_base base)
+{
+  gfc_constructor *c;
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+    {
+      if (c->iterator == NULL)
+	show_expr (c->expr);
+      else
+	{
+	  fputc ('(', dumpfile);
+	  show_expr (c->expr);
+
+	  fputc (' ', dumpfile);
+	  show_expr (c->iterator->var);
+	  fputc ('=', dumpfile);
+	  show_expr (c->iterator->start);
+	  fputc (',', dumpfile);
+	  show_expr (c->iterator->end);
+	  fputc (',', dumpfile);
+	  show_expr (c->iterator->step);
+
+	  fputc (')', dumpfile);
+	}
+
+      if (gfc_constructor_next (c) != NULL)
+	fputs (" , ", dumpfile);
+    }
+}
+
+
+static void
+show_char_const (const gfc_char_t *c, int length)
+{
+  int i;
+
+  fputc ('\'', dumpfile);
+  for (i = 0; i < length; i++)
+    {
+      if (c[i] == '\'')
+	fputs ("''", dumpfile);
+      else
+	fputs (gfc_print_wide_char (c[i]), dumpfile);
+    }
+  fputc ('\'', dumpfile);
+}
+
+
+/* Show a component-call expression.  */
+
+static void
+show_compcall (gfc_expr* p)
+{
+  gcc_assert (p->expr_type == EXPR_COMPCALL);
+
+  fprintf (dumpfile, "%s", p->symtree->n.sym->name);
+  show_ref (p->ref);
+  fprintf (dumpfile, "%s", p->value.compcall.name);
+
+  show_actual_arglist (p->value.compcall.actual);
+}
+
+
+/* Show an expression.  */
+
+static void
+show_expr (gfc_expr *p)
+{
+  const char *c;
+  int i;
+
+  if (p == NULL)
+    {
+      fputs ("()", dumpfile);
+      return;
+    }
+
+  switch (p->expr_type)
+    {
+    case EXPR_SUBSTRING:
+      show_char_const (p->value.character.string, p->value.character.length);
+      show_ref (p->ref);
+      break;
+
+    case EXPR_STRUCTURE:
+      fprintf (dumpfile, "%s(", p->ts.u.derived->name);
+      show_constructor (p->value.constructor);
+      fputc (')', dumpfile);
+      break;
+
+    case EXPR_ARRAY:
+      fputs ("(/ ", dumpfile);
+      show_constructor (p->value.constructor);
+      fputs (" /)", dumpfile);
+
+      show_ref (p->ref);
+      break;
+
+    case EXPR_NULL:
+      fputs ("NULL()", dumpfile);
+      break;
+
+    case EXPR_CONSTANT:
+      switch (p->ts.type)
+	{
+	case BT_INTEGER:
+	  mpz_out_str (stdout, 10, p->value.integer);
+
+	  if (p->ts.kind != gfc_default_integer_kind)
+	    fprintf (dumpfile, "_%d", p->ts.kind);
+	  break;
+
+	case BT_LOGICAL:
+	  if (p->value.logical)
+	    fputs (".true.", dumpfile);
+	  else
+	    fputs (".false.", dumpfile);
+	  break;
+
+	case BT_REAL:
+	  mpfr_out_str (stdout, 10, 0, p->value.real, GFC_RND_MODE);
+	  if (p->ts.kind != gfc_default_real_kind)
+	    fprintf (dumpfile, "_%d", p->ts.kind);
+	  break;
+
+	case BT_CHARACTER:
+	  show_char_const (p->value.character.string, 
+			   p->value.character.length);
+	  break;
+
+	case BT_COMPLEX:
+	  fputs ("(complex ", dumpfile);
+
+	  mpfr_out_str (stdout, 10, 0, mpc_realref (p->value.complex),
+			GFC_RND_MODE);
+	  if (p->ts.kind != gfc_default_complex_kind)
+	    fprintf (dumpfile, "_%d", p->ts.kind);
+
+	  fputc (' ', dumpfile);
+
+	  mpfr_out_str (stdout, 10, 0, mpc_imagref (p->value.complex),
+			GFC_RND_MODE);
+	  if (p->ts.kind != gfc_default_complex_kind)
+	    fprintf (dumpfile, "_%d", p->ts.kind);
+
+	  fputc (')', dumpfile);
+	  break;
+
+	case BT_HOLLERITH:
+	  fprintf (dumpfile, "%dH", p->representation.length);
+	  c = p->representation.string;
+	  for (i = 0; i < p->representation.length; i++, c++)
+	    {
+	      fputc (*c, dumpfile);
+	    }
+	  break;
+
+	default:
+	  fputs ("???", dumpfile);
+	  break;
+	}
+
+      if (p->representation.string)
+	{
+	  fputs (" {", dumpfile);
+	  c = p->representation.string;
+	  for (i = 0; i < p->representation.length; i++, c++)
+	    {
+	      fprintf (dumpfile, "%.2x", (unsigned int) *c);
+	      if (i < p->representation.length - 1)
+		fputc (',', dumpfile);
+	    }
+	  fputc ('}', dumpfile);
+	}
+
+      break;
+
+    case EXPR_VARIABLE:
+      if (p->symtree->n.sym->ns && p->symtree->n.sym->ns->proc_name)
+	fprintf (dumpfile, "%s:", p->symtree->n.sym->ns->proc_name->name);
+      fprintf (dumpfile, "%s", p->symtree->n.sym->name);
+      show_ref (p->ref);
+      break;
+
+    case EXPR_OP:
+      fputc ('(', dumpfile);
+      switch (p->value.op.op)
+	{
+	case INTRINSIC_UPLUS:
+	  fputs ("U+ ", dumpfile);
+	  break;
+	case INTRINSIC_UMINUS:
+	  fputs ("U- ", dumpfile);
+	  break;
+	case INTRINSIC_PLUS:
+	  fputs ("+ ", dumpfile);
+	  break;
+	case INTRINSIC_MINUS:
+	  fputs ("- ", dumpfile);
+	  break;
+	case INTRINSIC_TIMES:
+	  fputs ("* ", dumpfile);
+	  break;
+	case INTRINSIC_DIVIDE:
+	  fputs ("/ ", dumpfile);
+	  break;
+	case INTRINSIC_POWER:
+	  fputs ("** ", dumpfile);
+	  break;
+	case INTRINSIC_CONCAT:
+	  fputs ("// ", dumpfile);
+	  break;
+	case INTRINSIC_AND:
+	  fputs ("AND ", dumpfile);
+	  break;
+	case INTRINSIC_OR:
+	  fputs ("OR ", dumpfile);
+	  break;
+	case INTRINSIC_EQV:
+	  fputs ("EQV ", dumpfile);
+	  break;
+	case INTRINSIC_NEQV:
+	  fputs ("NEQV ", dumpfile);
+	  break;
+	case INTRINSIC_EQ:
+	case INTRINSIC_EQ_OS:
+	  fputs ("= ", dumpfile);
+	  break;
+	case INTRINSIC_NE:
+	case INTRINSIC_NE_OS:
+	  fputs ("/= ", dumpfile);
+	  break;
+	case INTRINSIC_GT:
+	case INTRINSIC_GT_OS:
+	  fputs ("> ", dumpfile);
+	  break;
+	case INTRINSIC_GE:
+	case INTRINSIC_GE_OS:
+	  fputs (">= ", dumpfile);
+	  break;
+	case INTRINSIC_LT:
+	case INTRINSIC_LT_OS:
+	  fputs ("< ", dumpfile);
+	  break;
+	case INTRINSIC_LE:
+	case INTRINSIC_LE_OS:
+	  fputs ("<= ", dumpfile);
+	  break;
+	case INTRINSIC_NOT:
+	  fputs ("NOT ", dumpfile);
+	  break;
+	case INTRINSIC_PARENTHESES:
+	  fputs ("parens ", dumpfile);
+	  break;
+
+	default:
+	  gfc_internal_error
+	    ("show_expr(): Bad intrinsic in expression!");
+	}
+
+      show_expr (p->value.op.op1);
+
+      if (p->value.op.op2)
+	{
+	  fputc (' ', dumpfile);
+	  show_expr (p->value.op.op2);
+	}
+
+      fputc (')', dumpfile);
+      break;
+
+    case EXPR_FUNCTION:
+      if (p->value.function.name == NULL)
+	{
+	  fprintf (dumpfile, "%s", p->symtree->n.sym->name);
+	  if (gfc_is_proc_ptr_comp (p, NULL))
+	    show_ref (p->ref);
+	  fputc ('[', dumpfile);
+	  show_actual_arglist (p->value.function.actual);
+	  fputc (']', dumpfile);
+	}
+      else
+	{
+	  fprintf (dumpfile, "%s", p->value.function.name);
+	  if (gfc_is_proc_ptr_comp (p, NULL))
+	    show_ref (p->ref);
+	  fputc ('[', dumpfile);
+	  fputc ('[', dumpfile);
+	  show_actual_arglist (p->value.function.actual);
+	  fputc (']', dumpfile);
+	  fputc (']', dumpfile);
+	}
+
+      break;
+
+    case EXPR_COMPCALL:
+      show_compcall (p);
+      break;
+
+    default:
+      gfc_internal_error ("show_expr(): Don't know how to show expr");
+    }
+}
+
+/* Show symbol attributes.  The flavor and intent are followed by
+   whatever single bit attributes are present.  */
+
+static void
+show_attr (symbol_attribute *attr, const char * module)
+{
+  if (attr->flavor != FL_UNKNOWN)
+    fprintf (dumpfile, "(%s ", gfc_code2string (flavors, attr->flavor));
+  if (attr->access != ACCESS_UNKNOWN)
+    fprintf (dumpfile, "%s ", gfc_code2string (access_types, attr->access));
+  if (attr->proc != PROC_UNKNOWN)
+    fprintf (dumpfile, "%s ", gfc_code2string (procedures, attr->proc));
+  if (attr->save != SAVE_NONE)
+    fprintf (dumpfile, "%s", gfc_code2string (save_status, attr->save));
+
+  if (attr->allocatable)
+    fputs (" ALLOCATABLE", dumpfile);
+  if (attr->asynchronous)
+    fputs (" ASYNCHRONOUS", dumpfile);
+  if (attr->codimension)
+    fputs (" CODIMENSION", dumpfile);
+  if (attr->dimension)
+    fputs (" DIMENSION", dumpfile);
+  if (attr->contiguous)
+    fputs (" CONTIGUOUS", dumpfile);
+  if (attr->external)
+    fputs (" EXTERNAL", dumpfile);
+  if (attr->intrinsic)
+    fputs (" INTRINSIC", dumpfile);
+  if (attr->optional)
+    fputs (" OPTIONAL", dumpfile);
+  if (attr->pointer)
+    fputs (" POINTER", dumpfile);
+  if (attr->is_protected)
+    fputs (" PROTECTED", dumpfile);
+  if (attr->value)
+    fputs (" VALUE", dumpfile);
+  if (attr->volatile_)
+    fputs (" VOLATILE", dumpfile);
+  if (attr->threadprivate)
+    fputs (" THREADPRIVATE", dumpfile);
+  if (attr->target)
+    fputs (" TARGET", dumpfile);
+  if (attr->dummy)
+    {
+      fputs (" DUMMY", dumpfile);
+      if (attr->intent != INTENT_UNKNOWN)
+	fprintf (dumpfile, "(%s)", gfc_intent_string (attr->intent));
+    }
+
+  if (attr->result)
+    fputs (" RESULT", dumpfile);
+  if (attr->entry)
+    fputs (" ENTRY", dumpfile);
+  if (attr->is_bind_c)
+    fputs (" BIND(C)", dumpfile);
+
+  if (attr->data)
+    fputs (" DATA", dumpfile);
+  if (attr->use_assoc)
+    {
+      fputs (" USE-ASSOC", dumpfile);
+      if (module != NULL)
+	fprintf (dumpfile, "(%s)", module);
+    }
+
+  if (attr->in_namelist)
+    fputs (" IN-NAMELIST", dumpfile);
+  if (attr->in_common)
+    fputs (" IN-COMMON", dumpfile);
+
+  if (attr->abstract)
+    fputs (" ABSTRACT", dumpfile);
+  if (attr->function)
+    fputs (" FUNCTION", dumpfile);
+  if (attr->subroutine)
+    fputs (" SUBROUTINE", dumpfile);
+  if (attr->implicit_type)
+    fputs (" IMPLICIT-TYPE", dumpfile);
+
+  if (attr->sequence)
+    fputs (" SEQUENCE", dumpfile);
+  if (attr->elemental)
+    fputs (" ELEMENTAL", dumpfile);
+  if (attr->pure)
+    fputs (" PURE", dumpfile);
+  if (attr->recursive)
+    fputs (" RECURSIVE", dumpfile);
+
+  fputc (')', dumpfile);
+}
+
+
+/* Show components of a derived type.  */
+
+static void
+show_components (gfc_symbol *sym)
+{
+  gfc_component *c;
+
+  for (c = sym->components; c; c = c->next)
+    {
+      fprintf (dumpfile, "(%s ", c->name);
+      show_typespec (&c->ts);
+      if (c->attr.allocatable)
+	fputs (" ALLOCATABLE", dumpfile);
+      if (c->attr.pointer)
+	fputs (" POINTER", dumpfile);
+      if (c->attr.proc_pointer)
+	fputs (" PPC", dumpfile);
+      if (c->attr.dimension)
+	fputs (" DIMENSION", dumpfile);
+      fputc (' ', dumpfile);
+      show_array_spec (c->as);
+      if (c->attr.access)
+	fprintf (dumpfile, " %s", gfc_code2string (access_types, c->attr.access));
+      fputc (')', dumpfile);
+      if (c->next != NULL)
+	fputc (' ', dumpfile);
+    }
+}
+
+
+/* Show the f2k_derived namespace with procedure bindings.  */
+
+static void
+show_typebound_proc (gfc_typebound_proc* tb, const char* name)
+{
+  show_indent ();
+
+  if (tb->is_generic)
+    fputs ("GENERIC", dumpfile);
+  else
+    {
+      fputs ("PROCEDURE, ", dumpfile);
+      if (tb->nopass)
+	fputs ("NOPASS", dumpfile);
+      else
+	{
+	  if (tb->pass_arg)
+	    fprintf (dumpfile, "PASS(%s)", tb->pass_arg);
+	  else
+	    fputs ("PASS", dumpfile);
+	}
+      if (tb->non_overridable)
+	fputs (", NON_OVERRIDABLE", dumpfile);
+    }
+
+  if (tb->access == ACCESS_PUBLIC)
+    fputs (", PUBLIC", dumpfile);
+  else
+    fputs (", PRIVATE", dumpfile);
+
+  fprintf (dumpfile, " :: %s => ", name);
+
+  if (tb->is_generic)
+    {
+      gfc_tbp_generic* g;
+      for (g = tb->u.generic; g; g = g->next)
+	{
+	  fputs (g->specific_st->name, dumpfile);
+	  if (g->next)
+	    fputs (", ", dumpfile);
+	}
+    }
+  else
+    fputs (tb->u.specific->n.sym->name, dumpfile);
+}
+
+static void
+show_typebound_symtree (gfc_symtree* st)
+{
+  gcc_assert (st->n.tb);
+  show_typebound_proc (st->n.tb, st->name);
+}
+
+static void
+show_f2k_derived (gfc_namespace* f2k)
+{
+  gfc_finalizer* f;
+  int op;
+
+  show_indent ();
+  fputs ("Procedure bindings:", dumpfile);
+  ++show_level;
+
+  /* Finalizer bindings.  */
+  for (f = f2k->finalizers; f; f = f->next)
+    {
+      show_indent ();
+      fprintf (dumpfile, "FINAL %s", f->proc_sym->name);
+    }
+
+  /* Type-bound procedures.  */
+  gfc_traverse_symtree (f2k->tb_sym_root, &show_typebound_symtree);
+
+  --show_level;
+
+  show_indent ();
+  fputs ("Operator bindings:", dumpfile);
+  ++show_level;
+
+  /* User-defined operators.  */
+  gfc_traverse_symtree (f2k->tb_uop_root, &show_typebound_symtree);
+
+  /* Intrinsic operators.  */
+  for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; ++op)
+    if (f2k->tb_op[op])
+      show_typebound_proc (f2k->tb_op[op],
+			   gfc_op2string ((gfc_intrinsic_op) op));
+
+  --show_level;
+}
+
+
+/* Show a symbol.  If a symbol is an ENTRY, SUBROUTINE or FUNCTION, we
+   show the interface.  Information needed to reconstruct the list of
+   specific interfaces associated with a generic symbol is done within
+   that symbol.  */
+
+static void
+show_symbol (gfc_symbol *sym)
+{
+  gfc_formal_arglist *formal;
+  gfc_interface *intr;
+  int i,len;
+
+  if (sym == NULL)
+    return;
+
+  fprintf (dumpfile, "|| symbol: '%s' ", sym->name);
+  len = strlen (sym->name);
+  for (i=len; i<12; i++)
+    fputc(' ', dumpfile);
+
+  ++show_level;
+
+  show_indent ();
+  fputs ("type spec : ", dumpfile);
+  show_typespec (&sym->ts);
+
+  show_indent ();
+  fputs ("attributes: ", dumpfile);
+  show_attr (&sym->attr, sym->module);
+
+  if (sym->value)
+    {
+      show_indent ();
+      fputs ("value: ", dumpfile);
+      show_expr (sym->value);
+    }
+
+  if (sym->as)
+    {
+      show_indent ();
+      fputs ("Array spec:", dumpfile);
+      show_array_spec (sym->as);
+    }
+
+  if (sym->generic)
+    {
+      show_indent ();
+      fputs ("Generic interfaces:", dumpfile);
+      for (intr = sym->generic; intr; intr = intr->next)
+	fprintf (dumpfile, " %s", intr->sym->name);
+    }
+
+  if (sym->result)
+    {
+      show_indent ();
+      fprintf (dumpfile, "result: %s", sym->result->name);
+    }
+
+  if (sym->components)
+    {
+      show_indent ();
+      fputs ("components: ", dumpfile);
+      show_components (sym);
+    }
+
+  if (sym->f2k_derived)
+    {
+      show_indent ();
+      if (sym->hash_value)
+	fprintf (dumpfile, "hash: %d", sym->hash_value);
+      show_f2k_derived (sym->f2k_derived);
+    }
+
+  if (sym->formal)
+    {
+      show_indent ();
+      fputs ("Formal arglist:", dumpfile);
+
+      for (formal = sym->formal; formal; formal = formal->next)
+	{
+	  if (formal->sym != NULL)
+	    fprintf (dumpfile, " %s", formal->sym->name);
+	  else
+	    fputs (" [Alt Return]", dumpfile);
+	}
+    }
+
+  if (sym->formal_ns && (sym->formal_ns->proc_name != sym)
+      && sym->attr.proc != PROC_ST_FUNCTION)
+    {
+      show_indent ();
+      fputs ("Formal namespace", dumpfile);
+      show_namespace (sym->formal_ns);
+    }
+  --show_level;
+}
+
+
+/* Show a user-defined operator.  Just prints an operator
+   and the name of the associated subroutine, really.  */
+
+static void
+show_uop (gfc_user_op *uop)
+{
+  gfc_interface *intr;
+
+  show_indent ();
+  fprintf (dumpfile, "%s:", uop->name);
+
+  for (intr = uop->op; intr; intr = intr->next)
+    fprintf (dumpfile, " %s", intr->sym->name);
+}
+
+
+/* Workhorse function for traversing the user operator symtree.  */
+
+static void
+traverse_uop (gfc_symtree *st, void (*func) (gfc_user_op *))
+{
+  if (st == NULL)
+    return;
+
+  (*func) (st->n.uop);
+
+  traverse_uop (st->left, func);
+  traverse_uop (st->right, func);
+}
+
+
+/* Traverse the tree of user operator nodes.  */
+
+void
+gfc_traverse_user_op (gfc_namespace *ns, void (*func) (gfc_user_op *))
+{
+  traverse_uop (ns->uop_root, func);
+}
+
+
+/* Function to display a common block.  */
+
+static void
+show_common (gfc_symtree *st)
+{
+  gfc_symbol *s;
+
+  show_indent ();
+  fprintf (dumpfile, "common: /%s/ ", st->name);
+
+  s = st->n.common->head;
+  while (s)
+    {
+      fprintf (dumpfile, "%s", s->name);
+      s = s->common_next;
+      if (s)
+	fputs (", ", dumpfile);
+    }
+  fputc ('\n', dumpfile);
+}    
+
+
+/* Worker function to display the symbol tree.  */
+
+static void
+show_symtree (gfc_symtree *st)
+{
+  int len, i;
+
+  show_indent ();
+
+  len = strlen(st->name);
+  fprintf (dumpfile, "symtree: '%s'", st->name);
+
+  for (i=len; i<12; i++)
+    fputc(' ', dumpfile);
+
+  if (st->ambiguous)
+    fputs( " Ambiguous", dumpfile);
+
+  if (st->n.sym->ns != gfc_current_ns)
+    fprintf (dumpfile, "|| symbol: '%s' from namespace '%s'", st->n.sym->name,
+	     st->n.sym->ns->proc_name->name);
+  else
+    show_symbol (st->n.sym);
+}
+
+
+/******************* Show gfc_code structures **************/
+
+
+/* Show a list of code structures.  Mutually recursive with
+   show_code_node().  */
+
+static void
+show_code (int level, gfc_code *c)
+{
+  for (; c; c = c->next)
+    show_code_node (level, c);
+}
+
+static void
+show_namelist (gfc_namelist *n)
+{
+  for (; n->next; n = n->next)
+    fprintf (dumpfile, "%s,", n->sym->name);
+  fprintf (dumpfile, "%s", n->sym->name);
+}
+
+/* Show a single OpenMP directive node and everything underneath it
+   if necessary.  */
+
+static void
+show_omp_node (int level, gfc_code *c)
+{
+  gfc_omp_clauses *omp_clauses = NULL;
+  const char *name = NULL;
+
+  switch (c->op)
+    {
+    case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
+    case EXEC_OMP_BARRIER: name = "BARRIER"; break;
+    case EXEC_OMP_CRITICAL: name = "CRITICAL"; break;
+    case EXEC_OMP_FLUSH: name = "FLUSH"; break;
+    case EXEC_OMP_DO: name = "DO"; break;
+    case EXEC_OMP_MASTER: name = "MASTER"; break;
+    case EXEC_OMP_ORDERED: name = "ORDERED"; break;
+    case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
+    case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
+    case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
+    case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
+    case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
+    case EXEC_OMP_SINGLE: name = "SINGLE"; break;
+    case EXEC_OMP_TASK: name = "TASK"; break;
+    case EXEC_OMP_TASKWAIT: name = "TASKWAIT"; break;
+    case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
+    default:
+      gcc_unreachable ();
+    }
+  fprintf (dumpfile, "!$OMP %s", name);
+  switch (c->op)
+    {
+    case EXEC_OMP_DO:
+    case EXEC_OMP_PARALLEL:
+    case EXEC_OMP_PARALLEL_DO:
+    case EXEC_OMP_PARALLEL_SECTIONS:
+    case EXEC_OMP_SECTIONS:
+    case EXEC_OMP_SINGLE:
+    case EXEC_OMP_WORKSHARE:
+    case EXEC_OMP_PARALLEL_WORKSHARE:
+    case EXEC_OMP_TASK:
+      omp_clauses = c->ext.omp_clauses;
+      break;
+    case EXEC_OMP_CRITICAL:
+      if (c->ext.omp_name)
+	fprintf (dumpfile, " (%s)", c->ext.omp_name);
+      break;
+    case EXEC_OMP_FLUSH:
+      if (c->ext.omp_namelist)
+	{
+	  fputs (" (", dumpfile);
+	  show_namelist (c->ext.omp_namelist);
+	  fputc (')', dumpfile);
+	}
+      return;
+    case EXEC_OMP_BARRIER:
+    case EXEC_OMP_TASKWAIT:
+      return;
+    default:
+      break;
+    }
+  if (omp_clauses)
+    {
+      int list_type;
+
+      if (omp_clauses->if_expr)
+	{
+	  fputs (" IF(", dumpfile);
+	  show_expr (omp_clauses->if_expr);
+	  fputc (')', dumpfile);
+	}
+      if (omp_clauses->num_threads)
+	{
+	  fputs (" NUM_THREADS(", dumpfile);
+	  show_expr (omp_clauses->num_threads);
+	  fputc (')', dumpfile);
+	}
+      if (omp_clauses->sched_kind != OMP_SCHED_NONE)
+	{
+	  const char *type;
+	  switch (omp_clauses->sched_kind)
+	    {
+	    case OMP_SCHED_STATIC: type = "STATIC"; break;
+	    case OMP_SCHED_DYNAMIC: type = "DYNAMIC"; break;
+	    case OMP_SCHED_GUIDED: type = "GUIDED"; break;
+	    case OMP_SCHED_RUNTIME: type = "RUNTIME"; break;
+	    case OMP_SCHED_AUTO: type = "AUTO"; break;
+	    default:
+	      gcc_unreachable ();
+	    }
+	  fprintf (dumpfile, " SCHEDULE (%s", type);
+	  if (omp_clauses->chunk_size)
+	    {
+	      fputc (',', dumpfile);
+	      show_expr (omp_clauses->chunk_size);
+	    }
+	  fputc (')', dumpfile);
+	}
+      if (omp_clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
+	{
+	  const char *type;
+	  switch (omp_clauses->default_sharing)
+	    {
+	    case OMP_DEFAULT_NONE: type = "NONE"; break;
+	    case OMP_DEFAULT_PRIVATE: type = "PRIVATE"; break;
+	    case OMP_DEFAULT_SHARED: type = "SHARED"; break;
+	    case OMP_DEFAULT_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
+	    default:
+	      gcc_unreachable ();
+	    }
+	  fprintf (dumpfile, " DEFAULT(%s)", type);
+	}
+      if (omp_clauses->ordered)
+	fputs (" ORDERED", dumpfile);
+      if (omp_clauses->untied)
+	fputs (" UNTIED", dumpfile);
+      if (omp_clauses->collapse)
+	fprintf (dumpfile, " COLLAPSE(%d)", omp_clauses->collapse);
+      for (list_type = 0; list_type < OMP_LIST_NUM; list_type++)
+	if (omp_clauses->lists[list_type] != NULL
+	    && list_type != OMP_LIST_COPYPRIVATE)
+	  {
+	    const char *type;
+	    if (list_type >= OMP_LIST_REDUCTION_FIRST)
+	      {
+		switch (list_type)
+		  {
+		  case OMP_LIST_PLUS: type = "+"; break;
+		  case OMP_LIST_MULT: type = "*"; break;
+		  case OMP_LIST_SUB: type = "-"; break;
+		  case OMP_LIST_AND: type = ".AND."; break;
+		  case OMP_LIST_OR: type = ".OR."; break;
+		  case OMP_LIST_EQV: type = ".EQV."; break;
+		  case OMP_LIST_NEQV: type = ".NEQV."; break;
+		  case OMP_LIST_MAX: type = "MAX"; break;
+		  case OMP_LIST_MIN: type = "MIN"; break;
+		  case OMP_LIST_IAND: type = "IAND"; break;
+		  case OMP_LIST_IOR: type = "IOR"; break;
+		  case OMP_LIST_IEOR: type = "IEOR"; break;
+		  default:
+		    gcc_unreachable ();
+		  }
+		fprintf (dumpfile, " REDUCTION(%s:", type);
+	      }
+	    else
+	      {
+		switch (list_type)
+		  {
+		  case OMP_LIST_PRIVATE: type = "PRIVATE"; break;
+		  case OMP_LIST_FIRSTPRIVATE: type = "FIRSTPRIVATE"; break;
+		  case OMP_LIST_LASTPRIVATE: type = "LASTPRIVATE"; break;
+		  case OMP_LIST_SHARED: type = "SHARED"; break;
+		  case OMP_LIST_COPYIN: type = "COPYIN"; break;
+		  default:
+		    gcc_unreachable ();
+		  }
+		fprintf (dumpfile, " %s(", type);
+	      }
+	    show_namelist (omp_clauses->lists[list_type]);
+	    fputc (')', dumpfile);
+	  }
+    }
+  fputc ('\n', dumpfile);
+  if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
+    {
+      gfc_code *d = c->block;
+      while (d != NULL)
+	{
+	  show_code (level + 1, d->next);
+	  if (d->block == NULL)
+	    break;
+	  code_indent (level, 0);
+	  fputs ("!$OMP SECTION\n", dumpfile);
+	  d = d->block;
+	}
+    }
+  else
+    show_code (level + 1, c->block->next);
+  if (c->op == EXEC_OMP_ATOMIC)
+    return;
+  code_indent (level, 0);
+  fprintf (dumpfile, "!$OMP END %s", name);
+  if (omp_clauses != NULL)
+    {
+      if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
+	{
+	  fputs (" COPYPRIVATE(", dumpfile);
+	  show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
+	  fputc (')', dumpfile);
+	}
+      else if (omp_clauses->nowait)
+	fputs (" NOWAIT", dumpfile);
+    }
+  else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_name)
+    fprintf (dumpfile, " (%s)", c->ext.omp_name);
+}
+
+
+/* Show a single code node and everything underneath it if necessary.  */
+
+static void
+show_code_node (int level, gfc_code *c)
+{
+  gfc_forall_iterator *fa;
+  gfc_open *open;
+  gfc_case *cp;
+  gfc_alloc *a;
+  gfc_code *d;
+  gfc_close *close;
+  gfc_filepos *fp;
+  gfc_inquire *i;
+  gfc_dt *dt;
+  gfc_namespace *ns;
+
+  if (c->here)
+    {
+      fputc ('\n', dumpfile);
+      code_indent (level, c->here);
+    }
+  else
+    show_indent ();
+
+  switch (c->op)
+    {
+    case EXEC_END_PROCEDURE:
+      break;
+
+    case EXEC_NOP:
+      fputs ("NOP", dumpfile);
+      break;
+
+    case EXEC_CONTINUE:
+      fputs ("CONTINUE", dumpfile);
+      break;
+
+    case EXEC_ENTRY:
+      fprintf (dumpfile, "ENTRY %s", c->ext.entry->sym->name);
+      break;
+
+    case EXEC_INIT_ASSIGN:
+    case EXEC_ASSIGN:
+      fputs ("ASSIGN ", dumpfile);
+      show_expr (c->expr1);
+      fputc (' ', dumpfile);
+      show_expr (c->expr2);
+      break;
+
+    case EXEC_LABEL_ASSIGN:
+      fputs ("LABEL ASSIGN ", dumpfile);
+      show_expr (c->expr1);
+      fprintf (dumpfile, " %d", c->label1->value);
+      break;
+
+    case EXEC_POINTER_ASSIGN:
+      fputs ("POINTER ASSIGN ", dumpfile);
+      show_expr (c->expr1);
+      fputc (' ', dumpfile);
+      show_expr (c->expr2);
+      break;
+
+    case EXEC_GOTO:
+      fputs ("GOTO ", dumpfile);
+      if (c->label1)
+	fprintf (dumpfile, "%d", c->label1->value);
+      else
+	{
+	  show_expr (c->expr1);
+	  d = c->block;
+	  if (d != NULL)
+	    {
+	      fputs (", (", dumpfile);
+	      for (; d; d = d ->block)
+		{
+		  code_indent (level, d->label1);
+		  if (d->block != NULL)
+		    fputc (',', dumpfile);
+		  else
+		    fputc (')', dumpfile);
+		}
+	    }
+	}
+      break;
+
+    case EXEC_CALL:
+    case EXEC_ASSIGN_CALL:
+      if (c->resolved_sym)
+	fprintf (dumpfile, "CALL %s ", c->resolved_sym->name);
+      else if (c->symtree)
+	fprintf (dumpfile, "CALL %s ", c->symtree->name);
+      else
+	fputs ("CALL ?? ", dumpfile);
+
+      show_actual_arglist (c->ext.actual);
+      break;
+
+    case EXEC_COMPCALL:
+      fputs ("CALL ", dumpfile);
+      show_compcall (c->expr1);
+      break;
+
+    case EXEC_CALL_PPC:
+      fputs ("CALL ", dumpfile);
+      show_expr (c->expr1);
+      show_actual_arglist (c->ext.actual);
+      break;
+
+    case EXEC_RETURN:
+      fputs ("RETURN ", dumpfile);
+      if (c->expr1)
+	show_expr (c->expr1);
+      break;
+
+    case EXEC_PAUSE:
+      fputs ("PAUSE ", dumpfile);
+
+      if (c->expr1 != NULL)
+	show_expr (c->expr1);
+      else
+	fprintf (dumpfile, "%d", c->ext.stop_code);
+
+      break;
+
+    case EXEC_ERROR_STOP:
+      fputs ("ERROR ", dumpfile);
+      /* Fall through.  */
+
+    case EXEC_STOP:
+      fputs ("STOP ", dumpfile);
+
+      if (c->expr1 != NULL)
+	show_expr (c->expr1);
+      else
+	fprintf (dumpfile, "%d", c->ext.stop_code);
+
+      break;
+
+    case EXEC_SYNC_ALL:
+      fputs ("SYNC ALL ", dumpfile);
+      if (c->expr2 != NULL)
+	{
+	  fputs (" stat=", dumpfile);
+	  show_expr (c->expr2);
+	}
+      if (c->expr3 != NULL)
+	{
+	  fputs (" errmsg=", dumpfile);
+	  show_expr (c->expr3);
+	}
+      break;
+
+    case EXEC_SYNC_MEMORY:
+      fputs ("SYNC MEMORY ", dumpfile);
+      if (c->expr2 != NULL)
+ 	{
+	  fputs (" stat=", dumpfile);
+	  show_expr (c->expr2);
+	}
+      if (c->expr3 != NULL)
+	{
+	  fputs (" errmsg=", dumpfile);
+	  show_expr (c->expr3);
+	}
+      break;
+
+    case EXEC_SYNC_IMAGES:
+      fputs ("SYNC IMAGES  image-set=", dumpfile);
+      if (c->expr1 != NULL)
+	show_expr (c->expr1);
+      else
+	fputs ("* ", dumpfile);
+      if (c->expr2 != NULL)
+	{
+	  fputs (" stat=", dumpfile);
+	  show_expr (c->expr2);
+	}
+      if (c->expr3 != NULL)
+	{
+	  fputs (" errmsg=", dumpfile);
+	  show_expr (c->expr3);
+	}
+      break;
+
+    case EXEC_ARITHMETIC_IF:
+      fputs ("IF ", dumpfile);
+      show_expr (c->expr1);
+      fprintf (dumpfile, " %d, %d, %d",
+		  c->label1->value, c->label2->value, c->label3->value);
+      break;
+
+    case EXEC_IF:
+      d = c->block;
+      fputs ("IF ", dumpfile);
+      show_expr (d->expr1);
+
+      ++show_level;
+      show_code (level + 1, d->next);
+      --show_level;
+
+      d = d->block;
+      for (; d; d = d->block)
+	{
+	  code_indent (level, 0);
+
+	  if (d->expr1 == NULL)
+	    fputs ("ELSE", dumpfile);
+	  else
+	    {
+	      fputs ("ELSE IF ", dumpfile);
+	      show_expr (d->expr1);
+	    }
+
+	  ++show_level;
+	  show_code (level + 1, d->next);
+	  --show_level;
+	}
+
+      if (c->label1)
+	code_indent (level, c->label1);
+      else
+	show_indent ();
+
+      fputs ("ENDIF", dumpfile);
+      break;
+
+    case EXEC_BLOCK:
+      {
+	const char* blocktype;
+	if (c->ext.block.assoc)
+	  blocktype = "ASSOCIATE";
+	else
+	  blocktype = "BLOCK";
+	show_indent ();
+	fprintf (dumpfile, "%s ", blocktype);
+	++show_level;
+	ns = c->ext.block.ns;
+	gfc_traverse_symtree (ns->sym_root, show_symtree);
+	show_code (show_level, ns->code);
+	--show_level;
+	show_indent ();
+	fprintf (dumpfile, "END %s ", blocktype);
+	break;
+      }
+
+    case EXEC_SELECT:
+      d = c->block;
+      fputs ("SELECT CASE ", dumpfile);
+      show_expr (c->expr1);
+      fputc ('\n', dumpfile);
+
+      for (; d; d = d->block)
+	{
+	  code_indent (level, 0);
+
+	  fputs ("CASE ", dumpfile);
+	  for (cp = d->ext.block.case_list; cp; cp = cp->next)
+	    {
+	      fputc ('(', dumpfile);
+	      show_expr (cp->low);
+	      fputc (' ', dumpfile);
+	      show_expr (cp->high);
+	      fputc (')', dumpfile);
+	      fputc (' ', dumpfile);
+	    }
+	  fputc ('\n', dumpfile);
+
+	  show_code (level + 1, d->next);
+	}
+
+      code_indent (level, c->label1);
+      fputs ("END SELECT", dumpfile);
+      break;
+
+    case EXEC_WHERE:
+      fputs ("WHERE ", dumpfile);
+
+      d = c->block;
+      show_expr (d->expr1);
+      fputc ('\n', dumpfile);
+
+      show_code (level + 1, d->next);
+
+      for (d = d->block; d; d = d->block)
+	{
+	  code_indent (level, 0);
+	  fputs ("ELSE WHERE ", dumpfile);
+	  show_expr (d->expr1);
+	  fputc ('\n', dumpfile);
+	  show_code (level + 1, d->next);
+	}
+
+      code_indent (level, 0);
+      fputs ("END WHERE", dumpfile);
+      break;
+
+
+    case EXEC_FORALL:
+      fputs ("FORALL ", dumpfile);
+      for (fa = c->ext.forall_iterator; fa; fa = fa->next)
+	{
+	  show_expr (fa->var);
+	  fputc (' ', dumpfile);
+	  show_expr (fa->start);
+	  fputc (':', dumpfile);
+	  show_expr (fa->end);
+	  fputc (':', dumpfile);
+	  show_expr (fa->stride);
+
+	  if (fa->next != NULL)
+	    fputc (',', dumpfile);
+	}
+
+      if (c->expr1 != NULL)
+	{
+	  fputc (',', dumpfile);
+	  show_expr (c->expr1);
+	}
+      fputc ('\n', dumpfile);
+
+      show_code (level + 1, c->block->next);
+
+      code_indent (level, 0);
+      fputs ("END FORALL", dumpfile);
+      break;
+
+    case EXEC_CRITICAL:
+      fputs ("CRITICAL\n", dumpfile);
+      show_code (level + 1, c->block->next);
+      code_indent (level, 0);
+      fputs ("END CRITICAL", dumpfile);
+      break;
+
+    case EXEC_DO:
+      fputs ("DO ", dumpfile);
+      if (c->label1)
+	fprintf (dumpfile, " %-5d ", c->label1->value);
+
+      show_expr (c->ext.iterator->var);
+      fputc ('=', dumpfile);
+      show_expr (c->ext.iterator->start);
+      fputc (' ', dumpfile);
+      show_expr (c->ext.iterator->end);
+      fputc (' ', dumpfile);
+      show_expr (c->ext.iterator->step);
+
+      ++show_level;
+      show_code (level + 1, c->block->next);
+      --show_level;
+
+      if (c->label1)
+	break;
+
+      show_indent ();
+      fputs ("END DO", dumpfile);
+      break;
+
+    case EXEC_DO_WHILE:
+      fputs ("DO WHILE ", dumpfile);
+      show_expr (c->expr1);
+      fputc ('\n', dumpfile);
+
+      show_code (level + 1, c->block->next);
+
+      code_indent (level, c->label1);
+      fputs ("END DO", dumpfile);
+      break;
+
+    case EXEC_CYCLE:
+      fputs ("CYCLE", dumpfile);
+      if (c->symtree)
+	fprintf (dumpfile, " %s", c->symtree->n.sym->name);
+      break;
+
+    case EXEC_EXIT:
+      fputs ("EXIT", dumpfile);
+      if (c->symtree)
+	fprintf (dumpfile, " %s", c->symtree->n.sym->name);
+      break;
+
+    case EXEC_ALLOCATE:
+      fputs ("ALLOCATE ", dumpfile);
+      if (c->expr1)
+	{
+	  fputs (" STAT=", dumpfile);
+	  show_expr (c->expr1);
+	}
+
+      if (c->expr2)
+	{
+	  fputs (" ERRMSG=", dumpfile);
+	  show_expr (c->expr2);
+	}
+
+      if (c->expr3)
+	{
+	  if (c->expr3->mold)
+	    fputs (" MOLD=", dumpfile);
+	  else
+	    fputs (" SOURCE=", dumpfile);
+	  show_expr (c->expr3);
+	}
+
+      for (a = c->ext.alloc.list; a; a = a->next)
+	{
+	  fputc (' ', dumpfile);
+	  show_expr (a->expr);
+	}
+
+      break;
+
+    case EXEC_DEALLOCATE:
+      fputs ("DEALLOCATE ", dumpfile);
+      if (c->expr1)
+	{
+	  fputs (" STAT=", dumpfile);
+	  show_expr (c->expr1);
+	}
+
+      if (c->expr2)
+	{
+	  fputs (" ERRMSG=", dumpfile);
+	  show_expr (c->expr2);
+	}
+
+      for (a = c->ext.alloc.list; a; a = a->next)
+	{
+	  fputc (' ', dumpfile);
+	  show_expr (a->expr);
+	}
+
+      break;
+
+    case EXEC_OPEN:
+      fputs ("OPEN", dumpfile);
+      open = c->ext.open;
+
+      if (open->unit)
+	{
+	  fputs (" UNIT=", dumpfile);
+	  show_expr (open->unit);
+	}
+      if (open->iomsg)
+	{
+	  fputs (" IOMSG=", dumpfile);
+	  show_expr (open->iomsg);
+	}
+      if (open->iostat)
+	{
+	  fputs (" IOSTAT=", dumpfile);
+	  show_expr (open->iostat);
+	}
+      if (open->file)
+	{
+	  fputs (" FILE=", dumpfile);
+	  show_expr (open->file);
+	}
+      if (open->status)
+	{
+	  fputs (" STATUS=", dumpfile);
+	  show_expr (open->status);
+	}
+      if (open->access)
+	{
+	  fputs (" ACCESS=", dumpfile);
+	  show_expr (open->access);
+	}
+      if (open->form)
+	{
+	  fputs (" FORM=", dumpfile);
+	  show_expr (open->form);
+	}
+      if (open->recl)
+	{
+	  fputs (" RECL=", dumpfile);
+	  show_expr (open->recl);
+	}
+      if (open->blank)
+	{
+	  fputs (" BLANK=", dumpfile);
+	  show_expr (open->blank);
+	}
+      if (open->position)
+	{
+	  fputs (" POSITION=", dumpfile);
+	  show_expr (open->position);
+	}
+      if (open->action)
+	{
+	  fputs (" ACTION=", dumpfile);
+	  show_expr (open->action);
+	}
+      if (open->delim)
+	{
+	  fputs (" DELIM=", dumpfile);
+	  show_expr (open->delim);
+	}
+      if (open->pad)
+	{
+	  fputs (" PAD=", dumpfile);
+	  show_expr (open->pad);
+	}
+      if (open->decimal)
+	{
+	  fputs (" DECIMAL=", dumpfile);
+	  show_expr (open->decimal);
+	}
+      if (open->encoding)
+	{
+	  fputs (" ENCODING=", dumpfile);
+	  show_expr (open->encoding);
+	}
+      if (open->round)
+	{
+	  fputs (" ROUND=", dumpfile);
+	  show_expr (open->round);
+	}
+      if (open->sign)
+	{
+	  fputs (" SIGN=", dumpfile);
+	  show_expr (open->sign);
+	}
+      if (open->convert)
+	{
+	  fputs (" CONVERT=", dumpfile);
+	  show_expr (open->convert);
+	}
+      if (open->asynchronous)
+	{
+	  fputs (" ASYNCHRONOUS=", dumpfile);
+	  show_expr (open->asynchronous);
+	}
+      if (open->err != NULL)
+	fprintf (dumpfile, " ERR=%d", open->err->value);
+
+      break;
+
+    case EXEC_CLOSE:
+      fputs ("CLOSE", dumpfile);
+      close = c->ext.close;
+
+      if (close->unit)
+	{
+	  fputs (" UNIT=", dumpfile);
+	  show_expr (close->unit);
+	}
+      if (close->iomsg)
+	{
+	  fputs (" IOMSG=", dumpfile);
+	  show_expr (close->iomsg);
+	}
+      if (close->iostat)
+	{
+	  fputs (" IOSTAT=", dumpfile);
+	  show_expr (close->iostat);
+	}
+      if (close->status)
+	{
+	  fputs (" STATUS=", dumpfile);
+	  show_expr (close->status);
+	}
+      if (close->err != NULL)
+	fprintf (dumpfile, " ERR=%d", close->err->value);
+      break;
+
+    case EXEC_BACKSPACE:
+      fputs ("BACKSPACE", dumpfile);
+      goto show_filepos;
+
+    case EXEC_ENDFILE:
+      fputs ("ENDFILE", dumpfile);
+      goto show_filepos;
+
+    case EXEC_REWIND:
+      fputs ("REWIND", dumpfile);
+      goto show_filepos;
+
+    case EXEC_FLUSH:
+      fputs ("FLUSH", dumpfile);
+
+    show_filepos:
+      fp = c->ext.filepos;
+
+      if (fp->unit)
+	{
+	  fputs (" UNIT=", dumpfile);
+	  show_expr (fp->unit);
+	}
+      if (fp->iomsg)
+	{
+	  fputs (" IOMSG=", dumpfile);
+	  show_expr (fp->iomsg);
+	}
+      if (fp->iostat)
+	{
+	  fputs (" IOSTAT=", dumpfile);
+	  show_expr (fp->iostat);
+	}
+      if (fp->err != NULL)
+	fprintf (dumpfile, " ERR=%d", fp->err->value);
+      break;
+
+    case EXEC_INQUIRE:
+      fputs ("INQUIRE", dumpfile);
+      i = c->ext.inquire;
+
+      if (i->unit)
+	{
+	  fputs (" UNIT=", dumpfile);
+	  show_expr (i->unit);
+	}
+      if (i->file)
+	{
+	  fputs (" FILE=", dumpfile);
+	  show_expr (i->file);
+	}
+
+      if (i->iomsg)
+	{
+	  fputs (" IOMSG=", dumpfile);
+	  show_expr (i->iomsg);
+	}
+      if (i->iostat)
+	{
+	  fputs (" IOSTAT=", dumpfile);
+	  show_expr (i->iostat);
+	}
+      if (i->exist)
+	{
+	  fputs (" EXIST=", dumpfile);
+	  show_expr (i->exist);
+	}
+      if (i->opened)
+	{
+	  fputs (" OPENED=", dumpfile);
+	  show_expr (i->opened);
+	}
+      if (i->number)
+	{
+	  fputs (" NUMBER=", dumpfile);
+	  show_expr (i->number);
+	}
+      if (i->named)
+	{
+	  fputs (" NAMED=", dumpfile);
+	  show_expr (i->named);
+	}
+      if (i->name)
+	{
+	  fputs (" NAME=", dumpfile);
+	  show_expr (i->name);
+	}
+      if (i->access)
+	{
+	  fputs (" ACCESS=", dumpfile);
+	  show_expr (i->access);
+	}
+      if (i->sequential)
+	{
+	  fputs (" SEQUENTIAL=", dumpfile);
+	  show_expr (i->sequential);
+	}
+
+      if (i->direct)
+	{
+	  fputs (" DIRECT=", dumpfile);
+	  show_expr (i->direct);
+	}
+      if (i->form)
+	{
+	  fputs (" FORM=", dumpfile);
+	  show_expr (i->form);
+	}
+      if (i->formatted)
+	{
+	  fputs (" FORMATTED", dumpfile);
+	  show_expr (i->formatted);
+	}
+      if (i->unformatted)
+	{
+	  fputs (" UNFORMATTED=", dumpfile);
+	  show_expr (i->unformatted);
+	}
+      if (i->recl)
+	{
+	  fputs (" RECL=", dumpfile);
+	  show_expr (i->recl);
+	}
+      if (i->nextrec)
+	{
+	  fputs (" NEXTREC=", dumpfile);
+	  show_expr (i->nextrec);
+	}
+      if (i->blank)
+	{
+	  fputs (" BLANK=", dumpfile);
+	  show_expr (i->blank);
+	}
+      if (i->position)
+	{
+	  fputs (" POSITION=", dumpfile);
+	  show_expr (i->position);
+	}
+      if (i->action)
+	{
+	  fputs (" ACTION=", dumpfile);
+	  show_expr (i->action);
+	}
+      if (i->read)
+	{
+	  fputs (" READ=", dumpfile);
+	  show_expr (i->read);
+	}
+      if (i->write)
+	{
+	  fputs (" WRITE=", dumpfile);
+	  show_expr (i->write);
+	}
+      if (i->readwrite)
+	{
+	  fputs (" READWRITE=", dumpfile);
+	  show_expr (i->readwrite);
+	}
+      if (i->delim)
+	{
+	  fputs (" DELIM=", dumpfile);
+	  show_expr (i->delim);
+	}
+      if (i->pad)
+	{
+	  fputs (" PAD=", dumpfile);
+	  show_expr (i->pad);
+	}
+      if (i->convert)
+	{
+	  fputs (" CONVERT=", dumpfile);
+	  show_expr (i->convert);
+	}
+      if (i->asynchronous)
+	{
+	  fputs (" ASYNCHRONOUS=", dumpfile);
+	  show_expr (i->asynchronous);
+	}
+      if (i->decimal)
+	{
+	  fputs (" DECIMAL=", dumpfile);
+	  show_expr (i->decimal);
+	}
+      if (i->encoding)
+	{
+	  fputs (" ENCODING=", dumpfile);
+	  show_expr (i->encoding);
+	}
+      if (i->pending)
+	{
+	  fputs (" PENDING=", dumpfile);
+	  show_expr (i->pending);
+	}
+      if (i->round)
+	{
+	  fputs (" ROUND=", dumpfile);
+	  show_expr (i->round);
+	}
+      if (i->sign)
+	{
+	  fputs (" SIGN=", dumpfile);
+	  show_expr (i->sign);
+	}
+      if (i->size)
+	{
+	  fputs (" SIZE=", dumpfile);
+	  show_expr (i->size);
+	}
+      if (i->id)
+	{
+	  fputs (" ID=", dumpfile);
+	  show_expr (i->id);
+	}
+
+      if (i->err != NULL)
+	fprintf (dumpfile, " ERR=%d", i->err->value);
+      break;
+
+    case EXEC_IOLENGTH:
+      fputs ("IOLENGTH ", dumpfile);
+      show_expr (c->expr1);
+      goto show_dt_code;
+      break;
+
+    case EXEC_READ:
+      fputs ("READ", dumpfile);
+      goto show_dt;
+
+    case EXEC_WRITE:
+      fputs ("WRITE", dumpfile);
+
+    show_dt:
+      dt = c->ext.dt;
+      if (dt->io_unit)
+	{
+	  fputs (" UNIT=", dumpfile);
+	  show_expr (dt->io_unit);
+	}
+
+      if (dt->format_expr)
+	{
+	  fputs (" FMT=", dumpfile);
+	  show_expr (dt->format_expr);
+	}
+
+      if (dt->format_label != NULL)
+	fprintf (dumpfile, " FMT=%d", dt->format_label->value);
+      if (dt->namelist)
+	fprintf (dumpfile, " NML=%s", dt->namelist->name);
+
+      if (dt->iomsg)
+	{
+	  fputs (" IOMSG=", dumpfile);
+	  show_expr (dt->iomsg);
+	}
+      if (dt->iostat)
+	{
+	  fputs (" IOSTAT=", dumpfile);
+	  show_expr (dt->iostat);
+	}
+      if (dt->size)
+	{
+	  fputs (" SIZE=", dumpfile);
+	  show_expr (dt->size);
+	}
+      if (dt->rec)
+	{
+	  fputs (" REC=", dumpfile);
+	  show_expr (dt->rec);
+	}
+      if (dt->advance)
+	{
+	  fputs (" ADVANCE=", dumpfile);
+	  show_expr (dt->advance);
+	}
+      if (dt->id)
+	{
+	  fputs (" ID=", dumpfile);
+	  show_expr (dt->id);
+	}
+      if (dt->pos)
+	{
+	  fputs (" POS=", dumpfile);
+	  show_expr (dt->pos);
+	}
+      if (dt->asynchronous)
+	{
+	  fputs (" ASYNCHRONOUS=", dumpfile);
+	  show_expr (dt->asynchronous);
+	}
+      if (dt->blank)
+	{
+	  fputs (" BLANK=", dumpfile);
+	  show_expr (dt->blank);
+	}
+      if (dt->decimal)
+	{
+	  fputs (" DECIMAL=", dumpfile);
+	  show_expr (dt->decimal);
+	}
+      if (dt->delim)
+	{
+	  fputs (" DELIM=", dumpfile);
+	  show_expr (dt->delim);
+	}
+      if (dt->pad)
+	{
+	  fputs (" PAD=", dumpfile);
+	  show_expr (dt->pad);
+	}
+      if (dt->round)
+	{
+	  fputs (" ROUND=", dumpfile);
+	  show_expr (dt->round);
+	}
+      if (dt->sign)
+	{
+	  fputs (" SIGN=", dumpfile);
+	  show_expr (dt->sign);
+	}
+
+    show_dt_code:
+      for (c = c->block->next; c; c = c->next)
+	show_code_node (level + (c->next != NULL), c);
+      return;
+
+    case EXEC_TRANSFER:
+      fputs ("TRANSFER ", dumpfile);
+      show_expr (c->expr1);
+      break;
+
+    case EXEC_DT_END:
+      fputs ("DT_END", dumpfile);
+      dt = c->ext.dt;
+
+      if (dt->err != NULL)
+	fprintf (dumpfile, " ERR=%d", dt->err->value);
+      if (dt->end != NULL)
+	fprintf (dumpfile, " END=%d", dt->end->value);
+      if (dt->eor != NULL)
+	fprintf (dumpfile, " EOR=%d", dt->eor->value);
+      break;
+
+    case EXEC_OMP_ATOMIC:
+    case EXEC_OMP_BARRIER:
+    case EXEC_OMP_CRITICAL:
+    case EXEC_OMP_FLUSH:
+    case EXEC_OMP_DO:
+    case EXEC_OMP_MASTER:
+    case EXEC_OMP_ORDERED:
+    case EXEC_OMP_PARALLEL:
+    case EXEC_OMP_PARALLEL_DO:
+    case EXEC_OMP_PARALLEL_SECTIONS:
+    case EXEC_OMP_PARALLEL_WORKSHARE:
+    case EXEC_OMP_SECTIONS:
+    case EXEC_OMP_SINGLE:
+    case EXEC_OMP_TASK:
+    case EXEC_OMP_TASKWAIT:
+    case EXEC_OMP_WORKSHARE:
+      show_omp_node (level, c);
+      break;
+
+    default:
+      gfc_internal_error ("show_code_node(): Bad statement code");
+    }
+}
+
+
+/* Show an equivalence chain.  */
+
+static void
+show_equiv (gfc_equiv *eq)
+{
+  show_indent ();
+  fputs ("Equivalence: ", dumpfile);
+  while (eq)
+    {
+      show_expr (eq->expr);
+      eq = eq->eq;
+      if (eq)
+	fputs (", ", dumpfile);
+    }
+}
+
+
+/* Show a freakin' whole namespace.  */
+
+static void
+show_namespace (gfc_namespace *ns)
+{
+  gfc_interface *intr;
+  gfc_namespace *save;
+  int op;
+  gfc_equiv *eq;
+  int i;
+
+  save = gfc_current_ns;
+
+  show_indent ();
+  fputs ("Namespace:", dumpfile);
+
+  if (ns != NULL)
+    {
+      i = 0;
+      do
+	{
+	  int l = i;
+	  while (i < GFC_LETTERS - 1
+		 && gfc_compare_types(&ns->default_type[i+1],
+				      &ns->default_type[l]))
+	    i++;
+
+	  if (i > l)
+	    fprintf (dumpfile, " %c-%c: ", l+'A', i+'A');
+	  else
+	    fprintf (dumpfile, " %c: ", l+'A');
+
+	  show_typespec(&ns->default_type[l]);
+	  i++;
+      } while (i < GFC_LETTERS);
+
+      if (ns->proc_name != NULL)
+	{
+	  show_indent ();
+	  fprintf (dumpfile, "procedure name = %s", ns->proc_name->name);
+	}
+
+      ++show_level;
+      gfc_current_ns = ns;
+      gfc_traverse_symtree (ns->common_root, show_common);
+
+      gfc_traverse_symtree (ns->sym_root, show_symtree);
+
+      for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; op++)
+	{
+	  /* User operator interfaces */
+	  intr = ns->op[op];
+	  if (intr == NULL)
+	    continue;
+
+	  show_indent ();
+	  fprintf (dumpfile, "Operator interfaces for %s:",
+		   gfc_op2string ((gfc_intrinsic_op) op));
+
+	  for (; intr; intr = intr->next)
+	    fprintf (dumpfile, " %s", intr->sym->name);
+	}
+
+      if (ns->uop_root != NULL)
+	{
+	  show_indent ();
+	  fputs ("User operators:\n", dumpfile);
+	  gfc_traverse_user_op (ns, show_uop);
+	}
+    }
+  else
+    ++show_level;
+  
+  for (eq = ns->equiv; eq; eq = eq->next)
+    show_equiv (eq);
+
+  fputc ('\n', dumpfile);
+  show_indent ();
+  fputs ("code:", dumpfile);
+  show_code (show_level, ns->code);
+  --show_level;
+
+  for (ns = ns->contained; ns; ns = ns->sibling)
+    {
+      fputs ("\nCONTAINS\n", dumpfile);
+      ++show_level;
+      show_namespace (ns);
+      --show_level;
+    }
+
+  fputc ('\n', dumpfile);
+  gfc_current_ns = save;
+}
+
+
+/* Main function for dumping a parse tree.  */
+
+void
+gfc_dump_parse_tree (gfc_namespace *ns, FILE *file)
+{
+  dumpfile = file;
+  show_namespace (ns);
+}
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
new file mode 100644
index 000000000..bedb62977
--- /dev/null
+++ b/gcc/fortran/error.c
@@ -0,0 +1,1086 @@
+/* Handle errors.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2010
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught & Niels Kristian Bech Jensen
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* Handle the inevitable errors.  A major catch here is that things
+   flagged as errors in one match subroutine can conceivably be legal
+   elsewhere.  This means that error messages are recorded and saved
+   for possible use later.  If a line does not match a legal
+   construction, then the saved error message is reported.  */
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "gfortran.h"
+
+static int suppress_errors = 0;
+
+static int warnings_not_errors = 0; 
+
+static int terminal_width, buffer_flag, errors, warnings;
+
+static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer;
+
+
+/* Go one level deeper suppressing errors.  */
+
+void
+gfc_push_suppress_errors (void)
+{
+  gcc_assert (suppress_errors >= 0);
+  ++suppress_errors;
+}
+
+
+/* Leave one level of error suppressing.  */
+
+void
+gfc_pop_suppress_errors (void)
+{
+  gcc_assert (suppress_errors > 0);
+  --suppress_errors;
+}
+
+
+/* Per-file error initialization.  */
+
+void
+gfc_error_init_1 (void)
+{
+  terminal_width = gfc_terminal_width ();
+  errors = 0;
+  warnings = 0;
+  buffer_flag = 0;
+}
+
+
+/* Set the flag for buffering errors or not.  */
+
+void
+gfc_buffer_error (int flag)
+{
+  buffer_flag = flag;
+}
+
+
+/* Add a single character to the error buffer or output depending on
+   buffer_flag.  */
+
+static void
+error_char (char c)
+{
+  if (buffer_flag)
+    {
+      if (cur_error_buffer->index >= cur_error_buffer->allocated)
+	{
+	  cur_error_buffer->allocated = cur_error_buffer->allocated
+				      ? cur_error_buffer->allocated * 2 : 1000;
+	  cur_error_buffer->message = XRESIZEVEC (char, cur_error_buffer->message,
+						  cur_error_buffer->allocated);
+	}
+      cur_error_buffer->message[cur_error_buffer->index++] = c;
+    }
+  else
+    {
+      if (c != 0)
+	{
+	  /* We build up complete lines before handing things
+	     over to the library in order to speed up error printing.  */
+	  static char *line;
+	  static size_t allocated = 0, index = 0;
+
+	  if (index + 1 >= allocated)
+	    {
+	      allocated = allocated ? allocated * 2 : 1000;
+	      line = XRESIZEVEC (char, line, allocated);
+	    }
+	  line[index++] = c;
+	  if (c == '\n')
+	    {
+	      line[index] = '\0';
+	      fputs (line, stderr);
+	      index = 0;
+	    }
+	}
+    }
+}
+
+
+/* Copy a string to wherever it needs to go.  */
+
+static void
+error_string (const char *p)
+{
+  while (*p)
+    error_char (*p++);
+}
+
+
+/* Print a formatted integer to the error buffer or output.  */
+
+#define IBUF_LEN 60
+
+static void
+error_uinteger (unsigned long int i)
+{
+  char *p, int_buf[IBUF_LEN];
+
+  p = int_buf + IBUF_LEN - 1;
+  *p-- = '\0';
+
+  if (i == 0)
+    *p-- = '0';
+
+  while (i > 0)
+    {
+      *p-- = i % 10 + '0';
+      i = i / 10;
+    }
+
+  error_string (p + 1);
+}
+
+static void
+error_integer (long int i)
+{
+  unsigned long int u;
+
+  if (i < 0)
+    {
+      u = (unsigned long int) -i;
+      error_char ('-');
+    }
+  else
+    u = i;
+
+  error_uinteger (u);
+}
+
+
+static void
+print_wide_char_into_buffer (gfc_char_t c, char *buf)
+{
+  static const char xdigit[16] = { '0', '1', '2', '3', '4', '5', '6',
+    '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' };
+
+  if (gfc_wide_is_printable (c))
+    {
+      buf[1] = '\0';
+      buf[0] = (unsigned char) c;
+    }
+  else if (c < ((gfc_char_t) 1 << 8))
+    {
+      buf[4] = '\0';
+      buf[3] = xdigit[c & 0x0F];
+      c = c >> 4;
+      buf[2] = xdigit[c & 0x0F];
+
+      buf[1] = 'x';
+      buf[0] = '\\';
+    }
+  else if (c < ((gfc_char_t) 1 << 16))
+    {
+      buf[6] = '\0';
+      buf[5] = xdigit[c & 0x0F];
+      c = c >> 4;
+      buf[4] = xdigit[c & 0x0F];
+      c = c >> 4;
+      buf[3] = xdigit[c & 0x0F];
+      c = c >> 4;
+      buf[2] = xdigit[c & 0x0F];
+
+      buf[1] = 'u';
+      buf[0] = '\\';
+    }
+  else
+    {
+      buf[10] = '\0';
+      buf[9] = xdigit[c & 0x0F];
+      c = c >> 4;
+      buf[8] = xdigit[c & 0x0F];
+      c = c >> 4;
+      buf[7] = xdigit[c & 0x0F];
+      c = c >> 4;
+      buf[6] = xdigit[c & 0x0F];
+      c = c >> 4;
+      buf[5] = xdigit[c & 0x0F];
+      c = c >> 4;
+      buf[4] = xdigit[c & 0x0F];
+      c = c >> 4;
+      buf[3] = xdigit[c & 0x0F];
+      c = c >> 4;
+      buf[2] = xdigit[c & 0x0F];
+
+      buf[1] = 'U';
+      buf[0] = '\\';
+    }
+}
+
+static char wide_char_print_buffer[11];
+
+const char *
+gfc_print_wide_char (gfc_char_t c)
+{
+  print_wide_char_into_buffer (c, wide_char_print_buffer);
+  return wide_char_print_buffer;
+}
+
+
+/* Show the file, where it was included, and the source line, give a
+   locus.  Calls error_printf() recursively, but the recursion is at
+   most one level deep.  */
+
+static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
+
+static void
+show_locus (locus *loc, int c1, int c2)
+{
+  gfc_linebuf *lb;
+  gfc_file *f;
+  gfc_char_t c, *p;
+  int i, offset, cmax;
+
+  /* TODO: Either limit the total length and number of included files
+     displayed or add buffering of arbitrary number of characters in
+     error messages.  */
+
+  /* Write out the error header line, giving the source file and error
+     location (in GNU standard "[file]:[line].[column]:" format),
+     followed by an "included by" stack and a blank line.  This header
+     format is matched by a testsuite parser defined in
+     lib/gfortran-dg.exp.  */
+
+  lb = loc->lb;
+  f = lb->file;
+
+  error_string (f->filename);
+  error_char (':');
+    
+  error_integer (LOCATION_LINE (lb->location));
+
+  if ((c1 > 0) || (c2 > 0))
+    error_char ('.');
+
+  if (c1 > 0)
+    error_integer (c1);
+
+  if ((c1 > 0) && (c2 > 0))
+    error_char ('-');
+
+  if (c2 > 0)
+    error_integer (c2);
+
+  error_char (':');
+  error_char ('\n');
+
+  for (;;)
+    {
+      i = f->inclusion_line;
+
+      f = f->up;
+      if (f == NULL) break;
+
+      error_printf ("    Included at %s:%d:", f->filename, i);
+    }
+
+  error_char ('\n');
+
+  /* Calculate an appropriate horizontal offset of the source line in
+     order to get the error locus within the visible portion of the
+     line.  Note that if the margin of 5 here is changed, the
+     corresponding margin of 10 in show_loci should be changed.  */
+
+  offset = 0;
+
+  /* If the two loci would appear in the same column, we shift
+     '2' one column to the right, so as to print '12' rather than
+     just '1'.  We do this here so it will be accounted for in the
+     margin calculations.  */
+
+  if (c1 == c2)
+    c2 += 1;
+
+  cmax = (c1 < c2) ? c2 : c1;
+  if (cmax > terminal_width - 5)
+    offset = cmax - terminal_width + 5;
+
+  /* Show the line itself, taking care not to print more than what can
+     show up on the terminal.  Tabs are converted to spaces, and 
+     nonprintable characters are converted to a "\xNN" sequence.  */
+
+  /* TODO: Although setting i to the terminal width is clever, it fails
+     to work correctly when nonprintable characters exist.  A better 
+     solution should be found.  */
+
+  p = &(lb->line[offset]);
+  i = gfc_wide_strlen (p);
+  if (i > terminal_width)
+    i = terminal_width - 1;
+
+  for (; i > 0; i--)
+    {
+      static char buffer[11];
+
+      c = *p++;
+      if (c == '\t')
+	c = ' ';
+
+      print_wide_char_into_buffer (c, buffer);
+      error_string (buffer);
+    }
+
+  error_char ('\n');
+
+  /* Show the '1' and/or '2' corresponding to the column of the error
+     locus.  Note that a value of -1 for c1 or c2 will simply cause 
+     the relevant number not to be printed.  */
+
+  c1 -= offset;
+  c2 -= offset;
+
+  for (i = 0; i <= cmax; i++)
+    {
+      if (i == c1)
+	error_char ('1');
+      else if (i == c2)
+	error_char ('2');
+      else
+	error_char (' ');
+    }
+
+  error_char ('\n');
+
+}
+
+
+/* As part of printing an error, we show the source lines that caused
+   the problem.  We show at least one, and possibly two loci; the two
+   loci may or may not be on the same source line.  */
+
+static void
+show_loci (locus *l1, locus *l2)
+{
+  int m, c1, c2;
+
+  if (l1 == NULL || l1->lb == NULL)
+    {
+      error_printf ("<During initialization>\n");
+      return;
+    }
+
+  /* While calculating parameters for printing the loci, we consider possible
+     reasons for printing one per line.  If appropriate, print the loci
+     individually; otherwise we print them both on the same line.  */
+
+  c1 = l1->nextc - l1->lb->line;
+  if (l2 == NULL)
+    {
+      show_locus (l1, c1, -1);
+      return;
+    }
+
+  c2 = l2->nextc - l2->lb->line;
+
+  if (c1 < c2)
+    m = c2 - c1;
+  else
+    m = c1 - c2;
+
+  /* Note that the margin value of 10 here needs to be less than the 
+     margin of 5 used in the calculation of offset in show_locus.  */
+
+  if (l1->lb != l2->lb || m > terminal_width - 10)
+    {
+      show_locus (l1, c1, -1);
+      show_locus (l2, -1, c2);
+      return;
+    }
+
+  show_locus (l1, c1, c2);
+
+  return;
+}
+
+
+/* Workhorse for the error printing subroutines.  This subroutine is
+   inspired by g77's error handling and is similar to printf() with
+   the following %-codes:
+
+   %c Character, %d or %i Integer, %s String, %% Percent
+   %L  Takes locus argument
+   %C  Current locus (no argument)
+
+   If a locus pointer is given, the actual source line is printed out
+   and the column is indicated.  Since we want the error message at
+   the bottom of any source file information, we must scan the
+   argument list twice -- once to determine whether the loci are 
+   present and record this for printing, and once to print the error
+   message after and loci have been printed.  A maximum of two locus
+   arguments are permitted.
+   
+   This function is also called (recursively) by show_locus in the
+   case of included files; however, as show_locus does not resupply
+   any loci, the recursion is at most one level deep.  */
+
+#define MAX_ARGS 10
+
+static void ATTRIBUTE_GCC_GFC(2,0)
+error_print (const char *type, const char *format0, va_list argp)
+{
+  enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
+         TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING,
+	 NOTYPE };
+  struct
+  {
+    int type;
+    int pos;
+    union
+    {
+      int intval;
+      unsigned int uintval;
+      long int longintval;
+      unsigned long int ulongintval;
+      char charval;
+      const char * stringval;
+    } u;
+  } arg[MAX_ARGS], spec[MAX_ARGS];
+  /* spec is the array of specifiers, in the same order as they
+     appear in the format string.  arg is the array of arguments,
+     in the same order as they appear in the va_list.  */
+
+  char c;
+  int i, n, have_l1, pos, maxpos;
+  locus *l1, *l2, *loc;
+  const char *format;
+
+  loc = l1 = l2 = NULL;
+
+  have_l1 = 0;
+  pos = -1;
+  maxpos = -1;
+
+  n = 0;
+  format = format0;
+
+  for (i = 0; i < MAX_ARGS; i++)
+    {
+      arg[i].type = NOTYPE;
+      spec[i].pos = -1;
+    }
+
+  /* First parse the format string for position specifiers.  */
+  while (*format)
+    {
+      c = *format++;
+      if (c != '%')
+	continue;
+
+      if (*format == '%')
+	{
+	  format++;
+	  continue;
+	}
+
+      if (ISDIGIT (*format))
+	{
+	  /* This is a position specifier.  For example, the number
+	     12 in the format string "%12$d", which specifies the third
+	     argument of the va_list, formatted in %d format.
+	     For details, see "man 3 printf".  */
+	  pos = atoi(format) - 1;
+	  gcc_assert (pos >= 0);
+	  while (ISDIGIT(*format))
+	    format++;
+	  gcc_assert (*format++ == '$');
+	}
+      else
+	pos++;
+
+      c = *format++;
+
+      if (pos > maxpos)
+	maxpos = pos;
+
+      switch (c)
+	{
+	  case 'C':
+	    arg[pos].type = TYPE_CURRENTLOC;
+	    break;
+
+	  case 'L':
+	    arg[pos].type = TYPE_LOCUS;
+	    break;
+
+	  case 'd':
+	  case 'i':
+	    arg[pos].type = TYPE_INTEGER;
+	    break;
+
+	  case 'u':
+	    arg[pos].type = TYPE_UINTEGER;
+	    break;
+
+	  case 'l':
+	    c = *format++;
+	    if (c == 'u')
+	      arg[pos].type = TYPE_ULONGINT;
+	    else if (c == 'i' || c == 'd')
+	      arg[pos].type = TYPE_LONGINT;
+	    else
+	      gcc_unreachable ();
+	    break;
+
+	  case 'c':
+	    arg[pos].type = TYPE_CHAR;
+	    break;
+
+	  case 's':
+	    arg[pos].type = TYPE_STRING;
+	    break;
+
+	  default:
+	    gcc_unreachable ();
+	}
+
+      spec[n++].pos = pos;
+    }
+
+  /* Then convert the values for each %-style argument.  */
+  for (pos = 0; pos <= maxpos; pos++)
+    {
+      gcc_assert (arg[pos].type != NOTYPE);
+      switch (arg[pos].type)
+	{
+	  case TYPE_CURRENTLOC:
+	    loc = &gfc_current_locus;
+	    /* Fall through.  */
+
+	  case TYPE_LOCUS:
+	    if (arg[pos].type == TYPE_LOCUS)
+	      loc = va_arg (argp, locus *);
+
+	    if (have_l1)
+	      {
+		l2 = loc;
+		arg[pos].u.stringval = "(2)";
+	      }
+	    else
+	      {
+		l1 = loc;
+		have_l1 = 1;
+		arg[pos].u.stringval = "(1)";
+	      }
+	    break;
+
+	  case TYPE_INTEGER:
+	    arg[pos].u.intval = va_arg (argp, int);
+	    break;
+
+	  case TYPE_UINTEGER:
+	    arg[pos].u.uintval = va_arg (argp, unsigned int);
+	    break;
+
+	  case TYPE_LONGINT:
+	    arg[pos].u.longintval = va_arg (argp, long int);
+	    break;
+
+	  case TYPE_ULONGINT:
+	    arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
+	    break;
+
+	  case TYPE_CHAR:
+	    arg[pos].u.charval = (char) va_arg (argp, int);
+	    break;
+
+	  case TYPE_STRING:
+	    arg[pos].u.stringval = (const char *) va_arg (argp, char *);
+	    break;
+
+	  default:
+	    gcc_unreachable ();
+	}
+    }
+
+  for (n = 0; spec[n].pos >= 0; n++)
+    spec[n].u = arg[spec[n].pos].u;
+
+  /* Show the current loci if we have to.  */
+  if (have_l1)
+    show_loci (l1, l2);
+
+  if (*type)
+    {
+      error_string (type);
+      error_char (' ');
+    }
+
+  have_l1 = 0;
+  format = format0;
+  n = 0;
+
+  for (; *format; format++)
+    {
+      if (*format != '%')
+	{
+	  error_char (*format);
+	  continue;
+	}
+
+      format++;
+      if (ISDIGIT (*format))
+	{
+	  /* This is a position specifier.  See comment above.  */
+	  while (ISDIGIT (*format))
+	    format++;
+	    
+	  /* Skip over the dollar sign.  */
+	  format++;
+	}
+	
+      switch (*format)
+	{
+	case '%':
+	  error_char ('%');
+	  break;
+
+	case 'c':
+	  error_char (spec[n++].u.charval);
+	  break;
+
+	case 's':
+	case 'C':		/* Current locus */
+	case 'L':		/* Specified locus */
+	  error_string (spec[n++].u.stringval);
+	  break;
+
+	case 'd':
+	case 'i':
+	  error_integer (spec[n++].u.intval);
+	  break;
+
+	case 'u':
+	  error_uinteger (spec[n++].u.uintval);
+	  break;
+
+	case 'l':
+	  format++;
+	  if (*format == 'u')
+	    error_uinteger (spec[n++].u.ulongintval);
+	  else
+	    error_integer (spec[n++].u.longintval);
+	  break;
+
+	}
+    }
+
+  error_char ('\n');
+}
+
+
+/* Wrapper for error_print().  */
+
+static void
+error_printf (const char *gmsgid, ...)
+{
+  va_list argp;
+
+  va_start (argp, gmsgid);
+  error_print ("", _(gmsgid), argp);
+  va_end (argp);
+}
+
+
+/* Increment the number of errors, and check whether too many have 
+   been printed.  */
+
+static void
+gfc_increment_error_count (void)
+{
+  errors++;
+  if ((gfc_option.max_errors != 0) && (errors >= gfc_option.max_errors))
+    gfc_fatal_error ("Error count reached limit of %d.", gfc_option.max_errors);
+}
+
+
+/* Issue a warning.  */
+
+void
+gfc_warning (const char *gmsgid, ...)
+{
+  va_list argp;
+
+  if (inhibit_warnings)
+    return;
+
+  warning_buffer.flag = 1;
+  warning_buffer.index = 0;
+  cur_error_buffer = &warning_buffer;
+
+  va_start (argp, gmsgid);
+  error_print (_("Warning:"), _(gmsgid), argp);
+  va_end (argp);
+
+  error_char ('\0');
+
+  if (buffer_flag == 0)
+  {
+    warnings++;
+    if (warnings_are_errors)
+      gfc_increment_error_count();
+  }
+}
+
+
+/* Whether, for a feature included in a given standard set (GFC_STD_*),
+   we should issue an error or a warning, or be quiet.  */
+
+notification
+gfc_notification_std (int std)
+{
+  bool warning;
+
+  warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
+  if ((gfc_option.allow_std & std) != 0 && !warning)
+    return SILENT;
+
+  return warning ? WARNING : ERROR;
+}
+
+
+/* Possibly issue a warning/error about use of a nonstandard (or deleted)
+   feature.  An error/warning will be issued if the currently selected
+   standard does not contain the requested bits.  Return FAILURE if
+   an error is generated.  */
+
+gfc_try
+gfc_notify_std (int std, const char *gmsgid, ...)
+{
+  va_list argp;
+  bool warning;
+
+  warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
+  if ((gfc_option.allow_std & std) != 0 && !warning)
+    return SUCCESS;
+
+  if (suppress_errors)
+    return warning ? SUCCESS : FAILURE;
+
+  cur_error_buffer = warning ? &warning_buffer : &error_buffer;
+  cur_error_buffer->flag = 1;
+  cur_error_buffer->index = 0;
+
+  va_start (argp, gmsgid);
+  if (warning)
+    error_print (_("Warning:"), _(gmsgid), argp);
+  else
+    error_print (_("Error:"), _(gmsgid), argp);
+  va_end (argp);
+
+  error_char ('\0');
+
+  if (buffer_flag == 0)
+    {
+      if (warning && !warnings_are_errors)
+	warnings++;
+      else
+	gfc_increment_error_count();
+    }
+
+  return (warning && !warnings_are_errors) ? SUCCESS : FAILURE;
+}
+
+
+/* Immediate warning (i.e. do not buffer the warning).  */
+
+void
+gfc_warning_now (const char *gmsgid, ...)
+{
+  va_list argp;
+  int i;
+
+  if (inhibit_warnings)
+    return;
+
+  i = buffer_flag;
+  buffer_flag = 0;
+  warnings++;
+
+  va_start (argp, gmsgid);
+  error_print (_("Warning:"), _(gmsgid), argp);
+  va_end (argp);
+
+  error_char ('\0');
+
+  if (warnings_are_errors)
+    gfc_increment_error_count();
+
+  buffer_flag = i;
+}
+
+
+/* Clear the warning flag.  */
+
+void
+gfc_clear_warning (void)
+{
+  warning_buffer.flag = 0;
+}
+
+
+/* Check to see if any warnings have been saved.
+   If so, print the warning.  */
+
+void
+gfc_warning_check (void)
+{
+  if (warning_buffer.flag)
+    {
+      warnings++;
+      if (warning_buffer.message != NULL)
+	fputs (warning_buffer.message, stderr);
+      warning_buffer.flag = 0;
+    }
+}
+
+
+/* Issue an error.  */
+
+void
+gfc_error (const char *gmsgid, ...)
+{
+  va_list argp;
+
+  if (warnings_not_errors)
+    goto warning;
+
+  if (suppress_errors)
+    return;
+
+  error_buffer.flag = 1;
+  error_buffer.index = 0;
+  cur_error_buffer = &error_buffer;
+
+  va_start (argp, gmsgid);
+  error_print (_("Error:"), _(gmsgid), argp);
+  va_end (argp);
+
+  error_char ('\0');
+
+  if (buffer_flag == 0)
+    gfc_increment_error_count();
+
+  return;
+
+warning:
+
+  if (inhibit_warnings)
+    return;
+
+  warning_buffer.flag = 1;
+  warning_buffer.index = 0;
+  cur_error_buffer = &warning_buffer;
+
+  va_start (argp, gmsgid);
+  error_print (_("Warning:"), _(gmsgid), argp);
+  va_end (argp);
+
+  error_char ('\0');
+
+  if (buffer_flag == 0)
+  {
+    warnings++;
+    if (warnings_are_errors)
+      gfc_increment_error_count();
+  }
+}
+
+
+/* Immediate error.  */
+
+void
+gfc_error_now (const char *gmsgid, ...)
+{
+  va_list argp;
+  int i;
+
+  error_buffer.flag = 1;
+  error_buffer.index = 0;
+  cur_error_buffer = &error_buffer;
+
+  i = buffer_flag;
+  buffer_flag = 0;
+
+  va_start (argp, gmsgid);
+  error_print (_("Error:"), _(gmsgid), argp);
+  va_end (argp);
+
+  error_char ('\0');
+
+  gfc_increment_error_count();
+
+  buffer_flag = i;
+
+  if (flag_fatal_errors)
+    exit (FATAL_EXIT_CODE);
+}
+
+
+/* Fatal error, never returns.  */
+
+void
+gfc_fatal_error (const char *gmsgid, ...)
+{
+  va_list argp;
+
+  buffer_flag = 0;
+
+  va_start (argp, gmsgid);
+  error_print (_("Fatal Error:"), _(gmsgid), argp);
+  va_end (argp);
+
+  exit (FATAL_EXIT_CODE);
+}
+
+
+/* This shouldn't happen... but sometimes does.  */
+
+void
+gfc_internal_error (const char *format, ...)
+{
+  va_list argp;
+
+  buffer_flag = 0;
+
+  va_start (argp, format);
+
+  show_loci (&gfc_current_locus, NULL);
+  error_printf ("Internal Error at (1):");
+
+  error_print ("", format, argp);
+  va_end (argp);
+
+  exit (ICE_EXIT_CODE);
+}
+
+
+/* Clear the error flag when we start to compile a source line.  */
+
+void
+gfc_clear_error (void)
+{
+  error_buffer.flag = 0;
+  warnings_not_errors = 0;
+}
+
+
+/* Tests the state of error_flag.  */
+
+int
+gfc_error_flag_test (void)
+{
+  return error_buffer.flag;
+}
+
+
+/* Check to see if any errors have been saved.
+   If so, print the error.  Returns the state of error_flag.  */
+
+int
+gfc_error_check (void)
+{
+  int rc;
+
+  rc = error_buffer.flag;
+
+  if (error_buffer.flag)
+    {
+      if (error_buffer.message != NULL)
+	fputs (error_buffer.message, stderr);
+      error_buffer.flag = 0;
+
+      gfc_increment_error_count();
+
+      if (flag_fatal_errors)
+	exit (FATAL_EXIT_CODE);
+    }
+
+  return rc;
+}
+
+
+/* Save the existing error state.  */
+
+void
+gfc_push_error (gfc_error_buf *err)
+{
+  err->flag = error_buffer.flag;
+  if (error_buffer.flag)
+    err->message = xstrdup (error_buffer.message);
+
+  error_buffer.flag = 0;
+}
+
+
+/* Restore a previous pushed error state.  */
+
+void
+gfc_pop_error (gfc_error_buf *err)
+{
+  error_buffer.flag = err->flag;
+  if (error_buffer.flag)
+    {
+      size_t len = strlen (err->message) + 1;
+      gcc_assert (len <= error_buffer.allocated);
+      memcpy (error_buffer.message, err->message, len);
+      gfc_free (err->message);
+    }
+}
+
+
+/* Free a pushed error state, but keep the current error state.  */
+
+void
+gfc_free_error (gfc_error_buf *err)
+{
+  if (err->flag)
+    gfc_free (err->message);
+}
+
+
+/* Report the number of warnings and errors that occurred to the caller.  */
+
+void
+gfc_get_errors (int *w, int *e)
+{
+  if (w != NULL)
+    *w = warnings;
+  if (e != NULL)
+    *e = errors;
+}
+
+
+/* Switch errors into warnings.  */
+
+void
+gfc_errors_to_warnings (int f)
+{
+  warnings_not_errors = (f == 1) ? 1 : 0;
+}
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
new file mode 100644
index 000000000..5fa937e85
--- /dev/null
+++ b/gcc/fortran/expr.c
@@ -0,0 +1,4621 @@
+/* Routines for manipulation of expression nodes.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2009, 2010, 2011
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+#include "arith.h"
+#include "match.h"
+#include "target-memory.h" /* for gfc_convert_boz */
+#include "constructor.h"
+
+
+/* The following set of functions provide access to gfc_expr* of
+   various types - actual all but EXPR_FUNCTION and EXPR_VARIABLE.
+
+   There are two functions available elsewhere that provide
+   slightly different flavours of variables.  Namely:
+     expr.c (gfc_get_variable_expr)
+     symbol.c (gfc_lval_expr_from_sym)
+   TODO: Merge these functions, if possible.  */
+
+/* Get a new expression node.  */
+
+gfc_expr *
+gfc_get_expr (void)
+{
+  gfc_expr *e;
+
+  e = XCNEW (gfc_expr);
+  gfc_clear_ts (&e->ts);
+  e->shape = NULL;
+  e->ref = NULL;
+  e->symtree = NULL;
+  return e;
+}
+
+
+/* Get a new expression node that is an array constructor
+   of given type and kind.  */
+
+gfc_expr *
+gfc_get_array_expr (bt type, int kind, locus *where)
+{
+  gfc_expr *e;
+
+  e = gfc_get_expr ();
+  e->expr_type = EXPR_ARRAY;
+  e->value.constructor = NULL;
+  e->rank = 1;
+  e->shape = NULL;
+
+  e->ts.type = type;
+  e->ts.kind = kind;
+  if (where)
+    e->where = *where;
+
+  return e;
+}
+
+
+/* Get a new expression node that is the NULL expression.  */
+
+gfc_expr *
+gfc_get_null_expr (locus *where)
+{
+  gfc_expr *e;
+
+  e = gfc_get_expr ();
+  e->expr_type = EXPR_NULL;
+  e->ts.type = BT_UNKNOWN;
+
+  if (where)
+    e->where = *where;
+
+  return e;
+}
+
+
+/* Get a new expression node that is an operator expression node.  */
+
+gfc_expr *
+gfc_get_operator_expr (locus *where, gfc_intrinsic_op op,
+                      gfc_expr *op1, gfc_expr *op2)
+{
+  gfc_expr *e;
+
+  e = gfc_get_expr ();
+  e->expr_type = EXPR_OP;
+  e->value.op.op = op;
+  e->value.op.op1 = op1;
+  e->value.op.op2 = op2;
+
+  if (where)
+    e->where = *where;
+
+  return e;
+}
+
+
+/* Get a new expression node that is an structure constructor
+   of given type and kind.  */
+
+gfc_expr *
+gfc_get_structure_constructor_expr (bt type, int kind, locus *where)
+{
+  gfc_expr *e;
+
+  e = gfc_get_expr ();
+  e->expr_type = EXPR_STRUCTURE;
+  e->value.constructor = NULL;
+
+  e->ts.type = type;
+  e->ts.kind = kind;
+  if (where)
+    e->where = *where;
+
+  return e;
+}
+
+
+/* Get a new expression node that is an constant of given type and kind.  */
+
+gfc_expr *
+gfc_get_constant_expr (bt type, int kind, locus *where)
+{
+  gfc_expr *e;
+
+  if (!where)
+    gfc_internal_error ("gfc_get_constant_expr(): locus 'where' cannot be NULL");
+
+  e = gfc_get_expr ();
+
+  e->expr_type = EXPR_CONSTANT;
+  e->ts.type = type;
+  e->ts.kind = kind;
+  e->where = *where;
+
+  switch (type)
+    {
+    case BT_INTEGER:
+      mpz_init (e->value.integer);
+      break;
+
+    case BT_REAL:
+      gfc_set_model_kind (kind);
+      mpfr_init (e->value.real);
+      break;
+
+    case BT_COMPLEX:
+      gfc_set_model_kind (kind);
+      mpc_init2 (e->value.complex, mpfr_get_default_prec());
+      break;
+
+    default:
+      break;
+    }
+
+  return e;
+}
+
+
+/* Get a new expression node that is an string constant.
+   If no string is passed, a string of len is allocated,
+   blanked and null-terminated.  */
+
+gfc_expr *
+gfc_get_character_expr (int kind, locus *where, const char *src, int len)
+{
+  gfc_expr *e;
+  gfc_char_t *dest;
+
+  if (!src)
+    {
+      dest = gfc_get_wide_string (len + 1);
+      gfc_wide_memset (dest, ' ', len);
+      dest[len] = '\0';
+    }
+  else
+    dest = gfc_char_to_widechar (src);
+
+  e = gfc_get_constant_expr (BT_CHARACTER, kind,
+                            where ? where : &gfc_current_locus);
+  e->value.character.string = dest;
+  e->value.character.length = len;
+
+  return e;
+}
+
+
+/* Get a new expression node that is an integer constant.  */
+
+gfc_expr *
+gfc_get_int_expr (int kind, locus *where, int value)
+{
+  gfc_expr *p;
+  p = gfc_get_constant_expr (BT_INTEGER, kind,
+			     where ? where : &gfc_current_locus);
+
+  mpz_set_si (p->value.integer, value);
+
+  return p;
+}
+
+
+/* Get a new expression node that is a logical constant.  */
+
+gfc_expr *
+gfc_get_logical_expr (int kind, locus *where, bool value)
+{
+  gfc_expr *p;
+  p = gfc_get_constant_expr (BT_LOGICAL, kind,
+			     where ? where : &gfc_current_locus);
+
+  p->value.logical = value;
+
+  return p;
+}
+
+
+gfc_expr *
+gfc_get_iokind_expr (locus *where, io_kind k)
+{
+  gfc_expr *e;
+
+  /* Set the types to something compatible with iokind. This is needed to
+     get through gfc_free_expr later since iokind really has no Basic Type,
+     BT, of its own.  */
+
+  e = gfc_get_expr ();
+  e->expr_type = EXPR_CONSTANT;
+  e->ts.type = BT_LOGICAL;
+  e->value.iokind = k;
+  e->where = *where;
+
+  return e;
+}
+
+
+/* Given an expression pointer, return a copy of the expression.  This
+   subroutine is recursive.  */
+
+gfc_expr *
+gfc_copy_expr (gfc_expr *p)
+{
+  gfc_expr *q;
+  gfc_char_t *s;
+  char *c;
+
+  if (p == NULL)
+    return NULL;
+
+  q = gfc_get_expr ();
+  *q = *p;
+
+  switch (q->expr_type)
+    {
+    case EXPR_SUBSTRING:
+      s = gfc_get_wide_string (p->value.character.length + 1);
+      q->value.character.string = s;
+      memcpy (s, p->value.character.string,
+	      (p->value.character.length + 1) * sizeof (gfc_char_t));
+      break;
+
+    case EXPR_CONSTANT:
+      /* Copy target representation, if it exists.  */
+      if (p->representation.string)
+	{
+	  c = XCNEWVEC (char, p->representation.length + 1);
+	  q->representation.string = c;
+	  memcpy (c, p->representation.string, (p->representation.length + 1));
+	}
+
+      /* Copy the values of any pointer components of p->value.  */
+      switch (q->ts.type)
+	{
+	case BT_INTEGER:
+	  mpz_init_set (q->value.integer, p->value.integer);
+	  break;
+
+	case BT_REAL:
+	  gfc_set_model_kind (q->ts.kind);
+	  mpfr_init (q->value.real);
+	  mpfr_set (q->value.real, p->value.real, GFC_RND_MODE);
+	  break;
+
+	case BT_COMPLEX:
+	  gfc_set_model_kind (q->ts.kind);
+	  mpc_init2 (q->value.complex, mpfr_get_default_prec());
+	  mpc_set (q->value.complex, p->value.complex, GFC_MPC_RND_MODE);
+	  break;
+
+	case BT_CHARACTER:
+	  if (p->representation.string)
+	    q->value.character.string
+	      = gfc_char_to_widechar (q->representation.string);
+	  else
+	    {
+	      s = gfc_get_wide_string (p->value.character.length + 1);
+	      q->value.character.string = s;
+
+	      /* This is the case for the C_NULL_CHAR named constant.  */
+	      if (p->value.character.length == 0
+		  && (p->ts.is_c_interop || p->ts.is_iso_c))
+		{
+		  *s = '\0';
+		  /* Need to set the length to 1 to make sure the NUL
+		     terminator is copied.  */
+		  q->value.character.length = 1;
+		}
+	      else
+		memcpy (s, p->value.character.string,
+			(p->value.character.length + 1) * sizeof (gfc_char_t));
+	    }
+	  break;
+
+	case BT_HOLLERITH:
+	case BT_LOGICAL:
+	case BT_DERIVED:
+	case BT_CLASS:
+	  break;		/* Already done.  */
+
+	case BT_PROCEDURE:
+        case BT_VOID:
+           /* Should never be reached.  */
+	case BT_UNKNOWN:
+	  gfc_internal_error ("gfc_copy_expr(): Bad expr node");
+	  /* Not reached.  */
+	}
+
+      break;
+
+    case EXPR_OP:
+      switch (q->value.op.op)
+	{
+	case INTRINSIC_NOT:
+	case INTRINSIC_PARENTHESES:
+	case INTRINSIC_UPLUS:
+	case INTRINSIC_UMINUS:
+	  q->value.op.op1 = gfc_copy_expr (p->value.op.op1);
+	  break;
+
+	default:		/* Binary operators.  */
+	  q->value.op.op1 = gfc_copy_expr (p->value.op.op1);
+	  q->value.op.op2 = gfc_copy_expr (p->value.op.op2);
+	  break;
+	}
+
+      break;
+
+    case EXPR_FUNCTION:
+      q->value.function.actual =
+	gfc_copy_actual_arglist (p->value.function.actual);
+      break;
+
+    case EXPR_COMPCALL:
+    case EXPR_PPC:
+      q->value.compcall.actual =
+	gfc_copy_actual_arglist (p->value.compcall.actual);
+      q->value.compcall.tbp = p->value.compcall.tbp;
+      break;
+
+    case EXPR_STRUCTURE:
+    case EXPR_ARRAY:
+      q->value.constructor = gfc_constructor_copy (p->value.constructor);
+      break;
+
+    case EXPR_VARIABLE:
+    case EXPR_NULL:
+      break;
+    }
+
+  q->shape = gfc_copy_shape (p->shape, p->rank);
+
+  q->ref = gfc_copy_ref (p->ref);
+
+  return q;
+}
+
+
+void
+gfc_clear_shape (mpz_t *shape, int rank)
+{
+  int i;
+
+  for (i = 0; i < rank; i++)
+    mpz_clear (shape[i]);
+}
+
+
+void
+gfc_free_shape (mpz_t **shape, int rank)
+{
+  if (*shape == NULL)
+    return;
+
+  gfc_clear_shape (*shape, rank);
+  gfc_free (*shape);
+  *shape = NULL;
+}
+
+
+/* Workhorse function for gfc_free_expr() that frees everything
+   beneath an expression node, but not the node itself.  This is
+   useful when we want to simplify a node and replace it with
+   something else or the expression node belongs to another structure.  */
+
+static void
+free_expr0 (gfc_expr *e)
+{
+  switch (e->expr_type)
+    {
+    case EXPR_CONSTANT:
+      /* Free any parts of the value that need freeing.  */
+      switch (e->ts.type)
+	{
+	case BT_INTEGER:
+	  mpz_clear (e->value.integer);
+	  break;
+
+	case BT_REAL:
+	  mpfr_clear (e->value.real);
+	  break;
+
+	case BT_CHARACTER:
+	  gfc_free (e->value.character.string);
+	  break;
+
+	case BT_COMPLEX:
+	  mpc_clear (e->value.complex);
+	  break;
+
+	default:
+	  break;
+	}
+
+      /* Free the representation.  */
+      if (e->representation.string)
+	gfc_free (e->representation.string);
+
+      break;
+
+    case EXPR_OP:
+      if (e->value.op.op1 != NULL)
+	gfc_free_expr (e->value.op.op1);
+      if (e->value.op.op2 != NULL)
+	gfc_free_expr (e->value.op.op2);
+      break;
+
+    case EXPR_FUNCTION:
+      gfc_free_actual_arglist (e->value.function.actual);
+      break;
+
+    case EXPR_COMPCALL:
+    case EXPR_PPC:
+      gfc_free_actual_arglist (e->value.compcall.actual);
+      break;
+
+    case EXPR_VARIABLE:
+      break;
+
+    case EXPR_ARRAY:
+    case EXPR_STRUCTURE:
+      gfc_constructor_free (e->value.constructor);
+      break;
+
+    case EXPR_SUBSTRING:
+      gfc_free (e->value.character.string);
+      break;
+
+    case EXPR_NULL:
+      break;
+
+    default:
+      gfc_internal_error ("free_expr0(): Bad expr type");
+    }
+
+  /* Free a shape array.  */
+  gfc_free_shape (&e->shape, e->rank);
+
+  gfc_free_ref_list (e->ref);
+
+  memset (e, '\0', sizeof (gfc_expr));
+}
+
+
+/* Free an expression node and everything beneath it.  */
+
+void
+gfc_free_expr (gfc_expr *e)
+{
+  if (e == NULL)
+    return;
+  free_expr0 (e);
+  gfc_free (e);
+}
+
+
+/* Free an argument list and everything below it.  */
+
+void
+gfc_free_actual_arglist (gfc_actual_arglist *a1)
+{
+  gfc_actual_arglist *a2;
+
+  while (a1)
+    {
+      a2 = a1->next;
+      gfc_free_expr (a1->expr);
+      gfc_free (a1);
+      a1 = a2;
+    }
+}
+
+
+/* Copy an arglist structure and all of the arguments.  */
+
+gfc_actual_arglist *
+gfc_copy_actual_arglist (gfc_actual_arglist *p)
+{
+  gfc_actual_arglist *head, *tail, *new_arg;
+
+  head = tail = NULL;
+
+  for (; p; p = p->next)
+    {
+      new_arg = gfc_get_actual_arglist ();
+      *new_arg = *p;
+
+      new_arg->expr = gfc_copy_expr (p->expr);
+      new_arg->next = NULL;
+
+      if (head == NULL)
+	head = new_arg;
+      else
+	tail->next = new_arg;
+
+      tail = new_arg;
+    }
+
+  return head;
+}
+
+
+/* Free a list of reference structures.  */
+
+void
+gfc_free_ref_list (gfc_ref *p)
+{
+  gfc_ref *q;
+  int i;
+
+  for (; p; p = q)
+    {
+      q = p->next;
+
+      switch (p->type)
+	{
+	case REF_ARRAY:
+	  for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
+	    {
+	      gfc_free_expr (p->u.ar.start[i]);
+	      gfc_free_expr (p->u.ar.end[i]);
+	      gfc_free_expr (p->u.ar.stride[i]);
+	    }
+
+	  break;
+
+	case REF_SUBSTRING:
+	  gfc_free_expr (p->u.ss.start);
+	  gfc_free_expr (p->u.ss.end);
+	  break;
+
+	case REF_COMPONENT:
+	  break;
+	}
+
+      gfc_free (p);
+    }
+}
+
+
+/* Graft the *src expression onto the *dest subexpression.  */
+
+void
+gfc_replace_expr (gfc_expr *dest, gfc_expr *src)
+{
+  free_expr0 (dest);
+  *dest = *src;
+  gfc_free (src);
+}
+
+
+/* Try to extract an integer constant from the passed expression node.
+   Returns an error message or NULL if the result is set.  It is
+   tempting to generate an error and return SUCCESS or FAILURE, but
+   failure is OK for some callers.  */
+
+const char *
+gfc_extract_int (gfc_expr *expr, int *result)
+{
+  if (expr->expr_type != EXPR_CONSTANT)
+    return _("Constant expression required at %C");
+
+  if (expr->ts.type != BT_INTEGER)
+    return _("Integer expression required at %C");
+
+  if ((mpz_cmp_si (expr->value.integer, INT_MAX) > 0)
+      || (mpz_cmp_si (expr->value.integer, INT_MIN) < 0))
+    {
+      return _("Integer value too large in expression at %C");
+    }
+
+  *result = (int) mpz_get_si (expr->value.integer);
+
+  return NULL;
+}
+
+
+/* Recursively copy a list of reference structures.  */
+
+gfc_ref *
+gfc_copy_ref (gfc_ref *src)
+{
+  gfc_array_ref *ar;
+  gfc_ref *dest;
+
+  if (src == NULL)
+    return NULL;
+
+  dest = gfc_get_ref ();
+  dest->type = src->type;
+
+  switch (src->type)
+    {
+    case REF_ARRAY:
+      ar = gfc_copy_array_ref (&src->u.ar);
+      dest->u.ar = *ar;
+      gfc_free (ar);
+      break;
+
+    case REF_COMPONENT:
+      dest->u.c = src->u.c;
+      break;
+
+    case REF_SUBSTRING:
+      dest->u.ss = src->u.ss;
+      dest->u.ss.start = gfc_copy_expr (src->u.ss.start);
+      dest->u.ss.end = gfc_copy_expr (src->u.ss.end);
+      break;
+    }
+
+  dest->next = gfc_copy_ref (src->next);
+
+  return dest;
+}
+
+
+/* Detect whether an expression has any vector index array references.  */
+
+int
+gfc_has_vector_index (gfc_expr *e)
+{
+  gfc_ref *ref;
+  int i;
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY)
+      for (i = 0; i < ref->u.ar.dimen; i++)
+	if (ref->u.ar.dimen_type[i] == DIMEN_VECTOR)
+	  return 1;
+  return 0;
+}
+
+
+/* Copy a shape array.  */
+
+mpz_t *
+gfc_copy_shape (mpz_t *shape, int rank)
+{
+  mpz_t *new_shape;
+  int n;
+
+  if (shape == NULL)
+    return NULL;
+
+  new_shape = gfc_get_shape (rank);
+
+  for (n = 0; n < rank; n++)
+    mpz_init_set (new_shape[n], shape[n]);
+
+  return new_shape;
+}
+
+
+/* Copy a shape array excluding dimension N, where N is an integer
+   constant expression.  Dimensions are numbered in fortran style --
+   starting with ONE.
+
+   So, if the original shape array contains R elements
+      { s1 ... sN-1  sN  sN+1 ... sR-1 sR}
+   the result contains R-1 elements:
+      { s1 ... sN-1  sN+1    ...  sR-1}
+
+   If anything goes wrong -- N is not a constant, its value is out
+   of range -- or anything else, just returns NULL.  */
+
+mpz_t *
+gfc_copy_shape_excluding (mpz_t *shape, int rank, gfc_expr *dim)
+{
+  mpz_t *new_shape, *s;
+  int i, n;
+
+  if (shape == NULL 
+      || rank <= 1
+      || dim == NULL
+      || dim->expr_type != EXPR_CONSTANT 
+      || dim->ts.type != BT_INTEGER)
+    return NULL;
+
+  n = mpz_get_si (dim->value.integer);
+  n--; /* Convert to zero based index.  */
+  if (n < 0 || n >= rank)
+    return NULL;
+
+  s = new_shape = gfc_get_shape (rank - 1);
+
+  for (i = 0; i < rank; i++)
+    {
+      if (i == n)
+	continue;
+      mpz_init_set (*s, shape[i]);
+      s++;
+    }
+
+  return new_shape;
+}
+
+
+/* Return the maximum kind of two expressions.  In general, higher
+   kind numbers mean more precision for numeric types.  */
+
+int
+gfc_kind_max (gfc_expr *e1, gfc_expr *e2)
+{
+  return (e1->ts.kind > e2->ts.kind) ? e1->ts.kind : e2->ts.kind;
+}
+
+
+/* Returns nonzero if the type is numeric, zero otherwise.  */
+
+static int
+numeric_type (bt type)
+{
+  return type == BT_COMPLEX || type == BT_REAL || type == BT_INTEGER;
+}
+
+
+/* Returns nonzero if the typespec is a numeric type, zero otherwise.  */
+
+int
+gfc_numeric_ts (gfc_typespec *ts)
+{
+  return numeric_type (ts->type);
+}
+
+
+/* Return an expression node with an optional argument list attached.
+   A variable number of gfc_expr pointers are strung together in an
+   argument list with a NULL pointer terminating the list.  */
+
+gfc_expr *
+gfc_build_conversion (gfc_expr *e)
+{
+  gfc_expr *p;
+
+  p = gfc_get_expr ();
+  p->expr_type = EXPR_FUNCTION;
+  p->symtree = NULL;
+  p->value.function.actual = NULL;
+
+  p->value.function.actual = gfc_get_actual_arglist ();
+  p->value.function.actual->expr = e;
+
+  return p;
+}
+
+
+/* Given an expression node with some sort of numeric binary
+   expression, insert type conversions required to make the operands
+   have the same type. Conversion warnings are disabled if wconversion
+   is set to 0.
+
+   The exception is that the operands of an exponential don't have to
+   have the same type.  If possible, the base is promoted to the type
+   of the exponent.  For example, 1**2.3 becomes 1.0**2.3, but
+   1.0**2 stays as it is.  */
+
+void
+gfc_type_convert_binary (gfc_expr *e, int wconversion)
+{
+  gfc_expr *op1, *op2;
+
+  op1 = e->value.op.op1;
+  op2 = e->value.op.op2;
+
+  if (op1->ts.type == BT_UNKNOWN || op2->ts.type == BT_UNKNOWN)
+    {
+      gfc_clear_ts (&e->ts);
+      return;
+    }
+
+  /* Kind conversions of same type.  */
+  if (op1->ts.type == op2->ts.type)
+    {
+      if (op1->ts.kind == op2->ts.kind)
+	{
+	  /* No type conversions.  */
+	  e->ts = op1->ts;
+	  goto done;
+	}
+
+      if (op1->ts.kind > op2->ts.kind)
+	gfc_convert_type_warn (op2, &op1->ts, 2, wconversion);
+      else
+	gfc_convert_type_warn (op1, &op2->ts, 2, wconversion);
+
+      e->ts = op1->ts;
+      goto done;
+    }
+
+  /* Integer combined with real or complex.  */
+  if (op2->ts.type == BT_INTEGER)
+    {
+      e->ts = op1->ts;
+
+      /* Special case for ** operator.  */
+      if (e->value.op.op == INTRINSIC_POWER)
+	goto done;
+
+      gfc_convert_type_warn (e->value.op.op2, &e->ts, 2, wconversion);
+      goto done;
+    }
+
+  if (op1->ts.type == BT_INTEGER)
+    {
+      e->ts = op2->ts;
+      gfc_convert_type_warn (e->value.op.op1, &e->ts, 2, wconversion);
+      goto done;
+    }
+
+  /* Real combined with complex.  */
+  e->ts.type = BT_COMPLEX;
+  if (op1->ts.kind > op2->ts.kind)
+    e->ts.kind = op1->ts.kind;
+  else
+    e->ts.kind = op2->ts.kind;
+  if (op1->ts.type != BT_COMPLEX || op1->ts.kind != e->ts.kind)
+    gfc_convert_type_warn (e->value.op.op1, &e->ts, 2, wconversion);
+  if (op2->ts.type != BT_COMPLEX || op2->ts.kind != e->ts.kind)
+    gfc_convert_type_warn (e->value.op.op2, &e->ts, 2, wconversion);
+
+done:
+  return;
+}
+
+
+/* Function to determine if an expression is constant or not.  This
+   function expects that the expression has already been simplified.  */
+
+int
+gfc_is_constant_expr (gfc_expr *e)
+{
+  gfc_constructor *c;
+  gfc_actual_arglist *arg;
+  gfc_symbol *sym;
+
+  if (e == NULL)
+    return 1;
+
+  switch (e->expr_type)
+    {
+    case EXPR_OP:
+      return (gfc_is_constant_expr (e->value.op.op1)
+	      && (e->value.op.op2 == NULL
+		  || gfc_is_constant_expr (e->value.op.op2)));
+
+    case EXPR_VARIABLE:
+      return 0;
+
+    case EXPR_FUNCTION:
+    case EXPR_PPC:
+    case EXPR_COMPCALL:
+      gcc_assert (e->symtree || e->value.function.esym
+		  || e->value.function.isym);
+
+      /* Call to intrinsic with at least one argument.  */
+      if (e->value.function.isym && e->value.function.actual)
+	{
+	  for (arg = e->value.function.actual; arg; arg = arg->next)
+	    if (!gfc_is_constant_expr (arg->expr))
+	      return 0;
+	}
+
+      /* Specification functions are constant.  */
+      /* F95, 7.1.6.2; F2003, 7.1.7  */
+      sym = NULL;
+      if (e->symtree)
+	sym = e->symtree->n.sym;
+      if (e->value.function.esym)
+	sym = e->value.function.esym;
+
+      if (sym
+	  && sym->attr.function
+	  && sym->attr.pure
+	  && !sym->attr.intrinsic
+	  && !sym->attr.recursive
+	  && sym->attr.proc != PROC_INTERNAL
+	  && sym->attr.proc != PROC_ST_FUNCTION
+	  && sym->attr.proc != PROC_UNKNOWN
+	  && sym->formal == NULL)
+	return 1;
+
+      if (e->value.function.isym
+	  && (e->value.function.isym->elemental
+	      || e->value.function.isym->pure
+	      || e->value.function.isym->inquiry
+	      || e->value.function.isym->transformational))
+	return 1;
+
+      return 0;
+
+    case EXPR_CONSTANT:
+    case EXPR_NULL:
+      return 1;
+
+    case EXPR_SUBSTRING:
+      return e->ref == NULL || (gfc_is_constant_expr (e->ref->u.ss.start)
+				&& gfc_is_constant_expr (e->ref->u.ss.end));
+
+    case EXPR_ARRAY:
+    case EXPR_STRUCTURE:
+      c = gfc_constructor_first (e->value.constructor);
+      if ((e->expr_type == EXPR_ARRAY) && c && c->iterator)
+        return gfc_constant_ac (e);
+
+      for (; c; c = gfc_constructor_next (c))
+	if (!gfc_is_constant_expr (c->expr))
+	  return 0;
+
+      return 1;
+
+
+    default:
+      gfc_internal_error ("gfc_is_constant_expr(): Unknown expression type");
+      return 0;
+    }
+}
+
+
+/* Is true if an array reference is followed by a component or substring
+   reference.  */
+bool
+is_subref_array (gfc_expr * e)
+{
+  gfc_ref * ref;
+  bool seen_array;
+
+  if (e->expr_type != EXPR_VARIABLE)
+    return false;
+
+  if (e->symtree->n.sym->attr.subref_array_pointer)
+    return true;
+
+  seen_array = false;
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_ARRAY
+	    && ref->u.ar.type != AR_ELEMENT)
+	seen_array = true;
+
+      if (seen_array
+	    && ref->type != REF_ARRAY)
+	return seen_array;
+    }
+  return false;
+}
+
+
+/* Try to collapse intrinsic expressions.  */
+
+static gfc_try
+simplify_intrinsic_op (gfc_expr *p, int type)
+{
+  gfc_intrinsic_op op;
+  gfc_expr *op1, *op2, *result;
+
+  if (p->value.op.op == INTRINSIC_USER)
+    return SUCCESS;
+
+  op1 = p->value.op.op1;
+  op2 = p->value.op.op2;
+  op  = p->value.op.op;
+
+  if (gfc_simplify_expr (op1, type) == FAILURE)
+    return FAILURE;
+  if (gfc_simplify_expr (op2, type) == FAILURE)
+    return FAILURE;
+
+  if (!gfc_is_constant_expr (op1)
+      || (op2 != NULL && !gfc_is_constant_expr (op2)))
+    return SUCCESS;
+
+  /* Rip p apart.  */
+  p->value.op.op1 = NULL;
+  p->value.op.op2 = NULL;
+
+  switch (op)
+    {
+    case INTRINSIC_PARENTHESES:
+      result = gfc_parentheses (op1);
+      break;
+
+    case INTRINSIC_UPLUS:
+      result = gfc_uplus (op1);
+      break;
+
+    case INTRINSIC_UMINUS:
+      result = gfc_uminus (op1);
+      break;
+
+    case INTRINSIC_PLUS:
+      result = gfc_add (op1, op2);
+      break;
+
+    case INTRINSIC_MINUS:
+      result = gfc_subtract (op1, op2);
+      break;
+
+    case INTRINSIC_TIMES:
+      result = gfc_multiply (op1, op2);
+      break;
+
+    case INTRINSIC_DIVIDE:
+      result = gfc_divide (op1, op2);
+      break;
+
+    case INTRINSIC_POWER:
+      result = gfc_power (op1, op2);
+      break;
+
+    case INTRINSIC_CONCAT:
+      result = gfc_concat (op1, op2);
+      break;
+
+    case INTRINSIC_EQ:
+    case INTRINSIC_EQ_OS:
+      result = gfc_eq (op1, op2, op);
+      break;
+
+    case INTRINSIC_NE:
+    case INTRINSIC_NE_OS:
+      result = gfc_ne (op1, op2, op);
+      break;
+
+    case INTRINSIC_GT:
+    case INTRINSIC_GT_OS:
+      result = gfc_gt (op1, op2, op);
+      break;
+
+    case INTRINSIC_GE:
+    case INTRINSIC_GE_OS:
+      result = gfc_ge (op1, op2, op);
+      break;
+
+    case INTRINSIC_LT:
+    case INTRINSIC_LT_OS:
+      result = gfc_lt (op1, op2, op);
+      break;
+
+    case INTRINSIC_LE:
+    case INTRINSIC_LE_OS:
+      result = gfc_le (op1, op2, op);
+      break;
+
+    case INTRINSIC_NOT:
+      result = gfc_not (op1);
+      break;
+
+    case INTRINSIC_AND:
+      result = gfc_and (op1, op2);
+      break;
+
+    case INTRINSIC_OR:
+      result = gfc_or (op1, op2);
+      break;
+
+    case INTRINSIC_EQV:
+      result = gfc_eqv (op1, op2);
+      break;
+
+    case INTRINSIC_NEQV:
+      result = gfc_neqv (op1, op2);
+      break;
+
+    default:
+      gfc_internal_error ("simplify_intrinsic_op(): Bad operator");
+    }
+
+  if (result == NULL)
+    {
+      gfc_free_expr (op1);
+      gfc_free_expr (op2);
+      return FAILURE;
+    }
+
+  result->rank = p->rank;
+  result->where = p->where;
+  gfc_replace_expr (p, result);
+
+  return SUCCESS;
+}
+
+
+/* Subroutine to simplify constructor expressions.  Mutually recursive
+   with gfc_simplify_expr().  */
+
+static gfc_try
+simplify_constructor (gfc_constructor_base base, int type)
+{
+  gfc_constructor *c;
+  gfc_expr *p;
+
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+    {
+      if (c->iterator
+	  && (gfc_simplify_expr (c->iterator->start, type) == FAILURE
+	      || gfc_simplify_expr (c->iterator->end, type) == FAILURE
+	      || gfc_simplify_expr (c->iterator->step, type) == FAILURE))
+	return FAILURE;
+
+      if (c->expr)
+	{
+	  /* Try and simplify a copy.  Replace the original if successful
+	     but keep going through the constructor at all costs.  Not
+	     doing so can make a dog's dinner of complicated things.  */
+	  p = gfc_copy_expr (c->expr);
+
+	  if (gfc_simplify_expr (p, type) == FAILURE)
+	    {
+	      gfc_free_expr (p);
+	      continue;
+	    }
+
+	  gfc_replace_expr (c->expr, p);
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* Pull a single array element out of an array constructor.  */
+
+static gfc_try
+find_array_element (gfc_constructor_base base, gfc_array_ref *ar,
+		    gfc_constructor **rval)
+{
+  unsigned long nelemen;
+  int i;
+  mpz_t delta;
+  mpz_t offset;
+  mpz_t span;
+  mpz_t tmp;
+  gfc_constructor *cons;
+  gfc_expr *e;
+  gfc_try t;
+
+  t = SUCCESS;
+  e = NULL;
+
+  mpz_init_set_ui (offset, 0);
+  mpz_init (delta);
+  mpz_init (tmp);
+  mpz_init_set_ui (span, 1);
+  for (i = 0; i < ar->dimen; i++)
+    {
+      if (gfc_reduce_init_expr (ar->as->lower[i]) == FAILURE
+	  || gfc_reduce_init_expr (ar->as->upper[i]) == FAILURE)
+	{
+	  t = FAILURE;
+	  cons = NULL;
+	  goto depart;
+	}
+
+      e = gfc_copy_expr (ar->start[i]);
+      if (e->expr_type != EXPR_CONSTANT)
+	{
+	  cons = NULL;
+	  goto depart;
+	}
+
+      gcc_assert (ar->as->upper[i]->expr_type == EXPR_CONSTANT
+		  && ar->as->lower[i]->expr_type == EXPR_CONSTANT);
+
+      /* Check the bounds.  */
+      if ((ar->as->upper[i]
+	   && mpz_cmp (e->value.integer,
+		       ar->as->upper[i]->value.integer) > 0)
+	  || (mpz_cmp (e->value.integer,
+		       ar->as->lower[i]->value.integer) < 0))
+	{
+	  gfc_error ("Index in dimension %d is out of bounds "
+		     "at %L", i + 1, &ar->c_where[i]);
+	  cons = NULL;
+	  t = FAILURE;
+	  goto depart;
+	}
+
+      mpz_sub (delta, e->value.integer, ar->as->lower[i]->value.integer);
+      mpz_mul (delta, delta, span);
+      mpz_add (offset, offset, delta);
+
+      mpz_set_ui (tmp, 1);
+      mpz_add (tmp, tmp, ar->as->upper[i]->value.integer);
+      mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
+      mpz_mul (span, span, tmp);
+    }
+
+  for (cons = gfc_constructor_first (base), nelemen = mpz_get_ui (offset);
+       cons && nelemen > 0; cons = gfc_constructor_next (cons), nelemen--)
+    {
+      if (cons->iterator)
+	{
+	  cons = NULL;
+	  goto depart;
+	}
+    }
+
+depart:
+  mpz_clear (delta);
+  mpz_clear (offset);
+  mpz_clear (span);
+  mpz_clear (tmp);
+  if (e)
+    gfc_free_expr (e);
+  *rval = cons;
+  return t;
+}
+
+
+/* Find a component of a structure constructor.  */
+
+static gfc_constructor *
+find_component_ref (gfc_constructor_base base, gfc_ref *ref)
+{
+  gfc_component *comp;
+  gfc_component *pick;
+  gfc_constructor *c = gfc_constructor_first (base);
+
+  comp = ref->u.c.sym->components;
+  pick = ref->u.c.component;
+  while (comp != pick)
+    {
+      comp = comp->next;
+      c = gfc_constructor_next (c);
+    }
+
+  return c;
+}
+
+
+/* Replace an expression with the contents of a constructor, removing
+   the subobject reference in the process.  */
+
+static void
+remove_subobject_ref (gfc_expr *p, gfc_constructor *cons)
+{
+  gfc_expr *e;
+
+  if (cons)
+    {
+      e = cons->expr;
+      cons->expr = NULL;
+    }
+  else
+    e = gfc_copy_expr (p);
+  e->ref = p->ref->next;
+  p->ref->next =  NULL;
+  gfc_replace_expr (p, e);
+}
+
+
+/* Pull an array section out of an array constructor.  */
+
+static gfc_try
+find_array_section (gfc_expr *expr, gfc_ref *ref)
+{
+  int idx;
+  int rank;
+  int d;
+  int shape_i;
+  int limit;
+  long unsigned one = 1;
+  bool incr_ctr;
+  mpz_t start[GFC_MAX_DIMENSIONS];
+  mpz_t end[GFC_MAX_DIMENSIONS];
+  mpz_t stride[GFC_MAX_DIMENSIONS];
+  mpz_t delta[GFC_MAX_DIMENSIONS];
+  mpz_t ctr[GFC_MAX_DIMENSIONS];
+  mpz_t delta_mpz;
+  mpz_t tmp_mpz;
+  mpz_t nelts;
+  mpz_t ptr;
+  gfc_constructor_base base;
+  gfc_constructor *cons, *vecsub[GFC_MAX_DIMENSIONS];
+  gfc_expr *begin;
+  gfc_expr *finish;
+  gfc_expr *step;
+  gfc_expr *upper;
+  gfc_expr *lower;
+  gfc_try t;
+
+  t = SUCCESS;
+
+  base = expr->value.constructor;
+  expr->value.constructor = NULL;
+
+  rank = ref->u.ar.as->rank;
+
+  if (expr->shape == NULL)
+    expr->shape = gfc_get_shape (rank);
+
+  mpz_init_set_ui (delta_mpz, one);
+  mpz_init_set_ui (nelts, one);
+  mpz_init (tmp_mpz);
+
+  /* Do the initialization now, so that we can cleanup without
+     keeping track of where we were.  */
+  for (d = 0; d < rank; d++)
+    {
+      mpz_init (delta[d]);
+      mpz_init (start[d]);
+      mpz_init (end[d]);
+      mpz_init (ctr[d]);
+      mpz_init (stride[d]);
+      vecsub[d] = NULL;
+    }
+
+  /* Build the counters to clock through the array reference.  */
+  shape_i = 0;
+  for (d = 0; d < rank; d++)
+    {
+      /* Make this stretch of code easier on the eye!  */
+      begin = ref->u.ar.start[d];
+      finish = ref->u.ar.end[d];
+      step = ref->u.ar.stride[d];
+      lower = ref->u.ar.as->lower[d];
+      upper = ref->u.ar.as->upper[d];
+
+      if (ref->u.ar.dimen_type[d] == DIMEN_VECTOR)  /* Vector subscript.  */
+	{
+	  gfc_constructor *ci;
+	  gcc_assert (begin);
+
+	  if (begin->expr_type != EXPR_ARRAY || !gfc_is_constant_expr (begin))
+	    {
+	      t = FAILURE;
+	      goto cleanup;
+	    }
+
+	  gcc_assert (begin->rank == 1);
+	  /* Zero-sized arrays have no shape and no elements, stop early.  */
+	  if (!begin->shape) 
+	    {
+	      mpz_init_set_ui (nelts, 0);
+	      break;
+	    }
+
+	  vecsub[d] = gfc_constructor_first (begin->value.constructor);
+	  mpz_set (ctr[d], vecsub[d]->expr->value.integer);
+	  mpz_mul (nelts, nelts, begin->shape[0]);
+	  mpz_set (expr->shape[shape_i++], begin->shape[0]);
+
+	  /* Check bounds.  */
+	  for (ci = vecsub[d]; ci; ci = gfc_constructor_next (ci))
+	    {
+	      if (mpz_cmp (ci->expr->value.integer, upper->value.integer) > 0
+		  || mpz_cmp (ci->expr->value.integer,
+			      lower->value.integer) < 0)
+		{
+		  gfc_error ("index in dimension %d is out of bounds "
+			     "at %L", d + 1, &ref->u.ar.c_where[d]);
+		  t = FAILURE;
+		  goto cleanup;
+		}
+	    }
+	}
+      else
+	{
+	  if ((begin && begin->expr_type != EXPR_CONSTANT)
+	      || (finish && finish->expr_type != EXPR_CONSTANT)
+	      || (step && step->expr_type != EXPR_CONSTANT))
+	    {
+	      t = FAILURE;
+	      goto cleanup;
+	    }
+
+	  /* Obtain the stride.  */
+	  if (step)
+	    mpz_set (stride[d], step->value.integer);
+	  else
+	    mpz_set_ui (stride[d], one);
+
+	  if (mpz_cmp_ui (stride[d], 0) == 0)
+	    mpz_set_ui (stride[d], one);
+
+	  /* Obtain the start value for the index.  */
+	  if (begin)
+	    mpz_set (start[d], begin->value.integer);
+	  else
+	    mpz_set (start[d], lower->value.integer);
+
+	  mpz_set (ctr[d], start[d]);
+
+	  /* Obtain the end value for the index.  */
+	  if (finish)
+	    mpz_set (end[d], finish->value.integer);
+	  else
+	    mpz_set (end[d], upper->value.integer);
+
+	  /* Separate 'if' because elements sometimes arrive with
+	     non-null end.  */
+	  if (ref->u.ar.dimen_type[d] == DIMEN_ELEMENT)
+	    mpz_set (end [d], begin->value.integer);
+
+	  /* Check the bounds.  */
+	  if (mpz_cmp (ctr[d], upper->value.integer) > 0
+	      || mpz_cmp (end[d], upper->value.integer) > 0
+	      || mpz_cmp (ctr[d], lower->value.integer) < 0
+	      || mpz_cmp (end[d], lower->value.integer) < 0)
+	    {
+	      gfc_error ("index in dimension %d is out of bounds "
+			 "at %L", d + 1, &ref->u.ar.c_where[d]);
+	      t = FAILURE;
+	      goto cleanup;
+	    }
+
+	  /* Calculate the number of elements and the shape.  */
+	  mpz_set (tmp_mpz, stride[d]);
+	  mpz_add (tmp_mpz, end[d], tmp_mpz);
+	  mpz_sub (tmp_mpz, tmp_mpz, ctr[d]);
+	  mpz_div (tmp_mpz, tmp_mpz, stride[d]);
+	  mpz_mul (nelts, nelts, tmp_mpz);
+
+	  /* An element reference reduces the rank of the expression; don't
+	     add anything to the shape array.  */
+	  if (ref->u.ar.dimen_type[d] != DIMEN_ELEMENT) 
+	    mpz_set (expr->shape[shape_i++], tmp_mpz);
+	}
+
+      /* Calculate the 'stride' (=delta) for conversion of the
+	 counter values into the index along the constructor.  */
+      mpz_set (delta[d], delta_mpz);
+      mpz_sub (tmp_mpz, upper->value.integer, lower->value.integer);
+      mpz_add_ui (tmp_mpz, tmp_mpz, one);
+      mpz_mul (delta_mpz, delta_mpz, tmp_mpz);
+    }
+
+  mpz_init (ptr);
+  cons = gfc_constructor_first (base);
+
+  /* Now clock through the array reference, calculating the index in
+     the source constructor and transferring the elements to the new
+     constructor.  */  
+  for (idx = 0; idx < (int) mpz_get_si (nelts); idx++)
+    {
+      if (ref->u.ar.offset)
+	mpz_set (ptr, ref->u.ar.offset->value.integer);
+      else
+	mpz_init_set_ui (ptr, 0);
+
+      incr_ctr = true;
+      for (d = 0; d < rank; d++)
+	{
+	  mpz_set (tmp_mpz, ctr[d]);
+	  mpz_sub (tmp_mpz, tmp_mpz, ref->u.ar.as->lower[d]->value.integer);
+	  mpz_mul (tmp_mpz, tmp_mpz, delta[d]);
+	  mpz_add (ptr, ptr, tmp_mpz);
+
+	  if (!incr_ctr) continue;
+
+	  if (ref->u.ar.dimen_type[d] == DIMEN_VECTOR) /* Vector subscript.  */
+	    {
+	      gcc_assert(vecsub[d]);
+
+	      if (!gfc_constructor_next (vecsub[d]))
+		vecsub[d] = gfc_constructor_first (ref->u.ar.start[d]->value.constructor);
+	      else
+		{
+		  vecsub[d] = gfc_constructor_next (vecsub[d]);
+		  incr_ctr = false;
+		}
+	      mpz_set (ctr[d], vecsub[d]->expr->value.integer);
+	    }
+	  else
+	    {
+	      mpz_add (ctr[d], ctr[d], stride[d]); 
+
+	      if (mpz_cmp_ui (stride[d], 0) > 0
+		  ? mpz_cmp (ctr[d], end[d]) > 0
+		  : mpz_cmp (ctr[d], end[d]) < 0)
+		mpz_set (ctr[d], start[d]);
+	      else
+		incr_ctr = false;
+	    }
+	}
+
+      limit = mpz_get_ui (ptr);
+      if (limit >= gfc_option.flag_max_array_constructor)
+        {
+	  gfc_error ("The number of elements in the array constructor "
+		     "at %L requires an increase of the allowed %d "
+		     "upper limit.   See -fmax-array-constructor "
+		     "option", &expr->where,
+		     gfc_option.flag_max_array_constructor);
+	  return FAILURE;
+	}
+
+      cons = gfc_constructor_lookup (base, limit);
+      gcc_assert (cons);
+      gfc_constructor_append_expr (&expr->value.constructor,
+				   gfc_copy_expr (cons->expr), NULL);
+    }
+
+  mpz_clear (ptr);
+
+cleanup:
+
+  mpz_clear (delta_mpz);
+  mpz_clear (tmp_mpz);
+  mpz_clear (nelts);
+  for (d = 0; d < rank; d++)
+    {
+      mpz_clear (delta[d]);
+      mpz_clear (start[d]);
+      mpz_clear (end[d]);
+      mpz_clear (ctr[d]);
+      mpz_clear (stride[d]);
+    }
+  gfc_constructor_free (base);
+  return t;
+}
+
+/* Pull a substring out of an expression.  */
+
+static gfc_try
+find_substring_ref (gfc_expr *p, gfc_expr **newp)
+{
+  int end;
+  int start;
+  int length;
+  gfc_char_t *chr;
+
+  if (p->ref->u.ss.start->expr_type != EXPR_CONSTANT
+      || p->ref->u.ss.end->expr_type != EXPR_CONSTANT)
+    return FAILURE;
+
+  *newp = gfc_copy_expr (p);
+  gfc_free ((*newp)->value.character.string);
+
+  end = (int) mpz_get_ui (p->ref->u.ss.end->value.integer);
+  start = (int) mpz_get_ui (p->ref->u.ss.start->value.integer);
+  length = end - start + 1;
+
+  chr = (*newp)->value.character.string = gfc_get_wide_string (length + 1);
+  (*newp)->value.character.length = length;
+  memcpy (chr, &p->value.character.string[start - 1],
+	  length * sizeof (gfc_char_t));
+  chr[length] = '\0';
+  return SUCCESS;
+}
+
+
+
+/* Simplify a subobject reference of a constructor.  This occurs when
+   parameter variable values are substituted.  */
+
+static gfc_try
+simplify_const_ref (gfc_expr *p)
+{
+  gfc_constructor *cons, *c;
+  gfc_expr *newp;
+  gfc_ref *last_ref;
+
+  while (p->ref)
+    {
+      switch (p->ref->type)
+	{
+	case REF_ARRAY:
+	  switch (p->ref->u.ar.type)
+	    {
+	    case AR_ELEMENT:
+	      /* <type/kind spec>, parameter :: x(<int>) = scalar_expr
+		 will generate this.  */
+	      if (p->expr_type != EXPR_ARRAY)
+		{
+		  remove_subobject_ref (p, NULL);
+		  break;
+		}
+	      if (find_array_element (p->value.constructor, &p->ref->u.ar,
+				      &cons) == FAILURE)
+		return FAILURE;
+
+	      if (!cons)
+		return SUCCESS;
+
+	      remove_subobject_ref (p, cons);
+	      break;
+
+	    case AR_SECTION:
+	      if (find_array_section (p, p->ref) == FAILURE)
+		return FAILURE;
+	      p->ref->u.ar.type = AR_FULL;
+
+	    /* Fall through.  */
+
+	    case AR_FULL:
+	      if (p->ref->next != NULL
+		  && (p->ts.type == BT_CHARACTER || p->ts.type == BT_DERIVED))
+		{
+		  for (c = gfc_constructor_first (p->value.constructor);
+		       c; c = gfc_constructor_next (c))
+		    {
+		      c->expr->ref = gfc_copy_ref (p->ref->next);
+		      if (simplify_const_ref (c->expr) == FAILURE)
+			return FAILURE;
+		    }
+
+		  if (p->ts.type == BT_DERIVED
+			&& p->ref->next
+			&& (c = gfc_constructor_first (p->value.constructor)))
+		    {
+		      /* There may have been component references.  */
+		      p->ts = c->expr->ts;
+		    }
+
+		  last_ref = p->ref;
+		  for (; last_ref->next; last_ref = last_ref->next) {};
+
+		  if (p->ts.type == BT_CHARACTER
+			&& last_ref->type == REF_SUBSTRING)
+		    {
+		      /* If this is a CHARACTER array and we possibly took
+			 a substring out of it, update the type-spec's
+			 character length according to the first element
+			 (as all should have the same length).  */
+		      int string_len;
+		      if ((c = gfc_constructor_first (p->value.constructor)))
+			{
+			  const gfc_expr* first = c->expr;
+			  gcc_assert (first->expr_type == EXPR_CONSTANT);
+			  gcc_assert (first->ts.type == BT_CHARACTER);
+			  string_len = first->value.character.length;
+			}
+		      else
+			string_len = 0;
+
+		      if (!p->ts.u.cl)
+			p->ts.u.cl = gfc_new_charlen (p->symtree->n.sym->ns,
+						      NULL);
+		      else
+			gfc_free_expr (p->ts.u.cl->length);
+
+		      p->ts.u.cl->length
+			= gfc_get_int_expr (gfc_default_integer_kind,
+					    NULL, string_len);
+		    }
+		}
+	      gfc_free_ref_list (p->ref);
+	      p->ref = NULL;
+	      break;
+
+	    default:
+	      return SUCCESS;
+	    }
+
+	  break;
+
+	case REF_COMPONENT:
+	  cons = find_component_ref (p->value.constructor, p->ref);
+	  remove_subobject_ref (p, cons);
+	  break;
+
+	case REF_SUBSTRING:
+  	  if (find_substring_ref (p, &newp) == FAILURE)
+	    return FAILURE;
+
+	  gfc_replace_expr (p, newp);
+	  gfc_free_ref_list (p->ref);
+	  p->ref = NULL;
+	  break;
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* Simplify a chain of references.  */
+
+static gfc_try
+simplify_ref_chain (gfc_ref *ref, int type)
+{
+  int n;
+
+  for (; ref; ref = ref->next)
+    {
+      switch (ref->type)
+	{
+	case REF_ARRAY:
+	  for (n = 0; n < ref->u.ar.dimen; n++)
+	    {
+	      if (gfc_simplify_expr (ref->u.ar.start[n], type) == FAILURE)
+		return FAILURE;
+	      if (gfc_simplify_expr (ref->u.ar.end[n], type) == FAILURE)
+		return FAILURE;
+	      if (gfc_simplify_expr (ref->u.ar.stride[n], type) == FAILURE)
+		return FAILURE;
+	    }
+	  break;
+
+	case REF_SUBSTRING:
+	  if (gfc_simplify_expr (ref->u.ss.start, type) == FAILURE)
+	    return FAILURE;
+	  if (gfc_simplify_expr (ref->u.ss.end, type) == FAILURE)
+	    return FAILURE;
+	  break;
+
+	default:
+	  break;
+	}
+    }
+  return SUCCESS;
+}
+
+
+/* Try to substitute the value of a parameter variable.  */
+
+static gfc_try
+simplify_parameter_variable (gfc_expr *p, int type)
+{
+  gfc_expr *e;
+  gfc_try t;
+
+  e = gfc_copy_expr (p->symtree->n.sym->value);
+  if (e == NULL)
+    return FAILURE;
+
+  e->rank = p->rank;
+
+  /* Do not copy subobject refs for constant.  */
+  if (e->expr_type != EXPR_CONSTANT && p->ref != NULL)
+    e->ref = gfc_copy_ref (p->ref);
+  t = gfc_simplify_expr (e, type);
+
+  /* Only use the simplification if it eliminated all subobject references.  */
+  if (t == SUCCESS && !e->ref)
+    gfc_replace_expr (p, e);
+  else
+    gfc_free_expr (e);
+
+  return t;
+}
+
+/* Given an expression, simplify it by collapsing constant
+   expressions.  Most simplification takes place when the expression
+   tree is being constructed.  If an intrinsic function is simplified
+   at some point, we get called again to collapse the result against
+   other constants.
+
+   We work by recursively simplifying expression nodes, simplifying
+   intrinsic functions where possible, which can lead to further
+   constant collapsing.  If an operator has constant operand(s), we
+   rip the expression apart, and rebuild it, hoping that it becomes
+   something simpler.
+
+   The expression type is defined for:
+     0   Basic expression parsing
+     1   Simplifying array constructors -- will substitute
+	 iterator values.
+   Returns FAILURE on error, SUCCESS otherwise.
+   NOTE: Will return SUCCESS even if the expression can not be simplified.  */
+
+gfc_try
+gfc_simplify_expr (gfc_expr *p, int type)
+{
+  gfc_actual_arglist *ap;
+
+  if (p == NULL)
+    return SUCCESS;
+
+  switch (p->expr_type)
+    {
+    case EXPR_CONSTANT:
+    case EXPR_NULL:
+      break;
+
+    case EXPR_FUNCTION:
+      for (ap = p->value.function.actual; ap; ap = ap->next)
+	if (gfc_simplify_expr (ap->expr, type) == FAILURE)
+	  return FAILURE;
+
+      if (p->value.function.isym != NULL
+	  && gfc_intrinsic_func_interface (p, 1) == MATCH_ERROR)
+	return FAILURE;
+
+      break;
+
+    case EXPR_SUBSTRING:
+      if (simplify_ref_chain (p->ref, type) == FAILURE)
+	return FAILURE;
+
+      if (gfc_is_constant_expr (p))
+	{
+	  gfc_char_t *s;
+	  int start, end;
+
+	  start = 0;
+	  if (p->ref && p->ref->u.ss.start)
+	    {
+	      gfc_extract_int (p->ref->u.ss.start, &start);
+	      start--;  /* Convert from one-based to zero-based.  */
+	    }
+
+	  end = p->value.character.length;
+	  if (p->ref && p->ref->u.ss.end)
+	    gfc_extract_int (p->ref->u.ss.end, &end);
+
+	  if (end < 0)
+	    end = 0;
+
+	  s = gfc_get_wide_string (end - start + 2);
+	  memcpy (s, p->value.character.string + start,
+		  (end - start) * sizeof (gfc_char_t));
+	  s[end - start + 1] = '\0';  /* TODO: C-style string.  */
+	  gfc_free (p->value.character.string);
+	  p->value.character.string = s;
+	  p->value.character.length = end - start;
+	  p->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+	  p->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+						 NULL,
+						 p->value.character.length);
+	  gfc_free_ref_list (p->ref);
+	  p->ref = NULL;
+	  p->expr_type = EXPR_CONSTANT;
+	}
+      break;
+
+    case EXPR_OP:
+      if (simplify_intrinsic_op (p, type) == FAILURE)
+	return FAILURE;
+      break;
+
+    case EXPR_VARIABLE:
+      /* Only substitute array parameter variables if we are in an
+	 initialization expression, or we want a subsection.  */
+      if (p->symtree->n.sym->attr.flavor == FL_PARAMETER
+	  && (gfc_init_expr_flag || p->ref
+	      || p->symtree->n.sym->value->expr_type != EXPR_ARRAY))
+	{
+	  if (simplify_parameter_variable (p, type) == FAILURE)
+	    return FAILURE;
+	  break;
+	}
+
+      if (type == 1)
+	{
+	  gfc_simplify_iterator_var (p);
+	}
+
+      /* Simplify subcomponent references.  */
+      if (simplify_ref_chain (p->ref, type) == FAILURE)
+	return FAILURE;
+
+      break;
+
+    case EXPR_STRUCTURE:
+    case EXPR_ARRAY:
+      if (simplify_ref_chain (p->ref, type) == FAILURE)
+	return FAILURE;
+
+      if (simplify_constructor (p->value.constructor, type) == FAILURE)
+	return FAILURE;
+
+      if (p->expr_type == EXPR_ARRAY && p->ref && p->ref->type == REF_ARRAY
+	  && p->ref->u.ar.type == AR_FULL)
+	  gfc_expand_constructor (p, false);
+
+      if (simplify_const_ref (p) == FAILURE)
+	return FAILURE;
+
+      break;
+
+    case EXPR_COMPCALL:
+    case EXPR_PPC:
+      gcc_unreachable ();
+      break;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Returns the type of an expression with the exception that iterator
+   variables are automatically integers no matter what else they may
+   be declared as.  */
+
+static bt
+et0 (gfc_expr *e)
+{
+  if (e->expr_type == EXPR_VARIABLE && gfc_check_iter_variable (e) == SUCCESS)
+    return BT_INTEGER;
+
+  return e->ts.type;
+}
+
+
+/* Check an intrinsic arithmetic operation to see if it is consistent
+   with some type of expression.  */
+
+static gfc_try check_init_expr (gfc_expr *);
+
+
+/* Scalarize an expression for an elemental intrinsic call.  */
+
+static gfc_try
+scalarize_intrinsic_call (gfc_expr *e)
+{
+  gfc_actual_arglist *a, *b;
+  gfc_constructor_base ctor;
+  gfc_constructor *args[5];
+  gfc_constructor *ci, *new_ctor;
+  gfc_expr *expr, *old;
+  int n, i, rank[5], array_arg;
+  
+  /* Find which, if any, arguments are arrays.  Assume that the old
+     expression carries the type information and that the first arg
+     that is an array expression carries all the shape information.*/
+  n = array_arg = 0;
+  a = e->value.function.actual;
+  for (; a; a = a->next)
+    {
+      n++;
+      if (a->expr->expr_type != EXPR_ARRAY)
+	continue;
+      array_arg = n;
+      expr = gfc_copy_expr (a->expr);
+      break;
+    }
+
+  if (!array_arg)
+    return FAILURE;
+
+  old = gfc_copy_expr (e);
+
+  gfc_constructor_free (expr->value.constructor);
+  expr->value.constructor = NULL;
+  expr->ts = old->ts;
+  expr->where = old->where;
+  expr->expr_type = EXPR_ARRAY;
+
+  /* Copy the array argument constructors into an array, with nulls
+     for the scalars.  */
+  n = 0;
+  a = old->value.function.actual;
+  for (; a; a = a->next)
+    {
+      /* Check that this is OK for an initialization expression.  */
+      if (a->expr && check_init_expr (a->expr) == FAILURE)
+	goto cleanup;
+
+      rank[n] = 0;
+      if (a->expr && a->expr->rank && a->expr->expr_type == EXPR_VARIABLE)
+	{
+	  rank[n] = a->expr->rank;
+	  ctor = a->expr->symtree->n.sym->value->value.constructor;
+	  args[n] = gfc_constructor_first (ctor);
+	}
+      else if (a->expr && a->expr->expr_type == EXPR_ARRAY)
+	{
+	  if (a->expr->rank)
+	    rank[n] = a->expr->rank;
+	  else
+	    rank[n] = 1;
+	  ctor = gfc_constructor_copy (a->expr->value.constructor);
+	  args[n] = gfc_constructor_first (ctor);
+	}
+      else
+	args[n] = NULL;
+
+      n++;
+    }
+
+
+  /* Using the array argument as the master, step through the array
+     calling the function for each element and advancing the array
+     constructors together.  */
+  for (ci = args[array_arg - 1]; ci; ci = gfc_constructor_next (ci))
+    {
+      new_ctor = gfc_constructor_append_expr (&expr->value.constructor,
+					      gfc_copy_expr (old), NULL);
+
+      gfc_free_actual_arglist (new_ctor->expr->value.function.actual);
+      a = NULL;
+      b = old->value.function.actual;
+      for (i = 0; i < n; i++)
+	{
+	  if (a == NULL)
+	    new_ctor->expr->value.function.actual
+			= a = gfc_get_actual_arglist ();
+	  else
+	    {
+	      a->next = gfc_get_actual_arglist ();
+	      a = a->next;
+	    }
+
+	  if (args[i])
+	    a->expr = gfc_copy_expr (args[i]->expr);
+	  else
+	    a->expr = gfc_copy_expr (b->expr);
+
+	  b = b->next;
+	}
+
+      /* Simplify the function calls.  If the simplification fails, the
+	 error will be flagged up down-stream or the library will deal
+	 with it.  */
+      gfc_simplify_expr (new_ctor->expr, 0);
+
+      for (i = 0; i < n; i++)
+	if (args[i])
+	  args[i] = gfc_constructor_next (args[i]);
+
+      for (i = 1; i < n; i++)
+	if (rank[i] && ((args[i] != NULL && args[array_arg - 1] == NULL)
+			|| (args[i] == NULL && args[array_arg - 1] != NULL)))
+	  goto compliance;
+    }
+
+  free_expr0 (e);
+  *e = *expr;
+  gfc_free_expr (old);
+  return SUCCESS;
+
+compliance:
+  gfc_error_now ("elemental function arguments at %C are not compliant");
+
+cleanup:
+  gfc_free_expr (expr);
+  gfc_free_expr (old);
+  return FAILURE;
+}
+
+
+static gfc_try
+check_intrinsic_op (gfc_expr *e, gfc_try (*check_function) (gfc_expr *))
+{
+  gfc_expr *op1 = e->value.op.op1;
+  gfc_expr *op2 = e->value.op.op2;
+
+  if ((*check_function) (op1) == FAILURE)
+    return FAILURE;
+
+  switch (e->value.op.op)
+    {
+    case INTRINSIC_UPLUS:
+    case INTRINSIC_UMINUS:
+      if (!numeric_type (et0 (op1)))
+	goto not_numeric;
+      break;
+
+    case INTRINSIC_EQ:
+    case INTRINSIC_EQ_OS:
+    case INTRINSIC_NE:
+    case INTRINSIC_NE_OS:
+    case INTRINSIC_GT:
+    case INTRINSIC_GT_OS:
+    case INTRINSIC_GE:
+    case INTRINSIC_GE_OS:
+    case INTRINSIC_LT:
+    case INTRINSIC_LT_OS:
+    case INTRINSIC_LE:
+    case INTRINSIC_LE_OS:
+      if ((*check_function) (op2) == FAILURE)
+	return FAILURE;
+      
+      if (!(et0 (op1) == BT_CHARACTER && et0 (op2) == BT_CHARACTER)
+	  && !(numeric_type (et0 (op1)) && numeric_type (et0 (op2))))
+	{
+	  gfc_error ("Numeric or CHARACTER operands are required in "
+		     "expression at %L", &e->where);
+	 return FAILURE;
+	}
+      break;
+
+    case INTRINSIC_PLUS:
+    case INTRINSIC_MINUS:
+    case INTRINSIC_TIMES:
+    case INTRINSIC_DIVIDE:
+    case INTRINSIC_POWER:
+      if ((*check_function) (op2) == FAILURE)
+	return FAILURE;
+
+      if (!numeric_type (et0 (op1)) || !numeric_type (et0 (op2)))
+	goto not_numeric;
+
+      break;
+
+    case INTRINSIC_CONCAT:
+      if ((*check_function) (op2) == FAILURE)
+	return FAILURE;
+
+      if (et0 (op1) != BT_CHARACTER || et0 (op2) != BT_CHARACTER)
+	{
+	  gfc_error ("Concatenation operator in expression at %L "
+		     "must have two CHARACTER operands", &op1->where);
+	  return FAILURE;
+	}
+
+      if (op1->ts.kind != op2->ts.kind)
+	{
+	  gfc_error ("Concat operator at %L must concatenate strings of the "
+		     "same kind", &e->where);
+	  return FAILURE;
+	}
+
+      break;
+
+    case INTRINSIC_NOT:
+      if (et0 (op1) != BT_LOGICAL)
+	{
+	  gfc_error (".NOT. operator in expression at %L must have a LOGICAL "
+		     "operand", &op1->where);
+	  return FAILURE;
+	}
+
+      break;
+
+    case INTRINSIC_AND:
+    case INTRINSIC_OR:
+    case INTRINSIC_EQV:
+    case INTRINSIC_NEQV:
+      if ((*check_function) (op2) == FAILURE)
+	return FAILURE;
+
+      if (et0 (op1) != BT_LOGICAL || et0 (op2) != BT_LOGICAL)
+	{
+	  gfc_error ("LOGICAL operands are required in expression at %L",
+		     &e->where);
+	  return FAILURE;
+	}
+
+      break;
+
+    case INTRINSIC_PARENTHESES:
+      break;
+
+    default:
+      gfc_error ("Only intrinsic operators can be used in expression at %L",
+		 &e->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+
+not_numeric:
+  gfc_error ("Numeric operands are required in expression at %L", &e->where);
+
+  return FAILURE;
+}
+
+/* F2003, 7.1.7 (3): In init expression, allocatable components
+   must not be data-initialized.  */
+static gfc_try
+check_alloc_comp_init (gfc_expr *e)
+{
+  gfc_component *comp;
+  gfc_constructor *ctor;
+
+  gcc_assert (e->expr_type == EXPR_STRUCTURE);
+  gcc_assert (e->ts.type == BT_DERIVED);
+
+  for (comp = e->ts.u.derived->components,
+       ctor = gfc_constructor_first (e->value.constructor);
+       comp; comp = comp->next, ctor = gfc_constructor_next (ctor))
+    {
+      if (comp->attr.allocatable
+          && ctor->expr->expr_type != EXPR_NULL)
+        {
+	  gfc_error("Invalid initialization expression for ALLOCATABLE "
+	            "component '%s' in structure constructor at %L",
+	            comp->name, &ctor->expr->where);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+static match
+check_init_expr_arguments (gfc_expr *e)
+{
+  gfc_actual_arglist *ap;
+
+  for (ap = e->value.function.actual; ap; ap = ap->next)
+    if (check_init_expr (ap->expr) == FAILURE)
+      return MATCH_ERROR;
+
+  return MATCH_YES;
+}
+
+static gfc_try check_restricted (gfc_expr *);
+
+/* F95, 7.1.6.1, Initialization expressions, (7)
+   F2003, 7.1.7 Initialization expression, (8)  */
+
+static match
+check_inquiry (gfc_expr *e, int not_restricted)
+{
+  const char *name;
+  const char *const *functions;
+
+  static const char *const inquiry_func_f95[] = {
+    "lbound", "shape", "size", "ubound",
+    "bit_size", "len", "kind",
+    "digits", "epsilon", "huge", "maxexponent", "minexponent",
+    "precision", "radix", "range", "tiny",
+    NULL
+  };
+
+  static const char *const inquiry_func_f2003[] = {
+    "lbound", "shape", "size", "ubound",
+    "bit_size", "len", "kind",
+    "digits", "epsilon", "huge", "maxexponent", "minexponent",
+    "precision", "radix", "range", "tiny",
+    "new_line", NULL
+  };
+
+  int i;
+  gfc_actual_arglist *ap;
+
+  if (!e->value.function.isym
+      || !e->value.function.isym->inquiry)
+    return MATCH_NO;
+
+  /* An undeclared parameter will get us here (PR25018).  */
+  if (e->symtree == NULL)
+    return MATCH_NO;
+
+  name = e->symtree->n.sym->name;
+
+  functions = (gfc_option.warn_std & GFC_STD_F2003) 
+		? inquiry_func_f2003 : inquiry_func_f95;
+
+  for (i = 0; functions[i]; i++)
+    if (strcmp (functions[i], name) == 0)
+      break;
+
+  if (functions[i] == NULL)
+    return MATCH_ERROR;
+
+  /* At this point we have an inquiry function with a variable argument.  The
+     type of the variable might be undefined, but we need it now, because the
+     arguments of these functions are not allowed to be undefined.  */
+
+  for (ap = e->value.function.actual; ap; ap = ap->next)
+    {
+      if (!ap->expr)
+	continue;
+
+      if (ap->expr->ts.type == BT_UNKNOWN)
+	{
+	  if (ap->expr->symtree->n.sym->ts.type == BT_UNKNOWN
+	      && gfc_set_default_type (ap->expr->symtree->n.sym, 0, gfc_current_ns)
+	      == FAILURE)
+	    return MATCH_NO;
+
+	  ap->expr->ts = ap->expr->symtree->n.sym->ts;
+	}
+
+	/* Assumed character length will not reduce to a constant expression
+	   with LEN, as required by the standard.  */
+	if (i == 5 && not_restricted
+	    && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER
+	    && (ap->expr->symtree->n.sym->ts.u.cl->length == NULL
+		|| ap->expr->symtree->n.sym->ts.deferred))
+	  {
+	    gfc_error ("Assumed or deferred character length variable '%s' "
+			" in constant expression at %L",
+			ap->expr->symtree->n.sym->name,
+			&ap->expr->where);
+	      return MATCH_ERROR;
+	  }
+	else if (not_restricted && check_init_expr (ap->expr) == FAILURE)
+	  return MATCH_ERROR;
+
+	if (not_restricted == 0
+	      && ap->expr->expr_type != EXPR_VARIABLE
+	      && check_restricted (ap->expr) == FAILURE)
+	  return MATCH_ERROR;
+
+	if (not_restricted == 0
+	    && ap->expr->expr_type == EXPR_VARIABLE
+	    && ap->expr->symtree->n.sym->attr.dummy
+	    && ap->expr->symtree->n.sym->attr.optional)
+	  return MATCH_NO;
+    }
+
+  return MATCH_YES;
+}
+
+
+/* F95, 7.1.6.1, Initialization expressions, (5)
+   F2003, 7.1.7 Initialization expression, (5)  */
+
+static match
+check_transformational (gfc_expr *e)
+{
+  static const char * const trans_func_f95[] = {
+    "repeat", "reshape", "selected_int_kind",
+    "selected_real_kind", "transfer", "trim", NULL
+  };
+
+  static const char * const trans_func_f2003[] =  {
+    "all", "any", "count", "dot_product", "matmul", "null", "pack",
+    "product", "repeat", "reshape", "selected_char_kind", "selected_int_kind",
+    "selected_real_kind", "spread", "sum", "transfer", "transpose",
+    "trim", "unpack", NULL
+  };
+
+  int i;
+  const char *name;
+  const char *const *functions;
+
+  if (!e->value.function.isym
+      || !e->value.function.isym->transformational)
+    return MATCH_NO;
+
+  name = e->symtree->n.sym->name;
+
+  functions = (gfc_option.allow_std & GFC_STD_F2003) 
+		? trans_func_f2003 : trans_func_f95;
+
+  /* NULL() is dealt with below.  */
+  if (strcmp ("null", name) == 0)
+    return MATCH_NO;
+
+  for (i = 0; functions[i]; i++)
+    if (strcmp (functions[i], name) == 0)
+       break;
+
+  if (functions[i] == NULL)
+    {
+      gfc_error("transformational intrinsic '%s' at %L is not permitted "
+		"in an initialization expression", name, &e->where);
+      return MATCH_ERROR;
+    }
+
+  return check_init_expr_arguments (e);
+}
+
+
+/* F95, 7.1.6.1, Initialization expressions, (6)
+   F2003, 7.1.7 Initialization expression, (6)  */
+
+static match
+check_null (gfc_expr *e)
+{
+  if (strcmp ("null", e->symtree->n.sym->name) != 0)
+    return MATCH_NO;
+
+  return check_init_expr_arguments (e);
+}
+
+
+static match
+check_elemental (gfc_expr *e)
+{
+  if (!e->value.function.isym
+      || !e->value.function.isym->elemental)
+    return MATCH_NO;
+
+  if (e->ts.type != BT_INTEGER
+      && e->ts.type != BT_CHARACTER
+      && gfc_notify_std (GFC_STD_F2003, "Extension: Evaluation of "
+			"nonstandard initialization expression at %L",
+			&e->where) == FAILURE)
+    return MATCH_ERROR;
+
+  return check_init_expr_arguments (e);
+}
+
+
+static match
+check_conversion (gfc_expr *e)
+{
+  if (!e->value.function.isym
+      || !e->value.function.isym->conversion)
+    return MATCH_NO;
+
+  return check_init_expr_arguments (e);
+}
+
+
+/* Verify that an expression is an initialization expression.  A side
+   effect is that the expression tree is reduced to a single constant
+   node if all goes well.  This would normally happen when the
+   expression is constructed but function references are assumed to be
+   intrinsics in the context of initialization expressions.  If
+   FAILURE is returned an error message has been generated.  */
+
+static gfc_try
+check_init_expr (gfc_expr *e)
+{
+  match m;
+  gfc_try t;
+
+  if (e == NULL)
+    return SUCCESS;
+
+  switch (e->expr_type)
+    {
+    case EXPR_OP:
+      t = check_intrinsic_op (e, check_init_expr);
+      if (t == SUCCESS)
+	t = gfc_simplify_expr (e, 0);
+
+      break;
+
+    case EXPR_FUNCTION:
+      t = FAILURE;
+
+      {
+	gfc_intrinsic_sym* isym;
+	gfc_symbol* sym;
+
+	sym = e->symtree->n.sym;
+	if (!gfc_is_intrinsic (sym, 0, e->where)
+	    || (m = gfc_intrinsic_func_interface (e, 0)) != MATCH_YES)
+	  {
+	    gfc_error ("Function '%s' in initialization expression at %L "
+		       "must be an intrinsic function",
+		       e->symtree->n.sym->name, &e->where);
+	    break;
+	  }
+
+	if ((m = check_conversion (e)) == MATCH_NO
+	    && (m = check_inquiry (e, 1)) == MATCH_NO
+	    && (m = check_null (e)) == MATCH_NO
+	    && (m = check_transformational (e)) == MATCH_NO
+	    && (m = check_elemental (e)) == MATCH_NO)
+	  {
+	    gfc_error ("Intrinsic function '%s' at %L is not permitted "
+		       "in an initialization expression",
+		       e->symtree->n.sym->name, &e->where);
+	    m = MATCH_ERROR;
+	  }
+
+	if (m == MATCH_ERROR)
+	  return FAILURE;
+
+	/* Try to scalarize an elemental intrinsic function that has an
+	   array argument.  */
+	isym = gfc_find_function (e->symtree->n.sym->name);
+	if (isym && isym->elemental
+	    && (t = scalarize_intrinsic_call (e)) == SUCCESS)
+	  break;
+      }
+
+      if (m == MATCH_YES)
+	t = gfc_simplify_expr (e, 0);
+
+      break;
+
+    case EXPR_VARIABLE:
+      t = SUCCESS;
+
+      if (gfc_check_iter_variable (e) == SUCCESS)
+	break;
+
+      if (e->symtree->n.sym->attr.flavor == FL_PARAMETER)
+	{
+	  /* A PARAMETER shall not be used to define itself, i.e.
+		REAL, PARAMETER :: x = transfer(0, x)
+	     is invalid.  */
+	  if (!e->symtree->n.sym->value)
+	    {
+	      gfc_error("PARAMETER '%s' is used at %L before its definition "
+			"is complete", e->symtree->n.sym->name, &e->where);
+	      t = FAILURE;
+	    }
+	  else
+	    t = simplify_parameter_variable (e, 0);
+
+	  break;
+	}
+
+      if (gfc_in_match_data ())
+	break;
+
+      t = FAILURE;
+
+      if (e->symtree->n.sym->as)
+	{
+	  switch (e->symtree->n.sym->as->type)
+	    {
+	      case AS_ASSUMED_SIZE:
+		gfc_error ("Assumed size array '%s' at %L is not permitted "
+			   "in an initialization expression",
+			   e->symtree->n.sym->name, &e->where);
+		break;
+
+	      case AS_ASSUMED_SHAPE:
+		gfc_error ("Assumed shape array '%s' at %L is not permitted "
+			   "in an initialization expression",
+			   e->symtree->n.sym->name, &e->where);
+		break;
+
+	      case AS_DEFERRED:
+		gfc_error ("Deferred array '%s' at %L is not permitted "
+			   "in an initialization expression",
+			   e->symtree->n.sym->name, &e->where);
+		break;
+
+	      case AS_EXPLICIT:
+		gfc_error ("Array '%s' at %L is a variable, which does "
+			   "not reduce to a constant expression",
+			   e->symtree->n.sym->name, &e->where);
+		break;
+
+	      default:
+		gcc_unreachable();
+	  }
+	}
+      else
+	gfc_error ("Parameter '%s' at %L has not been declared or is "
+		   "a variable, which does not reduce to a constant "
+		   "expression", e->symtree->n.sym->name, &e->where);
+
+      break;
+
+    case EXPR_CONSTANT:
+    case EXPR_NULL:
+      t = SUCCESS;
+      break;
+
+    case EXPR_SUBSTRING:
+      t = check_init_expr (e->ref->u.ss.start);
+      if (t == FAILURE)
+	break;
+
+      t = check_init_expr (e->ref->u.ss.end);
+      if (t == SUCCESS)
+	t = gfc_simplify_expr (e, 0);
+
+      break;
+
+    case EXPR_STRUCTURE:
+      t = e->ts.is_iso_c ? SUCCESS : FAILURE;
+      if (t == SUCCESS)
+	break;
+
+      t = check_alloc_comp_init (e);
+      if (t == FAILURE)
+	break;
+
+      t = gfc_check_constructor (e, check_init_expr);
+      if (t == FAILURE)
+	break;
+
+      break;
+
+    case EXPR_ARRAY:
+      t = gfc_check_constructor (e, check_init_expr);
+      if (t == FAILURE)
+	break;
+
+      t = gfc_expand_constructor (e, true);
+      if (t == FAILURE)
+	break;
+
+      t = gfc_check_constructor_type (e);
+      break;
+
+    default:
+      gfc_internal_error ("check_init_expr(): Unknown expression type");
+    }
+
+  return t;
+}
+
+/* Reduces a general expression to an initialization expression (a constant).
+   This used to be part of gfc_match_init_expr.
+   Note that this function doesn't free the given expression on FAILURE.  */
+
+gfc_try
+gfc_reduce_init_expr (gfc_expr *expr)
+{
+  gfc_try t;
+
+  gfc_init_expr_flag = true;
+  t = gfc_resolve_expr (expr);
+  if (t == SUCCESS)
+    t = check_init_expr (expr);
+  gfc_init_expr_flag = false;
+
+  if (t == FAILURE)
+    return FAILURE;
+
+  if (expr->expr_type == EXPR_ARRAY)
+    {
+      if (gfc_check_constructor_type (expr) == FAILURE)
+	return FAILURE;
+      if (gfc_expand_constructor (expr, true) == FAILURE)
+	return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Match an initialization expression.  We work by first matching an
+   expression, then reducing it to a constant.  */
+
+match
+gfc_match_init_expr (gfc_expr **result)
+{
+  gfc_expr *expr;
+  match m;
+  gfc_try t;
+
+  expr = NULL;
+
+  gfc_init_expr_flag = true;
+
+  m = gfc_match_expr (&expr);
+  if (m != MATCH_YES)
+    {
+      gfc_init_expr_flag = false;
+      return m;
+    }
+
+  t = gfc_reduce_init_expr (expr);
+  if (t != SUCCESS)
+    {
+      gfc_free_expr (expr);
+      gfc_init_expr_flag = false;
+      return MATCH_ERROR;
+    }
+
+  *result = expr;
+  gfc_init_expr_flag = false;
+
+  return MATCH_YES;
+}
+
+
+/* Given an actual argument list, test to see that each argument is a
+   restricted expression and optionally if the expression type is
+   integer or character.  */
+
+static gfc_try
+restricted_args (gfc_actual_arglist *a)
+{
+  for (; a; a = a->next)
+    {
+      if (check_restricted (a->expr) == FAILURE)
+	return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/************* Restricted/specification expressions *************/
+
+
+/* Make sure a non-intrinsic function is a specification function.  */
+
+static gfc_try
+external_spec_function (gfc_expr *e)
+{
+  gfc_symbol *f;
+
+  f = e->value.function.esym;
+
+  if (f->attr.proc == PROC_ST_FUNCTION)
+    {
+      gfc_error ("Specification function '%s' at %L cannot be a statement "
+		 "function", f->name, &e->where);
+      return FAILURE;
+    }
+
+  if (f->attr.proc == PROC_INTERNAL)
+    {
+      gfc_error ("Specification function '%s' at %L cannot be an internal "
+		 "function", f->name, &e->where);
+      return FAILURE;
+    }
+
+  if (!f->attr.pure && !f->attr.elemental)
+    {
+      gfc_error ("Specification function '%s' at %L must be PURE", f->name,
+		 &e->where);
+      return FAILURE;
+    }
+
+  if (f->attr.recursive)
+    {
+      gfc_error ("Specification function '%s' at %L cannot be RECURSIVE",
+		 f->name, &e->where);
+      return FAILURE;
+    }
+
+  return restricted_args (e->value.function.actual);
+}
+
+
+/* Check to see that a function reference to an intrinsic is a
+   restricted expression.  */
+
+static gfc_try
+restricted_intrinsic (gfc_expr *e)
+{
+  /* TODO: Check constraints on inquiry functions.  7.1.6.2 (7).  */
+  if (check_inquiry (e, 0) == MATCH_YES)
+    return SUCCESS;
+
+  return restricted_args (e->value.function.actual);
+}
+
+
+/* Check the expressions of an actual arglist.  Used by check_restricted.  */
+
+static gfc_try
+check_arglist (gfc_actual_arglist* arg, gfc_try (*checker) (gfc_expr*))
+{
+  for (; arg; arg = arg->next)
+    if (checker (arg->expr) == FAILURE)
+      return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Check the subscription expressions of a reference chain with a checking
+   function; used by check_restricted.  */
+
+static gfc_try
+check_references (gfc_ref* ref, gfc_try (*checker) (gfc_expr*))
+{
+  int dim;
+
+  if (!ref)
+    return SUCCESS;
+
+  switch (ref->type)
+    {
+    case REF_ARRAY:
+      for (dim = 0; dim != ref->u.ar.dimen; ++dim)
+	{
+	  if (checker (ref->u.ar.start[dim]) == FAILURE)
+	    return FAILURE;
+	  if (checker (ref->u.ar.end[dim]) == FAILURE)
+	    return FAILURE;
+	  if (checker (ref->u.ar.stride[dim]) == FAILURE)
+	    return FAILURE;
+	}
+      break;
+
+    case REF_COMPONENT:
+      /* Nothing needed, just proceed to next reference.  */
+      break;
+
+    case REF_SUBSTRING:
+      if (checker (ref->u.ss.start) == FAILURE)
+	return FAILURE;
+      if (checker (ref->u.ss.end) == FAILURE)
+	return FAILURE;
+      break;
+
+    default:
+      gcc_unreachable ();
+      break;
+    }
+
+  return check_references (ref->next, checker);
+}
+
+
+/* Verify that an expression is a restricted expression.  Like its
+   cousin check_init_expr(), an error message is generated if we
+   return FAILURE.  */
+
+static gfc_try
+check_restricted (gfc_expr *e)
+{
+  gfc_symbol* sym;
+  gfc_try t;
+
+  if (e == NULL)
+    return SUCCESS;
+
+  switch (e->expr_type)
+    {
+    case EXPR_OP:
+      t = check_intrinsic_op (e, check_restricted);
+      if (t == SUCCESS)
+	t = gfc_simplify_expr (e, 0);
+
+      break;
+
+    case EXPR_FUNCTION:
+      if (e->value.function.esym)
+	{
+	  t = check_arglist (e->value.function.actual, &check_restricted);
+	  if (t == SUCCESS)
+	    t = external_spec_function (e);
+	}
+      else
+	{
+	  if (e->value.function.isym && e->value.function.isym->inquiry)
+	    t = SUCCESS;
+	  else
+	    t = check_arglist (e->value.function.actual, &check_restricted);
+
+	  if (t == SUCCESS)
+	    t = restricted_intrinsic (e);
+	}
+      break;
+
+    case EXPR_VARIABLE:
+      sym = e->symtree->n.sym;
+      t = FAILURE;
+
+      /* If a dummy argument appears in a context that is valid for a
+	 restricted expression in an elemental procedure, it will have
+	 already been simplified away once we get here.  Therefore we
+	 don't need to jump through hoops to distinguish valid from
+	 invalid cases.  */
+      if (sym->attr.dummy && sym->ns == gfc_current_ns
+	  && sym->ns->proc_name && sym->ns->proc_name->attr.elemental)
+	{
+	  gfc_error ("Dummy argument '%s' not allowed in expression at %L",
+		     sym->name, &e->where);
+	  break;
+	}
+
+      if (sym->attr.optional)
+	{
+	  gfc_error ("Dummy argument '%s' at %L cannot be OPTIONAL",
+		     sym->name, &e->where);
+	  break;
+	}
+
+      if (sym->attr.intent == INTENT_OUT)
+	{
+	  gfc_error ("Dummy argument '%s' at %L cannot be INTENT(OUT)",
+		     sym->name, &e->where);
+	  break;
+	}
+
+      /* Check reference chain if any.  */
+      if (check_references (e->ref, &check_restricted) == FAILURE)
+	break;
+
+      /* gfc_is_formal_arg broadcasts that a formal argument list is being
+	 processed in resolve.c(resolve_formal_arglist).  This is done so
+	 that host associated dummy array indices are accepted (PR23446).
+	 This mechanism also does the same for the specification expressions
+	 of array-valued functions.  */
+      if (e->error
+	    || sym->attr.in_common
+	    || sym->attr.use_assoc
+	    || sym->attr.dummy
+	    || sym->attr.implied_index
+	    || sym->attr.flavor == FL_PARAMETER
+	    || (sym->ns && sym->ns == gfc_current_ns->parent)
+	    || (sym->ns && gfc_current_ns->parent
+		  && sym->ns == gfc_current_ns->parent->parent)
+	    || (sym->ns->proc_name != NULL
+		  && sym->ns->proc_name->attr.flavor == FL_MODULE)
+	    || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns)))
+	{
+	  t = SUCCESS;
+	  break;
+	}
+
+      gfc_error ("Variable '%s' cannot appear in the expression at %L",
+		 sym->name, &e->where);
+      /* Prevent a repetition of the error.  */
+      e->error = 1;
+      break;
+
+    case EXPR_NULL:
+    case EXPR_CONSTANT:
+      t = SUCCESS;
+      break;
+
+    case EXPR_SUBSTRING:
+      t = gfc_specification_expr (e->ref->u.ss.start);
+      if (t == FAILURE)
+	break;
+
+      t = gfc_specification_expr (e->ref->u.ss.end);
+      if (t == SUCCESS)
+	t = gfc_simplify_expr (e, 0);
+
+      break;
+
+    case EXPR_STRUCTURE:
+      t = gfc_check_constructor (e, check_restricted);
+      break;
+
+    case EXPR_ARRAY:
+      t = gfc_check_constructor (e, check_restricted);
+      break;
+
+    default:
+      gfc_internal_error ("check_restricted(): Unknown expression type");
+    }
+
+  return t;
+}
+
+
+/* Check to see that an expression is a specification expression.  If
+   we return FAILURE, an error has been generated.  */
+
+gfc_try
+gfc_specification_expr (gfc_expr *e)
+{
+  gfc_component *comp;
+
+  if (e == NULL)
+    return SUCCESS;
+
+  if (e->ts.type != BT_INTEGER)
+    {
+      gfc_error ("Expression at %L must be of INTEGER type, found %s",
+		 &e->where, gfc_basic_typename (e->ts.type));
+      return FAILURE;
+    }
+
+  if (e->expr_type == EXPR_FUNCTION
+	  && !e->value.function.isym
+	  && !e->value.function.esym
+	  && !gfc_pure (e->symtree->n.sym)
+	  && (!gfc_is_proc_ptr_comp (e, &comp)
+	      || !comp->attr.pure))
+    {
+      gfc_error ("Function '%s' at %L must be PURE",
+		 e->symtree->n.sym->name, &e->where);
+      /* Prevent repeat error messages.  */
+      e->symtree->n.sym->attr.pure = 1;
+      return FAILURE;
+    }
+
+  if (e->rank != 0)
+    {
+      gfc_error ("Expression at %L must be scalar", &e->where);
+      return FAILURE;
+    }
+
+  if (gfc_simplify_expr (e, 0) == FAILURE)
+    return FAILURE;
+
+  return check_restricted (e);
+}
+
+
+/************** Expression conformance checks.  *************/
+
+/* Given two expressions, make sure that the arrays are conformable.  */
+
+gfc_try
+gfc_check_conformance (gfc_expr *op1, gfc_expr *op2, const char *optype_msgid, ...)
+{
+  int op1_flag, op2_flag, d;
+  mpz_t op1_size, op2_size;
+  gfc_try t;
+
+  va_list argp;
+  char buffer[240];
+
+  if (op1->rank == 0 || op2->rank == 0)
+    return SUCCESS;
+
+  va_start (argp, optype_msgid);
+  vsnprintf (buffer, 240, optype_msgid, argp);
+  va_end (argp);
+
+  if (op1->rank != op2->rank)
+    {
+      gfc_error ("Incompatible ranks in %s (%d and %d) at %L", _(buffer),
+		 op1->rank, op2->rank, &op1->where);
+      return FAILURE;
+    }
+
+  t = SUCCESS;
+
+  for (d = 0; d < op1->rank; d++)
+    {
+      op1_flag = gfc_array_dimen_size (op1, d, &op1_size) == SUCCESS;
+      op2_flag = gfc_array_dimen_size (op2, d, &op2_size) == SUCCESS;
+
+      if (op1_flag && op2_flag && mpz_cmp (op1_size, op2_size) != 0)
+	{
+	  gfc_error ("Different shape for %s at %L on dimension %d "
+		     "(%d and %d)", _(buffer), &op1->where, d + 1,
+		     (int) mpz_get_si (op1_size),
+		     (int) mpz_get_si (op2_size));
+
+	  t = FAILURE;
+	}
+
+      if (op1_flag)
+	mpz_clear (op1_size);
+      if (op2_flag)
+	mpz_clear (op2_size);
+
+      if (t == FAILURE)
+	return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Given an assignable expression and an arbitrary expression, make
+   sure that the assignment can take place.  */
+
+gfc_try
+gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
+{
+  gfc_symbol *sym;
+  gfc_ref *ref;
+  int has_pointer;
+
+  sym = lvalue->symtree->n.sym;
+
+  /* See if this is the component or subcomponent of a pointer.  */
+  has_pointer = sym->attr.pointer;
+  for (ref = lvalue->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
+      {
+	has_pointer = 1;
+	break;
+      }
+
+  /* 12.5.2.2, Note 12.26: The result variable is very similar to any other
+     variable local to a function subprogram.  Its existence begins when
+     execution of the function is initiated and ends when execution of the
+     function is terminated...
+     Therefore, the left hand side is no longer a variable, when it is:  */
+  if (sym->attr.flavor == FL_PROCEDURE && sym->attr.proc != PROC_ST_FUNCTION
+      && !sym->attr.external)
+    {
+      bool bad_proc;
+      bad_proc = false;
+
+      /* (i) Use associated;  */
+      if (sym->attr.use_assoc)
+	bad_proc = true;
+
+      /* (ii) The assignment is in the main program; or  */
+      if (gfc_current_ns->proc_name->attr.is_main_program)
+	bad_proc = true;
+
+      /* (iii) A module or internal procedure...  */
+      if ((gfc_current_ns->proc_name->attr.proc == PROC_INTERNAL
+	   || gfc_current_ns->proc_name->attr.proc == PROC_MODULE)
+	  && gfc_current_ns->parent
+	  && (!(gfc_current_ns->parent->proc_name->attr.function
+		|| gfc_current_ns->parent->proc_name->attr.subroutine)
+	      || gfc_current_ns->parent->proc_name->attr.is_main_program))
+	{
+	  /* ... that is not a function...  */ 
+	  if (!gfc_current_ns->proc_name->attr.function)
+	    bad_proc = true;
+
+	  /* ... or is not an entry and has a different name.  */
+	  if (!sym->attr.entry && sym->name != gfc_current_ns->proc_name->name)
+	    bad_proc = true;
+	}
+
+      /* (iv) Host associated and not the function symbol or the
+	      parent result.  This picks up sibling references, which
+	      cannot be entries.  */
+      if (!sym->attr.entry
+	    && sym->ns == gfc_current_ns->parent
+	    && sym != gfc_current_ns->proc_name
+	    && sym != gfc_current_ns->parent->proc_name->result)
+	bad_proc = true;
+
+      if (bad_proc)
+	{
+	  gfc_error ("'%s' at %L is not a VALUE", sym->name, &lvalue->where);
+	  return FAILURE;
+	}
+    }
+
+  if (rvalue->rank != 0 && lvalue->rank != rvalue->rank)
+    {
+      gfc_error ("Incompatible ranks %d and %d in assignment at %L",
+		 lvalue->rank, rvalue->rank, &lvalue->where);
+      return FAILURE;
+    }
+
+  if (lvalue->ts.type == BT_UNKNOWN)
+    {
+      gfc_error ("Variable type is UNKNOWN in assignment at %L",
+		 &lvalue->where);
+      return FAILURE;
+    }
+
+  if (rvalue->expr_type == EXPR_NULL)
+    {  
+      if (has_pointer && (ref == NULL || ref->next == NULL)
+	  && lvalue->symtree->n.sym->attr.data)
+        return SUCCESS;
+      else
+	{
+	  gfc_error ("NULL appears on right-hand side in assignment at %L",
+		     &rvalue->where);
+	  return FAILURE;
+	}
+    }
+
+  /* This is possibly a typo: x = f() instead of x => f().  */
+  if (gfc_option.warn_surprising 
+      && rvalue->expr_type == EXPR_FUNCTION
+      && rvalue->symtree->n.sym->attr.pointer)
+    gfc_warning ("POINTER valued function appears on right-hand side of "
+		 "assignment at %L", &rvalue->where);
+
+  /* Check size of array assignments.  */
+  if (lvalue->rank != 0 && rvalue->rank != 0
+      && gfc_check_conformance (lvalue, rvalue, "array assignment") != SUCCESS)
+    return FAILURE;
+
+  if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER
+      && lvalue->symtree->n.sym->attr.data
+      && gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L used to "
+                         "initialize non-integer variable '%s'",
+			 &rvalue->where, lvalue->symtree->n.sym->name)
+	 == FAILURE)
+    return FAILURE;
+  else if (rvalue->is_boz && !lvalue->symtree->n.sym->attr.data
+      && gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L outside "
+			 "a DATA statement and outside INT/REAL/DBLE/CMPLX",
+			 &rvalue->where) == FAILURE)
+    return FAILURE;
+
+  /* Handle the case of a BOZ literal on the RHS.  */
+  if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER)
+    {
+      int rc;
+      if (gfc_option.warn_surprising)
+        gfc_warning ("BOZ literal at %L is bitwise transferred "
+                     "non-integer symbol '%s'", &rvalue->where,
+                     lvalue->symtree->n.sym->name);
+      if (!gfc_convert_boz (rvalue, &lvalue->ts))
+	return FAILURE;
+      if ((rc = gfc_range_check (rvalue)) != ARITH_OK)
+	{
+	  if (rc == ARITH_UNDERFLOW)
+	    gfc_error ("Arithmetic underflow of bit-wise transferred BOZ at %L"
+		       ". This check can be disabled with the option "
+		       "-fno-range-check", &rvalue->where);
+	  else if (rc == ARITH_OVERFLOW)
+	    gfc_error ("Arithmetic overflow of bit-wise transferred BOZ at %L"
+		       ". This check can be disabled with the option "
+		       "-fno-range-check", &rvalue->where);
+	  else if (rc == ARITH_NAN)
+	    gfc_error ("Arithmetic NaN of bit-wise transferred BOZ at %L"
+		       ". This check can be disabled with the option "
+		       "-fno-range-check", &rvalue->where);
+	  return FAILURE;
+	}
+    }
+
+  if (gfc_compare_types (&lvalue->ts, &rvalue->ts))
+    return SUCCESS;
+
+  /* Only DATA Statements come here.  */
+  if (!conform)
+    {
+      /* Numeric can be converted to any other numeric. And Hollerith can be
+	 converted to any other type.  */
+      if ((gfc_numeric_ts (&lvalue->ts) && gfc_numeric_ts (&rvalue->ts))
+	  || rvalue->ts.type == BT_HOLLERITH)
+	return SUCCESS;
+
+      if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL)
+	return SUCCESS;
+
+      gfc_error ("Incompatible types in DATA statement at %L; attempted "
+		 "conversion of %s to %s", &lvalue->where,
+		 gfc_typename (&rvalue->ts), gfc_typename (&lvalue->ts));
+
+      return FAILURE;
+    }
+
+  /* Assignment is the only case where character variables of different
+     kind values can be converted into one another.  */
+  if (lvalue->ts.type == BT_CHARACTER && rvalue->ts.type == BT_CHARACTER)
+    {
+      if (lvalue->ts.kind != rvalue->ts.kind)
+	gfc_convert_chartype (rvalue, &lvalue->ts);
+
+      return SUCCESS;
+    }
+
+  return gfc_convert_type (rvalue, &lvalue->ts, 1);
+}
+
+
+/* Check that a pointer assignment is OK.  We first check lvalue, and
+   we only check rvalue if it's not an assignment to NULL() or a
+   NULLIFY statement.  */
+
+gfc_try
+gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
+{
+  symbol_attribute attr;
+  gfc_ref *ref;
+  bool is_pure, is_implicit_pure, rank_remap;
+  int proc_pointer;
+
+  if (lvalue->symtree->n.sym->ts.type == BT_UNKNOWN
+      && !lvalue->symtree->n.sym->attr.proc_pointer)
+    {
+      gfc_error ("Pointer assignment target is not a POINTER at %L",
+		 &lvalue->where);
+      return FAILURE;
+    }
+
+  if (lvalue->symtree->n.sym->attr.flavor == FL_PROCEDURE
+      && lvalue->symtree->n.sym->attr.use_assoc
+      && !lvalue->symtree->n.sym->attr.proc_pointer)
+    {
+      gfc_error ("'%s' in the pointer assignment at %L cannot be an "
+		 "l-value since it is a procedure",
+		 lvalue->symtree->n.sym->name, &lvalue->where);
+      return FAILURE;
+    }
+
+  proc_pointer = lvalue->symtree->n.sym->attr.proc_pointer;
+
+  rank_remap = false;
+  for (ref = lvalue->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_COMPONENT)
+	proc_pointer = ref->u.c.component->attr.proc_pointer;
+
+      if (ref->type == REF_ARRAY && ref->next == NULL)
+	{
+	  int dim;
+
+	  if (ref->u.ar.type == AR_FULL)
+	    break;
+
+	  if (ref->u.ar.type != AR_SECTION)
+	    {
+	      gfc_error ("Expected bounds specification for '%s' at %L",
+			 lvalue->symtree->n.sym->name, &lvalue->where);
+	      return FAILURE;
+	    }
+
+	  if (gfc_notify_std (GFC_STD_F2003,"Fortran 2003: Bounds "
+			      "specification for '%s' in pointer assignment "
+			      "at %L", lvalue->symtree->n.sym->name,
+			      &lvalue->where) == FAILURE)
+	    return FAILURE;
+
+	  /* When bounds are given, all lbounds are necessary and either all
+	     or none of the upper bounds; no strides are allowed.  If the
+	     upper bounds are present, we may do rank remapping.  */
+	  for (dim = 0; dim < ref->u.ar.dimen; ++dim)
+	    {
+	      if (!ref->u.ar.start[dim])
+		{
+		  gfc_error ("Lower bound has to be present at %L",
+			     &lvalue->where);
+		  return FAILURE;
+		}
+	      if (ref->u.ar.stride[dim])
+		{
+		  gfc_error ("Stride must not be present at %L",
+			     &lvalue->where);
+		  return FAILURE;
+		}
+
+	      if (dim == 0)
+		rank_remap = (ref->u.ar.end[dim] != NULL);
+	      else
+		{
+		  if ((rank_remap && !ref->u.ar.end[dim])
+		      || (!rank_remap && ref->u.ar.end[dim]))
+		    {
+		      gfc_error ("Either all or none of the upper bounds"
+				 " must be specified at %L", &lvalue->where);
+		      return FAILURE;
+		    }
+		}
+	    }
+	}
+    }
+
+  is_pure = gfc_pure (NULL);
+  is_implicit_pure = gfc_implicit_pure (NULL);
+
+  /* If rvalue is a NULL() or NULLIFY, we're done. Otherwise the type,
+     kind, etc for lvalue and rvalue must match, and rvalue must be a
+     pure variable if we're in a pure function.  */
+  if (rvalue->expr_type == EXPR_NULL && rvalue->ts.type == BT_UNKNOWN)
+    return SUCCESS;
+
+  /* F2008, C723 (pointer) and C726 (proc-pointer); for PURE also C1283.  */
+  if (lvalue->expr_type == EXPR_VARIABLE
+      && gfc_is_coindexed (lvalue))
+    {
+      gfc_ref *ref;
+      for (ref = lvalue->ref; ref; ref = ref->next)
+	if (ref->type == REF_ARRAY && ref->u.ar.codimen)
+	  {
+	    gfc_error ("Pointer object at %L shall not have a coindex",
+		       &lvalue->where);
+	    return FAILURE;
+	  }
+    }
+
+  /* Checks on rvalue for procedure pointer assignments.  */
+  if (proc_pointer)
+    {
+      char err[200];
+      gfc_symbol *s1,*s2;
+      gfc_component *comp;
+      const char *name;
+
+      attr = gfc_expr_attr (rvalue);
+      if (!((rvalue->expr_type == EXPR_NULL)
+	    || (rvalue->expr_type == EXPR_FUNCTION && attr.proc_pointer)
+	    || (rvalue->expr_type == EXPR_VARIABLE && attr.proc_pointer)
+	    || (rvalue->expr_type == EXPR_VARIABLE
+		&& attr.flavor == FL_PROCEDURE)))
+	{
+	  gfc_error ("Invalid procedure pointer assignment at %L",
+		     &rvalue->where);
+	  return FAILURE;
+	}
+      if (attr.abstract)
+	{
+	  gfc_error ("Abstract interface '%s' is invalid "
+		     "in procedure pointer assignment at %L",
+		     rvalue->symtree->name, &rvalue->where);
+	  return FAILURE;
+	}
+      /* Check for C727.  */
+      if (attr.flavor == FL_PROCEDURE)
+	{
+	  if (attr.proc == PROC_ST_FUNCTION)
+	    {
+	      gfc_error ("Statement function '%s' is invalid "
+			 "in procedure pointer assignment at %L",
+			 rvalue->symtree->name, &rvalue->where);
+	      return FAILURE;
+	    }
+	  if (attr.proc == PROC_INTERNAL &&
+	      gfc_notify_std (GFC_STD_F2008, "Internal procedure '%s' is "
+			      "invalid in procedure pointer assignment at %L",
+			      rvalue->symtree->name, &rvalue->where) == FAILURE)
+	    return FAILURE;
+	}
+
+      /* Ensure that the calling convention is the same. As other attributes
+	 such as DLLEXPORT may differ, one explicitly only tests for the
+	 calling conventions.  */
+      if (rvalue->expr_type == EXPR_VARIABLE
+	  && lvalue->symtree->n.sym->attr.ext_attr
+	       != rvalue->symtree->n.sym->attr.ext_attr)
+	{
+	  symbol_attribute calls;
+
+	  calls.ext_attr = 0;
+	  gfc_add_ext_attribute (&calls, EXT_ATTR_CDECL, NULL);
+	  gfc_add_ext_attribute (&calls, EXT_ATTR_STDCALL, NULL);
+	  gfc_add_ext_attribute (&calls, EXT_ATTR_FASTCALL, NULL);
+
+	  if ((calls.ext_attr & lvalue->symtree->n.sym->attr.ext_attr)
+	      != (calls.ext_attr & rvalue->symtree->n.sym->attr.ext_attr))
+	    {
+	      gfc_error ("Mismatch in the procedure pointer assignment "
+			 "at %L: mismatch in the calling convention",
+			 &rvalue->where);
+	  return FAILURE;
+	    }
+	}
+
+      if (gfc_is_proc_ptr_comp (lvalue, &comp))
+	s1 = comp->ts.interface;
+      else
+	s1 = lvalue->symtree->n.sym;
+
+      if (gfc_is_proc_ptr_comp (rvalue, &comp))
+	{
+	  s2 = comp->ts.interface;
+	  name = comp->name;
+	}
+      else if (rvalue->expr_type == EXPR_FUNCTION)
+	{
+	  s2 = rvalue->symtree->n.sym->result;
+	  name = rvalue->symtree->n.sym->result->name;
+	}
+      else
+	{
+	  s2 = rvalue->symtree->n.sym;
+	  name = rvalue->symtree->n.sym->name;
+	}
+
+      if (s1 && s2 && !gfc_compare_interfaces (s1, s2, name, 0, 1,
+					       err, sizeof(err)))
+	{
+	  gfc_error ("Interface mismatch in procedure pointer assignment "
+		     "at %L: %s", &rvalue->where, err);
+	  return FAILURE;
+	}
+
+      return SUCCESS;
+    }
+
+  if (!gfc_compare_types (&lvalue->ts, &rvalue->ts))
+    {
+      gfc_error ("Different types in pointer assignment at %L; attempted "
+		 "assignment of %s to %s", &lvalue->where, 
+		 gfc_typename (&rvalue->ts), gfc_typename (&lvalue->ts));
+      return FAILURE;
+    }
+
+  if (lvalue->ts.type != BT_CLASS && lvalue->ts.kind != rvalue->ts.kind)
+    {
+      gfc_error ("Different kind type parameters in pointer "
+		 "assignment at %L", &lvalue->where);
+      return FAILURE;
+    }
+
+  if (lvalue->rank != rvalue->rank && !rank_remap)
+    {
+      gfc_error ("Different ranks in pointer assignment at %L", &lvalue->where);
+      return FAILURE;
+    }
+
+  if (lvalue->ts.type == BT_CLASS && rvalue->ts.type == BT_DERIVED)
+    /* Make sure the vtab is present.  */
+    gfc_find_derived_vtab (rvalue->ts.u.derived);
+
+  /* Check rank remapping.  */
+  if (rank_remap)
+    {
+      mpz_t lsize, rsize;
+
+      /* If this can be determined, check that the target must be at least as
+	 large as the pointer assigned to it is.  */
+      if (gfc_array_size (lvalue, &lsize) == SUCCESS
+	  && gfc_array_size (rvalue, &rsize) == SUCCESS
+	  && mpz_cmp (rsize, lsize) < 0)
+	{
+	  gfc_error ("Rank remapping target is smaller than size of the"
+		     " pointer (%ld < %ld) at %L",
+		     mpz_get_si (rsize), mpz_get_si (lsize),
+		     &lvalue->where);
+	  return FAILURE;
+	}
+
+      /* The target must be either rank one or it must be simply contiguous
+	 and F2008 must be allowed.  */
+      if (rvalue->rank != 1)
+	{
+	  if (!gfc_is_simply_contiguous (rvalue, true))
+	    {
+	      gfc_error ("Rank remapping target must be rank 1 or"
+			 " simply contiguous at %L", &rvalue->where);
+	      return FAILURE;
+	    }
+	  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Rank remapping"
+			      " target is not rank 1 at %L", &rvalue->where)
+		== FAILURE)
+	    return FAILURE;
+	}
+    }
+
+  /* Now punt if we are dealing with a NULLIFY(X) or X = NULL(X).  */
+  if (rvalue->expr_type == EXPR_NULL)
+    return SUCCESS;
+
+  if (lvalue->ts.type == BT_CHARACTER)
+    {
+      gfc_try t = gfc_check_same_strlen (lvalue, rvalue, "pointer assignment");
+      if (t == FAILURE)
+	return FAILURE;
+    }
+
+  if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue))
+    lvalue->symtree->n.sym->attr.subref_array_pointer = 1;
+
+  attr = gfc_expr_attr (rvalue);
+
+  if (rvalue->expr_type == EXPR_FUNCTION && !attr.pointer)
+    {
+      gfc_error ("Target expression in pointer assignment "
+		 "at %L must deliver a pointer result",
+		 &rvalue->where);
+      return FAILURE;
+    }
+
+  if (!attr.target && !attr.pointer)
+    {
+      gfc_error ("Pointer assignment target is neither TARGET "
+		 "nor POINTER at %L", &rvalue->where);
+      return FAILURE;
+    }
+
+  if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym))
+    {
+      gfc_error ("Bad target in pointer assignment in PURE "
+		 "procedure at %L", &rvalue->where);
+    }
+
+  if (is_implicit_pure && gfc_impure_variable (rvalue->symtree->n.sym))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+    
+
+  if (gfc_has_vector_index (rvalue))
+    {
+      gfc_error ("Pointer assignment with vector subscript "
+		 "on rhs at %L", &rvalue->where);
+      return FAILURE;
+    }
+
+  if (attr.is_protected && attr.use_assoc
+      && !(attr.pointer || attr.proc_pointer))
+    {
+      gfc_error ("Pointer assignment target has PROTECTED "
+		 "attribute at %L", &rvalue->where);
+      return FAILURE;
+    }
+
+  /* F2008, C725. For PURE also C1283.  */
+  if (rvalue->expr_type == EXPR_VARIABLE
+      && gfc_is_coindexed (rvalue))
+    {
+      gfc_ref *ref;
+      for (ref = rvalue->ref; ref; ref = ref->next)
+	if (ref->type == REF_ARRAY && ref->u.ar.codimen)
+	  {
+	    gfc_error ("Data target at %L shall not have a coindex",
+		       &rvalue->where);
+	    return FAILURE;
+	  }
+    }
+
+  return SUCCESS;
+}
+
+
+/* Relative of gfc_check_assign() except that the lvalue is a single
+   symbol.  Used for initialization assignments.  */
+
+gfc_try
+gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr *rvalue)
+{
+  gfc_expr lvalue;
+  gfc_try r;
+
+  memset (&lvalue, '\0', sizeof (gfc_expr));
+
+  lvalue.expr_type = EXPR_VARIABLE;
+  lvalue.ts = sym->ts;
+  if (sym->as)
+    lvalue.rank = sym->as->rank;
+  lvalue.symtree = (gfc_symtree *) gfc_getmem (sizeof (gfc_symtree));
+  lvalue.symtree->n.sym = sym;
+  lvalue.where = sym->declared_at;
+
+  if (sym->attr.pointer || sym->attr.proc_pointer
+      || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.class_pointer
+	  && rvalue->expr_type == EXPR_NULL))
+    r = gfc_check_pointer_assign (&lvalue, rvalue);
+  else
+    r = gfc_check_assign (&lvalue, rvalue, 1);
+
+  gfc_free (lvalue.symtree);
+
+  if (r == FAILURE)
+    return r;
+  
+  if (sym->attr.pointer && rvalue->expr_type != EXPR_NULL)
+    {
+      /* F08:C461. Additional checks for pointer initialization.  */
+      symbol_attribute attr;
+      attr = gfc_expr_attr (rvalue);
+      if (attr.allocatable)
+	{
+	  gfc_error ("Pointer initialization target at %C "
+	             "must not be ALLOCATABLE ");
+	  return FAILURE;
+	}
+      if (!attr.target || attr.pointer)
+	{
+	  gfc_error ("Pointer initialization target at %C "
+		     "must have the TARGET attribute");
+	  return FAILURE;
+	}
+      if (!attr.save)
+	{
+	  gfc_error ("Pointer initialization target at %C "
+		     "must have the SAVE attribute");
+	  return FAILURE;
+	}
+    }
+    
+  if (sym->attr.proc_pointer && rvalue->expr_type != EXPR_NULL)
+    {
+      /* F08:C1220. Additional checks for procedure pointer initialization.  */
+      symbol_attribute attr = gfc_expr_attr (rvalue);
+      if (attr.proc_pointer)
+	{
+	  gfc_error ("Procedure pointer initialization target at %L "
+		     "may not be a procedure pointer", &rvalue->where);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* Check for default initializer; sym->value is not enough
+   as it is also set for EXPR_NULL of allocatables.  */
+
+bool
+gfc_has_default_initializer (gfc_symbol *der)
+{
+  gfc_component *c;
+
+  gcc_assert (der->attr.flavor == FL_DERIVED);
+  for (c = der->components; c; c = c->next)
+    if (c->ts.type == BT_DERIVED)
+      {
+        if (!c->attr.pointer
+	     && gfc_has_default_initializer (c->ts.u.derived))
+	  return true;
+	if (c->attr.pointer && c->initializer)
+	  return true;
+      }
+    else
+      {
+        if (c->initializer)
+	  return true;
+      }
+
+  return false;
+}
+
+
+/* Get an expression for a default initializer.  */
+
+gfc_expr *
+gfc_default_initializer (gfc_typespec *ts)
+{
+  gfc_expr *init;
+  gfc_component *comp;
+
+  /* See if we have a default initializer in this, but not in nested
+     types (otherwise we could use gfc_has_default_initializer()).  */
+  for (comp = ts->u.derived->components; comp; comp = comp->next)
+    if (comp->initializer || comp->attr.allocatable
+	|| (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
+	    && CLASS_DATA (comp)->attr.allocatable))
+      break;
+
+  if (!comp)
+    return NULL;
+
+  init = gfc_get_structure_constructor_expr (ts->type, ts->kind,
+					     &ts->u.derived->declared_at);
+  init->ts = *ts;
+
+  for (comp = ts->u.derived->components; comp; comp = comp->next)
+    {
+      gfc_constructor *ctor = gfc_constructor_get();
+
+      if (comp->initializer)
+	ctor->expr = gfc_copy_expr (comp->initializer);
+
+      if (comp->attr.allocatable
+	  || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)->attr.allocatable))
+	{
+	  ctor->expr = gfc_get_expr ();
+	  ctor->expr->expr_type = EXPR_NULL;
+	  ctor->expr->ts = comp->ts;
+	}
+
+      gfc_constructor_append (&init->value.constructor, ctor);
+    }
+
+  return init;
+}
+
+
+/* Given a symbol, create an expression node with that symbol as a
+   variable. If the symbol is array valued, setup a reference of the
+   whole array.  */
+
+gfc_expr *
+gfc_get_variable_expr (gfc_symtree *var)
+{
+  gfc_expr *e;
+
+  e = gfc_get_expr ();
+  e->expr_type = EXPR_VARIABLE;
+  e->symtree = var;
+  e->ts = var->n.sym->ts;
+
+  if (var->n.sym->as != NULL)
+    {
+      e->rank = var->n.sym->as->rank;
+      e->ref = gfc_get_ref ();
+      e->ref->type = REF_ARRAY;
+      e->ref->u.ar.type = AR_FULL;
+    }
+
+  return e;
+}
+
+
+gfc_expr *
+gfc_lval_expr_from_sym (gfc_symbol *sym)
+{
+  gfc_expr *lval;
+  lval = gfc_get_expr ();
+  lval->expr_type = EXPR_VARIABLE;
+  lval->where = sym->declared_at;
+  lval->ts = sym->ts;
+  lval->symtree = gfc_find_symtree (sym->ns->sym_root, sym->name);
+
+  /* It will always be a full array.  */
+  lval->rank = sym->as ? sym->as->rank : 0;
+  if (lval->rank)
+    {
+      lval->ref = gfc_get_ref ();
+      lval->ref->type = REF_ARRAY;
+      lval->ref->u.ar.type = AR_FULL;
+      lval->ref->u.ar.dimen = lval->rank;
+      lval->ref->u.ar.where = sym->declared_at;
+      lval->ref->u.ar.as = sym->as;
+    }
+
+  return lval;
+}
+
+
+/* Returns the array_spec of a full array expression.  A NULL is
+   returned otherwise.  */
+gfc_array_spec *
+gfc_get_full_arrayspec_from_expr (gfc_expr *expr)
+{
+  gfc_array_spec *as;
+  gfc_ref *ref;
+
+  if (expr->rank == 0)
+    return NULL;
+
+  /* Follow any component references.  */
+  if (expr->expr_type == EXPR_VARIABLE
+      || expr->expr_type == EXPR_CONSTANT)
+    {
+      as = expr->symtree->n.sym->as;
+      for (ref = expr->ref; ref; ref = ref->next)
+	{
+	  switch (ref->type)
+	    {
+	    case REF_COMPONENT:
+	      as = ref->u.c.component->as;
+	      continue;
+
+	    case REF_SUBSTRING:
+	      continue;
+
+	    case REF_ARRAY:
+	      {
+		switch (ref->u.ar.type)
+		  {
+		  case AR_ELEMENT:
+		  case AR_SECTION:
+		  case AR_UNKNOWN:
+		    as = NULL;
+		    continue;
+
+		  case AR_FULL:
+		    break;
+		  }
+		break;
+	      }
+	    }
+	}
+    }
+  else
+    as = NULL;
+
+  return as;
+}
+
+
+/* General expression traversal function.  */
+
+bool
+gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym,
+		   bool (*func)(gfc_expr *, gfc_symbol *, int*),
+		   int f)
+{
+  gfc_array_ref ar;
+  gfc_ref *ref;
+  gfc_actual_arglist *args;
+  gfc_constructor *c;
+  int i;
+
+  if (!expr)
+    return false;
+
+  if ((*func) (expr, sym, &f))
+    return true;
+
+  if (expr->ts.type == BT_CHARACTER
+	&& expr->ts.u.cl
+	&& expr->ts.u.cl->length
+	&& expr->ts.u.cl->length->expr_type != EXPR_CONSTANT
+	&& gfc_traverse_expr (expr->ts.u.cl->length, sym, func, f))
+    return true;
+
+  switch (expr->expr_type)
+    {
+    case EXPR_PPC:
+    case EXPR_COMPCALL:
+    case EXPR_FUNCTION:
+      for (args = expr->value.function.actual; args; args = args->next)
+	{
+	  if (gfc_traverse_expr (args->expr, sym, func, f))
+	    return true;
+	}
+      break;
+
+    case EXPR_VARIABLE:
+    case EXPR_CONSTANT:
+    case EXPR_NULL:
+    case EXPR_SUBSTRING:
+      break;
+
+    case EXPR_STRUCTURE:
+    case EXPR_ARRAY:
+      for (c = gfc_constructor_first (expr->value.constructor);
+	   c; c = gfc_constructor_next (c))
+	{
+	  if (gfc_traverse_expr (c->expr, sym, func, f))
+	    return true;
+	  if (c->iterator)
+	    {
+	      if (gfc_traverse_expr (c->iterator->var, sym, func, f))
+		return true;
+	      if (gfc_traverse_expr (c->iterator->start, sym, func, f))
+		return true;
+	      if (gfc_traverse_expr (c->iterator->end, sym, func, f))
+		return true;
+	      if (gfc_traverse_expr (c->iterator->step, sym, func, f))
+		return true;
+	    }
+	}
+      break;
+
+    case EXPR_OP:
+      if (gfc_traverse_expr (expr->value.op.op1, sym, func, f))
+	return true;
+      if (gfc_traverse_expr (expr->value.op.op2, sym, func, f))
+	return true;
+      break;
+
+    default:
+      gcc_unreachable ();
+      break;
+    }
+
+  ref = expr->ref;
+  while (ref != NULL)
+    {
+      switch (ref->type)
+	{
+	case  REF_ARRAY:
+	  ar = ref->u.ar;
+	  for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
+	    {
+	      if (gfc_traverse_expr (ar.start[i], sym, func, f))
+		return true;
+	      if (gfc_traverse_expr (ar.end[i], sym, func, f))
+		return true;
+	      if (gfc_traverse_expr (ar.stride[i], sym, func, f))
+		return true;
+	    }
+	  break;
+
+	case REF_SUBSTRING:
+	  if (gfc_traverse_expr (ref->u.ss.start, sym, func, f))
+	    return true;
+	  if (gfc_traverse_expr (ref->u.ss.end, sym, func, f))
+	    return true;
+	  break;
+
+	case REF_COMPONENT:
+	  if (ref->u.c.component->ts.type == BT_CHARACTER
+		&& ref->u.c.component->ts.u.cl
+		&& ref->u.c.component->ts.u.cl->length
+		&& ref->u.c.component->ts.u.cl->length->expr_type
+		     != EXPR_CONSTANT
+		&& gfc_traverse_expr (ref->u.c.component->ts.u.cl->length,
+				      sym, func, f))
+	    return true;
+
+	  if (ref->u.c.component->as)
+	    for (i = 0; i < ref->u.c.component->as->rank
+			    + ref->u.c.component->as->corank; i++)
+	      {
+		if (gfc_traverse_expr (ref->u.c.component->as->lower[i],
+				       sym, func, f))
+		  return true;
+		if (gfc_traverse_expr (ref->u.c.component->as->upper[i],
+				       sym, func, f))
+		  return true;
+	      }
+	  break;
+
+	default:
+	  gcc_unreachable ();
+	}
+      ref = ref->next;
+    }
+  return false;
+}
+
+/* Traverse expr, marking all EXPR_VARIABLE symbols referenced.  */
+
+static bool
+expr_set_symbols_referenced (gfc_expr *expr,
+			     gfc_symbol *sym ATTRIBUTE_UNUSED,
+			     int *f ATTRIBUTE_UNUSED)
+{
+  if (expr->expr_type != EXPR_VARIABLE)
+    return false;
+  gfc_set_sym_referenced (expr->symtree->n.sym);
+  return false;
+}
+
+void
+gfc_expr_set_symbols_referenced (gfc_expr *expr)
+{
+  gfc_traverse_expr (expr, NULL, expr_set_symbols_referenced, 0);
+}
+
+
+/* Determine if an expression is a procedure pointer component. If yes, the
+   argument 'comp' will point to the component (provided that 'comp' was
+   provided).  */
+
+bool
+gfc_is_proc_ptr_comp (gfc_expr *expr, gfc_component **comp)
+{
+  gfc_ref *ref;
+  bool ppc = false;
+
+  if (!expr || !expr->ref)
+    return false;
+
+  ref = expr->ref;
+  while (ref->next)
+    ref = ref->next;
+
+  if (ref->type == REF_COMPONENT)
+    {
+      ppc = ref->u.c.component->attr.proc_pointer;
+      if (ppc && comp)
+	*comp = ref->u.c.component;
+    }
+
+  return ppc;
+}
+
+
+/* Walk an expression tree and check each variable encountered for being typed.
+   If strict is not set, a top-level variable is tolerated untyped in -std=gnu
+   mode as is a basic arithmetic expression using those; this is for things in
+   legacy-code like:
+
+     INTEGER :: arr(n), n
+     INTEGER :: arr(n + 1), n
+
+   The namespace is needed for IMPLICIT typing.  */
+
+static gfc_namespace* check_typed_ns;
+
+static bool
+expr_check_typed_help (gfc_expr* e, gfc_symbol* sym ATTRIBUTE_UNUSED,
+                       int* f ATTRIBUTE_UNUSED)
+{
+  gfc_try t;
+
+  if (e->expr_type != EXPR_VARIABLE)
+    return false;
+
+  gcc_assert (e->symtree);
+  t = gfc_check_symbol_typed (e->symtree->n.sym, check_typed_ns,
+                              true, e->where);
+
+  return (t == FAILURE);
+}
+
+gfc_try
+gfc_expr_check_typed (gfc_expr* e, gfc_namespace* ns, bool strict)
+{
+  bool error_found;
+
+  /* If this is a top-level variable or EXPR_OP, do the check with strict given
+     to us.  */
+  if (!strict)
+    {
+      if (e->expr_type == EXPR_VARIABLE && !e->ref)
+	return gfc_check_symbol_typed (e->symtree->n.sym, ns, strict, e->where);
+
+      if (e->expr_type == EXPR_OP)
+	{
+	  gfc_try t = SUCCESS;
+
+	  gcc_assert (e->value.op.op1);
+	  t = gfc_expr_check_typed (e->value.op.op1, ns, strict);
+
+	  if (t == SUCCESS && e->value.op.op2)
+	    t = gfc_expr_check_typed (e->value.op.op2, ns, strict);
+
+	  return t;
+	}
+    }
+
+  /* Otherwise, walk the expression and do it strictly.  */
+  check_typed_ns = ns;
+  error_found = gfc_traverse_expr (e, NULL, &expr_check_typed_help, 0);
+
+  return error_found ? FAILURE : SUCCESS;
+}
+
+
+/* Walk an expression tree and replace all dummy symbols by the corresponding
+   symbol in the formal_ns of "sym". Needed for copying interfaces in PROCEDURE
+   statements. The boolean return value is required by gfc_traverse_expr.  */
+
+static bool
+replace_symbol (gfc_expr *expr, gfc_symbol *sym, int *i ATTRIBUTE_UNUSED)
+{
+  if ((expr->expr_type == EXPR_VARIABLE 
+       || (expr->expr_type == EXPR_FUNCTION
+	   && !gfc_is_intrinsic (expr->symtree->n.sym, 0, expr->where)))
+      && expr->symtree->n.sym->ns == sym->ts.interface->formal_ns
+      && expr->symtree->n.sym->attr.dummy)
+    {
+      gfc_symtree *root = sym->formal_ns ? sym->formal_ns->sym_root
+					 : gfc_current_ns->sym_root;
+      gfc_symtree *stree = gfc_find_symtree (root, expr->symtree->n.sym->name);
+      gcc_assert (stree);
+      stree->n.sym->attr = expr->symtree->n.sym->attr;
+      expr->symtree = stree;
+    }
+  return false;
+}
+
+void
+gfc_expr_replace_symbols (gfc_expr *expr, gfc_symbol *dest)
+{
+  gfc_traverse_expr (expr, dest, &replace_symbol, 0);
+}
+
+
+/* The following is analogous to 'replace_symbol', and needed for copying
+   interfaces for procedure pointer components. The argument 'sym' must formally
+   be a gfc_symbol, so that the function can be passed to gfc_traverse_expr.
+   However, it gets actually passed a gfc_component (i.e. the procedure pointer
+   component in whose formal_ns the arguments have to be).  */
+
+static bool
+replace_comp (gfc_expr *expr, gfc_symbol *sym, int *i ATTRIBUTE_UNUSED)
+{
+  gfc_component *comp;
+  comp = (gfc_component *)sym;
+  if ((expr->expr_type == EXPR_VARIABLE 
+       || (expr->expr_type == EXPR_FUNCTION
+	   && !gfc_is_intrinsic (expr->symtree->n.sym, 0, expr->where)))
+      && expr->symtree->n.sym->ns == comp->ts.interface->formal_ns)
+    {
+      gfc_symtree *stree;
+      gfc_namespace *ns = comp->formal_ns;
+      /* Don't use gfc_get_symtree as we prefer to fail badly if we don't find
+	 the symtree rather than create a new one (and probably fail later).  */
+      stree = gfc_find_symtree (ns ? ns->sym_root : gfc_current_ns->sym_root,
+		      		expr->symtree->n.sym->name);
+      gcc_assert (stree);
+      stree->n.sym->attr = expr->symtree->n.sym->attr;
+      expr->symtree = stree;
+    }
+  return false;
+}
+
+void
+gfc_expr_replace_comp (gfc_expr *expr, gfc_component *dest)
+{
+  gfc_traverse_expr (expr, (gfc_symbol *)dest, &replace_comp, 0);
+}
+
+
+bool
+gfc_is_coindexed (gfc_expr *e)
+{
+  gfc_ref *ref;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+      return true;
+
+  return false;
+}
+
+
+int
+gfc_get_corank (gfc_expr *e)
+{
+  int corank;
+  gfc_ref *ref;
+  corank = e->symtree->n.sym->as ? e->symtree->n.sym->as->corank : 0;
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_ARRAY)
+	corank = ref->u.ar.as->corank;
+      gcc_assert (ref->type != REF_SUBSTRING);
+    }
+  return corank;
+}
+
+
+/* Check whether the expression has an ultimate allocatable component.
+   Being itself allocatable does not count.  */
+bool
+gfc_has_ultimate_allocatable (gfc_expr *e)
+{
+  gfc_ref *ref, *last = NULL;
+
+  if (e->expr_type != EXPR_VARIABLE)
+    return false;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT)
+      last = ref;
+
+  if (last && last->u.c.component->ts.type == BT_CLASS)
+    return CLASS_DATA (last->u.c.component)->attr.alloc_comp;
+  else if (last && last->u.c.component->ts.type == BT_DERIVED)
+    return last->u.c.component->ts.u.derived->attr.alloc_comp;
+  else if (last)
+    return false;
+
+  if (e->ts.type == BT_CLASS)
+    return CLASS_DATA (e)->attr.alloc_comp;
+  else if (e->ts.type == BT_DERIVED)
+    return e->ts.u.derived->attr.alloc_comp;
+  else
+    return false;
+}
+
+
+/* Check whether the expression has an pointer component.
+   Being itself a pointer does not count.  */
+bool
+gfc_has_ultimate_pointer (gfc_expr *e)
+{
+  gfc_ref *ref, *last = NULL;
+
+  if (e->expr_type != EXPR_VARIABLE)
+    return false;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT)
+      last = ref;
+ 
+  if (last && last->u.c.component->ts.type == BT_CLASS)
+    return CLASS_DATA (last->u.c.component)->attr.pointer_comp;
+  else if (last && last->u.c.component->ts.type == BT_DERIVED)
+    return last->u.c.component->ts.u.derived->attr.pointer_comp;
+  else if (last)
+    return false;
+
+  if (e->ts.type == BT_CLASS)
+    return CLASS_DATA (e)->attr.pointer_comp;
+  else if (e->ts.type == BT_DERIVED)
+    return e->ts.u.derived->attr.pointer_comp;
+  else
+    return false;
+}
+
+
+/* Check whether an expression is "simply contiguous", cf. F2008, 6.5.4.
+   Note: A scalar is not regarded as "simply contiguous" by the standard.
+   if bool is not strict, some futher checks are done - for instance,
+   a "(::1)" is accepted.  */
+
+bool
+gfc_is_simply_contiguous (gfc_expr *expr, bool strict)
+{
+  bool colon;
+  int i;
+  gfc_array_ref *ar = NULL;
+  gfc_ref *ref, *part_ref = NULL;
+
+  if (expr->expr_type == EXPR_FUNCTION)
+    return expr->value.function.esym
+	   ? expr->value.function.esym->result->attr.contiguous : false;
+  else if (expr->expr_type != EXPR_VARIABLE)
+    return false;
+
+  if (expr->rank == 0)
+    return false;
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    {
+      if (ar)
+	return false; /* Array shall be last part-ref. */
+
+      if (ref->type == REF_COMPONENT)
+	part_ref  = ref;
+      else if (ref->type == REF_SUBSTRING)
+	return false;
+      else if (ref->u.ar.type != AR_ELEMENT)
+	ar = &ref->u.ar;
+    }
+
+  if ((part_ref && !part_ref->u.c.component->attr.contiguous
+       && part_ref->u.c.component->attr.pointer)
+      || (!part_ref && !expr->symtree->n.sym->attr.contiguous
+	  && (expr->symtree->n.sym->attr.pointer
+	      || expr->symtree->n.sym->as->type == AS_ASSUMED_SHAPE)))
+    return false;
+
+  if (!ar || ar->type == AR_FULL)
+    return true;
+
+  gcc_assert (ar->type == AR_SECTION);
+
+  /* Check for simply contiguous array */
+  colon = true;
+  for (i = 0; i < ar->dimen; i++)
+    {
+      if (ar->dimen_type[i] == DIMEN_VECTOR)
+	return false;
+
+      if (ar->dimen_type[i] == DIMEN_ELEMENT)
+	{
+	  colon = false;
+	  continue;
+	}
+
+      gcc_assert (ar->dimen_type[i] == DIMEN_RANGE);
+
+
+      /* If the previous section was not contiguous, that's an error,
+	 unless we have effective only one element and checking is not
+	 strict.  */
+      if (!colon && (strict || !ar->start[i] || !ar->end[i]
+		     || ar->start[i]->expr_type != EXPR_CONSTANT
+		     || ar->end[i]->expr_type != EXPR_CONSTANT
+		     || mpz_cmp (ar->start[i]->value.integer,
+				 ar->end[i]->value.integer) != 0))
+	return false;
+
+      /* Following the standard, "(::1)" or - if known at compile time -
+	 "(lbound:ubound)" are not simply contigous; if strict
+	 is false, they are regarded as simply contiguous.  */
+      if (ar->stride[i] && (strict || ar->stride[i]->expr_type != EXPR_CONSTANT
+			    || ar->stride[i]->ts.type != BT_INTEGER
+			    || mpz_cmp_si (ar->stride[i]->value.integer, 1) != 0))
+	return false;
+
+      if (ar->start[i]
+	  && (strict || ar->start[i]->expr_type != EXPR_CONSTANT
+	      || !ar->as->lower[i]
+	      || ar->as->lower[i]->expr_type != EXPR_CONSTANT
+	      || mpz_cmp (ar->start[i]->value.integer,
+			  ar->as->lower[i]->value.integer) != 0))
+	colon = false;
+
+      if (ar->end[i]
+	  && (strict || ar->end[i]->expr_type != EXPR_CONSTANT
+	      || !ar->as->upper[i]
+	      || ar->as->upper[i]->expr_type != EXPR_CONSTANT
+	      || mpz_cmp (ar->end[i]->value.integer,
+			  ar->as->upper[i]->value.integer) != 0))
+	colon = false;
+    }
+  
+  return true;
+}
+
+
+/* Build call to an intrinsic procedure.  The number of arguments has to be
+   passed (rather than ending the list with a NULL value) because we may
+   want to add arguments but with a NULL-expression.  */
+
+gfc_expr*
+gfc_build_intrinsic_call (gfc_namespace *ns, gfc_isym_id id, const char* name,
+			  locus where, unsigned numarg, ...)
+{
+  gfc_expr* result;
+  gfc_actual_arglist* atail;
+  gfc_intrinsic_sym* isym;
+  va_list ap;
+  unsigned i;
+  const char *mangled_name = gfc_get_string (GFC_PREFIX ("%s"), name);
+
+  isym = gfc_intrinsic_function_by_id (id);
+  gcc_assert (isym);
+  
+  result = gfc_get_expr ();
+  result->expr_type = EXPR_FUNCTION;
+  result->ts = isym->ts;
+  result->where = where;
+  result->value.function.name = mangled_name;
+  result->value.function.isym = isym;
+
+  gfc_get_sym_tree (mangled_name, ns, &result->symtree, false);
+  gfc_commit_symbol (result->symtree->n.sym);
+  gcc_assert (result->symtree
+	      && (result->symtree->n.sym->attr.flavor == FL_PROCEDURE
+		  || result->symtree->n.sym->attr.flavor == FL_UNKNOWN));
+
+  result->symtree->n.sym->intmod_sym_id = id;
+  result->symtree->n.sym->attr.flavor = FL_PROCEDURE;
+  result->symtree->n.sym->attr.intrinsic = 1;
+
+  va_start (ap, numarg);
+  atail = NULL;
+  for (i = 0; i < numarg; ++i)
+    {
+      if (atail)
+	{
+	  atail->next = gfc_get_actual_arglist ();
+	  atail = atail->next;
+	}
+      else
+	atail = result->value.function.actual = gfc_get_actual_arglist ();
+
+      atail->expr = va_arg (ap, gfc_expr*);
+    }
+  va_end (ap);
+
+  return result;
+}
+
+
+/* Check if an expression may appear in a variable definition context
+   (F2008, 16.6.7) or pointer association context (F2008, 16.6.8).
+   This is called from the various places when resolving
+   the pieces that make up such a context.
+
+   Optionally, a possible error message can be suppressed if context is NULL
+   and just the return status (SUCCESS / FAILURE) be requested.  */
+
+gfc_try
+gfc_check_vardef_context (gfc_expr* e, bool pointer, const char* context)
+{
+  gfc_symbol* sym = NULL;
+  bool is_pointer;
+  bool check_intentin;
+  bool ptr_component;
+  symbol_attribute attr;
+  gfc_ref* ref;
+
+  if (e->expr_type == EXPR_VARIABLE)
+    {
+      gcc_assert (e->symtree);
+      sym = e->symtree->n.sym;
+    }
+  else if (e->expr_type == EXPR_FUNCTION)
+    {
+      gcc_assert (e->symtree);
+      sym = e->value.function.esym ? e->value.function.esym : e->symtree->n.sym;
+    }
+
+  attr = gfc_expr_attr (e);
+  if (!pointer && e->expr_type == EXPR_FUNCTION && attr.pointer)
+    {
+      if (!(gfc_option.allow_std & GFC_STD_F2008))
+	{
+	  if (context)
+	    gfc_error ("Fortran 2008: Pointer functions in variable definition"
+		       " context (%s) at %L", context, &e->where);
+	  return FAILURE;
+	}
+    }
+  else if (e->expr_type != EXPR_VARIABLE)
+    {
+      if (context)
+	gfc_error ("Non-variable expression in variable definition context (%s)"
+		   " at %L", context, &e->where);
+      return FAILURE;
+    }
+
+  if (!pointer && sym->attr.flavor == FL_PARAMETER)
+    {
+      if (context)
+	gfc_error ("Named constant '%s' in variable definition context (%s)"
+		   " at %L", sym->name, context, &e->where);
+      return FAILURE;
+    }
+  if (!pointer && sym->attr.flavor != FL_VARIABLE
+      && !(sym->attr.flavor == FL_PROCEDURE && sym == sym->result)
+      && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer))
+    {
+      if (context)
+	gfc_error ("'%s' in variable definition context (%s) at %L is not"
+		   " a variable", sym->name, context, &e->where);
+      return FAILURE;
+    }
+
+  /* Find out whether the expr is a pointer; this also means following
+     component references to the last one.  */
+  is_pointer = (attr.pointer || attr.proc_pointer);
+  if (pointer && !is_pointer)
+    {
+      if (context)
+	gfc_error ("Non-POINTER in pointer association context (%s)"
+		   " at %L", context, &e->where);
+      return FAILURE;
+    }
+
+  /* INTENT(IN) dummy argument.  Check this, unless the object itself is
+     the component of sub-component of a pointer.  Obviously,
+     procedure pointers are of no interest here.  */
+  check_intentin = true;
+  ptr_component = sym->attr.pointer;
+  for (ref = e->ref; ref && check_intentin; ref = ref->next)
+    {
+      if (ptr_component && ref->type == REF_COMPONENT)
+	check_intentin = false;
+      if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
+	{
+	  ptr_component = true;
+	  if (!pointer)
+	    check_intentin = false;
+	}
+    }
+  if (check_intentin && sym->attr.intent == INTENT_IN)
+    {
+      if (pointer && is_pointer)
+	{
+	  if (context)
+	    gfc_error ("Dummy argument '%s' with INTENT(IN) in pointer"
+		       " association context (%s) at %L",
+		       sym->name, context, &e->where);
+	  return FAILURE;
+	}
+      if (!pointer && !is_pointer && !sym->attr.pointer)
+	{
+	  if (context)
+	    gfc_error ("Dummy argument '%s' with INTENT(IN) in variable"
+		       " definition context (%s) at %L",
+		       sym->name, context, &e->where);
+	  return FAILURE;
+	}
+    }
+
+  /* PROTECTED and use-associated.  */
+  if (sym->attr.is_protected && sym->attr.use_assoc  && check_intentin)
+    {
+      if (pointer && is_pointer)
+	{
+	  if (context)
+	    gfc_error ("Variable '%s' is PROTECTED and can not appear in a"
+		       " pointer association context (%s) at %L",
+		       sym->name, context, &e->where);
+	  return FAILURE;
+	}
+      if (!pointer && !is_pointer)
+	{
+	  if (context)
+	    gfc_error ("Variable '%s' is PROTECTED and can not appear in a"
+		       " variable definition context (%s) at %L",
+		       sym->name, context, &e->where);
+	  return FAILURE;
+	}
+    }
+
+  /* Variable not assignable from a PURE procedure but appears in
+     variable definition context.  */
+  if (!pointer && gfc_pure (NULL) && gfc_impure_variable (sym))
+    {
+      if (context)
+	gfc_error ("Variable '%s' can not appear in a variable definition"
+		   " context (%s) at %L in PURE procedure",
+		   sym->name, context, &e->where);
+      return FAILURE;
+    }
+
+  if (!pointer && context && gfc_implicit_pure (NULL)
+      && gfc_impure_variable (sym))
+    {
+      gfc_namespace *ns;
+      gfc_symbol *sym;
+
+      for (ns = gfc_current_ns; ns; ns = ns->parent)
+	{
+	  sym = ns->proc_name;
+	  if (sym == NULL)
+	    break;
+	  if (sym->attr.flavor == FL_PROCEDURE)
+	    {
+	      sym->attr.implicit_pure = 0;
+	      break;
+	    }
+	}
+    }
+  /* Check variable definition context for associate-names.  */
+  if (!pointer && sym->assoc)
+    {
+      const char* name;
+      gfc_association_list* assoc;
+
+      gcc_assert (sym->assoc->target);
+
+      /* If this is a SELECT TYPE temporary (the association is used internally
+	 for SELECT TYPE), silently go over to the target.  */
+      if (sym->attr.select_type_temporary)
+	{
+	  gfc_expr* t = sym->assoc->target;
+
+	  gcc_assert (t->expr_type == EXPR_VARIABLE);
+	  name = t->symtree->name;
+
+	  if (t->symtree->n.sym->assoc)
+	    assoc = t->symtree->n.sym->assoc;
+	  else
+	    assoc = sym->assoc;
+	}
+      else
+	{
+	  name = sym->name;
+	  assoc = sym->assoc;
+	}
+      gcc_assert (name && assoc);
+
+      /* Is association to a valid variable?  */
+      if (!assoc->variable)
+	{
+	  if (context)
+	    {
+	      if (assoc->target->expr_type == EXPR_VARIABLE)
+		gfc_error ("'%s' at %L associated to vector-indexed target can"
+			   " not be used in a variable definition context (%s)",
+			   name, &e->where, context);
+	      else
+		gfc_error ("'%s' at %L associated to expression can"
+			   " not be used in a variable definition context (%s)",
+			   name, &e->where, context);
+	    }
+	  return FAILURE;
+	}
+
+      /* Target must be allowed to appear in a variable definition context.  */
+      if (gfc_check_vardef_context (assoc->target, pointer, NULL) == FAILURE)
+	{
+	  if (context)
+	    gfc_error ("Associate-name '%s' can not appear in a variable"
+		       " definition context (%s) at %L because its target"
+		       " at %L can not, either",
+		       name, context, &e->where,
+		       &assoc->target->where);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
new file mode 100644
index 000000000..728b6311a
--- /dev/null
+++ b/gcc/fortran/f95-lang.c
@@ -0,0 +1,1168 @@
+/* gfortran backend interface
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* f95-lang.c-- GCC backend interface stuff */
+
+/* declare required prototypes: */
+
+#include "config.h"
+#include "system.h"
+#include "ansidecl.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "gimple.h"
+#include "flags.h"
+#include "langhooks.h"
+#include "langhooks-def.h"
+#include "timevar.h"
+#include "tm.h"
+#include "function.h"
+#include "ggc.h"
+#include "toplev.h"
+#include "target.h"
+#include "debug.h"
+#include "diagnostic.h"
+#include "tree-dump.h"
+#include "cgraph.h"
+#include "gfortran.h"
+#include "cpp.h"
+#include "trans.h"
+#include "trans-types.h"
+#include "trans-const.h"
+
+/* Language-dependent contents of an identifier.  */
+
+struct GTY(())
+lang_identifier {
+  struct tree_identifier common;
+};
+
+/* The resulting tree type.  */
+
+union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
+     chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
+
+lang_tree_node {
+  union tree_node GTY((tag ("0"),
+		       desc ("tree_node_structure (&%h)"))) generic;
+  struct lang_identifier GTY((tag ("1"))) identifier;
+};
+
+/* Save and restore the variables in this file and elsewhere
+   that keep track of the progress of compilation of the current function.
+   Used for nested functions.  */
+
+struct GTY(())
+language_function {
+  /* struct gfc_language_function base; */
+  struct binding_level *binding_level;
+};
+
+/* We don't have a lex/yacc lexer/parser, but toplev expects these to
+   exist anyway.  */
+void yyerror (const char *str);
+int yylex (void);
+
+static void gfc_init_decl_processing (void);
+static void gfc_init_builtin_functions (void);
+
+/* Each front end provides its own.  */
+static bool gfc_init (void);
+static void gfc_finish (void);
+static void gfc_write_global_declarations (void);
+static void gfc_print_identifier (FILE *, tree, int);
+void do_function_end (void);
+int global_bindings_p (void);
+static void clear_binding_stack (void);
+static void gfc_be_parse_file (void);
+static alias_set_type gfc_get_alias_set (tree);
+static void gfc_init_ts (void);
+
+#undef LANG_HOOKS_NAME
+#undef LANG_HOOKS_INIT
+#undef LANG_HOOKS_FINISH
+#undef LANG_HOOKS_WRITE_GLOBALS
+#undef LANG_HOOKS_OPTION_LANG_MASK
+#undef LANG_HOOKS_INIT_OPTIONS_STRUCT
+#undef LANG_HOOKS_INIT_OPTIONS
+#undef LANG_HOOKS_HANDLE_OPTION
+#undef LANG_HOOKS_POST_OPTIONS
+#undef LANG_HOOKS_PRINT_IDENTIFIER
+#undef LANG_HOOKS_PARSE_FILE
+#undef LANG_HOOKS_MARK_ADDRESSABLE
+#undef LANG_HOOKS_TYPE_FOR_MODE
+#undef LANG_HOOKS_TYPE_FOR_SIZE
+#undef LANG_HOOKS_GET_ALIAS_SET
+#undef LANG_HOOKS_INIT_TS
+#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
+#undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
+#undef LANG_HOOKS_OMP_REPORT_DECL
+#undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
+#undef LANG_HOOKS_OMP_CLAUSE_COPY_CTOR
+#undef LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP
+#undef LANG_HOOKS_OMP_CLAUSE_DTOR
+#undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
+#undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
+#undef LANG_HOOKS_OMP_PRIVATE_OUTER_REF
+#undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
+#undef LANG_HOOKS_BUILTIN_FUNCTION
+#undef LANG_HOOKS_GET_ARRAY_DESCR_INFO
+
+/* Define lang hooks.  */
+#define LANG_HOOKS_NAME                 "GNU Fortran"
+#define LANG_HOOKS_INIT                 gfc_init
+#define LANG_HOOKS_FINISH               gfc_finish
+#define LANG_HOOKS_WRITE_GLOBALS	gfc_write_global_declarations
+#define LANG_HOOKS_OPTION_LANG_MASK	gfc_option_lang_mask
+#define LANG_HOOKS_INIT_OPTIONS_STRUCT  gfc_init_options_struct
+#define LANG_HOOKS_INIT_OPTIONS         gfc_init_options
+#define LANG_HOOKS_HANDLE_OPTION        gfc_handle_option
+#define LANG_HOOKS_POST_OPTIONS		gfc_post_options
+#define LANG_HOOKS_PRINT_IDENTIFIER     gfc_print_identifier
+#define LANG_HOOKS_PARSE_FILE           gfc_be_parse_file
+#define LANG_HOOKS_TYPE_FOR_MODE	gfc_type_for_mode
+#define LANG_HOOKS_TYPE_FOR_SIZE	gfc_type_for_size
+#define LANG_HOOKS_GET_ALIAS_SET	gfc_get_alias_set
+#define LANG_HOOKS_INIT_TS		gfc_init_ts
+#define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE	gfc_omp_privatize_by_reference
+#define LANG_HOOKS_OMP_PREDETERMINED_SHARING	gfc_omp_predetermined_sharing
+#define LANG_HOOKS_OMP_REPORT_DECL		gfc_omp_report_decl
+#define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR	gfc_omp_clause_default_ctor
+#define LANG_HOOKS_OMP_CLAUSE_COPY_CTOR		gfc_omp_clause_copy_ctor
+#define LANG_HOOKS_OMP_CLAUSE_ASSIGN_OP		gfc_omp_clause_assign_op
+#define LANG_HOOKS_OMP_CLAUSE_DTOR		gfc_omp_clause_dtor
+#define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR	gfc_omp_disregard_value_expr
+#define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE	gfc_omp_private_debug_clause
+#define LANG_HOOKS_OMP_PRIVATE_OUTER_REF	gfc_omp_private_outer_ref
+#define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
+  gfc_omp_firstprivatize_type_sizes
+#define LANG_HOOKS_BUILTIN_FUNCTION          gfc_builtin_function
+#define LANG_HOOKS_GET_ARRAY_DESCR_INFO	     gfc_get_array_descr_info
+
+struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
+
+#define NULL_BINDING_LEVEL (struct binding_level *) NULL
+
+/* A chain of binding_level structures awaiting reuse.  */
+
+static GTY(()) struct binding_level *free_binding_level;
+
+/* The elements of `ridpointers' are identifier nodes
+   for the reserved type names and storage classes.
+   It is indexed by a RID_... value.  */
+tree *ridpointers = NULL;
+
+/* True means we've initialized exception handling.  */
+bool gfc_eh_initialized_p;
+
+/* The current translation unit.  */
+static GTY(()) tree current_translation_unit;
+
+
+/* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
+   or validate its data type for an `if' or `while' statement or ?..: exp.
+
+   This preparation consists of taking the ordinary
+   representation of an expression expr and producing a valid tree
+   boolean expression describing whether expr is nonzero.  We could
+   simply always do build_binary_op (NE_EXPR, expr, boolean_false_node, 1),
+   but we optimize comparisons, &&, ||, and !.
+
+   The resulting type should always be `boolean_type_node'.
+   This is much simpler than the corresponding C version because we have a
+   distinct boolean type.  */
+
+tree
+gfc_truthvalue_conversion (tree expr)
+{
+  switch (TREE_CODE (TREE_TYPE (expr)))
+    {
+    case BOOLEAN_TYPE:
+      if (TREE_TYPE (expr) == boolean_type_node)
+	return expr;
+      else if (COMPARISON_CLASS_P (expr))
+	{
+	  TREE_TYPE (expr) = boolean_type_node;
+	  return expr;
+	}
+      else if (TREE_CODE (expr) == NOP_EXPR)
+        return fold_build1_loc (input_location, NOP_EXPR,
+			    boolean_type_node, TREE_OPERAND (expr, 0));
+      else
+        return fold_build1_loc (input_location, NOP_EXPR, boolean_type_node,
+				expr);
+
+    case INTEGER_TYPE:
+      if (TREE_CODE (expr) == INTEGER_CST)
+	return integer_zerop (expr) ? boolean_false_node : boolean_true_node;
+      else
+        return fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				expr, build_int_cst (TREE_TYPE (expr), 0));
+
+    default:
+      internal_error ("Unexpected type in truthvalue_conversion");
+    }
+}
+
+
+static void
+gfc_create_decls (void)
+{
+  /* GCC builtins.  */
+  gfc_init_builtin_functions ();
+
+  /* Runtime/IO library functions.  */
+  gfc_build_builtin_function_decls ();
+
+  gfc_init_constants ();
+
+  /* Build our translation-unit decl.  */
+  current_translation_unit = build_translation_unit_decl (NULL_TREE);
+}
+
+
+static void
+gfc_be_parse_file (void)
+{
+  int errors;
+  int warnings;
+
+  gfc_create_decls ();
+  gfc_parse_file ();
+  gfc_generate_constructors ();
+
+  /* Tell the frontend about any errors.  */
+  gfc_get_errors (&warnings, &errors);
+  errorcount += errors;
+  warningcount += warnings;
+
+  clear_binding_stack ();
+}
+
+
+/* Initialize everything.  */
+
+static bool
+gfc_init (void)
+{
+  if (!gfc_cpp_enabled ())
+    {
+      linemap_add (line_table, LC_ENTER, false, gfc_source_file, 1);
+      linemap_add (line_table, LC_RENAME, false, "<built-in>", 0);
+    }
+  else
+    gfc_cpp_init_0 ();
+
+  gfc_init_decl_processing ();
+  gfc_static_ctors = NULL_TREE;
+
+  if (gfc_cpp_enabled ())
+    gfc_cpp_init ();
+
+  gfc_init_1 ();
+
+  if (gfc_new_file () != SUCCESS)
+    fatal_error ("can't open input file: %s", gfc_source_file);
+
+  return true;
+}
+
+
+static void
+gfc_finish (void)
+{
+  gfc_cpp_done ();
+  gfc_done_1 ();
+  gfc_release_include_path ();
+  return;
+}
+
+/* ??? This is something of a hack.
+
+   Emulated tls lowering needs to see all TLS variables before we call
+   cgraph_finalize_compilation_unit.  The C/C++ front ends manage this
+   by calling decl_rest_of_compilation on each global and static variable
+   as they are seen.  The Fortran front end waits until this hook.
+
+   A Correct solution is for cgraph_finalize_compilation_unit not to be
+   called during the WRITE_GLOBALS langhook, and have that hook only do what
+   its name suggests and write out globals.  But the C++ and Java front ends
+   have (unspecified) problems with aliases that gets in the way.  It has
+   been suggested that these problems would be solved by completing the
+   conversion to cgraph-based aliases.  */
+
+static void
+gfc_write_global_declarations (void)
+{
+  tree decl;
+
+  /* Finalize all of the globals.  */
+  for (decl = getdecls(); decl ; decl = DECL_CHAIN (decl))
+    rest_of_decl_compilation (decl, true, true);
+
+  write_global_declarations ();
+}
+
+
+static void
+gfc_print_identifier (FILE * file ATTRIBUTE_UNUSED,
+		      tree node ATTRIBUTE_UNUSED,
+		      int indent ATTRIBUTE_UNUSED)
+{
+  return;
+}
+
+
+/* These functions and variables deal with binding contours.  We only
+   need these functions for the list of PARM_DECLs, but we leave the
+   functions more general; these are a simplified version of the
+   functions from GNAT.  */
+
+/* For each binding contour we allocate a binding_level structure which
+   records the entities defined or declared in that contour.  Contours
+   include:
+
+        the global one
+        one for each subprogram definition
+        one for each compound statement (declare block)
+
+   Binding contours are used to create GCC tree BLOCK nodes.  */
+
+struct GTY(())
+binding_level {
+  /* A chain of ..._DECL nodes for all variables, constants, functions,
+     parameters and type declarations.  These ..._DECL nodes are chained
+     through the DECL_CHAIN field. Note that these ..._DECL nodes are stored
+     in the reverse of the order supplied to be compatible with the
+     back-end.  */
+  tree names;
+  /* For each level (except the global one), a chain of BLOCK nodes for all
+     the levels that were entered and exited one level down from this one.  */
+  tree blocks;
+  /* The binding level containing this one (the enclosing binding level).  */
+  struct binding_level *level_chain;
+};
+
+/* The binding level currently in effect.  */
+static GTY(()) struct binding_level *current_binding_level = NULL;
+
+/* The outermost binding level. This binding level is created when the
+   compiler is started and it will exist through the entire compilation.  */
+static GTY(()) struct binding_level *global_binding_level;
+
+/* Binding level structures are initialized by copying this one.  */
+static struct binding_level clear_binding_level = { NULL, NULL, NULL };
+
+
+/* Return nonzero if we are currently in the global binding level.  */
+
+int
+global_bindings_p (void)
+{
+  return current_binding_level == global_binding_level ? -1 : 0;
+}
+
+tree
+getdecls (void)
+{
+  return current_binding_level->names;
+}
+
+/* Enter a new binding level. The input parameter is ignored, but has to be
+   specified for back-end compatibility.  */
+
+void
+pushlevel (int ignore ATTRIBUTE_UNUSED)
+{
+  struct binding_level *newlevel = ggc_alloc_binding_level ();
+
+  *newlevel = clear_binding_level;
+
+  /* Add this level to the front of the chain (stack) of levels that are
+     active.  */
+  newlevel->level_chain = current_binding_level;
+  current_binding_level = newlevel;
+}
+
+/* Exit a binding level.
+   Pop the level off, and restore the state of the identifier-decl mappings
+   that were in effect when this level was entered.
+
+   If KEEP is nonzero, this level had explicit declarations, so
+   and create a "block" (a BLOCK node) for the level
+   to record its declarations and subblocks for symbol table output.
+
+   If FUNCTIONBODY is nonzero, this level is the body of a function,
+   so create a block as if KEEP were set and also clear out all
+   label names.
+
+   If REVERSE is nonzero, reverse the order of decls before putting
+   them into the BLOCK.  */
+
+tree
+poplevel (int keep, int reverse, int functionbody)
+{
+  /* Points to a BLOCK tree node. This is the BLOCK node constructed for the
+     binding level that we are about to exit and which is returned by this
+     routine.  */
+  tree block_node = NULL_TREE;
+  tree decl_chain;
+  tree subblock_chain = current_binding_level->blocks;
+  tree subblock_node;
+
+  /* Reverse the list of XXXX_DECL nodes if desired.  Note that the ..._DECL
+     nodes chained through the `names' field of current_binding_level are in
+     reverse order except for PARM_DECL node, which are explicitly stored in
+     the right order.  */
+  decl_chain = (reverse) ? nreverse (current_binding_level->names)
+			 : current_binding_level->names;
+
+  /* If there were any declarations in the current binding level, or if this
+     binding level is a function body, or if there are any nested blocks then
+     create a BLOCK node to record them for the life of this function.  */
+  if (keep || functionbody)
+    block_node = build_block (keep ? decl_chain : 0, subblock_chain, 0, 0);
+
+  /* Record the BLOCK node just built as the subblock its enclosing scope.  */
+  for (subblock_node = subblock_chain; subblock_node;
+       subblock_node = TREE_CHAIN (subblock_node))
+    BLOCK_SUPERCONTEXT (subblock_node) = block_node;
+
+  /* Clear out the meanings of the local variables of this level.  */
+
+  for (subblock_node = decl_chain; subblock_node;
+       subblock_node = DECL_CHAIN (subblock_node))
+    if (DECL_NAME (subblock_node) != 0)
+      /* If the identifier was used or addressed via a local extern decl,
+         don't forget that fact.  */
+      if (DECL_EXTERNAL (subblock_node))
+	{
+	  if (TREE_USED (subblock_node))
+	    TREE_USED (DECL_NAME (subblock_node)) = 1;
+	  if (TREE_ADDRESSABLE (subblock_node))
+	    TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (subblock_node)) = 1;
+	}
+
+  /* Pop the current level.  */
+  current_binding_level = current_binding_level->level_chain;
+
+  if (functionbody)
+    /* This is the top level block of a function. */
+    DECL_INITIAL (current_function_decl) = block_node;
+  else if (current_binding_level == global_binding_level)
+    /* When using gfc_start_block/gfc_finish_block from middle-end hooks,
+       don't add newly created BLOCKs as subblocks of global_binding_level.  */
+    ;
+  else if (block_node)
+    {
+      current_binding_level->blocks
+	= chainon (current_binding_level->blocks, block_node);
+    }
+
+  /* If we did not make a block for the level just exited, any blocks made for
+     inner levels (since they cannot be recorded as subblocks in that level)
+     must be carried forward so they will later become subblocks of something
+     else.  */
+  else if (subblock_chain)
+    current_binding_level->blocks
+      = chainon (current_binding_level->blocks, subblock_chain);
+  if (block_node)
+    TREE_USED (block_node) = 1;
+
+  return block_node;
+}
+
+
+/* Records a ..._DECL node DECL as belonging to the current lexical scope.
+   Returns the ..._DECL node.  */
+
+tree
+pushdecl (tree decl)
+{
+  if (global_bindings_p ())
+    DECL_CONTEXT (decl) = current_translation_unit;
+  else
+    {
+      /* External objects aren't nested.  For debug info insert a copy
+         of the decl into the binding level.  */
+      if (DECL_EXTERNAL (decl))
+	{
+	  tree orig = decl;
+	  decl = copy_node (decl);
+	  DECL_CONTEXT (orig) = NULL_TREE;
+	}
+      DECL_CONTEXT (decl) = current_function_decl;
+    }
+
+  /* Put the declaration on the list.  The list of declarations is in reverse
+     order. The list will be reversed later if necessary.  This needs to be
+     this way for compatibility with the back-end.  */
+
+  DECL_CHAIN (decl) = current_binding_level->names;
+  current_binding_level->names = decl;
+
+  /* For the declaration of a type, set its name if it is not already set.  */
+
+  if (TREE_CODE (decl) == TYPE_DECL && TYPE_NAME (TREE_TYPE (decl)) == 0)
+    {
+      if (DECL_SOURCE_LINE (decl) == 0)
+	TYPE_NAME (TREE_TYPE (decl)) = decl;
+      else
+	TYPE_NAME (TREE_TYPE (decl)) = DECL_NAME (decl);
+    }
+
+  return decl;
+}
+
+
+/* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL.  */
+
+tree
+pushdecl_top_level (tree x)
+{
+  tree t;
+  struct binding_level *b = current_binding_level;
+
+  current_binding_level = global_binding_level;
+  t = pushdecl (x);
+  current_binding_level = b;
+  return t;
+}
+
+
+/* Clear the binding stack.  */
+static void
+clear_binding_stack (void)
+{
+  while (!global_bindings_p ())
+    poplevel (0, 0, 0);
+}
+
+
+#ifndef CHAR_TYPE_SIZE
+#define CHAR_TYPE_SIZE BITS_PER_UNIT
+#endif
+
+#ifndef INT_TYPE_SIZE
+#define INT_TYPE_SIZE BITS_PER_WORD
+#endif
+
+#undef SIZE_TYPE
+#define SIZE_TYPE "long unsigned int"
+
+/* Create tree nodes for the basic scalar types of Fortran 95,
+   and some nodes representing standard constants (0, 1, (void *) 0).
+   Initialize the global binding level.
+   Make definitions for built-in primitive functions.  */
+static void
+gfc_init_decl_processing (void)
+{
+  current_function_decl = NULL;
+  current_binding_level = NULL_BINDING_LEVEL;
+  free_binding_level = NULL_BINDING_LEVEL;
+
+  /* Make the binding_level structure for global names. We move all
+     variables that are in a COMMON block to this binding level.  */
+  pushlevel (0);
+  global_binding_level = current_binding_level;
+
+  /* Build common tree nodes. char_type_node is unsigned because we
+     only use it for actual characters, not for INTEGER(1). Also, we
+     want double_type_node to actually have double precision.  */
+  build_common_tree_nodes (false);
+
+  size_type_node = gfc_build_uint_type (POINTER_SIZE);
+  set_sizetype (size_type_node);
+
+  build_common_tree_nodes_2 (0);
+  void_list_node = build_tree_list (NULL_TREE, void_type_node);
+
+  /* Set up F95 type nodes.  */
+  gfc_init_kinds ();
+  gfc_init_types ();
+}
+
+
+/* Return the typed-based alias set for T, which may be an expression
+   or a type.  Return -1 if we don't do anything special.  */
+
+static alias_set_type
+gfc_get_alias_set (tree t)
+{
+  tree u;
+
+  /* Permit type-punning when accessing an EQUIVALENCEd variable or
+     mixed type entry master's return value.  */
+  for (u = t; handled_component_p (u); u = TREE_OPERAND (u, 0))
+    if (TREE_CODE (u) == COMPONENT_REF
+	&& TREE_CODE (TREE_TYPE (TREE_OPERAND (u, 0))) == UNION_TYPE)
+      return 0;
+
+  return -1;
+}
+
+
+/* press the big red button - garbage (ggc) collection is on */
+
+int ggc_p = 1;
+
+/* Builtin function initialization.  */
+
+tree
+gfc_builtin_function (tree decl)
+{
+  make_decl_rtl (decl);
+  pushdecl (decl);
+  return decl;
+}
+
+/* So far we need just these 4 attribute types.  */
+#define ATTR_NOTHROW_LEAF_LIST		(ECF_NOTHROW | ECF_LEAF)
+#define ATTR_CONST_NOTHROW_LEAF_LIST	(ECF_NOTHROW | ECF_LEAF | ECF_CONST)
+#define ATTR_NOTHROW_LIST		(ECF_NOTHROW)
+#define ATTR_CONST_NOTHROW_LIST		(ECF_NOTHROW | ECF_CONST)
+
+static void
+gfc_define_builtin (const char *name, tree type, int code,
+		    const char *library_name, int attr)
+{
+  tree decl;
+
+  decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL,
+			       library_name, NULL_TREE);
+  if (attr & ECF_CONST)
+    TREE_READONLY (decl) = 1;
+  if (attr & ECF_NOTHROW)
+    TREE_NOTHROW (decl) = 1;
+  if (attr & ECF_LEAF)
+    DECL_ATTRIBUTES (decl) = tree_cons (get_identifier ("leaf"),
+					NULL, DECL_ATTRIBUTES (decl));
+
+  built_in_decls[code] = decl;
+  implicit_built_in_decls[code] = decl;
+}
+
+
+#define DO_DEFINE_MATH_BUILTIN(code, name, argtype, tbase) \
+    gfc_define_builtin ("__builtin_" name "l", tbase##longdouble[argtype], \
+			BUILT_IN_ ## code ## L, name "l", \
+			ATTR_CONST_NOTHROW_LEAF_LIST); \
+    gfc_define_builtin ("__builtin_" name, tbase##double[argtype], \
+			BUILT_IN_ ## code, name, \
+			ATTR_CONST_NOTHROW_LEAF_LIST); \
+    gfc_define_builtin ("__builtin_" name "f", tbase##float[argtype], \
+			BUILT_IN_ ## code ## F, name "f", \
+			ATTR_CONST_NOTHROW_LEAF_LIST);
+
+#define DEFINE_MATH_BUILTIN(code, name, argtype) \
+    DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_)
+
+#define DEFINE_MATH_BUILTIN_C(code, name, argtype) \
+    DO_DEFINE_MATH_BUILTIN (code, name, argtype, mfunc_) \
+    DO_DEFINE_MATH_BUILTIN (C##code, "c" name, argtype, mfunc_c)
+
+
+/* Create function types for builtin functions.  */
+
+static void
+build_builtin_fntypes (tree *fntype, tree type)
+{
+  /* type (*) (type) */
+  fntype[0] = build_function_type_list (type, type, NULL_TREE);
+  /* type (*) (type, type) */
+  fntype[1] = build_function_type_list (type, type, type, NULL_TREE);
+  /* type (*) (type, int) */
+  fntype[2] = build_function_type_list (type,
+                                        type, integer_type_node, NULL_TREE);
+  /* type (*) (void) */
+  fntype[3] = build_function_type_list (type, NULL_TREE);
+  /* type (*) (type, &int) */
+  fntype[4] = build_function_type_list (type, type,
+                                        build_pointer_type (integer_type_node),
+                                        NULL_TREE);
+  /* type (*) (int, type) */
+  fntype[5] = build_function_type_list (type,
+                                        integer_type_node, type, NULL_TREE);
+}
+
+
+static tree
+builtin_type_for_size (int size, bool unsignedp)
+{
+  tree type = lang_hooks.types.type_for_size (size, unsignedp);
+  return type ? type : error_mark_node;
+}
+
+/* Initialization of builtin function nodes.  */
+
+static void
+gfc_init_builtin_functions (void)
+{
+  enum builtin_type
+  {
+#define DEF_PRIMITIVE_TYPE(NAME, VALUE) NAME,
+#define DEF_FUNCTION_TYPE_0(NAME, RETURN) NAME,
+#define DEF_FUNCTION_TYPE_1(NAME, RETURN, ARG1) NAME,
+#define DEF_FUNCTION_TYPE_2(NAME, RETURN, ARG1, ARG2) NAME,
+#define DEF_FUNCTION_TYPE_3(NAME, RETURN, ARG1, ARG2, ARG3) NAME,
+#define DEF_FUNCTION_TYPE_4(NAME, RETURN, ARG1, ARG2, ARG3, ARG4) NAME,
+#define DEF_FUNCTION_TYPE_5(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5) NAME,
+#define DEF_FUNCTION_TYPE_6(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6) NAME,
+#define DEF_FUNCTION_TYPE_7(NAME, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7) NAME,
+#define DEF_FUNCTION_TYPE_VAR_0(NAME, RETURN) NAME,
+#define DEF_POINTER_TYPE(NAME, TYPE) NAME,
+#include "types.def"
+#undef DEF_PRIMITIVE_TYPE
+#undef DEF_FUNCTION_TYPE_0
+#undef DEF_FUNCTION_TYPE_1
+#undef DEF_FUNCTION_TYPE_2
+#undef DEF_FUNCTION_TYPE_3
+#undef DEF_FUNCTION_TYPE_4
+#undef DEF_FUNCTION_TYPE_5
+#undef DEF_FUNCTION_TYPE_6
+#undef DEF_FUNCTION_TYPE_7
+#undef DEF_FUNCTION_TYPE_VAR_0
+#undef DEF_POINTER_TYPE
+    BT_LAST
+  };
+  typedef enum builtin_type builtin_type;
+
+  tree mfunc_float[6];
+  tree mfunc_double[6];
+  tree mfunc_longdouble[6];
+  tree mfunc_cfloat[6];
+  tree mfunc_cdouble[6];
+  tree mfunc_clongdouble[6];
+  tree func_cfloat_float, func_float_cfloat;
+  tree func_cdouble_double, func_double_cdouble;
+  tree func_clongdouble_longdouble, func_longdouble_clongdouble;
+  tree func_float_floatp_floatp;
+  tree func_double_doublep_doublep;
+  tree func_longdouble_longdoublep_longdoublep;
+  tree ftype, ptype;
+  tree builtin_types[(int) BT_LAST + 1];
+
+  build_builtin_fntypes (mfunc_float, float_type_node);
+  build_builtin_fntypes (mfunc_double, double_type_node);
+  build_builtin_fntypes (mfunc_longdouble, long_double_type_node);
+  build_builtin_fntypes (mfunc_cfloat, complex_float_type_node);
+  build_builtin_fntypes (mfunc_cdouble, complex_double_type_node);
+  build_builtin_fntypes (mfunc_clongdouble, complex_long_double_type_node);
+
+  func_cfloat_float = build_function_type_list (float_type_node,
+                                                complex_float_type_node,
+                                                NULL_TREE);
+
+  func_float_cfloat = build_function_type_list (complex_float_type_node,
+                                                float_type_node, NULL_TREE);
+
+  func_cdouble_double = build_function_type_list (double_type_node,
+                                                  complex_double_type_node,
+                                                  NULL_TREE);
+
+  func_double_cdouble = build_function_type_list (complex_double_type_node,
+                                                  double_type_node, NULL_TREE);
+
+  func_clongdouble_longdouble =
+    build_function_type_list (long_double_type_node,
+                              complex_long_double_type_node, NULL_TREE);
+
+  func_longdouble_clongdouble =
+    build_function_type_list (complex_long_double_type_node,
+                              long_double_type_node, NULL_TREE);
+
+  ptype = build_pointer_type (float_type_node);
+  func_float_floatp_floatp =
+    build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
+
+  ptype = build_pointer_type (double_type_node);
+  func_double_doublep_doublep =
+    build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
+
+  ptype = build_pointer_type (long_double_type_node);
+  func_longdouble_longdoublep_longdoublep =
+    build_function_type_list (void_type_node, ptype, ptype, NULL_TREE);
+
+/* Non-math builtins are defined manually, so they're not included here.  */
+#define OTHER_BUILTIN(ID,NAME,TYPE,CONST)
+
+#include "mathbuiltins.def"
+
+  gfc_define_builtin ("__builtin_roundl", mfunc_longdouble[0], 
+		      BUILT_IN_ROUNDL, "roundl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_round", mfunc_double[0], 
+		      BUILT_IN_ROUND, "round", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_roundf", mfunc_float[0], 
+		      BUILT_IN_ROUNDF, "roundf", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  gfc_define_builtin ("__builtin_truncl", mfunc_longdouble[0],
+		      BUILT_IN_TRUNCL, "truncl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_trunc", mfunc_double[0],
+		      BUILT_IN_TRUNC, "trunc", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_truncf", mfunc_float[0],
+		      BUILT_IN_TRUNCF, "truncf", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  gfc_define_builtin ("__builtin_cabsl", func_clongdouble_longdouble, 
+		      BUILT_IN_CABSL, "cabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_cabs", func_cdouble_double, 
+		      BUILT_IN_CABS, "cabs", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_cabsf", func_cfloat_float, 
+		      BUILT_IN_CABSF, "cabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
+ 
+  gfc_define_builtin ("__builtin_copysignl", mfunc_longdouble[1], 
+		      BUILT_IN_COPYSIGNL, "copysignl",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_copysign", mfunc_double[1], 
+		      BUILT_IN_COPYSIGN, "copysign",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_copysignf", mfunc_float[1], 
+		      BUILT_IN_COPYSIGNF, "copysignf",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+ 
+  gfc_define_builtin ("__builtin_nextafterl", mfunc_longdouble[1], 
+		      BUILT_IN_NEXTAFTERL, "nextafterl",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_nextafter", mfunc_double[1], 
+		      BUILT_IN_NEXTAFTER, "nextafter",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_nextafterf", mfunc_float[1], 
+		      BUILT_IN_NEXTAFTERF, "nextafterf",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+ 
+  gfc_define_builtin ("__builtin_frexpl", mfunc_longdouble[4], 
+		      BUILT_IN_FREXPL, "frexpl", ATTR_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_frexp", mfunc_double[4], 
+		      BUILT_IN_FREXP, "frexp", ATTR_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_frexpf", mfunc_float[4], 
+		      BUILT_IN_FREXPF, "frexpf", ATTR_NOTHROW_LEAF_LIST);
+ 
+  gfc_define_builtin ("__builtin_fabsl", mfunc_longdouble[0], 
+		      BUILT_IN_FABSL, "fabsl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_fabs", mfunc_double[0], 
+		      BUILT_IN_FABS, "fabs", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_fabsf", mfunc_float[0], 
+		      BUILT_IN_FABSF, "fabsf", ATTR_CONST_NOTHROW_LEAF_LIST);
+ 
+  gfc_define_builtin ("__builtin_scalbnl", mfunc_longdouble[5], 
+		      BUILT_IN_SCALBNL, "scalbnl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_scalbn", mfunc_double[5], 
+		      BUILT_IN_SCALBN, "scalbn", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_scalbnf", mfunc_float[5], 
+		      BUILT_IN_SCALBNF, "scalbnf", ATTR_CONST_NOTHROW_LEAF_LIST);
+ 
+  gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1], 
+		      BUILT_IN_FMODL, "fmodl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_fmod", mfunc_double[1], 
+		      BUILT_IN_FMOD, "fmod", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_fmodf", mfunc_float[1], 
+		      BUILT_IN_FMODF, "fmodf", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  /* lround{f,,l} and llround{f,,l} */
+  ftype = build_function_type_list (long_integer_type_node,
+                                    float_type_node, NULL_TREE); 
+  gfc_define_builtin ("__builtin_lroundf", ftype, BUILT_IN_LROUNDF,
+		      "lroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
+  ftype = build_function_type_list (long_long_integer_type_node,
+                                    float_type_node, NULL_TREE); 
+  gfc_define_builtin ("__builtin_llroundf", ftype, BUILT_IN_LLROUNDF,
+		      "llroundf", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (long_integer_type_node,
+                                    double_type_node, NULL_TREE); 
+  gfc_define_builtin ("__builtin_lround", ftype, BUILT_IN_LROUND,
+		      "lround", ATTR_CONST_NOTHROW_LEAF_LIST);
+  ftype = build_function_type_list (long_long_integer_type_node,
+                                    double_type_node, NULL_TREE); 
+  gfc_define_builtin ("__builtin_llround", ftype, BUILT_IN_LLROUND,
+		      "llround", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (long_integer_type_node,
+                                    long_double_type_node, NULL_TREE); 
+  gfc_define_builtin ("__builtin_lroundl", ftype, BUILT_IN_LROUNDL,
+		      "lroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  ftype = build_function_type_list (long_long_integer_type_node,
+                                    long_double_type_node, NULL_TREE); 
+  gfc_define_builtin ("__builtin_llroundl", ftype, BUILT_IN_LLROUNDL,
+		      "llroundl", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  /* These are used to implement the ** operator.  */
+  gfc_define_builtin ("__builtin_powl", mfunc_longdouble[1], 
+		      BUILT_IN_POWL, "powl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_pow", mfunc_double[1], 
+		      BUILT_IN_POW, "pow", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_powf", mfunc_float[1], 
+		      BUILT_IN_POWF, "powf", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_cpowl", mfunc_clongdouble[1], 
+		      BUILT_IN_CPOWL, "cpowl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_cpow", mfunc_cdouble[1], 
+		      BUILT_IN_CPOW, "cpow", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_cpowf", mfunc_cfloat[1], 
+		      BUILT_IN_CPOWF, "cpowf", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_powil", mfunc_longdouble[2], 
+		      BUILT_IN_POWIL, "powil", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_powi", mfunc_double[2], 
+		      BUILT_IN_POWI, "powi", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_powif", mfunc_float[2], 
+		      BUILT_IN_POWIF, "powif", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+
+  if (TARGET_C99_FUNCTIONS)
+    {
+      gfc_define_builtin ("__builtin_cbrtl", mfunc_longdouble[0],
+			  BUILT_IN_CBRTL, "cbrtl",
+			  ATTR_CONST_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_cbrt", mfunc_double[0],
+			  BUILT_IN_CBRT, "cbrt",
+			  ATTR_CONST_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_cbrtf", mfunc_float[0],
+			  BUILT_IN_CBRTF, "cbrtf",
+			  ATTR_CONST_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_cexpil", func_longdouble_clongdouble, 
+			  BUILT_IN_CEXPIL, "cexpil",
+			  ATTR_CONST_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_cexpi", func_double_cdouble,
+			  BUILT_IN_CEXPI, "cexpi",
+			  ATTR_CONST_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_cexpif", func_float_cfloat,
+			  BUILT_IN_CEXPIF, "cexpif",
+			  ATTR_CONST_NOTHROW_LEAF_LIST);
+    }
+
+  if (TARGET_HAS_SINCOS)
+    {
+      gfc_define_builtin ("__builtin_sincosl",
+			  func_longdouble_longdoublep_longdoublep,
+			  BUILT_IN_SINCOSL, "sincosl", ATTR_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_sincos", func_double_doublep_doublep,
+			  BUILT_IN_SINCOS, "sincos", ATTR_NOTHROW_LEAF_LIST);
+      gfc_define_builtin ("__builtin_sincosf", func_float_floatp_floatp,
+			  BUILT_IN_SINCOSF, "sincosf", ATTR_NOTHROW_LEAF_LIST);
+    }
+
+  /* For LEADZ, TRAILZ, POPCNT and POPPAR.  */
+  ftype = build_function_type_list (integer_type_node,
+                                    unsigned_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_clz", ftype, BUILT_IN_CLZ,
+		      "__builtin_clz", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_ctz", ftype, BUILT_IN_CTZ,
+		      "__builtin_ctz", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_parity", ftype, BUILT_IN_PARITY,
+		      "__builtin_parity", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_popcount", ftype, BUILT_IN_POPCOUNT,
+		      "__builtin_popcount", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (integer_type_node,
+                                    long_unsigned_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_clzl", ftype, BUILT_IN_CLZL,
+		      "__builtin_clzl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_ctzl", ftype, BUILT_IN_CTZL,
+		      "__builtin_ctzl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_parityl", ftype, BUILT_IN_PARITYL,
+		      "__builtin_parityl", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_popcountl", ftype, BUILT_IN_POPCOUNTL,
+		      "__builtin_popcountl", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (integer_type_node,
+                                    long_long_unsigned_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_clzll", ftype, BUILT_IN_CLZLL,
+		      "__builtin_clzll", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_ctzll", ftype, BUILT_IN_CTZLL,
+		      "__builtin_ctzll", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_parityll", ftype, BUILT_IN_PARITYLL,
+		      "__builtin_parityll", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_popcountll", ftype, BUILT_IN_POPCOUNTLL,
+		      "__builtin_popcountll", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  /* Other builtin functions we use.  */
+
+  ftype = build_function_type_list (long_integer_type_node,
+                                    long_integer_type_node,
+                                    long_integer_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
+		      "__builtin_expect", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (void_type_node,
+                                    pvoid_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_free", ftype, BUILT_IN_FREE,
+		      "free", ATTR_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (pvoid_type_node,
+                                    size_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_malloc", ftype, BUILT_IN_MALLOC,
+		      "malloc", ATTR_NOTHROW_LEAF_LIST);
+  DECL_IS_MALLOC (built_in_decls[BUILT_IN_MALLOC]) = 1;
+
+  ftype = build_function_type_list (pvoid_type_node,
+                                    size_type_node, pvoid_type_node,
+                                    NULL_TREE);
+  gfc_define_builtin ("__builtin_realloc", ftype, BUILT_IN_REALLOC,
+		      "realloc", ATTR_NOTHROW_LEAF_LIST);
+
+  ftype = build_function_type_list (integer_type_node,
+                                    void_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_isnan", ftype, BUILT_IN_ISNAN,
+		      "__builtin_isnan", ATTR_CONST_NOTHROW_LEAF_LIST);
+
+#define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \
+  builtin_types[(int) ENUM] = VALUE;
+#define DEF_FUNCTION_TYPE_0(ENUM, RETURN)                       \
+  builtin_types[(int) ENUM]                                     \
+    = build_function_type_list (builtin_types[(int) RETURN],	\
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1)				\
+  builtin_types[(int) ENUM]						\
+    = build_function_type_list (builtin_types[(int) RETURN],            \
+                                builtin_types[(int) ARG1],              \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2)           \
+  builtin_types[(int) ENUM]                                     \
+    = build_function_type_list (builtin_types[(int) RETURN],    \
+                                builtin_types[(int) ARG1],      \
+                                builtin_types[(int) ARG2],      \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3)             \
+  builtin_types[(int) ENUM]                                             \
+    = build_function_type_list (builtin_types[(int) RETURN],            \
+                                builtin_types[(int) ARG1],              \
+                                builtin_types[(int) ARG2],              \
+                                builtin_types[(int) ARG3],              \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4)	\
+  builtin_types[(int) ENUM]						\
+    = build_function_type_list (builtin_types[(int) RETURN],            \
+                                builtin_types[(int) ARG1],              \
+                                builtin_types[(int) ARG2],              \
+                                builtin_types[(int) ARG3],		\
+                                builtin_types[(int) ARG4],              \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5)	\
+  builtin_types[(int) ENUM]						\
+    = build_function_type_list (builtin_types[(int) RETURN],            \
+                                builtin_types[(int) ARG1],              \
+                                builtin_types[(int) ARG2],              \
+                                builtin_types[(int) ARG3],		\
+                                builtin_types[(int) ARG4],              \
+                                builtin_types[(int) ARG5],              \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
+			    ARG6)					\
+  builtin_types[(int) ENUM]						\
+    = build_function_type_list (builtin_types[(int) RETURN],            \
+                                builtin_types[(int) ARG1],              \
+                                builtin_types[(int) ARG2],              \
+                                builtin_types[(int) ARG3],		\
+                                builtin_types[(int) ARG4],		\
+                                builtin_types[(int) ARG5],              \
+                                builtin_types[(int) ARG6],              \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
+			    ARG6, ARG7)					\
+  builtin_types[(int) ENUM]						\
+    = build_function_type_list (builtin_types[(int) RETURN],            \
+                                builtin_types[(int) ARG1],              \
+                                builtin_types[(int) ARG2],              \
+                                builtin_types[(int) ARG3],		\
+                                builtin_types[(int) ARG4],		\
+                                builtin_types[(int) ARG5],              \
+                                builtin_types[(int) ARG6],              \
+                                builtin_types[(int) ARG7],              \
+                                NULL_TREE);
+#define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN)				\
+  builtin_types[(int) ENUM]						\
+    = build_varargs_function_type_list (builtin_types[(int) RETURN],    \
+                                        NULL_TREE);
+#define DEF_POINTER_TYPE(ENUM, TYPE)			\
+  builtin_types[(int) ENUM]				\
+    = build_pointer_type (builtin_types[(int) TYPE]);
+#include "types.def"
+#undef DEF_PRIMITIVE_TYPE
+#undef DEF_FUNCTION_TYPE_1
+#undef DEF_FUNCTION_TYPE_2
+#undef DEF_FUNCTION_TYPE_3
+#undef DEF_FUNCTION_TYPE_4
+#undef DEF_FUNCTION_TYPE_5
+#undef DEF_FUNCTION_TYPE_6
+#undef DEF_FUNCTION_TYPE_VAR_0
+#undef DEF_POINTER_TYPE
+  builtin_types[(int) BT_LAST] = NULL_TREE;
+
+  /* Initialize synchronization builtins.  */
+#undef DEF_SYNC_BUILTIN
+#define DEF_SYNC_BUILTIN(code, name, type, attr) \
+    gfc_define_builtin (name, builtin_types[type], code, name, \
+			attr);
+#include "../sync-builtins.def"
+#undef DEF_SYNC_BUILTIN
+
+  if (gfc_option.gfc_flag_openmp || flag_tree_parallelize_loops)
+    {
+#undef DEF_GOMP_BUILTIN
+#define DEF_GOMP_BUILTIN(code, name, type, attr) \
+      gfc_define_builtin ("__builtin_" name, builtin_types[type], \
+			  code, name, attr);
+#include "../omp-builtins.def"
+#undef DEF_GOMP_BUILTIN
+    }
+
+  gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
+		      BUILT_IN_TRAP, NULL, ATTR_NOTHROW_LEAF_LIST);
+  TREE_THIS_VOLATILE (built_in_decls[BUILT_IN_TRAP]) = 1;
+
+  gfc_define_builtin ("__emutls_get_address",
+		      builtin_types[BT_FN_PTR_PTR],
+		      BUILT_IN_EMUTLS_GET_ADDRESS,
+		      "__emutls_get_address", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__emutls_register_common",
+		      builtin_types[BT_FN_VOID_PTR_WORD_WORD_PTR],
+		      BUILT_IN_EMUTLS_REGISTER_COMMON,
+		      "__emutls_register_common", ATTR_NOTHROW_LEAF_LIST);
+
+  build_common_builtin_nodes ();
+  targetm.init_builtins ();
+}
+
+#undef DEFINE_MATH_BUILTIN_C
+#undef DEFINE_MATH_BUILTIN
+
+static void
+gfc_init_ts (void)
+{
+  tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1;
+  tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1;
+  tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1;
+  tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1;
+  tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1;
+}
+
+void
+gfc_maybe_initialize_eh (void)
+{
+  if (!flag_exceptions || gfc_eh_initialized_p)
+    return;
+
+  gfc_eh_initialized_p = true;
+  using_eh_for_cleanups ();
+}
+
+
+#include "gt-fortran-f95-lang.h"
+#include "gtype-fortran.h"
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
new file mode 100644
index 000000000..7c5576798
--- /dev/null
+++ b/gcc/fortran/frontend-passes.c
@@ -0,0 +1,833 @@
+/* Pass manager for Fortran front end.
+   Copyright (C) 2010 Free Software Foundation, Inc.
+   Contributed by Thomas König.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+#include "arith.h"
+#include "flags.h"
+#include "dependency.h"
+#include "constructor.h"
+#include "opts.h"
+
+/* Forward declarations.  */
+
+static void strip_function_call (gfc_expr *);
+static void optimize_namespace (gfc_namespace *);
+static void optimize_assignment (gfc_code *);
+static bool optimize_op (gfc_expr *);
+static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op);
+static bool optimize_trim (gfc_expr *);
+
+/* How deep we are inside an argument list.  */
+
+static int count_arglist;
+
+/* Entry point - run all passes for a namespace.  So far, only an
+   optimization pass is run.  */
+
+void
+gfc_run_passes (gfc_namespace *ns)
+{
+  if (optimize)
+    {
+      optimize_namespace (ns);
+      if (gfc_option.dump_fortran_optimized)
+	gfc_dump_parse_tree (ns, stdout);
+    }
+}
+
+/* Callback for each gfc_code node invoked through gfc_code_walker
+   from optimize_namespace.  */
+
+static int
+optimize_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
+	       void *data ATTRIBUTE_UNUSED)
+{
+
+  gfc_exec_op op;
+
+  op = (*c)->op;
+
+  if (op == EXEC_CALL || op == EXEC_COMPCALL || op == EXEC_ASSIGN_CALL
+      || op == EXEC_CALL_PPC)
+    count_arglist = 1;
+  else
+    count_arglist = 0;
+
+  if (op == EXEC_ASSIGN)
+    optimize_assignment (*c);
+  return 0;
+}
+
+/* Callback for each gfc_expr node invoked through gfc_code_walker
+   from optimize_namespace.  */
+
+static int
+optimize_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+	       void *data ATTRIBUTE_UNUSED)
+{
+  bool function_expr;
+
+  if ((*e)->expr_type == EXPR_FUNCTION)
+    {
+      count_arglist ++;
+      function_expr = true;
+    }
+  else
+    function_expr = false;
+
+  if (optimize_trim (*e))
+    gfc_simplify_expr (*e, 0);
+
+  if ((*e)->expr_type == EXPR_OP && optimize_op (*e))
+    gfc_simplify_expr (*e, 0);
+
+  if (function_expr)
+    count_arglist --;
+
+  return 0;
+}
+
+/* Optimize a namespace, including all contained namespaces.  */
+
+static void
+optimize_namespace (gfc_namespace *ns)
+{
+  gfc_code_walker (&ns->code, optimize_code, optimize_expr, NULL);
+
+  for (ns = ns->contained; ns; ns = ns->sibling)
+    optimize_namespace (ns);
+}
+
+/* Replace code like
+   a = matmul(b,c) + d
+   with
+   a = matmul(b,c) ;   a = a + d
+   where the array function is not elemental and not allocatable
+   and does not depend on the left-hand side.
+*/
+
+static bool
+optimize_binop_array_assignment (gfc_code *c, gfc_expr **rhs, bool seen_op)
+{
+  gfc_expr *e;
+
+  e = *rhs;
+  if (e->expr_type == EXPR_OP)
+    {
+      switch (e->value.op.op)
+	{
+	  /* Unary operators and exponentiation: Only look at a single
+	     operand.  */
+	case INTRINSIC_NOT:
+	case INTRINSIC_UPLUS:
+	case INTRINSIC_UMINUS:
+	case INTRINSIC_PARENTHESES:
+	case INTRINSIC_POWER:
+	  if (optimize_binop_array_assignment (c, &e->value.op.op1, seen_op))
+	    return true;
+	  break;
+
+	default:
+	  /* Binary operators.  */
+	  if (optimize_binop_array_assignment (c, &e->value.op.op1, true))
+	    return true;
+
+	  if (optimize_binop_array_assignment (c, &e->value.op.op2, true))
+	    return true;
+
+	  break;
+	}
+    }
+  else if (seen_op && e->expr_type == EXPR_FUNCTION && e->rank > 0
+	   && ! (e->value.function.esym 
+		 && (e->value.function.esym->attr.elemental 
+		     || e->value.function.esym->attr.allocatable
+		     || e->value.function.esym->ts.type != c->expr1->ts.type
+		     || e->value.function.esym->ts.kind != c->expr1->ts.kind))
+	   && ! (e->value.function.isym
+		 && (e->value.function.isym->elemental
+		     || e->ts.type != c->expr1->ts.type
+		     || e->ts.kind != c->expr1->ts.kind)))
+    {
+
+      gfc_code *n;
+      gfc_expr *new_expr;
+
+      /* Insert a new assignment statement after the current one.  */
+      n = XCNEW (gfc_code);
+      n->op = EXEC_ASSIGN;
+      n->loc = c->loc;
+      n->next = c->next;
+      c->next = n;
+
+      n->expr1 = gfc_copy_expr (c->expr1);
+      n->expr2 = c->expr2;
+      new_expr = gfc_copy_expr (c->expr1);
+      c->expr2 = e;
+      *rhs = new_expr;
+      
+      return true;
+
+    }
+
+  /* Nothing to optimize.  */
+  return false;
+}
+
+/* Optimizations for an assignment.  */
+
+static void
+optimize_assignment (gfc_code * c)
+{
+  gfc_expr *lhs, *rhs;
+
+  lhs = c->expr1;
+  rhs = c->expr2;
+
+  /* Optimize away a = trim(b), where a is a character variable.  */
+
+  if (lhs->ts.type == BT_CHARACTER)
+    {
+      if (rhs->expr_type == EXPR_FUNCTION &&
+	  rhs->value.function.isym &&
+	  rhs->value.function.isym->id == GFC_ISYM_TRIM)
+	{
+	  strip_function_call (rhs);
+	  optimize_assignment (c);
+	  return;
+	}
+    }
+
+  if (lhs->rank > 0 && gfc_check_dependency (lhs, rhs, true) == 0)
+    optimize_binop_array_assignment (c, &rhs, false);
+}
+
+
+/* Remove an unneeded function call, modifying the expression.
+   This replaces the function call with the value of its
+   first argument.  The rest of the argument list is freed.  */
+
+static void
+strip_function_call (gfc_expr *e)
+{
+  gfc_expr *e1;
+  gfc_actual_arglist *a;
+
+  a = e->value.function.actual;
+
+  /* We should have at least one argument.  */
+  gcc_assert (a->expr != NULL);
+
+  e1 = a->expr;
+
+  /* Free the remaining arglist, if any.  */
+  if (a->next)
+    gfc_free_actual_arglist (a->next);
+
+  /* Graft the argument expression onto the original function.  */
+  *e = *e1;
+  gfc_free (e1);
+
+}
+
+/* Recursive optimization of operators.  */
+
+static bool
+optimize_op (gfc_expr *e)
+{
+  gfc_intrinsic_op op = e->value.op.op;
+
+  switch (op)
+    {
+    case INTRINSIC_EQ:
+    case INTRINSIC_EQ_OS:
+    case INTRINSIC_GE:
+    case INTRINSIC_GE_OS:
+    case INTRINSIC_LE:
+    case INTRINSIC_LE_OS:
+    case INTRINSIC_NE:
+    case INTRINSIC_NE_OS:
+    case INTRINSIC_GT:
+    case INTRINSIC_GT_OS:
+    case INTRINSIC_LT:
+    case INTRINSIC_LT_OS:
+      return optimize_comparison (e, op);
+
+    default:
+      break;
+    }
+
+  return false;
+}
+
+/* Optimize expressions for equality.  */
+
+static bool
+optimize_comparison (gfc_expr *e, gfc_intrinsic_op op)
+{
+  gfc_expr *op1, *op2;
+  bool change;
+  int eq;
+  bool result;
+
+  op1 = e->value.op.op1;
+  op2 = e->value.op.op2;
+
+  /* Strip off unneeded TRIM calls from string comparisons.  */
+
+  change = false;
+
+  if (op1->expr_type == EXPR_FUNCTION 
+      && op1->value.function.isym
+      && op1->value.function.isym->id == GFC_ISYM_TRIM)
+    {
+      strip_function_call (op1);
+      change = true;
+    }
+
+  if (op2->expr_type == EXPR_FUNCTION 
+      && op2->value.function.isym
+      && op2->value.function.isym->id == GFC_ISYM_TRIM)
+    {
+      strip_function_call (op2);
+      change = true;
+    }
+
+  if (change)
+    {
+      optimize_comparison (e, op);
+      return true;
+    }
+
+  /* An expression of type EXPR_CONSTANT is only valid for scalars.  */
+  /* TODO: A scalar constant may be acceptable in some cases (the scalarizer
+     handles them well). However, there are also cases that need a non-scalar
+     argument. For example the any intrinsic. See PR 45380.  */
+  if (e->rank > 0)
+    return false;
+
+  /* Don't compare REAL or COMPLEX expressions when honoring NaNs.  */
+
+  if (flag_finite_math_only
+      || (op1->ts.type != BT_REAL && op2->ts.type != BT_REAL
+	  && op1->ts.type != BT_COMPLEX && op2->ts.type != BT_COMPLEX))
+    {
+      eq = gfc_dep_compare_expr (op1, op2);
+      if (eq == -2)
+	{
+	  /* Replace A // B < A // C with B < C, and A // B < C // B
+	     with A < C.  */
+	  if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
+	      && op1->value.op.op == INTRINSIC_CONCAT
+	      && op2->value.op.op == INTRINSIC_CONCAT)
+	    {
+	      gfc_expr *op1_left = op1->value.op.op1;
+	      gfc_expr *op2_left = op2->value.op.op1;
+	      gfc_expr *op1_right = op1->value.op.op2;
+	      gfc_expr *op2_right = op2->value.op.op2;
+
+	      if (gfc_dep_compare_expr (op1_left, op2_left) == 0)
+		{
+		  /* Watch out for 'A ' // x vs. 'A' // x.  */
+
+		  if (op1_left->expr_type == EXPR_CONSTANT
+			&& op2_left->expr_type == EXPR_CONSTANT
+			&& op1_left->value.character.length
+			   != op2_left->value.character.length)
+		    return -2;
+		  else
+		    {
+		      gfc_free (op1_left);
+		      gfc_free (op2_left);
+		      e->value.op.op1 = op1_right;
+		      e->value.op.op2 = op2_right;
+		      optimize_comparison (e, op);
+		      return true;
+		    }
+		}
+	      if (gfc_dep_compare_expr (op1_right, op2_right) == 0)
+		{
+		  gfc_free (op1_right);
+		  gfc_free (op2_right);
+		  e->value.op.op1 = op1_left;
+		  e->value.op.op2 = op2_left;
+		  optimize_comparison (e, op);
+		  return true;
+		}
+	    }
+	}
+      else
+	{
+	  /* eq can only be -1, 0 or 1 at this point.  */
+	  switch (op)
+	    {
+	    case INTRINSIC_EQ:
+	    case INTRINSIC_EQ_OS:
+	      result = eq == 0;
+	      break;
+	      
+	    case INTRINSIC_GE:
+	    case INTRINSIC_GE_OS:
+	      result = eq >= 0;
+	      break;
+
+	    case INTRINSIC_LE:
+	    case INTRINSIC_LE_OS:
+	      result = eq <= 0;
+	      break;
+
+	    case INTRINSIC_NE:
+	    case INTRINSIC_NE_OS:
+	      result = eq != 0;
+	      break;
+
+	    case INTRINSIC_GT:
+	    case INTRINSIC_GT_OS:
+	      result = eq > 0;
+	      break;
+
+	    case INTRINSIC_LT:
+	    case INTRINSIC_LT_OS:
+	      result = eq < 0;
+	      break;
+	      
+	    default:
+	      gfc_internal_error ("illegal OP in optimize_comparison");
+	      break;
+	    }
+
+	  /* Replace the expression by a constant expression.  The typespec
+	     and where remains the way it is.  */
+	  gfc_free (op1);
+	  gfc_free (op2);
+	  e->expr_type = EXPR_CONSTANT;
+	  e->value.logical = result;
+	  return true;
+	}
+    }
+
+  return false;
+}
+
+/* Optimize a trim function by replacing it with an equivalent substring
+   involving a call to len_trim.  This only works for expressions where
+   variables are trimmed.  Return true if anything was modified.  */
+
+static bool
+optimize_trim (gfc_expr *e)
+{
+  gfc_expr *a;
+  gfc_ref *ref;
+  gfc_expr *fcn;
+  gfc_actual_arglist *actual_arglist, *next;
+
+  /* Don't do this optimization within an argument list, because
+     otherwise aliasing issues may occur.  */
+
+  if (count_arglist != 1)
+    return false;
+
+  if (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_FUNCTION
+      || e->value.function.isym == NULL
+      || e->value.function.isym->id != GFC_ISYM_TRIM)
+    return false;
+
+  a = e->value.function.actual->expr;
+
+  if (a->expr_type != EXPR_VARIABLE)
+    return false;
+
+  if (a->ref)
+    {
+      /* FIXME - also handle substring references, by modifying the
+	 reference itself.  Make sure not to evaluate functions in
+	 the references twice.  */
+      return false;
+    }
+  else
+    {
+      strip_function_call (e);
+
+      /* Create the reference.  */
+
+      ref = gfc_get_ref ();
+      ref->type = REF_SUBSTRING;
+
+      /* Set the start of the reference.  */
+
+      ref->u.ss.start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+
+      /* Build the function call to len_trim(x, gfc_defaul_integer_kind).  */
+
+      fcn = gfc_get_expr ();
+      fcn->expr_type = EXPR_FUNCTION;
+      fcn->value.function.isym =
+	gfc_intrinsic_function_by_id (GFC_ISYM_LEN_TRIM);
+      actual_arglist = gfc_get_actual_arglist ();
+      actual_arglist->expr = gfc_copy_expr (e);
+      next = gfc_get_actual_arglist ();
+      next->expr = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+				     gfc_default_integer_kind);
+      actual_arglist->next = next;
+      fcn->value.function.actual = actual_arglist;
+
+      /* Set the end of the reference to the call to len_trim.  */
+
+      ref->u.ss.end = fcn;
+      e->ref = ref;
+      return true;
+    }
+}
+
+#define WALK_SUBEXPR(NODE) \
+  do							\
+    {							\
+      result = gfc_expr_walker (&(NODE), exprfn, data);	\
+      if (result)					\
+	return result;					\
+    }							\
+  while (0)
+#define WALK_SUBEXPR_TAIL(NODE) e = &(NODE); continue
+
+/* Walk expression *E, calling EXPRFN on each expression in it.  */
+
+int
+gfc_expr_walker (gfc_expr **e, walk_expr_fn_t exprfn, void *data)
+{
+  while (*e)
+    {
+      int walk_subtrees = 1;
+      gfc_actual_arglist *a;
+      gfc_ref *r;
+      gfc_constructor *c;
+
+      int result = exprfn (e, &walk_subtrees, data);
+      if (result)
+	return result;
+      if (walk_subtrees)
+	switch ((*e)->expr_type)
+	  {
+	  case EXPR_OP:
+	    WALK_SUBEXPR ((*e)->value.op.op1);
+	    WALK_SUBEXPR_TAIL ((*e)->value.op.op2);
+	    break;
+	  case EXPR_FUNCTION:
+	    for (a = (*e)->value.function.actual; a; a = a->next)
+	      WALK_SUBEXPR (a->expr);
+	    break;
+	  case EXPR_COMPCALL:
+	  case EXPR_PPC:
+	    WALK_SUBEXPR ((*e)->value.compcall.base_object);
+	    for (a = (*e)->value.compcall.actual; a; a = a->next)
+	      WALK_SUBEXPR (a->expr);
+	    break;
+
+	  case EXPR_STRUCTURE:
+	  case EXPR_ARRAY:
+	    for (c = gfc_constructor_first ((*e)->value.constructor); c;
+		 c = gfc_constructor_next (c))
+	      {
+		WALK_SUBEXPR (c->expr);
+		if (c->iterator != NULL)
+		  {
+		    WALK_SUBEXPR (c->iterator->var);
+		    WALK_SUBEXPR (c->iterator->start);
+		    WALK_SUBEXPR (c->iterator->end);
+		    WALK_SUBEXPR (c->iterator->step);
+		  }
+	      }
+
+	    if ((*e)->expr_type != EXPR_ARRAY)
+	      break;
+
+	    /* Fall through to the variable case in order to walk the
+	       the reference.  */
+
+	  case EXPR_SUBSTRING:
+	  case EXPR_VARIABLE:
+	    for (r = (*e)->ref; r; r = r->next)
+	      {
+		gfc_array_ref *ar;
+		int i;
+
+		switch (r->type)
+		  {
+		  case REF_ARRAY:
+		    ar = &r->u.ar;
+		    if (ar->type == AR_SECTION || ar->type == AR_ELEMENT)
+		      {
+			for (i=0; i< ar->dimen; i++)
+			  {
+			    WALK_SUBEXPR (ar->start[i]);
+			    WALK_SUBEXPR (ar->end[i]);
+			    WALK_SUBEXPR (ar->stride[i]);
+			  }
+		      }
+
+		    break;
+
+		  case REF_SUBSTRING:
+		    WALK_SUBEXPR (r->u.ss.start);
+		    WALK_SUBEXPR (r->u.ss.end);
+		    break;
+
+		  case REF_COMPONENT:
+		    break;
+		  }
+	      }
+
+	  default:
+	    break;
+	  }
+      return 0;
+    }
+  return 0;
+}
+
+#define WALK_SUBCODE(NODE) \
+  do								\
+    {								\
+      result = gfc_code_walker (&(NODE), codefn, exprfn, data);	\
+      if (result)						\
+	return result;						\
+    }								\
+  while (0)
+
+/* Walk code *C, calling CODEFN on each gfc_code node in it and calling EXPRFN
+   on each expression in it.  If any of the hooks returns non-zero, that
+   value is immediately returned.  If the hook sets *WALK_SUBTREES to 0,
+   no subcodes or subexpressions are traversed.  */
+
+int
+gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
+		 void *data)
+{
+  for (; *c; c = &(*c)->next)
+    {
+      int walk_subtrees = 1;
+      int result = codefn (c, &walk_subtrees, data);
+      if (result)
+	return result;
+
+      if (walk_subtrees)
+	{
+	  gfc_code *b;
+	  gfc_actual_arglist *a;
+
+	  switch ((*c)->op)
+	    {
+	    case EXEC_DO:
+	      WALK_SUBEXPR ((*c)->ext.iterator->var);
+	      WALK_SUBEXPR ((*c)->ext.iterator->start);
+	      WALK_SUBEXPR ((*c)->ext.iterator->end);
+	      WALK_SUBEXPR ((*c)->ext.iterator->step);
+	      break;
+
+	    case EXEC_CALL:
+	    case EXEC_ASSIGN_CALL:
+	      for (a = (*c)->ext.actual; a; a = a->next)
+		WALK_SUBEXPR (a->expr);
+	      break;
+
+	    case EXEC_CALL_PPC:
+	      WALK_SUBEXPR ((*c)->expr1);
+	      for (a = (*c)->ext.actual; a; a = a->next)
+		WALK_SUBEXPR (a->expr);
+	      break;
+
+	    case EXEC_SELECT:
+	      WALK_SUBEXPR ((*c)->expr1);
+	      for (b = (*c)->block; b; b = b->block)
+		{
+		  gfc_case *cp;
+		  for (cp = b->ext.block.case_list; cp; cp = cp->next)
+		    {
+		      WALK_SUBEXPR (cp->low);
+		      WALK_SUBEXPR (cp->high);
+		    }
+		  WALK_SUBCODE (b->next);
+		}
+	      continue;
+
+	    case EXEC_ALLOCATE:
+	    case EXEC_DEALLOCATE:
+	      {
+		gfc_alloc *a;
+		for (a = (*c)->ext.alloc.list; a; a = a->next)
+		  WALK_SUBEXPR (a->expr);
+		break;
+	      }
+
+	    case EXEC_FORALL:
+	      {
+		gfc_forall_iterator *fa;
+		for (fa = (*c)->ext.forall_iterator; fa; fa = fa->next)
+		  {
+		    WALK_SUBEXPR (fa->var);
+		    WALK_SUBEXPR (fa->start);
+		    WALK_SUBEXPR (fa->end);
+		    WALK_SUBEXPR (fa->stride);
+		  }
+		break;
+	      }
+
+	    case EXEC_OPEN:
+	      WALK_SUBEXPR ((*c)->ext.open->unit);
+	      WALK_SUBEXPR ((*c)->ext.open->file);
+	      WALK_SUBEXPR ((*c)->ext.open->status);
+	      WALK_SUBEXPR ((*c)->ext.open->access);
+	      WALK_SUBEXPR ((*c)->ext.open->form);
+	      WALK_SUBEXPR ((*c)->ext.open->recl);
+	      WALK_SUBEXPR ((*c)->ext.open->blank);
+	      WALK_SUBEXPR ((*c)->ext.open->position);
+	      WALK_SUBEXPR ((*c)->ext.open->action);
+	      WALK_SUBEXPR ((*c)->ext.open->delim);
+	      WALK_SUBEXPR ((*c)->ext.open->pad);
+	      WALK_SUBEXPR ((*c)->ext.open->iostat);
+	      WALK_SUBEXPR ((*c)->ext.open->iomsg);
+	      WALK_SUBEXPR ((*c)->ext.open->convert);
+	      WALK_SUBEXPR ((*c)->ext.open->decimal);
+	      WALK_SUBEXPR ((*c)->ext.open->encoding);
+	      WALK_SUBEXPR ((*c)->ext.open->round);
+	      WALK_SUBEXPR ((*c)->ext.open->sign);
+	      WALK_SUBEXPR ((*c)->ext.open->asynchronous);
+	      WALK_SUBEXPR ((*c)->ext.open->id);
+	      WALK_SUBEXPR ((*c)->ext.open->newunit);
+	      break;
+
+	    case EXEC_CLOSE:
+	      WALK_SUBEXPR ((*c)->ext.close->unit);
+	      WALK_SUBEXPR ((*c)->ext.close->status);
+	      WALK_SUBEXPR ((*c)->ext.close->iostat);
+	      WALK_SUBEXPR ((*c)->ext.close->iomsg);
+	      break;
+
+	    case EXEC_BACKSPACE:
+	    case EXEC_ENDFILE:
+	    case EXEC_REWIND:
+	    case EXEC_FLUSH:
+	      WALK_SUBEXPR ((*c)->ext.filepos->unit);
+	      WALK_SUBEXPR ((*c)->ext.filepos->iostat);
+	      WALK_SUBEXPR ((*c)->ext.filepos->iomsg);
+	      break;
+
+	    case EXEC_INQUIRE:
+	      WALK_SUBEXPR ((*c)->ext.inquire->unit);
+	      WALK_SUBEXPR ((*c)->ext.inquire->file);
+	      WALK_SUBEXPR ((*c)->ext.inquire->iomsg);
+	      WALK_SUBEXPR ((*c)->ext.inquire->iostat);
+	      WALK_SUBEXPR ((*c)->ext.inquire->exist);
+	      WALK_SUBEXPR ((*c)->ext.inquire->opened);
+	      WALK_SUBEXPR ((*c)->ext.inquire->number);
+	      WALK_SUBEXPR ((*c)->ext.inquire->named);
+	      WALK_SUBEXPR ((*c)->ext.inquire->name);
+	      WALK_SUBEXPR ((*c)->ext.inquire->access);
+	      WALK_SUBEXPR ((*c)->ext.inquire->sequential);
+	      WALK_SUBEXPR ((*c)->ext.inquire->direct);
+	      WALK_SUBEXPR ((*c)->ext.inquire->form);
+	      WALK_SUBEXPR ((*c)->ext.inquire->formatted);
+	      WALK_SUBEXPR ((*c)->ext.inquire->unformatted);
+	      WALK_SUBEXPR ((*c)->ext.inquire->recl);
+	      WALK_SUBEXPR ((*c)->ext.inquire->nextrec);
+	      WALK_SUBEXPR ((*c)->ext.inquire->blank);
+	      WALK_SUBEXPR ((*c)->ext.inquire->position);
+	      WALK_SUBEXPR ((*c)->ext.inquire->action);
+	      WALK_SUBEXPR ((*c)->ext.inquire->read);
+	      WALK_SUBEXPR ((*c)->ext.inquire->write);
+	      WALK_SUBEXPR ((*c)->ext.inquire->readwrite);
+	      WALK_SUBEXPR ((*c)->ext.inquire->delim);
+	      WALK_SUBEXPR ((*c)->ext.inquire->encoding);
+	      WALK_SUBEXPR ((*c)->ext.inquire->pad);
+	      WALK_SUBEXPR ((*c)->ext.inquire->iolength);
+	      WALK_SUBEXPR ((*c)->ext.inquire->convert);
+	      WALK_SUBEXPR ((*c)->ext.inquire->strm_pos);
+	      WALK_SUBEXPR ((*c)->ext.inquire->asynchronous);
+	      WALK_SUBEXPR ((*c)->ext.inquire->decimal);
+	      WALK_SUBEXPR ((*c)->ext.inquire->pending);
+	      WALK_SUBEXPR ((*c)->ext.inquire->id);
+	      WALK_SUBEXPR ((*c)->ext.inquire->sign);
+	      WALK_SUBEXPR ((*c)->ext.inquire->size);
+	      WALK_SUBEXPR ((*c)->ext.inquire->round);
+	      break;
+
+	    case EXEC_WAIT:
+	      WALK_SUBEXPR ((*c)->ext.wait->unit);
+	      WALK_SUBEXPR ((*c)->ext.wait->iostat);
+	      WALK_SUBEXPR ((*c)->ext.wait->iomsg);
+	      WALK_SUBEXPR ((*c)->ext.wait->id);
+	      break;
+
+	    case EXEC_READ:
+	    case EXEC_WRITE:
+	      WALK_SUBEXPR ((*c)->ext.dt->io_unit);
+	      WALK_SUBEXPR ((*c)->ext.dt->format_expr);
+	      WALK_SUBEXPR ((*c)->ext.dt->rec);
+	      WALK_SUBEXPR ((*c)->ext.dt->advance);
+	      WALK_SUBEXPR ((*c)->ext.dt->iostat);
+	      WALK_SUBEXPR ((*c)->ext.dt->size);
+	      WALK_SUBEXPR ((*c)->ext.dt->iomsg);
+	      WALK_SUBEXPR ((*c)->ext.dt->id);
+	      WALK_SUBEXPR ((*c)->ext.dt->pos);
+	      WALK_SUBEXPR ((*c)->ext.dt->asynchronous);
+	      WALK_SUBEXPR ((*c)->ext.dt->blank);
+	      WALK_SUBEXPR ((*c)->ext.dt->decimal);
+	      WALK_SUBEXPR ((*c)->ext.dt->delim);
+	      WALK_SUBEXPR ((*c)->ext.dt->pad);
+	      WALK_SUBEXPR ((*c)->ext.dt->round);
+	      WALK_SUBEXPR ((*c)->ext.dt->sign);
+	      WALK_SUBEXPR ((*c)->ext.dt->extra_comma);
+	      break;
+
+	    case EXEC_OMP_DO:
+	    case EXEC_OMP_PARALLEL:
+	    case EXEC_OMP_PARALLEL_DO:
+	    case EXEC_OMP_PARALLEL_SECTIONS:
+	    case EXEC_OMP_PARALLEL_WORKSHARE:
+	    case EXEC_OMP_SECTIONS:
+	    case EXEC_OMP_SINGLE:
+	    case EXEC_OMP_WORKSHARE:
+	    case EXEC_OMP_END_SINGLE:
+	    case EXEC_OMP_TASK:
+	      if ((*c)->ext.omp_clauses)
+		{
+		  WALK_SUBEXPR ((*c)->ext.omp_clauses->if_expr);
+		  WALK_SUBEXPR ((*c)->ext.omp_clauses->num_threads);
+		  WALK_SUBEXPR ((*c)->ext.omp_clauses->chunk_size);
+		}
+	      break;
+	    default:
+	      break;
+	    }
+
+	  WALK_SUBEXPR ((*c)->expr1);
+	  WALK_SUBEXPR ((*c)->expr2);
+	  WALK_SUBEXPR ((*c)->expr3);
+	  for (b = (*c)->block; b; b = b->block)
+	    {
+	      WALK_SUBEXPR (b->expr1);
+	      WALK_SUBEXPR (b->expr2);
+	      WALK_SUBCODE (b->next);
+	    }
+	}
+    }
+  return 0;
+}
diff --git a/gcc/fortran/gfc-internals.texi b/gcc/fortran/gfc-internals.texi
new file mode 100644
index 000000000..ed4c5ed3d
--- /dev/null
+++ b/gcc/fortran/gfc-internals.texi
@@ -0,0 +1,826 @@
+\input texinfo  @c -*-texinfo-*-
+@c %**start of header
+@setfilename gfc-internals.info
+@set copyrights-gfortran 2007, 2008, 2009, 2010
+
+@include gcc-common.texi
+
+@synindex tp cp
+
+@settitle GNU Fortran Compiler Internals
+
+@c %**end of header
+
+@c Use with @@smallbook.
+
+@c %** start of document
+
+@c Cause even numbered pages to be printed on the left hand side of
+@c the page and odd numbered pages to be printed on the right hand
+@c side of the page.  Using this, you can print on both sides of a
+@c sheet of paper and have the text on the same part of the sheet.
+
+@c The text on right hand pages is pushed towards the right hand
+@c margin and the text on left hand pages is pushed toward the left
+@c hand margin.
+@c (To provide the reverse effect, set bindingoffset to -0.75in.)
+
+@c @tex
+@c \global\bindingoffset=0.75in
+@c \global\normaloffset =0.75in
+@c @end tex
+
+@copying
+Copyright @copyright{} @value{copyrights-gfortran} Free Software Foundation,
+Inc.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with the
+Invariant Sections being ``Funding Free Software'', the Front-Cover
+Texts being (a) (see below), and with the Back-Cover Texts being (b)
+(see below).  A copy of the license is included in the section entitled
+``GNU Free Documentation License''.
+
+(a) The FSF's Front-Cover Text is:
+
+     A GNU Manual
+
+(b) The FSF's Back-Cover Text is:
+
+     You have freedom to copy and modify this GNU Manual, like GNU
+     software.  Copies published by the Free Software Foundation raise
+     funds for GNU development.
+@end copying
+
+@ifinfo
+@dircategory Software development
+@direntry
+* gfortran: (gfortran).                  The GNU Fortran Compiler.
+@end direntry
+This file documents the internals of the GNU Fortran
+compiler, (@command{gfortran}).
+
+Published by the Free Software Foundation
+51 Franklin Street, Fifth Floor
+Boston, MA 02110-1301 USA
+
+@insertcopying
+@end ifinfo
+
+
+@setchapternewpage odd
+@titlepage
+@title GNU Fortran Internals
+@versionsubtitle
+@author The @t{gfortran} team
+@page
+@vskip 0pt plus 1filll
+Published by the Free Software Foundation@*
+51 Franklin Street, Fifth Floor@*
+Boston, MA 02110-1301, USA@*
+@c Last printed ??ber, 19??.@*
+@c Printed copies are available for $? each.@*
+@c ISBN ???
+@sp 1
+@insertcopying
+@end titlepage
+
+@summarycontents
+@contents
+
+@page
+
+@c ---------------------------------------------------------------------
+@c TexInfo table of contents.
+@c ---------------------------------------------------------------------
+
+@ifnottex
+@node Top
+@top Introduction
+@cindex Introduction
+
+This manual documents the internals of @command{gfortran}, 
+the GNU Fortran compiler.
+
+@ifset DEVELOPMENT
+@emph{Warning:} This document, and the compiler it describes, are still
+under development.  While efforts are made to keep it up-to-date, it might
+not accurately reflect the status of the most recent GNU Fortran compiler.
+@end ifset
+
+@comment
+@comment  When you add a new menu item, please keep the right hand
+@comment  aligned to the same column.  Do not use tabs.  This provides
+@comment  better formatting.
+@comment
+@menu
+* Introduction::           About this manual.
+* User Interface::         Code that Interacts with the User.
+* Frontend Data Structures::
+                           Data structures used by the frontend
+* Object Orientation::     Internals of Fortran 2003 OOP features.
+* LibGFortran::            The LibGFortran Runtime Library.
+* GNU Free Documentation License::
+                           How you can copy and share this manual.
+* Index::                  Index of this documentation.
+@end menu
+@end ifnottex
+
+@c ---------------------------------------------------------------------
+@c Introduction
+@c ---------------------------------------------------------------------
+
+@node Introduction
+@chapter Introduction
+
+@c The following duplicates the text on the TexInfo table of contents.
+@iftex
+This manual documents the internals of @command{gfortran}, the GNU Fortran
+compiler.
+
+@ifset DEVELOPMENT
+@emph{Warning:} This document, and the compiler it describes, are still
+under development.  While efforts are made to keep it up-to-date, it
+might not accurately reflect the status of the most recent GNU Fortran
+compiler.
+@end ifset
+@end iftex
+
+At present, this manual is very much a work in progress, containing 
+miscellaneous notes about the internals of the compiler.  It is hoped
+that at some point in the future it will become a reasonably complete
+guide; in the interim, GNU Fortran developers are strongly encouraged to
+contribute to it as a way of keeping notes while working on the 
+compiler.
+
+
+@c ---------------------------------------------------------------------
+@c Code that Interacts with the User
+@c ---------------------------------------------------------------------
+
+@node User Interface
+@chapter Code that Interacts with the User
+
+@menu
+* Command-Line Options::    Command-Line Options.
+* Error Handling::          Error Handling.
+@end menu
+
+
+@c ---------------------------------------------------------------------
+@c Command-Line Options
+@c ---------------------------------------------------------------------
+
+@node Command-Line Options
+@section Command-Line Options
+
+Command-line options for @command{gfortran} involve four interrelated
+pieces within the Fortran compiler code.
+
+The relevant command-line flag is defined in @file{lang.opt}, according
+to the documentation in @ref{Options,, Options, gccint, GNU Compiler
+Collection Internals}.  This is then processed by the overall GCC
+machinery to create the code that enables @command{gfortran} and
+@command{gcc} to recognize the option in the command-line arguments and
+call the relevant handler function.
+
+This generated code calls the @code{gfc_handle_option} code in
+@file{options.c} with an enumerator variable indicating which option is
+to be processed, and the relevant integer or string values associated
+with that option flag.  Typically, @code{gfc_handle_option} uses these
+arguments to set global flags which record the option states.
+
+The global flags that record the option states are stored in the
+@code{gfc_option_t} struct, which is defined in @file{gfortran.h}.
+Before the options are processed, initial values for these flags are set
+in @code{gfc_init_option} in @file{options.c}; these become the default
+values for the options.
+
+
+
+@c ---------------------------------------------------------------------
+@c Error Handling
+@c ---------------------------------------------------------------------
+
+@node Error Handling
+@section Error Handling
+
+The GNU Fortran compiler's parser operates by testing each piece of
+source code against a variety of matchers.  In some cases, if these
+matchers do not match the source code, they will store an error message
+in a buffer.  If the parser later finds a matcher that does correctly
+match the source code, then the buffered error is discarded.  However,
+if the parser cannot find a match, then the buffered error message is
+reported to the user.  This enables the compiler to provide more
+meaningful error messages even in the many cases where (erroneous)
+Fortran syntax is ambiguous due to things like the absence of reserved
+keywords.
+
+As an example of how this works, consider the following line:
+@smallexample
+IF = 3
+@end smallexample
+Hypothetically, this may get passed to the matcher for an @code{IF}
+statement.  Since this could plausibly be an erroneous @code{IF}
+statement, the matcher will buffer an error message reporting the
+absence of an expected @samp{(} following an @code{IF}.  Since no
+matchers reported an error-free match, however, the parser will also try
+matching this against a variable assignment.  When @code{IF} is a valid
+variable, this will be parsed as an assignment statement, and the error
+discarded.  However, when @code{IF} is not a valid variable, this
+buffered error message will be reported to the user.
+
+The error handling code is implemented in @file{error.c}.  Errors are
+normally entered into the buffer with the @code{gfc_error} function.
+Warnings go through a similar buffering process, and are entered into
+the buffer with @code{gfc_warning}.  There is also a special-purpose
+function, @code{gfc_notify_std}, for things which have an error/warning
+status that depends on the currently-selected language standard.
+
+The @code{gfc_error_check} function checks the buffer for errors,
+reports the error message to the user if one exists, clears the buffer,
+and returns a flag to the user indicating whether or not an error
+existed.  To check the state of the buffer without changing its state or
+reporting the errors, the @code{gfc_error_flag_test} function can be
+used.  The @code{gfc_clear_error} function will clear out any errors in
+the buffer, without reporting them.  The @code{gfc_warning_check} and
+@code{gfc_clear_warning} functions provide equivalent functionality for
+the warning buffer.
+
+Only one error and one warning can be in the buffers at a time, and
+buffering another will overwrite the existing one.  In cases where one
+may wish to work on a smaller piece of source code without disturbing an
+existing error state, the @code{gfc_push_error}, @code{gfc_pop_error},
+and @code{gfc_free_error} mechanism exists to implement a stack for the
+error buffer.
+
+For cases where an error or warning should be reported immediately
+rather than buffered, the @code{gfc_error_now} and
+@code{gfc_warning_now} functions can be used.  Normally, the compiler
+will continue attempting to parse the program after an error has
+occurred, but if this is not appropriate, the @code{gfc_fatal_error}
+function should be used instead.  For errors that are always the result
+of a bug somewhere in the compiler, the @code{gfc_internal_error}
+function should be used.
+
+The syntax for the strings used to produce the error/warning message in
+the various error and warning functions is similar to the @code{printf}
+syntax, with @samp{%}-escapes to insert variable values.  The details,
+and the allowable codes, are documented in the @code{error_print}
+function in @file{error.c}.
+
+@c ---------------------------------------------------------------------
+@c Frontend Data Structures
+@c ---------------------------------------------------------------------
+
+@node Frontend Data Structures
+@chapter Frontend Data Structures
+@cindex data structures
+
+This chapter should describe the details necessary to understand how
+the various @code{gfc_*} data are used and interact.  In general it is
+advisable to read the code in @file{dump-parse-tree.c} as its routines
+should exhaust all possible valid combinations of content for these
+structures.
+
+@menu
+* gfc_code:: Representation of Executable Statements.
+* gfc_expr:: Representation of Values and Expressions.
+@end menu
+
+
+@c gfc_code
+@c --------
+
+@node gfc_code
+@section @code{gfc_code}
+@cindex statement chaining
+@tindex @code{gfc_code}
+@tindex @code{struct gfc_code}
+
+The executable statements in a program unit are represented by a
+nested chain of @code{gfc_code} structures.  The type of statement is
+identified by the @code{op} member of the structure, the different
+possible values are enumerated in @code{gfc_exec_op}.  A special
+member of this @code{enum} is @code{EXEC_NOP} which is used to
+represent the various @code{END} statements if they carry a label.
+Depending on the type of statement some of the other fields will be
+filled in.  Fields that are generally applicable are the @code{next}
+and @code{here} fields.  The former points to the next statement in
+the current block or is @code{NULL} if the current statement is the
+last in a block, @code{here} points to the statement label of the
+current statement.
+
+If the current statement is one of @code{IF}, @code{DO}, @code{SELECT}
+it starts a block, i.e.@: a nested level in the program.  In order to
+represent this, the @code{block} member is set to point to a
+@code{gfc_code} structure whose @code{next} member starts the chain of
+statements inside the block; this structure's @code{op} member should be set to
+the same value as the parent structure's @code{op} member.  The @code{SELECT}
+and @code{IF} statements may contain various blocks (the chain of @code{ELSE IF}
+and @code{ELSE} blocks or the various @code{CASE}s, respectively).  These chains
+are linked-lists formed by the @code{block} members.
+
+Consider the following example code:
+
+@example
+IF (foo < 20) THEN
+  PRINT *, "Too small"
+  foo = 20
+ELSEIF (foo > 50) THEN
+  PRINT *, "Too large"
+  foo = 50
+ELSE
+  PRINT *, "Good"
+END IF
+@end example
+
+This statement-block will be represented in the internal gfortran tree as
+follows, were the horizontal link-chains are those induced by the @code{next}
+members and vertical links down are those of @code{block}. @samp{==|} and
+@samp{--|} mean @code{NULL} pointers to mark the end of a chain:
+
+@example
+... ==> IF ==> ...
+        |
+        +--> IF foo < 20 ==> PRINT *, "Too small" ==> foo = 20 ==|
+             |
+             +--> IF foo > 50 ==> PRINT *, "Too large" ==> foo = 50 ==|
+                  |
+                  +--> ELSE ==> PRINT *, "Good" ==|
+                       |
+                       +--|
+@end example
+
+
+@subsection IF Blocks
+
+Conditionals are represented by @code{gfc_code} structures with their
+@code{op} member set to @code{EXEC_IF}.  This structure's @code{block}
+member must point to another @code{gfc_code} node that is the header of the
+if-block.  This header's @code{op} member must be set to @code{EXEC_IF}, too,
+its @code{expr} member holds the condition to check for, and its @code{next}
+should point to the code-chain of the statements to execute if the condition is
+true.
+
+If in addition an @code{ELSEIF} or @code{ELSE} block is present, the
+@code{block} member of the if-block-header node points to yet another
+@code{gfc_code} structure that is the header of the elseif- or else-block.  Its
+structure is identical to that of the if-block-header, except that in case of an
+@code{ELSE} block without a new condition the @code{expr} member should be
+@code{NULL}.  This block can itself have its @code{block} member point to the
+next @code{ELSEIF} or @code{ELSE} block if there's a chain of them.
+
+
+@subsection Loops
+
+@code{DO} loops are stored in the tree as @code{gfc_code} nodes with their
+@code{op} set to @code{EXEC_DO} for a @code{DO} loop with iterator variable and
+to @code{EXEC_DO_WHILE} for infinite @code{DO}s and @code{DO WHILE} blocks.
+Their @code{block} member should point to a @code{gfc_code} structure heading
+the code-chain of the loop body; its @code{op} member should be set to
+@code{EXEC_DO} or @code{EXEC_DO_WHILE}, too, respectively.
+
+For @code{DO WHILE} loops, the loop condition is stored on the top
+@code{gfc_code} structure's @code{expr} member; @code{DO} forever loops are
+simply @code{DO WHILE} loops with a constant @code{.TRUE.} loop condition in
+the internal representation.
+
+Similarly, @code{DO} loops with an iterator have instead of the condition their
+@code{ext.iterator} member set to the correct values for the loop iterator
+variable and its range.
+
+
+@subsection @code{SELECT} Statements
+
+A @code{SELECT} block is introduced by a @code{gfc_code} structure with an
+@code{op} member of @code{EXEC_SELECT} and @code{expr} containing the expression
+to evaluate and test.  Its @code{block} member starts a list of @code{gfc_code}
+structures linked together by their @code{block} members that stores the various
+@code{CASE} parts.
+
+Each @code{CASE} node has its @code{op} member set to @code{EXEC_SELECT}, too,
+its @code{next} member points to the code-chain to be executed in the current
+case-block, and @code{extx.case_list} contains the case-values this block
+corresponds to.  The @code{block} member links to the next case in the list.
+
+
+@subsection @code{BLOCK} and @code{ASSOCIATE}
+
+The code related to a @code{BLOCK} statement is stored inside an
+@code{gfc_code} structure (say @var{c})
+with @code{c.op} set to @code{EXEC_BLOCK}.  The
+@code{gfc_namespace} holding the locally defined variables of the
+@code{BLOCK} is stored in @code{c.ext.block.ns}.  The code inside the
+construct is in @code{c.code}.
+
+@code{ASSOCIATE} constructs are based on @code{BLOCK} and thus also have
+the internal storage structure described above (including @code{EXEC_BLOCK}).
+However, for them @code{c.ext.block.assoc} is set additionally and points
+to a linked list of @code{gfc_association_list} structures.  Those
+structures basically store a link of associate-names to target expressions.
+The associate-names themselves are still also added to the @code{BLOCK}'s
+namespace as ordinary symbols, but they have their @code{gfc_symbol}'s
+member @code{assoc} set also pointing to the association-list structure.
+This way associate-names can be distinguished from ordinary variables
+and their target expressions identified.
+
+For association to expressions (as opposed to variables), at the very beginning
+of the @code{BLOCK} construct assignments are automatically generated to
+set the corresponding variables to their target expressions' values, and
+later on the compiler simply disallows using such associate-names in contexts
+that may change the value.
+
+
+@c gfc_expr
+@c --------
+
+@node gfc_expr
+@section @code{gfc_expr}
+@tindex @code{gfc_expr}
+@tindex @code{struct gfc_expr}
+
+Expressions and ``values'', including constants, variable-, array- and
+component-references as well as complex expressions consisting of operators and
+function calls are internally represented as one or a whole tree of
+@code{gfc_expr} objects.  The member @code{expr_type} specifies the overall
+type of an expression (for instance, @code{EXPR_CONSTANT} for constants or
+@code{EXPR_VARIABLE} for variable references).  The members @code{ts} and
+@code{rank} as well as @code{shape}, which can be @code{NULL}, specify
+the type, rank and, if applicable, shape of the whole expression or expression
+tree of which the current structure is the root.  @code{where} is the locus of
+this expression in the source code.
+
+Depending on the flavor of the expression being described by the object
+(that is, the value of its @code{expr_type} member), the corresponding structure
+in the @code{value} union will usually contain additional data describing the
+expression's value in a type-specific manner.  The @code{ref} member is used to
+build chains of (array-, component- and substring-) references if the expression
+in question contains such references, see below for details.
+
+
+@subsection Constants
+
+Scalar constants are represented by @code{gfc_expr} nodes with their
+@code{expr_type} set to @code{EXPR_CONSTANT}.  The constant's value shall
+already be known at compile-time and is stored in the @code{logical},
+@code{integer}, @code{real}, @code{complex} or @code{character} struct inside
+@code{value}, depending on the constant's type specification.
+
+
+@subsection Operators
+
+Operator-expressions are expressions that are the result of the execution of
+some operator on one or two operands.  The expressions have an @code{expr_type}
+of @code{EXPR_OP}.  Their @code{value.op} structure contains additional data.
+
+@code{op1} and optionally @code{op2} if the operator is binary point to the
+two operands, and @code{operator} or @code{uop} describe the operator that
+should be evaluated on these operands, where @code{uop} describes a user-defined
+operator.
+
+
+@subsection Function Calls
+
+If the expression is the return value of a function-call, its @code{expr_type}
+is set to @code{EXPR_FUNCTION}, and @code{symtree} must point to the symtree
+identifying the function to be called.  @code{value.function.actual} holds the
+actual arguments given to the function as a linked list of
+@code{gfc_actual_arglist} nodes.
+
+The other members of @code{value.function} describe the function being called
+in more detail, containing a link to the intrinsic symbol or user-defined
+function symbol if the call is to an intrinsic or external function,
+respectively.  These values are determined during resolution-phase from the
+structure's @code{symtree} member.
+
+A special case of function calls are ``component calls'' to type-bound
+procedures; those have the @code{expr_type} @code{EXPR_COMPCALL} with
+@code{value.compcall} containing the argument list and the procedure called,
+while @code{symtree} and @code{ref} describe the object on which the procedure
+was called in the same way as a @code{EXPR_VARIABLE} expression would.
+@xref{Type-bound Procedures}.
+
+
+@subsection Array- and Structure-Constructors
+
+Array- and structure-constructors (one could probably call them ``array-'' and
+``derived-type constants'') are @code{gfc_expr} structures with their
+@code{expr_type} member set to @code{EXPR_ARRAY} or @code{EXPR_STRUCTURE},
+respectively.  For structure constructors, @code{symtree} points to the
+derived-type symbol for the type being constructed.
+
+The values for initializing each array element or structure component are
+stored as linked-list of @code{gfc_constructor} nodes in the
+@code{value.constructor} member.
+
+
+@subsection Null
+
+@code{NULL} is a special value for pointers; it can be of different base types.
+Such a @code{NULL} value is represented in the internal tree by a
+@code{gfc_expr} node with @code{expr_type} @code{EXPR_NULL}.  If the base type
+of the @code{NULL} expression is known, it is stored in @code{ts} (that's for
+instance the case for default-initializers of @code{ALLOCATABLE} components),
+but this member can also be set to @code{BT_UNKNOWN} if the information is not
+available (for instance, when the expression is a pointer-initializer
+@code{NULL()}).
+
+
+@subsection Variables and Reference Expressions
+
+Variable references are @code{gfc_expr} structures with their @code{expr_type}
+set to @code{EXPR_VARIABLE}; their @code{symtree} should point to the variable
+that is referenced.
+
+For this type of expression, it's also possible to chain array-, component-
+or substring-references to the original expression to get something like
+@samp{struct%component(2:5)}, where @code{component} is either an array or
+a @code{CHARACTER} member of @code{struct} that is of some derived-type.  Such a
+chain of references is achieved by a linked list headed by @code{ref} of the
+@code{gfc_expr} node.  For the example above it would be (@samp{==|} is the
+last @code{NULL} pointer):
+
+@smallexample
+EXPR_VARIABLE(struct) ==> REF_COMPONENT(component) ==> REF_ARRAY(2:5) ==|
+@end smallexample
+
+If @code{component} is a string rather than an array, the last element would be
+a @code{REF_SUBSTRING} reference, of course.  If the variable itself or some
+component referenced is an array and the expression should reference the whole
+array rather than being followed by an array-element or -section reference, a
+@code{REF_ARRAY} reference must be built as the last element in the chain with
+an array-reference type of @code{AR_FULL}. Consider this example code:
+
+@smallexample
+TYPE :: mytype
+  INTEGER :: array(42)
+END TYPE mytype
+
+TYPE(mytype) :: variable
+INTEGER :: local_array(5)
+
+CALL do_something (variable%array, local_array)
+@end smallexample
+
+The @code{gfc_expr} nodes representing the arguments to the @samp{do_something}
+call will have a reference-chain like this:
+
+@smallexample
+EXPR_VARIABLE(variable) ==> REF_COMPONENT(array) ==> REF_ARRAY(FULL) ==|
+EXPR_VARIABLE(local_array) ==> REF_ARRAY(FULL) ==|
+@end smallexample
+
+
+@subsection Constant Substring References
+
+@code{EXPR_SUBSTRING} is a special type of expression that encodes a substring
+reference of a constant string, as in the following code snippet:
+
+@smallexample
+x = "abcde"(1:2)
+@end smallexample
+
+In this case, @code{value.character} contains the full string's data as if it
+was a string constant, but the @code{ref} member is also set and points to a
+substring reference as described in the subsection above.
+
+
+@c ---------------------------------------------------------------------
+@c F2003 OOP
+@c ---------------------------------------------------------------------
+
+@node Object Orientation
+@chapter Internals of Fortran 2003 OOP Features
+
+@menu
+* Type-bound Procedures:: Type-bound procedures.
+* Type-bound Operators::  Type-bound operators.
+@end menu
+
+
+@c Type-bound procedures
+@c ---------------------
+
+@node Type-bound Procedures
+@section Type-bound Procedures
+
+Type-bound procedures are stored in the @code{tb_sym_root} of the namespace
+@code{f2k_derived} associated with the derived-type symbol as @code{gfc_symtree}
+nodes.  The name and symbol of these symtrees corresponds to the binding-name
+of the procedure, i.e. the name that is used to call it from the context of an
+object of the derived-type.
+
+In addition, this type of symtrees stores in @code{n.tb} a struct of type
+@code{gfc_typebound_proc} containing the additional data needed:  The
+binding attributes (like @code{PASS} and @code{NOPASS}, @code{NON_OVERRIDABLE} 
+or the access-specifier), the binding's target(s) and, if the current binding
+overrides or extends an inherited binding of the same name, @code{overridden}
+points to this binding's @code{gfc_typebound_proc} structure.
+
+
+@subsection Specific Bindings
+@c --------------------------
+
+For specific bindings (declared with @code{PROCEDURE}), if they have a
+passed-object argument, the passed-object dummy argument is first saved by its
+name, and later during resolution phase the corresponding argument is looked for
+and its position remembered as @code{pass_arg_num} in @code{gfc_typebound_proc}.
+The binding's target procedure is pointed-to by @code{u.specific}.
+
+@code{DEFERRED} bindings are just like ordinary specific bindings, except
+that their @code{deferred} flag is set of course and that @code{u.specific}
+points to their ``interface'' defining symbol (might be an abstract interface)
+instead of the target procedure.
+
+At the moment, all type-bound procedure calls are statically dispatched and
+transformed into ordinary procedure calls at resolution time; their actual
+argument list is updated to include at the right position the passed-object
+argument, if applicable, and then a simple procedure call to the binding's
+target procedure is built.  To handle dynamic dispatch in the future, this will
+be extended to allow special code generation during the trans-phase to dispatch
+based on the object's dynamic type.
+
+
+@subsection Generic Bindings
+@c -------------------------
+
+Bindings declared as @code{GENERIC} store the specific bindings they target as
+a linked list using nodes of type @code{gfc_tbp_generic} in @code{u.generic}.
+For each specific target, the parser records its symtree and during resolution
+this symtree is bound to the corresponding @code{gfc_typebound_proc} structure
+of the specific target.
+
+Calls to generic bindings are handled entirely in the resolution-phase, where
+for the actual argument list present the matching specific binding is found
+and the call's target procedure (@code{value.compcall.tbp}) is re-pointed to
+the found specific binding and this call is subsequently handled by the logic
+for specific binding calls.
+
+
+@subsection Calls to Type-bound Procedures
+@c ---------------------------------------
+
+Calls to type-bound procedures are stored in the parse-tree as @code{gfc_expr}
+nodes of type @code{EXPR_COMPCALL}.  Their @code{value.compcall.actual} saves
+the actual argument list of the call and @code{value.compcall.tbp} points to the
+@code{gfc_typebound_proc} structure of the binding to be called.  The object
+in whose context the procedure was called is saved by combination of
+@code{symtree} and @code{ref}, as if the expression was of type
+@code{EXPR_VARIABLE}.
+
+For code like this:
+@smallexample
+CALL myobj%procedure (arg1, arg2)
+@end smallexample
+@noindent
+the @code{CALL} is represented in the parse-tree as a @code{gfc_code} node of
+type @code{EXEC_COMPCALL}.  The @code{expr} member of this node holds an
+expression of type @code{EXPR_COMPCALL} of the same structure as mentioned above
+except that its target procedure is of course a @code{SUBROUTINE} and not a
+@code{FUNCTION}.
+
+Expressions that are generated internally (as expansion of a type-bound
+operator call) may also use additional flags and members.
+@code{value.compcall.ignore_pass} signals that even though a @code{PASS}
+attribute may be present the actual argument list should not be updated because
+it already contains the passed-object.
+@code{value.compcall.base_object} overrides, if it is set, the base-object
+(that is normally stored in @code{symtree} and @code{ref} as mentioned above);
+this is needed because type-bound operators can be called on a base-object that
+need not be of type @code{EXPR_VARIABLE} and thus representable in this way.
+Finally, if @code{value.compcall.assign} is set, the call was produced in
+expansion of a type-bound assignment; this means that proper dependency-checking
+needs to be done when relevant.
+
+
+@c Type-bound operators
+@c --------------------
+
+@node Type-bound Operators
+@section Type-bound Operators
+
+Type-bound operators are in fact basically just @code{GENERIC} procedure
+bindings and are represented much in the same way as those (see
+@ref{Type-bound Procedures}).
+
+They come in two flavours:
+User-defined operators (like @code{.MYOPERATOR.})
+are stored in the @code{f2k_derived} namespace's @code{tb_uop_root}
+symtree exactly like ordinary type-bound procedures are stored in
+@code{tb_sym_root}; their symtrees' names are the operator-names (e.g.
+@samp{myoperator} in the example).
+Intrinsic operators on the other hand are stored in the namespace's
+array member @code{tb_op} indexed by the intrinsic operator's enum
+value.  Those need not be packed into @code{gfc_symtree} structures and are
+only @code{gfc_typebound_proc} instances.
+
+When an operator call or assignment is found that can not be handled in
+another way (i.e. neither matches an intrinsic nor interface operator
+definition) but that contains a derived-type expression, all type-bound
+operators defined on that derived-type are checked for a match with
+the operator call.  If there's indeed a relevant definition, the
+operator call is replaced with an internally generated @code{GENERIC}
+type-bound procedure call to the respective definition and that call is
+further processed.
+
+
+@c ---------------------------------------------------------------------
+@c LibGFortran
+@c ---------------------------------------------------------------------
+
+@node LibGFortran
+@chapter The LibGFortran Runtime Library
+
+@menu
+* Symbol Versioning::    Symbol Versioning.
+@end menu
+
+
+@c ---------------------------------------------------------------------
+@c Symbol Versioning
+@c ---------------------------------------------------------------------
+
+@node Symbol Versioning
+@section Symbol Versioning
+@comment Based on http://gcc.gnu.org/wiki/SymbolVersioning,
+@comment as of 2006-11-05, written by Janne Blomqvist.
+
+In general, this capability exists only on a few platforms, thus there
+is a need for configure magic so that it is used only on those targets
+where it is supported. 
+
+The central concept in symbol versioning is the so-called map file,
+which specifies the version node(s) exported symbols are labeled with.
+Also, the map file is used to hide local symbols. 
+
+Some relevant references:
+@itemize @bullet
+@item
+@uref{http://www.gnu.org/software/binutils/manual/ld-2.9.1/html_node/ld_25.html,
+GNU @command{ld} manual}
+
+@item
+@uref{http://people.redhat.com/drepper/symbol-versioning, ELF Symbol
+Versioning - Ulrich Depper}
+
+@item
+@uref{http://people.redhat.com/drepper/dsohowto.pdf, How to Write Shared
+Libraries - Ulrich Drepper (see Chapter 3)}
+
+@end itemize
+
+If one adds a new symbol to a library that should be exported, the new
+symbol should be mentioned in the map file and a new version node
+defined, e.g., if one adds a new symbols @code{foo} and @code{bar} to
+libgfortran for the next GCC release, the following should be added to
+the map file: 
+@smallexample
+GFORTRAN_1.1 @{
+    global:
+        foo;
+        bar;
+@} GFORTRAN_1.0;
+@end smallexample
+@noindent
+where @code{GFORTRAN_1.0} is the version node of the current release,
+and @code{GFORTRAN_1.1} is the version node of the next release where
+foo and bar are made available. 
+
+If one wants to change an existing interface, it is possible by using
+some asm trickery (from the @command{ld} manual referenced above): 
+
+@smallexample
+__asm__(".symver original_foo,foo@@");
+__asm__(".symver old_foo,foo@@VERS_1.1");
+__asm__(".symver old_foo1,foo@@VERS_1.2");
+__asm__(".symver new_foo,foo@@VERS_2.0");
+@end smallexample
+
+In this example, @code{foo@@} represents the symbol @code{foo} bound to
+the unspecified base version of the symbol. The source file that
+contains this example would define 4 C functions: @code{original_foo},
+@code{old_foo}, @code{old_foo1}, and @code{new_foo}. 
+
+In this case the map file must contain @code{foo} in @code{VERS_1.1}
+and @code{VERS_1.2} as well as in @code{VERS_2.0}.
+
+
+@c ---------------------------------------------------------------------
+@c GNU Free Documentation License
+@c ---------------------------------------------------------------------
+
+@include fdl.texi
+
+
+@c ---------------------------------------------------------------------
+@c Index
+@c ---------------------------------------------------------------------
+
+@node Index
+@unnumbered Index
+
+@printindex cp
+
+@bye
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
new file mode 100644
index 000000000..0c96a8224
--- /dev/null
+++ b/gcc/fortran/gfortran.h
@@ -0,0 +1,2922 @@
+/* gfortran header file
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2009, 2010, 2011
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#ifndef GCC_GFORTRAN_H
+#define GCC_GFORTRAN_H
+
+/* It's probably insane to have this large of a header file, but it
+   seemed like everything had to be recompiled anyway when a change
+   was made to a header file, and there were ordering issues with
+   multiple header files.  Besides, Microsoft's winnt.h was 250k last
+   time I looked, so by comparison this is perfectly reasonable.  */
+
+/* Declarations common to the front-end and library are put in
+   libgfortran/libgfortran_frontend.h  */
+#include "libgfortran.h"
+
+
+#include "intl.h"
+#include "coretypes.h"
+#include "input.h"
+#include "splay-tree.h"
+
+/* Major control parameters.  */
+
+#define GFC_MAX_SYMBOL_LEN 63   /* Must be at least 63 for F2003.  */
+#define GFC_MAX_BINDING_LABEL_LEN 126 /* (2 * GFC_MAX_SYMBOL_LEN) */
+#define GFC_MAX_LINE 132	/* Characters beyond this are not seen.  */
+#define GFC_LETTERS 26		/* Number of letters in the alphabet.  */
+
+#define MAX_SUBRECORD_LENGTH 2147483639   /* 2**31-9 */
+
+
+#define free(x) Use_gfc_free_instead_of_free()
+#define gfc_is_whitespace(c) ((c==' ') || (c=='\t'))
+
+/* Stringization.  */
+#define stringize(x) expand_macro(x)
+#define expand_macro(x) # x
+
+/* For the runtime library, a standard prefix is a requirement to
+   avoid cluttering the namespace with things nobody asked for.  It's
+   ugly to look at and a pain to type when you add the prefix by hand,
+   so we hide it behind a macro.  */
+#define PREFIX(x) "_gfortran_" x
+#define PREFIX_LEN 10
+
+/* A prefix for internal variables, which are not user-visible.  */
+#if !defined (NO_DOT_IN_LABEL)
+# define GFC_PREFIX(x) "_F." x
+#elif !defined (NO_DOLLAR_IN_LABEL)
+# define GFC_PREFIX(x) "_F$" x
+#else
+# define GFC_PREFIX(x) "_F_" x
+#endif
+
+#define BLANK_COMMON_NAME "__BLNK__"
+
+/* Macro to initialize an mstring structure.  */
+#define minit(s, t) { s, NULL, t }
+
+/* Structure for storing strings to be matched by gfc_match_string.  */
+typedef struct
+{
+  const char *string;
+  const char *mp;
+  int tag;
+}
+mstring;
+
+
+
+/*************************** Enums *****************************/
+
+/* Used when matching and resolving data I/O transfer statements.  */
+
+typedef enum
+{ M_READ, M_WRITE, M_PRINT, M_INQUIRE }
+io_kind;
+
+/* The author remains confused to this day about the convention of
+   returning '0' for 'SUCCESS'... or was it the other way around?  The
+   following enum makes things much more readable.  We also start
+   values off at one instead of zero.  */
+
+typedef enum
+{ SUCCESS = 1, FAILURE }
+gfc_try;
+
+/* These are flags for identifying whether we are reading a character literal
+   between quotes or normal source code.  */
+   
+typedef enum
+{ NONSTRING = 0, INSTRING_WARN, INSTRING_NOWARN }
+gfc_instring;
+
+/* This is returned by gfc_notification_std to know if, given the flags
+   that were given (-std=, -pedantic) we should issue an error, a warning
+   or nothing.  */
+
+typedef enum
+{ SILENT, WARNING, ERROR }
+notification;
+
+/* Matchers return one of these three values.  The difference between
+   MATCH_NO and MATCH_ERROR is that MATCH_ERROR means that a match was
+   successful, but that something non-syntactic is wrong and an error
+   has already been issued.  */
+
+typedef enum
+{ MATCH_NO = 1, MATCH_YES, MATCH_ERROR }
+match;
+
+/* Used for different Fortran source forms in places like scanner.c.  */
+typedef enum
+{ FORM_FREE, FORM_FIXED, FORM_UNKNOWN }
+gfc_source_form;
+
+/* Expression node types.  */
+typedef enum
+{ EXPR_OP = 1, EXPR_FUNCTION, EXPR_CONSTANT, EXPR_VARIABLE,
+  EXPR_SUBSTRING, EXPR_STRUCTURE, EXPR_ARRAY, EXPR_NULL, EXPR_COMPCALL, EXPR_PPC
+}
+expr_t;
+
+/* Array types.  */
+typedef enum
+{ AS_EXPLICIT = 1, AS_ASSUMED_SHAPE, AS_DEFERRED,
+  AS_ASSUMED_SIZE, AS_IMPLIED_SHAPE, AS_UNKNOWN
+}
+array_type;
+
+typedef enum
+{ AR_FULL = 1, AR_ELEMENT, AR_SECTION, AR_UNKNOWN }
+ar_type;
+
+/* Statement label types.  */
+typedef enum
+{ ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET,
+  ST_LABEL_BAD_TARGET, ST_LABEL_FORMAT
+}
+gfc_sl_type;
+
+/* Intrinsic operators.  */
+typedef enum
+{ GFC_INTRINSIC_BEGIN = 0,
+  INTRINSIC_NONE = -1, INTRINSIC_UPLUS = GFC_INTRINSIC_BEGIN,
+  INTRINSIC_UMINUS, INTRINSIC_PLUS, INTRINSIC_MINUS, INTRINSIC_TIMES,
+  INTRINSIC_DIVIDE, INTRINSIC_POWER, INTRINSIC_CONCAT,
+  INTRINSIC_AND, INTRINSIC_OR, INTRINSIC_EQV, INTRINSIC_NEQV,
+  /* ==, /=, >, >=, <, <=  */
+  INTRINSIC_EQ, INTRINSIC_NE, INTRINSIC_GT, INTRINSIC_GE,
+  INTRINSIC_LT, INTRINSIC_LE, 
+  /* .EQ., .NE., .GT., .GE., .LT., .LE. (OS = Old-Style)  */
+  INTRINSIC_EQ_OS, INTRINSIC_NE_OS, INTRINSIC_GT_OS, INTRINSIC_GE_OS,
+  INTRINSIC_LT_OS, INTRINSIC_LE_OS, 
+  INTRINSIC_NOT, INTRINSIC_USER, INTRINSIC_ASSIGN, 
+  INTRINSIC_PARENTHESES, GFC_INTRINSIC_END /* Sentinel */
+}
+gfc_intrinsic_op;
+
+/* This macro is the number of intrinsic operators that exist.
+   Assumptions are made about the numbering of the interface_op enums.  */
+#define GFC_INTRINSIC_OPS GFC_INTRINSIC_END
+
+/* Arithmetic results.  */
+typedef enum
+{ ARITH_OK = 1, ARITH_OVERFLOW, ARITH_UNDERFLOW, ARITH_NAN,
+  ARITH_DIV0, ARITH_INCOMMENSURATE, ARITH_ASYMMETRIC, ARITH_PROHIBIT
+}
+arith;
+
+/* Statements.  */
+typedef enum
+{
+  ST_ARITHMETIC_IF, ST_ALLOCATE, ST_ATTR_DECL, ST_ASSOCIATE,
+  ST_BACKSPACE, ST_BLOCK, ST_BLOCK_DATA,
+  ST_CALL, ST_CASE, ST_CLOSE, ST_COMMON, ST_CONTINUE, ST_CONTAINS, ST_CYCLE,
+  ST_DATA, ST_DATA_DECL, ST_DEALLOCATE, ST_DO, ST_ELSE, ST_ELSEIF,
+  ST_ELSEWHERE, ST_END_ASSOCIATE, ST_END_BLOCK, ST_END_BLOCK_DATA,
+  ST_ENDDO, ST_IMPLIED_ENDDO,
+  ST_END_FILE, ST_FINAL, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF,
+  ST_END_INTERFACE, ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT,
+  ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE,
+  ST_ERROR_STOP, ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION,
+  ST_GOTO, ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT,
+  ST_INQUIRE, ST_INTERFACE, ST_SYNC_ALL, ST_SYNC_MEMORY, ST_SYNC_IMAGES,
+  ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN,
+  ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND,
+  ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WAIT, 
+  ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
+  ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
+  ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_SELECT_TYPE, ST_TYPE_IS, ST_CLASS_IS,
+  ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL,
+  ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED, ST_OMP_END_PARALLEL,
+  ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
+  ST_OMP_END_PARALLEL_WORKSHARE, ST_OMP_END_SECTIONS, ST_OMP_END_SINGLE,
+  ST_OMP_END_WORKSHARE, ST_OMP_DO, ST_OMP_FLUSH, ST_OMP_MASTER, ST_OMP_ORDERED,
+  ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
+  ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE,
+  ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK,
+  ST_OMP_TASKWAIT, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
+  ST_GET_FCN_CHARACTERISTICS, ST_NONE
+}
+gfc_statement;
+
+/* Types of interfaces that we can have.  Assignment interfaces are
+   considered to be intrinsic operators.  */
+typedef enum
+{
+  INTERFACE_NAMELESS = 1, INTERFACE_GENERIC,
+  INTERFACE_INTRINSIC_OP, INTERFACE_USER_OP, INTERFACE_ABSTRACT
+}
+interface_type;
+
+/* Symbol flavors: these are all mutually exclusive.
+   10 elements = 4 bits.  */
+typedef enum sym_flavor
+{
+  FL_UNKNOWN = 0, FL_PROGRAM, FL_BLOCK_DATA, FL_MODULE, FL_VARIABLE,
+  FL_PARAMETER, FL_LABEL, FL_PROCEDURE, FL_DERIVED, FL_NAMELIST,
+  FL_VOID
+}
+sym_flavor;
+
+/* Procedure types.  7 elements = 3 bits.  */
+typedef enum procedure_type
+{ PROC_UNKNOWN, PROC_MODULE, PROC_INTERNAL, PROC_DUMMY,
+  PROC_INTRINSIC, PROC_ST_FUNCTION, PROC_EXTERNAL
+}
+procedure_type;
+
+/* Intent types.  */
+typedef enum sym_intent
+{ INTENT_UNKNOWN = 0, INTENT_IN, INTENT_OUT, INTENT_INOUT
+}
+sym_intent;
+
+/* Access types.  */
+typedef enum gfc_access
+{ ACCESS_UNKNOWN = 0, ACCESS_PUBLIC, ACCESS_PRIVATE
+}
+gfc_access;
+
+/* Flags to keep track of where an interface came from.
+   3 elements = 2 bits.  */
+typedef enum ifsrc
+{ IFSRC_UNKNOWN = 0,	/* Interface unknown, only return type may be known.  */
+  IFSRC_DECL,		/* FUNCTION or SUBROUTINE declaration.  */
+  IFSRC_IFBODY		/* INTERFACE statement or PROCEDURE statement
+			   with explicit interface.  */
+}
+ifsrc;
+
+/* Whether a SAVE attribute was set explicitly or implicitly.  */
+typedef enum save_state
+{ SAVE_NONE = 0, SAVE_EXPLICIT, SAVE_IMPLICIT
+}
+save_state;
+
+/* Strings for all symbol attributes.  We use these for dumping the
+   parse tree, in error messages, and also when reading and writing
+   modules.  In symbol.c.  */
+extern const mstring flavors[];
+extern const mstring procedures[];
+extern const mstring intents[];
+extern const mstring access_types[];
+extern const mstring ifsrc_types[];
+extern const mstring save_status[];
+
+/* Enumeration of all the generic intrinsic functions.  Used by the
+   backend for identification of a function.  */
+
+enum gfc_isym_id
+{
+  /* GFC_ISYM_NONE is used for intrinsics which will never be seen by
+     the backend (e.g. KIND).  */
+  GFC_ISYM_NONE = 0,
+  GFC_ISYM_ABORT,
+  GFC_ISYM_ABS,
+  GFC_ISYM_ACCESS,
+  GFC_ISYM_ACHAR,
+  GFC_ISYM_ACOS,
+  GFC_ISYM_ACOSH,
+  GFC_ISYM_ADJUSTL,
+  GFC_ISYM_ADJUSTR,
+  GFC_ISYM_AIMAG,
+  GFC_ISYM_AINT,
+  GFC_ISYM_ALARM,
+  GFC_ISYM_ALL,
+  GFC_ISYM_ALLOCATED,
+  GFC_ISYM_AND,
+  GFC_ISYM_ANINT,
+  GFC_ISYM_ANY,
+  GFC_ISYM_ASIN,
+  GFC_ISYM_ASINH,
+  GFC_ISYM_ASSOCIATED,
+  GFC_ISYM_ATAN,
+  GFC_ISYM_ATAN2,
+  GFC_ISYM_ATANH,
+  GFC_ISYM_BGE,
+  GFC_ISYM_BGT,
+  GFC_ISYM_BIT_SIZE,
+  GFC_ISYM_BLE,
+  GFC_ISYM_BLT,
+  GFC_ISYM_BTEST,
+  GFC_ISYM_CEILING,
+  GFC_ISYM_CHAR,
+  GFC_ISYM_CHDIR,
+  GFC_ISYM_CHMOD,
+  GFC_ISYM_CMPLX,
+  GFC_ISYM_COMMAND_ARGUMENT_COUNT,
+  GFC_ISYM_COMPILER_OPTIONS,
+  GFC_ISYM_COMPILER_VERSION,
+  GFC_ISYM_COMPLEX,
+  GFC_ISYM_CONJG,
+  GFC_ISYM_CONVERSION,
+  GFC_ISYM_COS,
+  GFC_ISYM_COSH,
+  GFC_ISYM_COUNT,
+  GFC_ISYM_CPU_TIME,
+  GFC_ISYM_CSHIFT,
+  GFC_ISYM_CTIME,
+  GFC_ISYM_C_SIZEOF,
+  GFC_ISYM_DATE_AND_TIME,
+  GFC_ISYM_DBLE,
+  GFC_ISYM_DIGITS,
+  GFC_ISYM_DIM,
+  GFC_ISYM_DOT_PRODUCT,
+  GFC_ISYM_DPROD,
+  GFC_ISYM_DSHIFTL,
+  GFC_ISYM_DSHIFTR,
+  GFC_ISYM_DTIME,
+  GFC_ISYM_EOSHIFT,
+  GFC_ISYM_EPSILON,
+  GFC_ISYM_ERF,
+  GFC_ISYM_ERFC,
+  GFC_ISYM_ERFC_SCALED,
+  GFC_ISYM_ETIME,
+  GFC_ISYM_EXECUTE_COMMAND_LINE,
+  GFC_ISYM_EXIT,
+  GFC_ISYM_EXP,
+  GFC_ISYM_EXPONENT,
+  GFC_ISYM_EXTENDS_TYPE_OF,
+  GFC_ISYM_FDATE,
+  GFC_ISYM_FGET,
+  GFC_ISYM_FGETC,
+  GFC_ISYM_FLOOR,
+  GFC_ISYM_FLUSH,
+  GFC_ISYM_FNUM,
+  GFC_ISYM_FPUT,
+  GFC_ISYM_FPUTC,
+  GFC_ISYM_FRACTION,
+  GFC_ISYM_FREE,
+  GFC_ISYM_FSEEK,
+  GFC_ISYM_FSTAT,
+  GFC_ISYM_FTELL,
+  GFC_ISYM_TGAMMA,
+  GFC_ISYM_GERROR,
+  GFC_ISYM_GETARG,
+  GFC_ISYM_GET_COMMAND,
+  GFC_ISYM_GET_COMMAND_ARGUMENT,
+  GFC_ISYM_GETCWD,
+  GFC_ISYM_GETENV,
+  GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
+  GFC_ISYM_GETGID,
+  GFC_ISYM_GETLOG,
+  GFC_ISYM_GETPID,
+  GFC_ISYM_GETUID,
+  GFC_ISYM_GMTIME,
+  GFC_ISYM_HOSTNM,
+  GFC_ISYM_HUGE,
+  GFC_ISYM_HYPOT,
+  GFC_ISYM_IACHAR,
+  GFC_ISYM_IALL,
+  GFC_ISYM_IAND,
+  GFC_ISYM_IANY,
+  GFC_ISYM_IARGC,
+  GFC_ISYM_IBCLR,
+  GFC_ISYM_IBITS,
+  GFC_ISYM_IBSET,
+  GFC_ISYM_ICHAR,
+  GFC_ISYM_IDATE,
+  GFC_ISYM_IEOR,
+  GFC_ISYM_IERRNO,
+  GFC_ISYM_IMAGE_INDEX,
+  GFC_ISYM_INDEX,
+  GFC_ISYM_INT,
+  GFC_ISYM_INT2,
+  GFC_ISYM_INT8,
+  GFC_ISYM_IOR,
+  GFC_ISYM_IPARITY,
+  GFC_ISYM_IRAND,
+  GFC_ISYM_ISATTY,
+  GFC_ISYM_IS_IOSTAT_END,
+  GFC_ISYM_IS_IOSTAT_EOR,
+  GFC_ISYM_ISNAN,
+  GFC_ISYM_ISHFT,
+  GFC_ISYM_ISHFTC,
+  GFC_ISYM_ITIME,
+  GFC_ISYM_J0,
+  GFC_ISYM_J1,
+  GFC_ISYM_JN,
+  GFC_ISYM_JN2,
+  GFC_ISYM_KILL,
+  GFC_ISYM_KIND,
+  GFC_ISYM_LBOUND,
+  GFC_ISYM_LCOBOUND,
+  GFC_ISYM_LEADZ,
+  GFC_ISYM_LEN,
+  GFC_ISYM_LEN_TRIM,
+  GFC_ISYM_LGAMMA,
+  GFC_ISYM_LGE,
+  GFC_ISYM_LGT,
+  GFC_ISYM_LINK,
+  GFC_ISYM_LLE,
+  GFC_ISYM_LLT,
+  GFC_ISYM_LOC,
+  GFC_ISYM_LOG,
+  GFC_ISYM_LOG10,
+  GFC_ISYM_LOGICAL,
+  GFC_ISYM_LONG,
+  GFC_ISYM_LSHIFT,
+  GFC_ISYM_LSTAT,
+  GFC_ISYM_LTIME,
+  GFC_ISYM_MALLOC,
+  GFC_ISYM_MASKL,
+  GFC_ISYM_MASKR,
+  GFC_ISYM_MATMUL,
+  GFC_ISYM_MAX,
+  GFC_ISYM_MAXEXPONENT,
+  GFC_ISYM_MAXLOC,
+  GFC_ISYM_MAXVAL,
+  GFC_ISYM_MCLOCK,
+  GFC_ISYM_MCLOCK8,
+  GFC_ISYM_MERGE,
+  GFC_ISYM_MERGE_BITS,
+  GFC_ISYM_MIN,
+  GFC_ISYM_MINEXPONENT,
+  GFC_ISYM_MINLOC,
+  GFC_ISYM_MINVAL,
+  GFC_ISYM_MOD,
+  GFC_ISYM_MODULO,
+  GFC_ISYM_MOVE_ALLOC,
+  GFC_ISYM_MVBITS,
+  GFC_ISYM_NEAREST,
+  GFC_ISYM_NEW_LINE,
+  GFC_ISYM_NINT,
+  GFC_ISYM_NORM2,
+  GFC_ISYM_NOT,
+  GFC_ISYM_NULL,
+  GFC_ISYM_NUMIMAGES,
+  GFC_ISYM_OR,
+  GFC_ISYM_PACK,
+  GFC_ISYM_PARITY,
+  GFC_ISYM_PERROR,
+  GFC_ISYM_POPCNT,
+  GFC_ISYM_POPPAR,
+  GFC_ISYM_PRECISION,
+  GFC_ISYM_PRESENT,
+  GFC_ISYM_PRODUCT,
+  GFC_ISYM_RADIX,
+  GFC_ISYM_RAND,
+  GFC_ISYM_RANDOM_NUMBER,
+  GFC_ISYM_RANDOM_SEED,
+  GFC_ISYM_RANGE,
+  GFC_ISYM_REAL,
+  GFC_ISYM_RENAME,
+  GFC_ISYM_REPEAT,
+  GFC_ISYM_RESHAPE,
+  GFC_ISYM_RRSPACING,
+  GFC_ISYM_RSHIFT,
+  GFC_ISYM_SAME_TYPE_AS,
+  GFC_ISYM_SC_KIND,
+  GFC_ISYM_SCALE,
+  GFC_ISYM_SCAN,
+  GFC_ISYM_SECNDS,
+  GFC_ISYM_SECOND,
+  GFC_ISYM_SET_EXPONENT,
+  GFC_ISYM_SHAPE,
+  GFC_ISYM_SHIFTA,
+  GFC_ISYM_SHIFTL,
+  GFC_ISYM_SHIFTR,
+  GFC_ISYM_SIGN,
+  GFC_ISYM_SIGNAL,
+  GFC_ISYM_SI_KIND,
+  GFC_ISYM_SIN,
+  GFC_ISYM_SINH,
+  GFC_ISYM_SIZE,
+  GFC_ISYM_SLEEP,
+  GFC_ISYM_SIZEOF,
+  GFC_ISYM_SPACING,
+  GFC_ISYM_SPREAD,
+  GFC_ISYM_SQRT,
+  GFC_ISYM_SRAND,
+  GFC_ISYM_SR_KIND,
+  GFC_ISYM_STAT,
+  GFC_ISYM_STORAGE_SIZE,
+  GFC_ISYM_SUM,
+  GFC_ISYM_SYMLINK,
+  GFC_ISYM_SYMLNK,
+  GFC_ISYM_SYSTEM,
+  GFC_ISYM_SYSTEM_CLOCK,
+  GFC_ISYM_TAN,
+  GFC_ISYM_TANH,
+  GFC_ISYM_THIS_IMAGE,
+  GFC_ISYM_TIME,
+  GFC_ISYM_TIME8,
+  GFC_ISYM_TINY,
+  GFC_ISYM_TRAILZ,
+  GFC_ISYM_TRANSFER,
+  GFC_ISYM_TRANSPOSE,
+  GFC_ISYM_TRIM,
+  GFC_ISYM_TTYNAM,
+  GFC_ISYM_UBOUND,
+  GFC_ISYM_UCOBOUND,
+  GFC_ISYM_UMASK,
+  GFC_ISYM_UNLINK,
+  GFC_ISYM_UNPACK,
+  GFC_ISYM_VERIFY,
+  GFC_ISYM_XOR,
+  GFC_ISYM_Y0,
+  GFC_ISYM_Y1,
+  GFC_ISYM_YN,
+  GFC_ISYM_YN2
+};
+typedef enum gfc_isym_id gfc_isym_id;
+
+
+typedef enum
+{
+  GFC_INIT_REAL_OFF = 0,
+  GFC_INIT_REAL_ZERO,
+  GFC_INIT_REAL_NAN,
+  GFC_INIT_REAL_SNAN,
+  GFC_INIT_REAL_INF,
+  GFC_INIT_REAL_NEG_INF
+}
+init_local_real;
+
+typedef enum
+{
+  GFC_INIT_LOGICAL_OFF = 0,
+  GFC_INIT_LOGICAL_FALSE,
+  GFC_INIT_LOGICAL_TRUE
+}
+init_local_logical;
+
+typedef enum
+{
+  GFC_INIT_CHARACTER_OFF = 0,
+  GFC_INIT_CHARACTER_ON
+}
+init_local_character;
+
+typedef enum
+{
+  GFC_INIT_INTEGER_OFF = 0,
+  GFC_INIT_INTEGER_ON
+}
+init_local_integer;
+
+typedef enum
+{
+  GFC_FCOARRAY_NONE = 0,
+  GFC_FCOARRAY_SINGLE
+}
+gfc_fcoarray;
+
+typedef enum
+{
+  GFC_ENABLE_REVERSE,
+  GFC_FORWARD_SET,
+  GFC_REVERSE_SET,
+  GFC_INHIBIT_REVERSE
+}
+gfc_reverse;
+
+/************************* Structures *****************************/
+
+/* Used for keeping things in balanced binary trees.  */
+#define BBT_HEADER(self) int priority; struct self *left, *right
+
+#define NAMED_INTCST(a,b,c,d) a,
+#define NAMED_KINDARRAY(a,b,c,d) a,
+#define NAMED_FUNCTION(a,b,c,d) a,
+typedef enum
+{
+  ISOFORTRANENV_INVALID = -1,
+#include "iso-fortran-env.def"
+  ISOFORTRANENV_LAST, ISOFORTRANENV_NUMBER = ISOFORTRANENV_LAST
+}
+iso_fortran_env_symbol;
+#undef NAMED_INTCST
+#undef NAMED_KINDARRAY
+#undef NAMED_FUNCTION
+
+#define NAMED_INTCST(a,b,c,d) a,
+#define NAMED_REALCST(a,b,c) a,
+#define NAMED_CMPXCST(a,b,c) a,
+#define NAMED_LOGCST(a,b,c) a,
+#define NAMED_CHARKNDCST(a,b,c) a,
+#define NAMED_CHARCST(a,b,c) a,
+#define DERIVED_TYPE(a,b,c) a,
+#define PROCEDURE(a,b) a,
+#define NAMED_FUNCTION(a,b,c,d) a,
+typedef enum
+{
+  ISOCBINDING_INVALID = -1, 
+#include "iso-c-binding.def"
+  ISOCBINDING_LAST,
+  ISOCBINDING_NUMBER = ISOCBINDING_LAST
+}
+iso_c_binding_symbol;
+#undef NAMED_INTCST
+#undef NAMED_REALCST
+#undef NAMED_CMPXCST
+#undef NAMED_LOGCST
+#undef NAMED_CHARKNDCST
+#undef NAMED_CHARCST
+#undef DERIVED_TYPE
+#undef PROCEDURE
+#undef NAMED_FUNCTION
+
+typedef enum
+{
+  INTMOD_NONE = 0, INTMOD_ISO_FORTRAN_ENV, INTMOD_ISO_C_BINDING
+}
+intmod_id;
+
+typedef struct
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  int value;  /* Used for both integer and character values.  */
+  bt f90_type;
+}
+CInteropKind_t;
+
+/* Array of structs, where the structs represent the C interop kinds.
+   The list will be implemented based on a hash of the kind name since
+   these could be accessed multiple times.
+   Declared in trans-types.c as a global, since it's in that file
+   that the list is initialized.  */
+extern CInteropKind_t c_interop_kinds_table[];
+
+
+/* Structure and list of supported extension attributes.  */
+typedef enum
+{
+  EXT_ATTR_DLLIMPORT = 0,
+  EXT_ATTR_DLLEXPORT,
+  EXT_ATTR_STDCALL,
+  EXT_ATTR_CDECL,
+  EXT_ATTR_FASTCALL,
+  EXT_ATTR_LAST, EXT_ATTR_NUM = EXT_ATTR_LAST
+}
+ext_attr_id_t;
+
+typedef struct
+{
+  const char *name;
+  unsigned id;
+  const char *middle_end_name;
+}
+ext_attr_t;
+
+extern const ext_attr_t ext_attr_list[];
+
+/* Symbol attribute structure.  */
+typedef struct
+{
+  /* Variable attributes.  */
+  unsigned allocatable:1, dimension:1, codimension:1, external:1, intrinsic:1,
+    optional:1, pointer:1, target:1, value:1, volatile_:1, temporary:1,
+    dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
+    implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1,
+    contiguous:1;
+
+  /* For CLASS containers, the pointer attribute is sometimes set internally
+     even though it was not directly specified.  In this case, keep the
+     "real" (original) value here.  */
+  unsigned class_pointer:1;
+
+  ENUM_BITFIELD (save_state) save:2;
+
+  unsigned data:1,		/* Symbol is named in a DATA statement.  */
+    is_protected:1,		/* Symbol has been marked as protected.  */
+    use_assoc:1,		/* Symbol has been use-associated.  */
+    use_only:1,			/* Symbol has been use-associated, with ONLY.  */
+    use_rename:1,		/* Symbol has been use-associated and renamed.  */
+    imported:1,			/* Symbol has been associated by IMPORT.  */
+    host_assoc:1;		/* Symbol has been host associated.  */ 
+
+  unsigned in_namelist:1, in_common:1, in_equivalence:1;
+  unsigned function:1, subroutine:1, procedure:1;
+  unsigned generic:1, generic_copy:1;
+  unsigned implicit_type:1;	/* Type defined via implicit rules.  */
+  unsigned untyped:1;		/* No implicit type could be found.  */
+
+  unsigned is_bind_c:1;		/* say if is bound to C.  */
+  unsigned extension:8;		/* extension level of a derived type.  */
+  unsigned is_class:1;		/* is a CLASS container.  */
+  unsigned class_ok:1;		/* is a CLASS object with correct attributes.  */
+  unsigned vtab:1;		/* is a derived type vtab, pointed to by CLASS objects.  */
+  unsigned vtype:1;		/* is a derived type of a vtab.  */
+
+  /* These flags are both in the typespec and attribute.  The attribute
+     list is what gets read from/written to a module file.  The typespec
+     is created from a decl being processed.  */
+  unsigned is_c_interop:1;	/* It's c interoperable.  */
+  unsigned is_iso_c:1;		/* Symbol is from iso_c_binding.  */
+
+  /* Function/subroutine attributes */
+  unsigned sequence:1, elemental:1, pure:1, recursive:1;
+  unsigned unmaskable:1, masked:1, contained:1, mod_proc:1, abstract:1;
+
+  /* This is set if a contained procedure could be declared pure.  This is
+     used for certain optimizations that require the result or arguments
+     cannot alias.  Note that this is zero for PURE procedures.  */
+  unsigned implicit_pure:1;
+
+  /* This is set if the subroutine doesn't return.  Currently, this
+     is only possible for intrinsic subroutines.  */
+  unsigned noreturn:1;
+
+  /* Set if this procedure is an alternate entry point.  These procedures
+     don't have any code associated, and the backend will turn them into
+     thunks to the master function.  */
+  unsigned entry:1;
+
+  /* Set if this is the master function for a procedure with multiple
+     entry points.  */
+  unsigned entry_master:1;
+
+  /* Set if this is the master function for a function with multiple
+     entry points where characteristics of the entry points differ.  */
+  unsigned mixed_entry_master:1;
+
+  /* Set if a function must always be referenced by an explicit interface.  */
+  unsigned always_explicit:1;
+
+  /* Set if the symbol has been referenced in an expression.  No further
+     modification of type or type parameters is permitted.  */
+  unsigned referenced:1;
+
+  /* Set if this is the symbol for the main program.  */
+  unsigned is_main_program:1;
+
+  /* Mutually exclusive multibit attributes.  */
+  ENUM_BITFIELD (gfc_access) access:2;
+  ENUM_BITFIELD (sym_intent) intent:2;
+  ENUM_BITFIELD (sym_flavor) flavor:4;
+  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;
+
+  /* The symbol is a derived type with allocatable components, pointer 
+     components or private components, procedure pointer components,
+     possibly nested.  zero_comp is true if the derived type has no
+     component at all.  */
+  unsigned alloc_comp:1, pointer_comp:1, proc_pointer_comp:1,
+	   private_comp:1, zero_comp:1, coarray_comp:1;
+
+  /* This is a temporary selector for SELECT TYPE.  */
+  unsigned select_type_temporary:1;
+
+  /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
+  unsigned ext_attr:EXT_ATTR_NUM;
+
+  /* The namespace where the attribute has been set.  */
+  struct gfc_namespace *volatile_ns, *asynchronous_ns;
+}
+symbol_attribute;
+
+
+/* We need to store source lines as sequences of multibyte source
+   characters. We define here a type wide enough to hold any multibyte
+   source character, just like libcpp does.  A 32-bit type is enough.  */
+
+#if HOST_BITS_PER_INT >= 32
+typedef unsigned int gfc_char_t;
+#elif HOST_BITS_PER_LONG >= 32
+typedef unsigned long gfc_char_t;
+#elif defined(HAVE_LONG_LONG) && (HOST_BITS_PER_LONGLONG >= 32)
+typedef unsigned long long gfc_char_t;
+#else
+# error "Cannot find an integer type with at least 32 bits"
+#endif
+
+
+/* The following three structures are used to identify a location in
+   the sources.
+
+   gfc_file is used to maintain a tree of the source files and how
+   they include each other
+
+   gfc_linebuf holds a single line of source code and information
+   which file it resides in
+
+   locus point to the sourceline and the character in the source
+   line.
+*/
+
+typedef struct gfc_file
+{
+  struct gfc_file *next, *up;
+  int inclusion_line, line;
+  char *filename;
+} gfc_file;
+
+typedef struct gfc_linebuf
+{
+  source_location location;
+  struct gfc_file *file;
+  struct gfc_linebuf *next;
+
+  int truncated;
+  bool dbg_emitted;
+
+  gfc_char_t line[1];
+} gfc_linebuf;
+
+#define gfc_linebuf_header_size (offsetof (gfc_linebuf, line))
+
+#define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location))
+
+typedef struct
+{
+  gfc_char_t *nextc;
+  gfc_linebuf *lb;
+} locus;
+
+/* In order for the "gfc" format checking to work correctly, you must
+   have declared a typedef locus first.  */
+#if GCC_VERSION >= 4001
+#define ATTRIBUTE_GCC_GFC(m, n) __attribute__ ((__format__ (__gcc_gfc__, m, n))) ATTRIBUTE_NONNULL(m)
+#else
+#define ATTRIBUTE_GCC_GFC(m, n) ATTRIBUTE_NONNULL(m)
+#endif
+
+
+/* Suppress error messages or re-enable them.  */
+
+void gfc_push_suppress_errors (void);
+void gfc_pop_suppress_errors (void);
+
+
+/* Character length structures hold the expression that gives the
+   length of a character variable.  We avoid putting these into
+   gfc_typespec because doing so prevents us from doing structure
+   copies and forces us to deallocate any typespecs we create, as well
+   as structures that contain typespecs.  They also can have multiple
+   character typespecs pointing to them.
+
+   These structures form a singly linked list within the current
+   namespace and are deallocated with the namespace.  It is possible to
+   end up with gfc_charlen structures that have nothing pointing to them.  */
+
+typedef struct gfc_charlen
+{
+  struct gfc_expr *length;
+  struct gfc_charlen *next;
+  bool length_from_typespec; /* Length from explicit array ctor typespec?  */
+  tree backend_decl;
+  tree passed_length; /* Length argument explicitly passed.  */
+
+  int resolved;
+}
+gfc_charlen;
+
+#define gfc_get_charlen() XCNEW (gfc_charlen)
+
+/* Type specification structure.  */
+typedef struct
+{
+  bt type;
+  int kind;
+
+  union
+  {
+    struct gfc_symbol *derived;	/* For derived types only.  */
+    gfc_charlen *cl;		/* For character types only.  */
+    int pad;			/* For hollerith types only.  */
+  }
+  u;
+
+  struct gfc_symbol *interface;	/* For PROCEDURE declarations.  */
+  int is_c_interop;
+  int is_iso_c;
+  bt f90_type;
+  bool deferred;
+}
+gfc_typespec;
+
+/* Array specification.  */
+typedef struct
+{
+  int rank;	/* A rank of zero means that a variable is a scalar.  */
+  int corank;
+  array_type type, cotype;
+  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;
+
+#define gfc_get_array_spec() XCNEW (gfc_array_spec)
+
+
+/* Components of derived types.  */
+typedef struct gfc_component
+{
+  const char *name;
+  gfc_typespec ts;
+
+  symbol_attribute attr;
+  gfc_array_spec *as;
+
+  tree backend_decl;
+  /* Used to cache a FIELD_DECL matching this same component
+     but applied to a different backend containing type that was
+     generated by gfc_nonrestricted_type.  */
+  tree norestrict_decl;
+  locus loc;
+  struct gfc_expr *initializer;
+  struct gfc_component *next;
+
+  /* Needed for procedure pointer components.  */
+  struct gfc_formal_arglist *formal;
+  struct gfc_namespace *formal_ns;
+  struct gfc_typebound_proc *tb;
+}
+gfc_component;
+
+#define gfc_get_component() XCNEW (gfc_component)
+
+/* Formal argument lists are lists of symbols.  */
+typedef struct gfc_formal_arglist
+{
+  /* Symbol representing the argument at this position in the arglist.  */
+  struct gfc_symbol *sym;
+  /* Points to the next formal argument.  */
+  struct gfc_formal_arglist *next;
+}
+gfc_formal_arglist;
+
+#define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist)
+
+
+/* The gfc_actual_arglist structure is for actual arguments.  */
+typedef struct gfc_actual_arglist
+{
+  const char *name;
+  /* Alternate return label when the expr member is null.  */
+  struct gfc_st_label *label;
+
+  /* This is set to the type of an eventual omitted optional
+     argument. This is used to determine if a hidden string length
+     argument has to be added to a function call.  */
+  bt missing_arg_type;
+
+  struct gfc_expr *expr;
+  struct gfc_actual_arglist *next;
+}
+gfc_actual_arglist;
+
+#define gfc_get_actual_arglist() XCNEW (gfc_actual_arglist)
+
+
+/* Because a symbol can belong to multiple namelists, they must be
+   linked externally to the symbol itself.  */
+typedef struct gfc_namelist
+{
+  struct gfc_symbol *sym;
+  struct gfc_namelist *next;
+}
+gfc_namelist;
+
+#define gfc_get_namelist() XCNEW (gfc_namelist)
+
+enum
+{
+  OMP_LIST_PRIVATE,
+  OMP_LIST_FIRSTPRIVATE,
+  OMP_LIST_LASTPRIVATE,
+  OMP_LIST_COPYPRIVATE,
+  OMP_LIST_SHARED,
+  OMP_LIST_COPYIN,
+  OMP_LIST_PLUS,
+  OMP_LIST_REDUCTION_FIRST = OMP_LIST_PLUS,
+  OMP_LIST_MULT,
+  OMP_LIST_SUB,
+  OMP_LIST_AND,
+  OMP_LIST_OR,
+  OMP_LIST_EQV,
+  OMP_LIST_NEQV,
+  OMP_LIST_MAX,
+  OMP_LIST_MIN,
+  OMP_LIST_IAND,
+  OMP_LIST_IOR,
+  OMP_LIST_IEOR,
+  OMP_LIST_REDUCTION_LAST = OMP_LIST_IEOR,
+  OMP_LIST_NUM
+};
+
+/* Because a symbol can belong to multiple namelists, they must be
+   linked externally to the symbol itself.  */
+
+enum gfc_omp_sched_kind
+{
+  OMP_SCHED_NONE,
+  OMP_SCHED_STATIC,
+  OMP_SCHED_DYNAMIC,
+  OMP_SCHED_GUIDED,
+  OMP_SCHED_RUNTIME,
+  OMP_SCHED_AUTO
+};
+
+enum gfc_omp_default_sharing
+{
+  OMP_DEFAULT_UNKNOWN,
+  OMP_DEFAULT_NONE,
+  OMP_DEFAULT_PRIVATE,
+  OMP_DEFAULT_SHARED,
+  OMP_DEFAULT_FIRSTPRIVATE
+};
+
+typedef struct gfc_omp_clauses
+{
+  struct gfc_expr *if_expr;
+  struct gfc_expr *num_threads;
+  gfc_namelist *lists[OMP_LIST_NUM];
+  enum gfc_omp_sched_kind sched_kind;
+  struct gfc_expr *chunk_size;
+  enum gfc_omp_default_sharing default_sharing;
+  int collapse;
+  bool nowait, ordered, untied;
+}
+gfc_omp_clauses;
+
+#define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses)
+
+
+/* The gfc_st_label structure is a BBT attached to a namespace that
+   records the usage of statement labels within that space.  */
+
+typedef struct gfc_st_label
+{
+  BBT_HEADER(gfc_st_label);
+
+  int value;
+
+  gfc_sl_type defined, referenced;
+
+  struct gfc_expr *format;
+
+  tree backend_decl;
+
+  locus where;
+}
+gfc_st_label;
+
+
+/* gfc_interface()-- Interfaces are lists of symbols strung together.  */
+typedef struct gfc_interface
+{
+  struct gfc_symbol *sym;
+  locus where;
+  struct gfc_interface *next;
+}
+gfc_interface;
+
+#define gfc_get_interface() XCNEW (gfc_interface)
+
+/* User operator nodes.  These are like stripped down symbols.  */
+typedef struct
+{
+  const char *name;
+
+  gfc_interface *op;
+  struct gfc_namespace *ns;
+  gfc_access access;
+}
+gfc_user_op;
+
+
+/* A list of specific bindings that are associated with a generic spec.  */
+typedef struct gfc_tbp_generic
+{
+  /* The parser sets specific_st, upon resolution we look for the corresponding
+     gfc_typebound_proc and set specific for further use.  */
+  struct gfc_symtree* specific_st;
+  struct gfc_typebound_proc* specific;
+
+  struct gfc_tbp_generic* next;
+}
+gfc_tbp_generic;
+
+#define gfc_get_tbp_generic() XCNEW (gfc_tbp_generic)
+
+
+/* Data needed for type-bound procedures.  */
+typedef struct gfc_typebound_proc
+{
+  locus where; /* Where the PROCEDURE/GENERIC definition was.  */
+
+  union
+  {
+    struct gfc_symtree* specific; /* The interface if DEFERRED.  */
+    gfc_tbp_generic* generic;
+  }
+  u;
+
+  gfc_access access;
+  const char* pass_arg; /* Argument-name for PASS.  NULL if not specified.  */
+
+  /* The overridden type-bound proc (or GENERIC with this name in the
+     parent-type) or NULL if non.  */
+  struct gfc_typebound_proc* overridden;
+
+  /* Once resolved, we use the position of pass_arg in the formal arglist of
+     the binding-target procedure to identify it.  The first argument has
+     number 1 here, the second 2, and so on.  */
+  unsigned pass_arg_num;
+
+  unsigned nopass:1; /* Whether we have NOPASS (PASS otherwise).  */
+  unsigned non_overridable:1;
+  unsigned deferred:1;
+  unsigned is_generic:1;
+  unsigned function:1, subroutine:1;
+  unsigned error:1; /* Ignore it, when an error occurred during resolution.  */
+  unsigned ppc:1;
+}
+gfc_typebound_proc;
+
+
+/* Symbol nodes.  These are important things.  They are what the
+   standard refers to as "entities".  The possibly multiple names that
+   refer to the same entity are accomplished by a binary tree of
+   symtree structures that is balanced by the red-black method-- more
+   than one symtree node can point to any given symbol.  */
+
+typedef struct gfc_symbol
+{
+  const char *name;	/* Primary name, before renaming */
+  const char *module;	/* Module this symbol came from */
+  locus declared_at;
+
+  gfc_typespec ts;
+  symbol_attribute attr;
+
+  /* The formal member points to the formal argument list if the
+     symbol is a function or subroutine name.  If the symbol is a
+     generic name, the generic member points to the list of
+     interfaces.  */
+
+  gfc_interface *generic;
+  gfc_access component_access;
+
+  gfc_formal_arglist *formal;
+  struct gfc_namespace *formal_ns;
+  struct gfc_namespace *f2k_derived;
+
+  struct gfc_expr *value;	/* Parameter/Initializer value */
+  gfc_array_spec *as;
+  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;
+
+  int entry_id;			/* Used in resolve.c for entries.  */
+
+  /* CLASS hashed name for declared and dynamic types in the class.  */
+  int hash_value;
+
+  struct gfc_symbol *common_next;	/* Links for COMMON syms */
+
+  /* This is in fact a gfc_common_head but it is only used for pointer
+     comparisons to check if symbols are in the same common block.  */
+  struct gfc_common_head* common_head;
+
+  /* Make sure setup code for dummy arguments is generated in the correct
+     order.  */
+  int dummy_order;
+
+  gfc_namelist *namelist, *namelist_tail;
+
+  /* Change management fields.  Symbols that might be modified by the
+     current statement have the mark member nonzero and are kept in a
+     singly linked list through the tlink field.  Of these symbols,
+     symbols with old_symbol equal to NULL are symbols created within
+     the current statement.  Otherwise, old_symbol points to a copy of
+     the old symbol.  */
+
+  struct gfc_symbol *old_symbol, *tlink;
+  unsigned mark:1, gfc_new:1;
+  /* Nonzero if all equivalences associated with this symbol have been
+     processed.  */
+  unsigned equiv_built:1;
+  /* Set if this variable is used as an index name in a FORALL.  */
+  unsigned forall_index:1;
+  int refs;
+  struct gfc_namespace *ns;	/* namespace containing this symbol */
+
+  tree backend_decl;
+   
+  /* Identity of the intrinsic module the symbol comes from, or
+     INTMOD_NONE if it's not imported from a intrinsic module.  */
+  intmod_id from_intmod;
+  /* Identity of the symbol from intrinsic modules, from enums maintained
+     separately by each intrinsic module.  Used together with from_intmod,
+     it uniquely identifies a symbol from an intrinsic module.  */
+  int intmod_sym_id;
+
+  /* This may be repetitive, since the typespec now has a binding
+     label field.  */
+  char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
+  /* Store a reference to the common_block, if this symbol is in one.  */
+  struct gfc_common_head *common_block;
+
+  /* Link to corresponding association-list if this is an associate name.  */
+  struct gfc_association_list *assoc;
+}
+gfc_symbol;
+
+
+/* This structure is used to keep track of symbols in common blocks.  */
+typedef struct gfc_common_head
+{
+  locus where;
+  char use_assoc, saved, threadprivate;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  struct gfc_symbol *head;
+  char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
+  int is_bind_c;
+}
+gfc_common_head;
+
+#define gfc_get_common_head() XCNEW (gfc_common_head)
+
+
+/* A list of all the alternate entry points for a procedure.  */
+
+typedef struct gfc_entry_list
+{
+  /* The symbol for this entry point.  */
+  gfc_symbol *sym;
+  /* The zero-based id of this entry point.  */
+  int id;
+  /* The LABEL_EXPR marking this entry point.  */
+  tree label;
+  /* The next item in the list.  */
+  struct gfc_entry_list *next;
+}
+gfc_entry_list;
+
+#define gfc_get_entry_list() \
+  (gfc_entry_list *) gfc_getmem(sizeof(gfc_entry_list))
+
+/* Lists of rename info for the USE statement.  */
+
+typedef struct gfc_use_rename
+{
+  char local_name[GFC_MAX_SYMBOL_LEN + 1], use_name[GFC_MAX_SYMBOL_LEN + 1];
+  struct gfc_use_rename *next;
+  int found;
+  gfc_intrinsic_op op;
+  locus where;
+}
+gfc_use_rename;
+
+#define gfc_get_use_rename() XCNEW (gfc_use_rename);
+
+/* A list of all USE statements in a namespace.  */
+
+typedef struct gfc_use_list
+{
+  const char *module_name;
+  int only_flag;
+  struct gfc_use_rename *rename;
+  locus where;
+  /* Next USE statement.  */
+  struct gfc_use_list *next;
+}
+gfc_use_list;
+
+#define gfc_get_use_list() \
+  (gfc_use_list *) gfc_getmem(sizeof(gfc_use_list))
+
+/* Within a namespace, symbols are pointed to by symtree nodes that
+   are linked together in a balanced binary tree.  There can be
+   several symtrees pointing to the same symbol node via USE
+   statements.  */
+
+typedef struct gfc_symtree
+{
+  BBT_HEADER (gfc_symtree);
+  const char *name;
+  int ambiguous;
+  union
+  {
+    gfc_symbol *sym;		/* Symbol associated with this node */
+    gfc_user_op *uop;
+    gfc_common_head *common;
+    gfc_typebound_proc *tb;
+  }
+  n;
+}
+gfc_symtree;
+
+/* A linked list of derived types in the namespace.  */
+typedef struct gfc_dt_list
+{
+  struct gfc_symbol *derived;
+  struct gfc_dt_list *next;
+}
+gfc_dt_list;
+
+#define gfc_get_dt_list() XCNEW (gfc_dt_list)
+
+  /* A list of all derived types.  */
+  extern gfc_dt_list *gfc_derived_types;
+
+/* A namespace describes the contents of procedure, module, interface block
+   or BLOCK construct.  */
+/* ??? Anything else use these?  */
+
+typedef struct gfc_namespace
+{
+  /* Tree containing all the symbols in this namespace.  */
+  gfc_symtree *sym_root;
+  /* Tree containing all the user-defined operators in the namespace.  */
+  gfc_symtree *uop_root;
+  /* Tree containing all the common blocks.  */
+  gfc_symtree *common_root;
+
+  /* Tree containing type-bound procedures.  */
+  gfc_symtree *tb_sym_root;
+  /* Type-bound user operators.  */
+  gfc_symtree *tb_uop_root;
+  /* For derived-types, store type-bound intrinsic operators here.  */
+  gfc_typebound_proc *tb_op[GFC_INTRINSIC_OPS];
+  /* Linked list of finalizer procedures.  */
+  struct gfc_finalizer *finalizers;
+
+  /* If set_flag[letter] is set, an implicit type has been set for letter.  */
+  int set_flag[GFC_LETTERS];
+  /* Keeps track of the implicit types associated with the letters.  */
+  gfc_typespec default_type[GFC_LETTERS];
+  /* Store the positions of IMPLICIT statements.  */
+  locus implicit_loc[GFC_LETTERS];
+
+  /* If this is a namespace of a procedure, this points to the procedure.  */
+  struct gfc_symbol *proc_name;
+  /* If this is the namespace of a unit which contains executable
+     code, this points to it.  */
+  struct gfc_code *code;
+
+  /* Points to the equivalences set up in this namespace.  */
+  struct gfc_equiv *equiv, *old_equiv;
+
+  /* Points to the equivalence groups produced by trans_common.  */
+  struct gfc_equiv_list *equiv_lists;
+
+  gfc_interface *op[GFC_INTRINSIC_OPS];
+
+  /* Points to the parent namespace, i.e. the namespace of a module or
+     procedure in which the procedure belonging to this namespace is
+     contained. The parent namespace points to this namespace either
+     directly via CONTAINED, or indirectly via the chain built by
+     SIBLING.  */
+  struct gfc_namespace *parent;
+  /* CONTAINED points to the first contained namespace. Sibling
+     namespaces are chained via SIBLING.  */
+  struct gfc_namespace  *contained, *sibling;
+
+  gfc_common_head blank_common;
+  gfc_access default_access, operator_access[GFC_INTRINSIC_OPS];
+
+  gfc_st_label *st_labels;
+  /* This list holds information about all the data initializers in
+     this namespace.  */
+  struct gfc_data *data;
+
+  gfc_charlen *cl_list, *old_cl_list;
+
+  gfc_dt_list *derived_types;
+
+  int save_all, seen_save, seen_implicit_none;
+
+  /* Normally we don't need to refcount namespaces.  However when we read
+     a module containing a function with multiple entry points, this
+     will appear as several functions with the same formal namespace.  */
+  int refs;
+
+  /* A list of all alternate entry points to this procedure (or NULL).  */
+  gfc_entry_list *entries;
+
+  /* A list of USE statements in this namespace.  */
+  gfc_use_list *use_stmts;
+
+  /* Set to 1 if namespace is a BLOCK DATA program unit.  */
+  unsigned is_block_data:1;
+
+  /* Set to 1 if namespace is an interface body with "IMPORT" used.  */
+  unsigned has_import_set:1;
+
+  /* Set to 1 if resolved has been called for this namespace.
+     Holds -1 during resolution.  */
+  signed resolved:2;
+
+  /* Set to 1 if code has been generated for this namespace.  */
+  unsigned translated:1;
+
+  /* Set to 1 if symbols in this namespace should be 'construct entities',
+     i.e. for BLOCK local variables.  */
+  unsigned construct_entities:1;
+}
+gfc_namespace;
+
+extern gfc_namespace *gfc_current_ns;
+extern gfc_namespace *gfc_global_ns_list;
+
+/* Global symbols are symbols of global scope. Currently we only use
+   this to detect collisions already when parsing.
+   TODO: Extend to verify procedure calls.  */
+
+enum gfc_symbol_type
+{
+  GSYM_UNKNOWN=1, GSYM_PROGRAM, GSYM_FUNCTION, GSYM_SUBROUTINE,
+  GSYM_MODULE, GSYM_COMMON, GSYM_BLOCK_DATA
+};
+
+typedef struct gfc_gsymbol
+{
+  BBT_HEADER(gfc_gsymbol);
+
+  const char *name;
+  const char *sym_name;
+  const char *mod_name;
+  const char *binding_label;
+  enum gfc_symbol_type type;
+
+  int defined, used;
+  locus where;
+  gfc_namespace *ns;
+}
+gfc_gsymbol;
+
+extern gfc_gsymbol *gfc_gsym_root;
+
+/* Information on interfaces being built.  */
+typedef struct
+{
+  interface_type type;
+  gfc_symbol *sym;
+  gfc_namespace *ns;
+  gfc_user_op *uop;
+  gfc_intrinsic_op op;
+}
+gfc_interface_info;
+
+extern gfc_interface_info current_interface;
+
+
+/* Array reference.  */
+
+enum gfc_array_ref_dimen_type
+{
+  DIMEN_ELEMENT = 1, DIMEN_RANGE, DIMEN_VECTOR, DIMEN_STAR, DIMEN_UNKNOWN
+};
+
+typedef struct gfc_array_ref
+{
+  ar_type type;
+  int dimen;			/* # of components in the reference */
+  int codimen;
+  bool in_allocate;		/* For coarray checks. */
+  locus where;
+  gfc_array_spec *as;
+
+  locus c_where[GFC_MAX_DIMENSIONS];	/* All expressions can be NULL */
+  struct gfc_expr *start[GFC_MAX_DIMENSIONS], *end[GFC_MAX_DIMENSIONS],
+    *stride[GFC_MAX_DIMENSIONS];
+
+  enum gfc_array_ref_dimen_type dimen_type[GFC_MAX_DIMENSIONS];
+
+  struct gfc_expr *offset;
+}
+gfc_array_ref;
+
+#define gfc_get_array_ref() XCNEW (gfc_array_ref)
+
+
+/* Component reference nodes.  A variable is stored as an expression
+   node that points to the base symbol.  After that, a singly linked
+   list of component reference nodes gives the variable's complete
+   resolution.  The array_ref component may be present and comes
+   before the component component.  */
+
+typedef enum
+  { REF_ARRAY, REF_COMPONENT, REF_SUBSTRING }
+ref_type;
+
+typedef struct gfc_ref
+{
+  ref_type type;
+
+  union
+  {
+    struct gfc_array_ref ar;
+
+    struct
+    {
+      gfc_component *component;
+      gfc_symbol *sym;
+    }
+    c;
+
+    struct
+    {
+      struct gfc_expr *start, *end;	/* Substring */
+      gfc_charlen *length;
+    }
+    ss;
+
+  }
+  u;
+
+  struct gfc_ref *next;
+}
+gfc_ref;
+
+#define gfc_get_ref() XCNEW (gfc_ref)
+
+
+/* Structures representing intrinsic symbols and their arguments lists.  */
+typedef struct gfc_intrinsic_arg
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+
+  gfc_typespec ts;
+  unsigned optional:1, value:1;
+  ENUM_BITFIELD (sym_intent) intent:2;
+  gfc_actual_arglist *actual;
+
+  struct gfc_intrinsic_arg *next;
+
+}
+gfc_intrinsic_arg;
+
+
+/* Specifies the various kinds of check functions used to verify the
+   argument lists of intrinsic functions. fX with X an integer refer
+   to check functions of intrinsics with X arguments. f1m is used for
+   the MAX and MIN intrinsics which can have an arbitrary number of
+   arguments, f3ml is used for the MINLOC and MAXLOC intrinsics as
+   these have special semantics.  */
+
+typedef union
+{
+  gfc_try (*f0)(void);
+  gfc_try (*f1)(struct gfc_expr *);
+  gfc_try (*f1m)(gfc_actual_arglist *);
+  gfc_try (*f2)(struct gfc_expr *, struct gfc_expr *);
+  gfc_try (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
+  gfc_try (*f3ml)(gfc_actual_arglist *);
+  gfc_try (*f3red)(gfc_actual_arglist *);
+  gfc_try (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
+	    struct gfc_expr *);
+  gfc_try (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
+	    struct gfc_expr *, struct gfc_expr *);
+}
+gfc_check_f;
+
+/* Like gfc_check_f, these specify the type of the simplification
+   function associated with an intrinsic. The fX are just like in
+   gfc_check_f. cc is used for type conversion functions.  */
+
+typedef union
+{
+  struct gfc_expr *(*f0)(void);
+  struct gfc_expr *(*f1)(struct gfc_expr *);
+  struct gfc_expr *(*f2)(struct gfc_expr *, struct gfc_expr *);
+  struct gfc_expr *(*f3)(struct gfc_expr *, struct gfc_expr *,
+			 struct gfc_expr *);
+  struct gfc_expr *(*f4)(struct gfc_expr *, struct gfc_expr *,
+			 struct gfc_expr *, struct gfc_expr *);
+  struct gfc_expr *(*f5)(struct gfc_expr *, struct gfc_expr *,
+			 struct gfc_expr *, struct gfc_expr *,
+			 struct gfc_expr *);
+  struct gfc_expr *(*cc)(struct gfc_expr *, bt, int);
+}
+gfc_simplify_f;
+
+/* Again like gfc_check_f, these specify the type of the resolution
+   function associated with an intrinsic. The fX are just like in
+   gfc_check_f. f1m is used for MIN and MAX, s1 is used for abort().  */
+
+typedef union
+{
+  void (*f0)(struct gfc_expr *);
+  void (*f1)(struct gfc_expr *, struct gfc_expr *);
+  void (*f1m)(struct gfc_expr *, struct gfc_actual_arglist *);
+  void (*f2)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
+  void (*f3)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
+	     struct gfc_expr *);
+  void (*f4)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
+	     struct gfc_expr *, struct gfc_expr *);
+  void (*f5)(struct gfc_expr *, struct gfc_expr *, struct gfc_expr *,
+	     struct gfc_expr *, struct gfc_expr *, struct gfc_expr *);
+  void (*s1)(struct gfc_code *);
+}
+gfc_resolve_f;
+
+
+typedef struct gfc_intrinsic_sym
+{
+  const char *name, *lib_name;
+  gfc_intrinsic_arg *formal;
+  gfc_typespec ts;
+  unsigned elemental:1, inquiry:1, transformational:1, pure:1, 
+    generic:1, specific:1, actual_ok:1, noreturn:1, conversion:1,
+    from_module:1;
+
+  int standard;
+
+  gfc_simplify_f simplify;
+  gfc_check_f check;
+  gfc_resolve_f resolve;
+  struct gfc_intrinsic_sym *specific_head, *next;
+  gfc_isym_id id;
+
+}
+gfc_intrinsic_sym;
+
+
+/* Expression nodes.  The expression node types deserve explanations,
+   since the last couple can be easily misconstrued:
+
+   EXPR_OP         Operator node pointing to one or two other nodes
+   EXPR_FUNCTION   Function call, symbol points to function's name
+   EXPR_CONSTANT   A scalar constant: Logical, String, Real, Int or Complex
+   EXPR_VARIABLE   An Lvalue with a root symbol and possible reference list
+		   which expresses structure, array and substring refs.
+   EXPR_NULL       The NULL pointer value (which also has a basic type).
+   EXPR_SUBSTRING  A substring of a constant string
+   EXPR_STRUCTURE  A structure constructor
+   EXPR_ARRAY      An array constructor.
+   EXPR_COMPCALL   Function (or subroutine) call of a procedure pointer
+		   component or type-bound procedure.  */
+
+#include <gmp.h>
+#include <mpfr.h>
+#include <mpc.h>
+#define GFC_RND_MODE GMP_RNDN
+#define GFC_MPC_RND_MODE MPC_RNDNN
+
+typedef splay_tree gfc_constructor_base;
+
+typedef struct gfc_expr
+{
+  expr_t expr_type;
+
+  gfc_typespec ts;	/* These two refer to the overall expression */
+
+  int rank;
+  mpz_t *shape;		/* Can be NULL if shape is unknown at compile time */
+
+  /* Nonnull for functions and structure constructors, may also used to hold the
+     base-object for component calls.  */
+  gfc_symtree *symtree;
+
+  gfc_ref *ref;
+
+  locus where;
+
+  /* is_boz is true if the integer is regarded as BOZ bitpatten and is_snan
+     denotes a signalling not-a-number.  */
+  unsigned int is_boz : 1, is_snan : 1;
+
+  /* Sometimes, when an error has been emitted, it is necessary to prevent
+      it from recurring.  */
+  unsigned int error : 1;
+  
+  /* Mark an expression where a user operator has been substituted by
+     a function call in interface.c(gfc_extend_expr).  */
+  unsigned int user_operator : 1;
+
+  /* Mark an expression as being a MOLD argument of ALLOCATE.  */
+  unsigned int mold : 1;
+  
+  /* If an expression comes from a Hollerith constant or compile-time
+     evaluation of a transfer statement, it may have a prescribed target-
+     memory representation, and these cannot always be backformed from
+     the value.  */
+  struct
+  {
+    int length;
+    char *string;
+  }
+  representation;
+
+  union
+  {
+    int logical;
+
+    io_kind iokind;
+
+    mpz_t integer;
+
+    mpfr_t real;
+
+    mpc_t complex;
+
+    struct
+    {
+      gfc_intrinsic_op op;
+      gfc_user_op *uop;
+      struct gfc_expr *op1, *op2;
+    }
+    op;
+
+    struct
+    {
+      gfc_actual_arglist *actual;
+      const char *name;	/* Points to the ultimate name of the function */
+      gfc_intrinsic_sym *isym;
+      gfc_symbol *esym;
+    }
+    function;
+
+    struct
+    {
+      gfc_actual_arglist* actual;
+      const char* name;
+      /* Base-object, whose component was called.  NULL means that it should
+	 be taken from symtree/ref.  */
+      struct gfc_expr* base_object;
+      gfc_typebound_proc* tbp; /* Should overlap with esym.  */
+
+      /* For type-bound operators, we want to call PASS procedures but already
+	 have the full arglist; mark this, so that it is not extended by the
+	 PASS argument.  */
+      unsigned ignore_pass:1;
+
+      /* Do assign-calls rather than calls, that is appropriate dependency
+	 checking.  */
+      unsigned assign:1;
+    }
+    compcall;
+
+    struct
+    {
+      int length;
+      gfc_char_t *string;
+    }
+    character;
+
+    gfc_constructor_base constructor;
+  }
+  value;
+
+}
+gfc_expr;
+
+
+#define gfc_get_shape(rank) ((mpz_t *) gfc_getmem((rank)*sizeof(mpz_t)))
+
+/* Structures for information associated with different kinds of
+   numbers.  The first set of integer parameters define all there is
+   to know about a particular kind.  The rest of the elements are
+   computed from the first elements.  */
+
+typedef struct
+{
+  /* Values really representable by the target.  */
+  mpz_t huge, pedantic_min_int, min_int;
+
+  int kind, radix, digits, bit_size, range;
+
+  /* True if the C type of the given name maps to this precision.
+     Note that more than one bit can be set.  */
+  unsigned int c_char : 1;
+  unsigned int c_short : 1;
+  unsigned int c_int : 1;
+  unsigned int c_long : 1;
+  unsigned int c_long_long : 1;
+}
+gfc_integer_info;
+
+extern gfc_integer_info gfc_integer_kinds[];
+
+
+typedef struct
+{
+  int kind, bit_size;
+
+  /* True if the C++ type bool, C99 type _Bool, maps to this precision.  */
+  unsigned int c_bool : 1;
+}
+gfc_logical_info;
+
+extern gfc_logical_info gfc_logical_kinds[];
+
+
+typedef struct
+{
+  mpfr_t epsilon, huge, tiny, subnormal;
+  int kind, radix, digits, min_exponent, max_exponent;
+  int range, precision;
+
+  /* The precision of the type as reported by GET_MODE_PRECISION.  */
+  int mode_precision;
+
+  /* True if the C type of the given name maps to this precision.
+     Note that more than one bit can be set.  */
+  unsigned int c_float : 1;
+  unsigned int c_double : 1;
+  unsigned int c_long_double : 1;
+  unsigned int c_float128 : 1;
+}
+gfc_real_info;
+
+extern gfc_real_info gfc_real_kinds[];
+
+typedef struct
+{
+  int kind, bit_size;
+  const char *name;
+}
+gfc_character_info;
+
+extern gfc_character_info gfc_character_kinds[];
+
+
+/* Equivalence structures.  Equivalent lvalues are linked along the
+   *eq pointer, equivalence sets are strung along the *next node.  */
+typedef struct gfc_equiv
+{
+  struct gfc_equiv *next, *eq;
+  gfc_expr *expr;
+  const char *module;
+  int used;
+}
+gfc_equiv;
+
+#define gfc_get_equiv() XCNEW (gfc_equiv)
+
+/* Holds a single equivalence member after processing.  */
+typedef struct gfc_equiv_info
+{
+  gfc_symbol *sym;
+  HOST_WIDE_INT offset;
+  HOST_WIDE_INT length;
+  struct gfc_equiv_info *next;
+} gfc_equiv_info;
+
+/* Holds equivalence groups, after they have been processed.  */
+typedef struct gfc_equiv_list
+{
+  gfc_equiv_info *equiv;
+  struct gfc_equiv_list *next;
+} gfc_equiv_list;
+
+/* gfc_case stores the selector list of a case statement.  The *low
+   and *high pointers can point to the same expression in the case of
+   a single value.  If *high is NULL, the selection is from *low
+   upwards, if *low is NULL the selection is *high downwards.
+
+   This structure has separate fields to allow single and double linked
+   lists of CASEs at the same time.  The singe linked list along the NEXT
+   field is a list of cases for a single CASE label.  The double linked
+   list along the LEFT/RIGHT fields is used to detect overlap and to
+   build a table of the cases for SELECT constructs with a CHARACTER
+   case expression.  */
+
+typedef struct gfc_case
+{
+  /* Where we saw this case.  */
+  locus where;
+  int n;
+
+  /* Case range values.  If (low == high), it's a single value.  If one of
+     the labels is NULL, it's an unbounded case.  If both are NULL, this
+     represents the default case.  */
+  gfc_expr *low, *high;
+
+  /* Only used for SELECT TYPE.  */
+  gfc_typespec ts;
+
+  /* Next case label in the list of cases for a single CASE label.  */
+  struct gfc_case *next;
+
+  /* Used for detecting overlap, and for code generation.  */
+  struct gfc_case *left, *right;
+
+  /* True if this case label can never be matched.  */
+  int unreachable;
+}
+gfc_case;
+
+#define gfc_get_case() XCNEW (gfc_case)
+
+
+typedef struct
+{
+  gfc_expr *var, *start, *end, *step;
+}
+gfc_iterator;
+
+#define gfc_get_iterator() XCNEW (gfc_iterator)
+
+
+/* Allocation structure for ALLOCATE, DEALLOCATE and NULLIFY statements.  */
+
+typedef struct gfc_alloc
+{
+  gfc_expr *expr;
+  struct gfc_alloc *next;
+}
+gfc_alloc;
+
+#define gfc_get_alloc() XCNEW (gfc_alloc)
+
+
+typedef struct
+{
+  gfc_expr *unit, *file, *status, *access, *form, *recl,
+    *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert,
+    *decimal, *encoding, *round, *sign, *asynchronous, *id, *newunit;
+  gfc_st_label *err;
+}
+gfc_open;
+
+
+typedef struct
+{
+  gfc_expr *unit, *status, *iostat, *iomsg;
+  gfc_st_label *err;
+}
+gfc_close;
+
+
+typedef struct
+{
+  gfc_expr *unit, *iostat, *iomsg;
+  gfc_st_label *err;
+}
+gfc_filepos;
+
+
+typedef struct
+{
+  gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
+    *name, *access, *sequential, *direct, *form, *formatted,
+    *unformatted, *recl, *nextrec, *blank, *position, *action, *read,
+    *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos,
+    *asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id;
+
+  gfc_st_label *err;
+
+}
+gfc_inquire;
+
+
+typedef struct
+{
+  gfc_expr *unit, *iostat, *iomsg, *id;
+  gfc_st_label *err, *end, *eor;
+}
+gfc_wait;
+
+
+typedef struct
+{
+  gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
+	   *id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
+	   *sign, *extra_comma, *dt_io_kind;
+
+  gfc_symbol *namelist;
+  /* A format_label of `format_asterisk' indicates the "*" format */
+  gfc_st_label *format_label;
+  gfc_st_label *err, *end, *eor;
+
+  locus eor_where, end_where, err_where;
+}
+gfc_dt;
+
+
+typedef struct gfc_forall_iterator
+{
+  gfc_expr *var, *start, *end, *stride;
+  struct gfc_forall_iterator *next;
+}
+gfc_forall_iterator;
+
+
+/* Linked list to store associations in an ASSOCIATE statement.  */
+
+typedef struct gfc_association_list
+{
+  struct gfc_association_list *next; 
+
+  /* Whether this is association to a variable that can be changed; otherwise,
+     it's association to an expression and the name may not be used as
+     lvalue.  */
+  unsigned variable:1;
+
+  /* True if this struct is currently only linked to from a gfc_symbol rather
+     than as part of a real list in gfc_code->ext.block.assoc.  This may
+     happen for SELECT TYPE temporaries and must be considered
+     for memory handling.  */
+  unsigned dangling:1;
+
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symtree *st; /* Symtree corresponding to name.  */
+  locus where;
+
+  gfc_expr *target;
+}
+gfc_association_list;
+#define gfc_get_association_list() XCNEW (gfc_association_list)
+
+
+/* Executable statements that fill gfc_code structures.  */
+typedef enum
+{
+  EXEC_NOP = 1, EXEC_END_BLOCK, EXEC_ASSIGN, EXEC_LABEL_ASSIGN,
+  EXEC_POINTER_ASSIGN, EXEC_CRITICAL, EXEC_ERROR_STOP,
+  EXEC_GOTO, EXEC_CALL, EXEC_COMPCALL, EXEC_ASSIGN_CALL, EXEC_RETURN,
+  EXEC_ENTRY, EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN,
+  EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT, EXEC_BLOCK,
+  EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT, EXEC_CALL_PPC,
+  EXEC_ALLOCATE, EXEC_DEALLOCATE, EXEC_END_PROCEDURE, EXEC_SELECT_TYPE,
+  EXEC_SYNC_ALL, EXEC_SYNC_MEMORY, EXEC_SYNC_IMAGES,
+  EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
+  EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
+  EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
+  EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
+  EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
+  EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
+  EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
+  EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
+  EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT
+}
+gfc_exec_op;
+
+typedef struct gfc_code
+{
+  gfc_exec_op op;
+
+  struct gfc_code *block, *next;
+  locus loc;
+
+  gfc_st_label *here, *label1, *label2, *label3;
+  gfc_symtree *symtree;
+  gfc_expr *expr1, *expr2, *expr3;
+  /* A name isn't sufficient to identify a subroutine, we need the actual
+     symbol for the interface definition.
+  const char *sub_name;  */
+  gfc_symbol *resolved_sym;
+  gfc_intrinsic_sym *resolved_isym;
+
+  union
+  {
+    gfc_actual_arglist *actual;
+    gfc_iterator *iterator;
+
+    struct
+    {
+      gfc_typespec ts;
+      gfc_alloc *list;
+    }
+    alloc;
+
+    struct
+    {
+      gfc_namespace *ns;
+      gfc_association_list *assoc;
+      gfc_case *case_list;
+    }
+    block;
+
+    gfc_open *open;
+    gfc_close *close;
+    gfc_filepos *filepos;
+    gfc_inquire *inquire;
+    gfc_wait *wait;
+    gfc_dt *dt;
+    gfc_forall_iterator *forall_iterator;
+    struct gfc_code *which_construct;
+    int stop_code;
+    gfc_entry_list *entry;
+    gfc_omp_clauses *omp_clauses;
+    const char *omp_name;
+    gfc_namelist *omp_namelist;
+    bool omp_bool;
+  }
+  ext;		/* Points to additional structures required by statement */
+
+  /* Cycle and break labels in constructs.  */
+  tree cycle_label;
+  tree exit_label;
+}
+gfc_code;
+
+
+/* Storage for DATA statements.  */
+typedef struct gfc_data_variable
+{
+  gfc_expr *expr;
+  gfc_iterator iter;
+  struct gfc_data_variable *list, *next;
+}
+gfc_data_variable;
+
+
+typedef struct gfc_data_value
+{
+  mpz_t repeat;
+  gfc_expr *expr;
+  struct gfc_data_value *next;
+}
+gfc_data_value;
+
+
+typedef struct gfc_data
+{
+  gfc_data_variable *var;
+  gfc_data_value *value;
+  locus where;
+
+  struct gfc_data *next;
+}
+gfc_data;
+
+
+/* Structure for holding compile options */
+typedef struct
+{
+  char *module_dir;
+  gfc_source_form source_form;
+  /* Maximum line lengths in fixed- and free-form source, respectively.
+     When fixed_line_length or free_line_length are 0, the whole line is used,
+     regardless of length.
+
+     If the user requests a fixed_line_length <7 then gfc_init_options()
+     emits a fatal error.  */
+  int fixed_line_length;
+  int free_line_length;
+  /* Maximum number of continuation lines in fixed- and free-form source,
+     respectively.  */
+  int max_continue_fixed;
+  int max_continue_free;
+  int max_identifier_length;
+  int dump_fortran_original;
+  int dump_fortran_optimized;
+
+  int warn_aliasing;
+  int warn_ampersand;
+  int gfc_warn_conversion;
+  int warn_conversion_extra;
+  int warn_implicit_interface;
+  int warn_implicit_procedure;
+  int warn_line_truncation;
+  int warn_surprising;
+  int warn_tabs;
+  int warn_underflow;
+  int warn_intrinsic_shadow;
+  int warn_intrinsics_std;
+  int warn_character_truncation;
+  int warn_array_temp;
+  int warn_align_commons;
+  int warn_real_q_constant;
+  int warn_unused_dummy_argument;
+  int max_errors;
+
+  int flag_all_intrinsics;
+  int flag_default_double;
+  int flag_default_integer;
+  int flag_default_real;
+  int flag_dollar_ok;
+  int flag_underscoring;
+  int flag_second_underscore;
+  int flag_implicit_none;
+  int flag_max_stack_var_size;
+  int flag_max_array_constructor;
+  int flag_range_check;
+  int flag_pack_derived;
+  int flag_repack_arrays;
+  int flag_preprocessed;
+  int flag_f2c;
+  int flag_automatic;
+  int flag_backslash;
+  int flag_backtrace;
+  int flag_allow_leading_underscore;
+  int flag_dump_core;
+  int flag_external_blas;
+  int blas_matmul_limit;
+  int flag_cray_pointer;
+  int flag_d_lines;
+  int gfc_flag_openmp;
+  int flag_sign_zero;
+  int flag_module_private;
+  int flag_recursive;
+  int flag_init_local_zero;
+  int flag_init_integer;
+  int flag_init_integer_value;
+  int flag_init_real;
+  int flag_init_logical;
+  int flag_init_character;
+  char flag_init_character_value;
+  int flag_align_commons;
+  int flag_whole_file;
+  int flag_protect_parens;
+  int flag_realloc_lhs;
+
+  int fpe;
+  int rtcheck;
+  gfc_fcoarray coarray;
+
+  int warn_std;
+  int allow_std;
+  int convert;
+  int record_marker;
+  int max_subrecord_length;
+}
+gfc_option_t;
+
+extern gfc_option_t gfc_option;
+
+/* Constructor nodes for array and structure constructors.  */
+typedef struct gfc_constructor
+{
+  gfc_constructor_base base;
+  mpz_t offset;               /* Offset within a constructor, used as
+				 key within base. */
+
+  gfc_expr *expr;
+  gfc_iterator *iterator;
+  locus where;
+
+  union
+  {
+     gfc_component *component; /* Record the component being initialized.  */
+  }
+  n;
+  mpz_t repeat; /* Record the repeat number of initial values in data
+		  statement like "data a/5*10/".  */
+}
+gfc_constructor;
+
+
+typedef struct iterator_stack
+{
+  gfc_symtree *variable;
+  mpz_t value;
+  struct iterator_stack *prev;
+}
+iterator_stack;
+extern iterator_stack *iter_stack;
+
+
+/* Used for (possibly nested) SELECT TYPE statements.  */
+typedef struct gfc_select_type_stack
+{
+  gfc_symbol *selector;			/* Current selector variable.  */
+  gfc_symtree *tmp;			/* Current temporary variable.  */
+  struct gfc_select_type_stack *prev;	/* Previous element on stack.  */
+}
+gfc_select_type_stack;
+extern gfc_select_type_stack *select_type_stack;
+#define gfc_get_select_type_stack() XCNEW (gfc_select_type_stack)
+
+
+/* Node in the linked list used for storing finalizer procedures.  */
+
+typedef struct gfc_finalizer
+{
+  struct gfc_finalizer* next;
+  locus where; /* Where the FINAL declaration occurred.  */
+
+  /* Up to resolution, we want the gfc_symbol, there we lookup the corresponding
+     symtree and later need only that.  This way, we can access and call the
+     finalizers from every context as they should be "always accessible".  I
+     don't make this a union because we need the information whether proc_sym is
+     still referenced or not for dereferencing it on deleting a gfc_finalizer
+     structure.  */
+  gfc_symbol*  proc_sym;
+  gfc_symtree* proc_tree; 
+}
+gfc_finalizer;
+#define gfc_get_finalizer() XCNEW (gfc_finalizer)
+
+
+/************************ Function prototypes *************************/
+
+/* decl.c */
+bool gfc_in_match_data (void);
+match gfc_match_char_spec (gfc_typespec *);
+
+/* scanner.c */
+void gfc_scanner_done_1 (void);
+void gfc_scanner_init_1 (void);
+
+void gfc_add_include_path (const char *, bool, bool);
+void gfc_add_intrinsic_modules_path (const char *);
+void gfc_release_include_path (void);
+FILE *gfc_open_included_file (const char *, bool, bool);
+FILE *gfc_open_intrinsic_module (const char *);
+
+int gfc_at_end (void);
+int gfc_at_eof (void);
+int gfc_at_bol (void);
+int gfc_at_eol (void);
+void gfc_advance_line (void);
+int gfc_check_include (void);
+int gfc_define_undef_line (void);
+
+int gfc_wide_is_printable (gfc_char_t);
+int gfc_wide_is_digit (gfc_char_t);
+int gfc_wide_fits_in_byte (gfc_char_t);
+gfc_char_t gfc_wide_tolower (gfc_char_t);
+gfc_char_t gfc_wide_toupper (gfc_char_t);
+size_t gfc_wide_strlen (const gfc_char_t *);
+int gfc_wide_strncasecmp (const gfc_char_t *, const char *, size_t);
+gfc_char_t *gfc_wide_memset (gfc_char_t *, gfc_char_t, size_t);
+char *gfc_widechar_to_char (const gfc_char_t *, int);
+gfc_char_t *gfc_char_to_widechar (const char *);
+
+#define gfc_get_wide_string(n) XCNEWVEC (gfc_char_t, n)
+
+void gfc_skip_comments (void);
+gfc_char_t gfc_next_char_literal (gfc_instring);
+gfc_char_t gfc_next_char (void);
+char gfc_next_ascii_char (void);
+gfc_char_t gfc_peek_char (void);
+char gfc_peek_ascii_char (void);
+void gfc_error_recovery (void);
+void gfc_gobble_whitespace (void);
+gfc_try gfc_new_file (void);
+const char * gfc_read_orig_filename (const char *, const char **);
+
+extern gfc_source_form gfc_current_form;
+extern const char *gfc_source_file;
+extern locus gfc_current_locus;
+
+void gfc_start_source_files (void);
+void gfc_end_source_files (void);
+
+/* misc.c */
+void *gfc_getmem (size_t) ATTRIBUTE_MALLOC;
+void gfc_free (void *);
+int gfc_terminal_width (void);
+void gfc_clear_ts (gfc_typespec *);
+FILE *gfc_open_file (const char *);
+const char *gfc_basic_typename (bt);
+const char *gfc_typename (gfc_typespec *);
+const char *gfc_op2string (gfc_intrinsic_op);
+const char *gfc_code2string (const mstring *, int);
+int gfc_string2code (const mstring *, const char *);
+const char *gfc_intent_string (sym_intent);
+
+void gfc_init_1 (void);
+void gfc_init_2 (void);
+void gfc_done_1 (void);
+void gfc_done_2 (void);
+
+int get_c_kind (const char *, CInteropKind_t *);
+
+/* options.c */
+unsigned int gfc_option_lang_mask (void);
+void gfc_init_options_struct (struct gcc_options *);
+void gfc_init_options (unsigned int,
+		       struct cl_decoded_option *);
+bool gfc_handle_option (size_t, const char *, int, int, location_t,
+			const struct cl_option_handlers *);
+bool gfc_post_options (const char **);
+char *gfc_get_option_string (void);
+
+/* f95-lang.c */
+void gfc_maybe_initialize_eh (void);
+
+/* iresolve.c */
+const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
+bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *);
+
+/* error.c */
+
+typedef struct gfc_error_buf
+{
+  int flag;
+  size_t allocated, index;
+  char *message;
+} gfc_error_buf;
+
+void gfc_error_init_1 (void);
+void gfc_buffer_error (int);
+
+const char *gfc_print_wide_char (gfc_char_t);
+
+void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
+void gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
+void gfc_clear_warning (void);
+void gfc_warning_check (void);
+
+void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
+void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
+void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
+void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
+void gfc_clear_error (void);
+int gfc_error_check (void);
+int gfc_error_flag_test (void);
+
+notification gfc_notification_std (int);
+gfc_try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
+
+/* A general purpose syntax error.  */
+#define gfc_syntax_error(ST)	\
+  gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST));
+
+void gfc_push_error (gfc_error_buf *);
+void gfc_pop_error (gfc_error_buf *);
+void gfc_free_error (gfc_error_buf *);
+
+void gfc_get_errors (int *, int *);
+void gfc_errors_to_warnings (int);
+
+/* arith.c */
+void gfc_arith_init_1 (void);
+void gfc_arith_done_1 (void);
+arith gfc_check_integer_range (mpz_t p, int kind);
+bool gfc_check_character_range (gfc_char_t, int);
+
+/* trans-types.c */
+gfc_try gfc_check_any_c_kind (gfc_typespec *);
+int gfc_validate_kind (bt, int, bool);
+int gfc_get_int_kind_from_width_isofortranenv (int size);
+int gfc_get_real_kind_from_width_isofortranenv (int size);
+tree gfc_get_derived_type (gfc_symbol * derived);
+extern int gfc_index_integer_kind;
+extern int gfc_default_integer_kind;
+extern int gfc_max_integer_kind;
+extern int gfc_default_real_kind;
+extern int gfc_default_double_kind;
+extern int gfc_default_character_kind;
+extern int gfc_default_logical_kind;
+extern int gfc_default_complex_kind;
+extern int gfc_c_int_kind;
+extern int gfc_intio_kind;
+extern int gfc_charlen_int_kind;
+extern int gfc_numeric_storage_size;
+extern int gfc_character_storage_size;
+
+/* symbol.c */
+void gfc_clear_new_implicit (void);
+gfc_try gfc_add_new_implicit_range (int, int);
+gfc_try gfc_merge_new_implicit (gfc_typespec *);
+void gfc_set_implicit_none (void);
+void gfc_check_function_type (gfc_namespace *);
+bool gfc_is_intrinsic_typename (const char *);
+
+gfc_typespec *gfc_get_default_type (const char *, gfc_namespace *);
+gfc_try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
+
+void gfc_set_sym_referenced (gfc_symbol *);
+
+gfc_try gfc_add_attribute (symbol_attribute *, locus *);
+gfc_try gfc_add_ext_attribute (symbol_attribute *, ext_attr_id_t, locus *);
+gfc_try gfc_add_allocatable (symbol_attribute *, locus *);
+gfc_try gfc_add_codimension (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_contiguous (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_dimension (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_external (symbol_attribute *, locus *);
+gfc_try gfc_add_intrinsic (symbol_attribute *, locus *);
+gfc_try gfc_add_optional (symbol_attribute *, locus *);
+gfc_try gfc_add_pointer (symbol_attribute *, locus *);
+gfc_try gfc_add_cray_pointer (symbol_attribute *, locus *);
+gfc_try gfc_add_cray_pointee (symbol_attribute *, locus *);
+match gfc_mod_pointee_as (gfc_array_spec *);
+gfc_try gfc_add_protected (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_result (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_save (symbol_attribute *, save_state, const char *, locus *);
+gfc_try gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_saved_common (symbol_attribute *, locus *);
+gfc_try gfc_add_target (symbol_attribute *, locus *);
+gfc_try gfc_add_dummy (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_generic (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_common (symbol_attribute *, locus *);
+gfc_try gfc_add_in_common (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_in_equivalence (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_data (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_in_namelist (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_sequence (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_elemental (symbol_attribute *, locus *);
+gfc_try gfc_add_pure (symbol_attribute *, locus *);
+gfc_try gfc_add_recursive (symbol_attribute *, locus *);
+gfc_try gfc_add_function (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_volatile (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_asynchronous (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_proc (symbol_attribute *attr, const char *name, locus *where);
+gfc_try gfc_add_abstract (symbol_attribute* attr, locus* where);
+
+gfc_try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
+gfc_try gfc_add_is_bind_c (symbol_attribute *, const char *, locus *, int);
+gfc_try gfc_add_extension (symbol_attribute *, locus *);
+gfc_try gfc_add_value (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
+gfc_try gfc_add_entry (symbol_attribute *, const char *, locus *);
+gfc_try gfc_add_procedure (symbol_attribute *, procedure_type,
+		       const char *, locus *);
+gfc_try gfc_add_intent (symbol_attribute *, sym_intent, locus *);
+gfc_try gfc_add_explicit_interface (gfc_symbol *, ifsrc,
+				gfc_formal_arglist *, locus *);
+gfc_try gfc_add_type (gfc_symbol *, gfc_typespec *, locus *);
+
+void gfc_clear_attr (symbol_attribute *);
+gfc_try gfc_missing_attr (symbol_attribute *, locus *);
+gfc_try gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *);
+
+gfc_try gfc_add_component (gfc_symbol *, const char *, gfc_component **);
+gfc_symbol *gfc_use_derived (gfc_symbol *);
+gfc_symtree *gfc_use_derived_tree (gfc_symtree *);
+gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool);
+
+gfc_st_label *gfc_get_st_label (int);
+void gfc_free_st_label (gfc_st_label *);
+void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
+gfc_try gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
+
+gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
+gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
+gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
+void gfc_delete_symtree (gfc_symtree **, const char *);
+gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
+gfc_user_op *gfc_get_uop (const char *);
+gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
+void gfc_free_symbol (gfc_symbol *);
+void gfc_release_symbol (gfc_symbol *);
+gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
+gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *);
+int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
+int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
+int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
+gfc_try verify_c_interop (gfc_typespec *);
+gfc_try verify_c_interop_param (gfc_symbol *);
+gfc_try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
+gfc_try verify_bind_c_derived_type (gfc_symbol *);
+gfc_try verify_com_block_vars_c_interop (gfc_common_head *);
+void generate_isocbinding_symbol (const char *, iso_c_binding_symbol, const char *);
+gfc_symbol *get_iso_c_sym (gfc_symbol *, char *, char *, int);
+int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **, bool);
+int gfc_get_ha_symbol (const char *, gfc_symbol **);
+int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
+
+void gfc_undo_symbols (void);
+void gfc_commit_symbols (void);
+void gfc_commit_symbol (gfc_symbol *);
+gfc_charlen *gfc_new_charlen (gfc_namespace *, gfc_charlen *);
+void gfc_free_charlen (gfc_charlen *, gfc_charlen *);
+void gfc_free_namespace (gfc_namespace *);
+
+void gfc_symbol_init_2 (void);
+void gfc_symbol_done_2 (void);
+
+void gfc_traverse_symtree (gfc_symtree *, void (*)(gfc_symtree *));
+void gfc_traverse_ns (gfc_namespace *, void (*)(gfc_symbol *));
+void gfc_traverse_user_op (gfc_namespace *, void (*)(gfc_user_op *));
+void gfc_save_all (gfc_namespace *);
+
+void gfc_enforce_clean_symbol_state (void);
+void gfc_free_dt_list (void);
+
+
+gfc_gsymbol *gfc_get_gsymbol (const char *);
+gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *);
+
+gfc_typebound_proc* gfc_get_typebound_proc (gfc_typebound_proc*);
+gfc_symbol* gfc_get_derived_super_type (gfc_symbol*);
+gfc_symbol* gfc_get_ultimate_derived_super_type (gfc_symbol*);
+bool gfc_type_is_extension_of (gfc_symbol *, gfc_symbol *);
+bool gfc_type_compatible (gfc_typespec *, gfc_typespec *);
+
+void gfc_copy_formal_args (gfc_symbol *, gfc_symbol *);
+void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *);
+void gfc_copy_formal_args_ppc (gfc_component *, gfc_symbol *);
+
+void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too  */
+
+gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus);
+gfc_namespace* gfc_find_proc_namespace (gfc_namespace*);
+
+bool gfc_is_associate_pointer (gfc_symbol*);
+
+/* intrinsic.c -- true if working in an init-expr, false otherwise.  */
+extern bool gfc_init_expr_flag;
+
+/* Given a symbol that we have decided is intrinsic, mark it as such
+   by placing it into a special module that is otherwise impossible to
+   read or write.  */
+
+#define gfc_intrinsic_symbol(SYM) SYM->module = gfc_get_string ("(intrinsic)")
+
+void gfc_intrinsic_init_1 (void);
+void gfc_intrinsic_done_1 (void);
+
+char gfc_type_letter (bt);
+gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *);
+gfc_try gfc_convert_type (gfc_expr *, gfc_typespec *, int);
+gfc_try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
+gfc_try gfc_convert_chartype (gfc_expr *, gfc_typespec *);
+int gfc_generic_intrinsic (const char *);
+int gfc_specific_intrinsic (const char *);
+bool gfc_is_intrinsic (gfc_symbol*, int, locus);
+int gfc_intrinsic_actual_ok (const char *, const bool);
+gfc_intrinsic_sym *gfc_find_function (const char *);
+gfc_intrinsic_sym *gfc_find_subroutine (const char *);
+gfc_intrinsic_sym *gfc_intrinsic_function_by_id (gfc_isym_id);
+
+match gfc_intrinsic_func_interface (gfc_expr *, int);
+match gfc_intrinsic_sub_interface (gfc_code *, int);
+
+void gfc_warn_intrinsic_shadow (const gfc_symbol*, bool, bool);
+gfc_try gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**,
+				      bool, locus);
+
+/* match.c -- FIXME */
+void gfc_free_iterator (gfc_iterator *, int);
+void gfc_free_forall_iterator (gfc_forall_iterator *);
+void gfc_free_alloc_list (gfc_alloc *);
+void gfc_free_namelist (gfc_namelist *);
+void gfc_free_equiv (gfc_equiv *);
+void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
+void gfc_free_data (gfc_data *);
+void gfc_free_case_list (gfc_case *);
+
+/* matchexp.c -- FIXME too?  */
+gfc_expr *gfc_get_parentheses (gfc_expr *);
+
+/* openmp.c */
+struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; };
+void gfc_free_omp_clauses (gfc_omp_clauses *);
+void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
+void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *);
+void gfc_resolve_omp_parallel_blocks (gfc_code *, gfc_namespace *);
+void gfc_resolve_omp_do_blocks (gfc_code *, gfc_namespace *);
+void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *);
+void gfc_omp_restore_state (struct gfc_omp_saved_state *);
+
+/* expr.c */
+void gfc_free_actual_arglist (gfc_actual_arglist *);
+gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
+const char *gfc_extract_int (gfc_expr *, int *);
+bool is_subref_array (gfc_expr *);
+bool gfc_is_simply_contiguous (gfc_expr *, bool);
+
+gfc_expr *gfc_build_conversion (gfc_expr *);
+void gfc_free_ref_list (gfc_ref *);
+void gfc_type_convert_binary (gfc_expr *, int);
+int gfc_is_constant_expr (gfc_expr *);
+gfc_try gfc_simplify_expr (gfc_expr *, int);
+int gfc_has_vector_index (gfc_expr *);
+
+gfc_expr *gfc_get_expr (void);
+gfc_expr *gfc_get_array_expr (bt type, int kind, locus *);
+gfc_expr *gfc_get_null_expr (locus *);
+gfc_expr *gfc_get_operator_expr (locus *, gfc_intrinsic_op,gfc_expr *, gfc_expr *);
+gfc_expr *gfc_get_structure_constructor_expr (bt, int, locus *);
+gfc_expr *gfc_get_constant_expr (bt, int, locus *);
+gfc_expr *gfc_get_character_expr (int, locus *, const char *, int len);
+gfc_expr *gfc_get_int_expr (int, locus *, int);
+gfc_expr *gfc_get_logical_expr (int, locus *, bool);
+gfc_expr *gfc_get_iokind_expr (locus *, io_kind);
+
+void gfc_clear_shape (mpz_t *shape, int rank);
+void gfc_free_shape (mpz_t **shape, int rank);
+void gfc_free_expr (gfc_expr *);
+void gfc_replace_expr (gfc_expr *, gfc_expr *);
+mpz_t *gfc_copy_shape (mpz_t *, int);
+mpz_t *gfc_copy_shape_excluding (mpz_t *, int, gfc_expr *);
+gfc_expr *gfc_copy_expr (gfc_expr *);
+gfc_ref* gfc_copy_ref (gfc_ref*);
+
+gfc_try gfc_specification_expr (gfc_expr *);
+
+int gfc_numeric_ts (gfc_typespec *);
+int gfc_kind_max (gfc_expr *, gfc_expr *);
+
+gfc_try gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3;
+gfc_try gfc_check_assign (gfc_expr *, gfc_expr *, int);
+gfc_try gfc_check_pointer_assign (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
+
+bool gfc_has_default_initializer (gfc_symbol *);
+gfc_expr *gfc_default_initializer (gfc_typespec *);
+gfc_expr *gfc_get_variable_expr (gfc_symtree *);
+gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
+
+gfc_array_spec *gfc_get_full_arrayspec_from_expr (gfc_expr *expr);
+
+bool gfc_traverse_expr (gfc_expr *, gfc_symbol *,
+			bool (*)(gfc_expr *, gfc_symbol *, int*),
+			int);
+void gfc_expr_set_symbols_referenced (gfc_expr *);
+gfc_try gfc_expr_check_typed (gfc_expr*, gfc_namespace*, bool);
+void gfc_expr_replace_symbols (gfc_expr *, gfc_symbol *);
+void gfc_expr_replace_comp (gfc_expr *, gfc_component *);
+
+bool gfc_is_proc_ptr_comp (gfc_expr *, gfc_component **);
+
+bool gfc_is_coindexed (gfc_expr *);
+int gfc_get_corank (gfc_expr *);
+bool gfc_has_ultimate_allocatable (gfc_expr *);
+bool gfc_has_ultimate_pointer (gfc_expr *);
+
+gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*,
+				    locus, unsigned, ...);
+gfc_try gfc_check_vardef_context (gfc_expr*, bool, const char*);
+
+
+/* st.c */
+extern gfc_code new_st;
+
+void gfc_clear_new_st (void);
+gfc_code *gfc_get_code (void);
+gfc_code *gfc_append_code (gfc_code *, gfc_code *);
+void gfc_free_statement (gfc_code *);
+void gfc_free_statements (gfc_code *);
+void gfc_free_association_list (gfc_association_list *);
+
+/* resolve.c */
+gfc_try gfc_resolve_expr (gfc_expr *);
+void gfc_resolve (gfc_namespace *);
+void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
+int gfc_impure_variable (gfc_symbol *);
+int gfc_pure (gfc_symbol *);
+int gfc_implicit_pure (gfc_symbol *);
+int gfc_elemental (gfc_symbol *);
+gfc_try gfc_resolve_iterator (gfc_iterator *, bool);
+gfc_try find_forall_index (gfc_expr *, gfc_symbol *, int);
+gfc_try gfc_resolve_index (gfc_expr *, int);
+gfc_try gfc_resolve_dim_arg (gfc_expr *);
+int gfc_is_formal_arg (void);
+void gfc_resolve_substring_charlen (gfc_expr *);
+match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *);
+gfc_expr *gfc_expr_to_initialize (gfc_expr *);
+bool gfc_type_is_extensible (gfc_symbol *sym);
+
+
+/* array.c */
+gfc_iterator *gfc_copy_iterator (gfc_iterator *);
+
+void gfc_free_array_spec (gfc_array_spec *);
+gfc_array_ref *gfc_copy_array_ref (gfc_array_ref *);
+
+gfc_try gfc_set_array_spec (gfc_symbol *, gfc_array_spec *, locus *);
+gfc_array_spec *gfc_copy_array_spec (gfc_array_spec *);
+gfc_try gfc_resolve_array_spec (gfc_array_spec *, int);
+
+int gfc_compare_array_spec (gfc_array_spec *, gfc_array_spec *);
+
+void gfc_simplify_iterator_var (gfc_expr *);
+gfc_try gfc_expand_constructor (gfc_expr *, bool);
+int gfc_constant_ac (gfc_expr *);
+int gfc_expanded_ac (gfc_expr *);
+gfc_try gfc_resolve_character_array_constructor (gfc_expr *);
+gfc_try gfc_resolve_array_constructor (gfc_expr *);
+gfc_try gfc_check_constructor_type (gfc_expr *);
+gfc_try gfc_check_iter_variable (gfc_expr *);
+gfc_try gfc_check_constructor (gfc_expr *, gfc_try (*)(gfc_expr *));
+gfc_try gfc_array_size (gfc_expr *, mpz_t *);
+gfc_try gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
+gfc_try gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
+gfc_array_ref *gfc_find_array_ref (gfc_expr *);
+tree gfc_conv_array_initializer (tree type, gfc_expr *);
+gfc_try spec_size (gfc_array_spec *, mpz_t *);
+gfc_try spec_dimen_size (gfc_array_spec *, int, mpz_t *);
+int gfc_is_compile_time_shape (gfc_array_spec *);
+
+gfc_try gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *, mpz_t *);
+
+
+/* interface.c -- FIXME: some of these should be in symbol.c */
+void gfc_free_interface (gfc_interface *);
+int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
+int gfc_compare_types (gfc_typespec *, gfc_typespec *);
+int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int,
+			    char *, int);
+void gfc_check_interfaces (gfc_namespace *);
+void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *);
+void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *);
+gfc_symbol *gfc_search_interface (gfc_interface *, int,
+				  gfc_actual_arglist **);
+gfc_try gfc_extend_expr (gfc_expr *, bool *);
+void gfc_free_formal_arglist (gfc_formal_arglist *);
+gfc_try gfc_extend_assign (gfc_code *, gfc_namespace *);
+gfc_try gfc_add_interface (gfc_symbol *);
+gfc_interface *gfc_current_interface_head (void);
+void gfc_set_current_interface_head (gfc_interface *);
+gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
+bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*);
+bool gfc_check_operator_interface (gfc_symbol*, gfc_intrinsic_op, locus);
+int gfc_has_vector_subscript (gfc_expr*);
+gfc_intrinsic_op gfc_equivalent_op (gfc_intrinsic_op);
+
+/* io.c */
+extern gfc_st_label format_asterisk;
+
+void gfc_free_open (gfc_open *);
+gfc_try gfc_resolve_open (gfc_open *);
+void gfc_free_close (gfc_close *);
+gfc_try gfc_resolve_close (gfc_close *);
+void gfc_free_filepos (gfc_filepos *);
+gfc_try gfc_resolve_filepos (gfc_filepos *);
+void gfc_free_inquire (gfc_inquire *);
+gfc_try gfc_resolve_inquire (gfc_inquire *);
+void gfc_free_dt (gfc_dt *);
+gfc_try gfc_resolve_dt (gfc_dt *, locus *);
+void gfc_free_wait (gfc_wait *);
+gfc_try gfc_resolve_wait (gfc_wait *);
+
+/* module.c */
+void gfc_module_init_2 (void);
+void gfc_module_done_2 (void);
+void gfc_dump_module (const char *, int);
+bool gfc_check_symbol_access (gfc_symbol *);
+void gfc_free_use_stmts (gfc_use_list *);
+
+/* primary.c */
+symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
+symbol_attribute gfc_expr_attr (gfc_expr *);
+match gfc_match_rvalue (gfc_expr **);
+match gfc_match_varspec (gfc_expr*, int, bool, bool);
+int gfc_check_digit (char, int);
+bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *);
+
+/* trans.c */
+void gfc_generate_code (gfc_namespace *);
+void gfc_generate_module_code (gfc_namespace *);
+
+/* bbt.c */
+typedef int (*compare_fn) (void *, void *);
+void gfc_insert_bbt (void *, void *, compare_fn);
+void gfc_delete_bbt (void *, void *, compare_fn);
+
+/* dump-parse-tree.c */
+void gfc_dump_parse_tree (gfc_namespace *, FILE *);
+
+/* parse.c */
+gfc_try gfc_parse_file (void);
+void gfc_global_used (gfc_gsymbol *, locus *);
+gfc_namespace* gfc_build_block_ns (gfc_namespace *);
+
+/* dependency.c */
+int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
+
+/* check.c */
+gfc_try gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*);
+
+/* class.c */
+void gfc_add_component_ref (gfc_expr *, const char *);
+#define gfc_add_data_component(e)     gfc_add_component_ref(e,"_data")
+#define gfc_add_vptr_component(e)     gfc_add_component_ref(e,"_vptr")
+#define gfc_add_hash_component(e)     gfc_add_component_ref(e,"_hash")
+#define gfc_add_size_component(e)     gfc_add_component_ref(e,"_size")
+#define gfc_add_def_init_component(e) gfc_add_component_ref(e,"_def_init")
+gfc_expr *gfc_class_null_initializer (gfc_typespec *);
+unsigned int gfc_hash_value (gfc_symbol *);
+gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
+				gfc_array_spec **, bool);
+gfc_symbol *gfc_find_derived_vtab (gfc_symbol *);
+gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*,
+				      const char*, bool, locus*);
+gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, gfc_try*,
+					 const char*, bool, locus*);
+gfc_typebound_proc* gfc_find_typebound_intrinsic_op (gfc_symbol*, gfc_try*,
+						     gfc_intrinsic_op, bool,
+						     locus*);
+gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*);
+
+#define CLASS_DATA(sym) sym->ts.u.derived->components
+
+/* frontend-passes.c */
+
+void gfc_run_passes (gfc_namespace *);
+
+typedef int (*walk_code_fn_t) (gfc_code **, int *, void *);
+typedef int (*walk_expr_fn_t) (gfc_expr **, int *, void *);
+
+int gfc_expr_walker (gfc_expr **, walk_expr_fn_t, void *);
+int gfc_code_walker (gfc_code **, walk_code_fn_t, walk_expr_fn_t, void *);
+
+#endif /* GCC_GFORTRAN_H  */
diff --git a/gcc/fortran/gfortran.info b/gcc/fortran/gfortran.info
new file mode 100644
index 000000000..e017b43a3
--- /dev/null
+++ b/gcc/fortran/gfortran.info
@@ -0,0 +1,17843 @@
+This is doc/gfortran.info, produced by makeinfo version 4.13 from
+/home/jakub/gcc-4.6.4/gcc-4.6.4/gcc/fortran/gfortran.texi.
+
+Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+
+   Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with the
+Invariant Sections being "Funding Free Software", the Front-Cover Texts
+being (a) (see below), and with the Back-Cover Texts being (b) (see
+below).  A copy of the license is included in the section entitled "GNU
+Free Documentation License".
+
+   (a) The FSF's Front-Cover Text is:
+
+   A GNU Manual
+
+   (b) The FSF's Back-Cover Text is:
+
+   You have freedom to copy and modify this GNU Manual, like GNU
+software.  Copies published by the Free Software Foundation raise
+funds for GNU development.
+
+INFO-DIR-SECTION Software development
+START-INFO-DIR-ENTRY
+* gfortran: (gfortran).                  The GNU Fortran Compiler.
+END-INFO-DIR-ENTRY
+   This file documents the use and the internals of the GNU Fortran
+compiler, (`gfortran').
+
+   Published by the Free Software Foundation 51 Franklin Street, Fifth
+Floor Boston, MA 02110-1301 USA
+
+   Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+
+   Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with the
+Invariant Sections being "Funding Free Software", the Front-Cover Texts
+being (a) (see below), and with the Back-Cover Texts being (b) (see
+below).  A copy of the license is included in the section entitled "GNU
+Free Documentation License".
+
+   (a) The FSF's Front-Cover Text is:
+
+   A GNU Manual
+
+   (b) The FSF's Back-Cover Text is:
+
+   You have freedom to copy and modify this GNU Manual, like GNU
+software.  Copies published by the Free Software Foundation raise
+funds for GNU development.
+
+
+File: gfortran.info,  Node: Top,  Next: Introduction,  Up: (dir)
+
+Introduction
+************
+
+This manual documents the use of `gfortran', the GNU Fortran compiler.
+You can find in this manual how to invoke `gfortran', as well as its
+features and incompatibilities.
+
+* Menu:
+
+* Introduction::
+
+Part I: Invoking GNU Fortran
+* Invoking GNU Fortran:: Command options supported by `gfortran'.
+* Runtime::              Influencing runtime behavior with environment variables.
+
+Part II: Language Reference
+* Fortran 2003 and 2008 status::  Fortran 2003 and 2008 features supported by GNU Fortran.
+* Compiler Characteristics::      User-visible implementation details.
+* Mixed-Language Programming::    Interoperability with C
+* Extensions::           Language extensions implemented by GNU Fortran.
+* Intrinsic Procedures:: Intrinsic procedures supported by GNU Fortran.
+* Intrinsic Modules::    Intrinsic modules supported by GNU Fortran.
+
+* Contributing::         How you can help.
+* Copying::              GNU General Public License says
+                         how you can copy and share GNU Fortran.
+* GNU Free Documentation License::
+                         How you can copy and share this manual.
+* Funding::              How to help assure continued work for free software.
+* Option Index::         Index of command line options
+* Keyword Index::        Index of concepts
+
+
+File: gfortran.info,  Node: Introduction,  Next: Invoking GNU Fortran,  Prev: Top,  Up: Top
+
+1 Introduction
+**************
+
+The GNU Fortran compiler front end was designed initially as a free
+replacement for, or alternative to, the unix `f95' command; `gfortran'
+is the command you'll use to invoke the compiler.
+
+* Menu:
+
+* About GNU Fortran::    What you should know about the GNU Fortran compiler.
+* GNU Fortran and GCC::  You can compile Fortran, C, or other programs.
+* Preprocessing and conditional compilation:: The Fortran preprocessor
+* GNU Fortran and G77::  Why we chose to start from scratch.
+* Project Status::       Status of GNU Fortran, roadmap, proposed extensions.
+* Standards::            Standards supported by GNU Fortran.
+
+
+File: gfortran.info,  Node: About GNU Fortran,  Next: GNU Fortran and GCC,  Up: Introduction
+
+1.1 About GNU Fortran
+=====================
+
+The GNU Fortran compiler supports the Fortran 77, 90 and 95 standards
+completely, parts of the Fortran 2003 and Fortran 2008 standards, and
+several vendor extensions.  The development goal is to provide the
+following features:
+
+   * Read a user's program, stored in a file and containing
+     instructions written in Fortran 77, Fortran 90, Fortran 95,
+     Fortran 2003 or Fortran 2008.  This file contains "source code".
+
+   * Translate the user's program into instructions a computer can
+     carry out more quickly than it takes to translate the instructions
+     in the first place.  The result after compilation of a program is
+     "machine code", code designed to be efficiently translated and
+     processed by a machine such as your computer.  Humans usually
+     aren't as good writing machine code as they are at writing Fortran
+     (or C++, Ada, or Java), because it is easy to make tiny mistakes
+     writing machine code.
+
+   * Provide the user with information about the reasons why the
+     compiler is unable to create a binary from the source code.
+     Usually this will be the case if the source code is flawed.  The
+     Fortran 90 standard requires that the compiler can point out
+     mistakes to the user.  An incorrect usage of the language causes
+     an "error message".
+
+     The compiler will also attempt to diagnose cases where the user's
+     program contains a correct usage of the language, but instructs
+     the computer to do something questionable.  This kind of
+     diagnostics message is called a "warning message".
+
+   * Provide optional information about the translation passes from the
+     source code to machine code.  This can help a user of the compiler
+     to find the cause of certain bugs which may not be obvious in the
+     source code, but may be more easily found at a lower level
+     compiler output.  It also helps developers to find bugs in the
+     compiler itself.
+
+   * Provide information in the generated machine code that can make it
+     easier to find bugs in the program (using a debugging tool, called
+     a "debugger", such as the GNU Debugger `gdb').
+
+   * Locate and gather machine code already generated to perform
+     actions requested by statements in the user's program.  This
+     machine code is organized into "modules" and is located and
+     "linked" to the user program.
+
+   The GNU Fortran compiler consists of several components:
+
+   * A version of the `gcc' command (which also might be installed as
+     the system's `cc' command) that also understands and accepts
+     Fortran source code.  The `gcc' command is the "driver" program for
+     all the languages in the GNU Compiler Collection (GCC); With `gcc',
+     you can compile the source code of any language for which a front
+     end is available in GCC.
+
+   * The `gfortran' command itself, which also might be installed as the
+     system's `f95' command.  `gfortran' is just another driver program,
+     but specifically for the Fortran compiler only.  The difference
+     with `gcc' is that `gfortran' will automatically link the correct
+     libraries to your program.
+
+   * A collection of run-time libraries.  These libraries contain the
+     machine code needed to support capabilities of the Fortran
+     language that are not directly provided by the machine code
+     generated by the `gfortran' compilation phase, such as intrinsic
+     functions and subroutines, and routines for interaction with files
+     and the operating system.
+
+   * The Fortran compiler itself, (`f951').  This is the GNU Fortran
+     parser and code generator, linked to and interfaced with the GCC
+     backend library.  `f951' "translates" the source code to assembler
+     code.  You would typically not use this program directly; instead,
+     the `gcc' or `gfortran' driver programs will call it for you.
+
+
+File: gfortran.info,  Node: GNU Fortran and GCC,  Next: Preprocessing and conditional compilation,  Prev: About GNU Fortran,  Up: Introduction
+
+1.2 GNU Fortran and GCC
+=======================
+
+GNU Fortran is a part of GCC, the "GNU Compiler Collection".  GCC
+consists of a collection of front ends for various languages, which
+translate the source code into a language-independent form called
+"GENERIC".  This is then processed by a common middle end which
+provides optimization, and then passed to one of a collection of back
+ends which generate code for different computer architectures and
+operating systems.
+
+   Functionally, this is implemented with a driver program (`gcc')
+which provides the command-line interface for the compiler.  It calls
+the relevant compiler front-end program (e.g., `f951' for Fortran) for
+each file in the source code, and then calls the assembler and linker
+as appropriate to produce the compiled output.  In a copy of GCC which
+has been compiled with Fortran language support enabled, `gcc' will
+recognize files with `.f', `.for', `.ftn', `.f90', `.f95', `.f03' and
+`.f08' extensions as Fortran source code, and compile it accordingly.
+A `gfortran' driver program is also provided, which is identical to
+`gcc' except that it automatically links the Fortran runtime libraries
+into the compiled program.
+
+   Source files with `.f', `.for', `.fpp', `.ftn', `.F', `.FOR',
+`.FPP', and `.FTN' extensions are treated as fixed form.  Source files
+with `.f90', `.f95', `.f03', `.f08', `.F90', `.F95', `.F03' and `.F08'
+extensions are treated as free form.  The capitalized versions of
+either form are run through preprocessing.  Source files with the lower
+case `.fpp' extension are also run through preprocessing.
+
+   This manual specifically documents the Fortran front end, which
+handles the programming language's syntax and semantics.  The aspects
+of GCC which relate to the optimization passes and the back-end code
+generation are documented in the GCC manual; see *note Introduction:
+(gcc)Top.  The two manuals together provide a complete reference for
+the GNU Fortran compiler.
+
+
+File: gfortran.info,  Node: Preprocessing and conditional compilation,  Next: GNU Fortran and G77,  Prev: GNU Fortran and GCC,  Up: Introduction
+
+1.3 Preprocessing and conditional compilation
+=============================================
+
+Many Fortran compilers including GNU Fortran allow passing the source
+code through a C preprocessor (CPP; sometimes also called the Fortran
+preprocessor, FPP) to allow for conditional compilation.  In the case
+of GNU Fortran, this is the GNU C Preprocessor in the traditional mode.
+On systems with case-preserving file names, the preprocessor is
+automatically invoked if the filename extension is `.F', `.FOR',
+`.FTN', `.fpp', `.FPP', `.F90', `.F95', `.F03' or `.F08'.  To manually
+invoke the preprocessor on any file, use `-cpp', to disable
+preprocessing on files where the preprocessor is run automatically, use
+`-nocpp'.
+
+   If a preprocessed file includes another file with the Fortran
+`INCLUDE' statement, the included file is not preprocessed.  To
+preprocess included files, use the equivalent preprocessor statement
+`#include'.
+
+   If GNU Fortran invokes the preprocessor, `__GFORTRAN__' is defined
+and `__GNUC__', `__GNUC_MINOR__' and `__GNUC_PATCHLEVEL__' can be used
+to determine the version of the compiler.  See *note Overview:
+(cpp)Top. for details.
+
+   While CPP is the de-facto standard for preprocessing Fortran code,
+Part 3 of the Fortran 95 standard (ISO/IEC 1539-3:1998) defines
+Conditional Compilation, which is not widely used and not directly
+supported by the GNU Fortran compiler.  You can use the program coco to
+preprocess such files (`http://www.daniellnagle.com/coco.html').
+
+
+File: gfortran.info,  Node: GNU Fortran and G77,  Next: Project Status,  Prev: Preprocessing and conditional compilation,  Up: Introduction
+
+1.4 GNU Fortran and G77
+=======================
+
+The GNU Fortran compiler is the successor to `g77', the Fortran 77
+front end included in GCC prior to version 4.  It is an entirely new
+program that has been designed to provide Fortran 95 support and
+extensibility for future Fortran language standards, as well as
+providing backwards compatibility for Fortran 77 and nearly all of the
+GNU language extensions supported by `g77'.
+
+
+File: gfortran.info,  Node: Project Status,  Next: Standards,  Prev: GNU Fortran and G77,  Up: Introduction
+
+1.5 Project Status
+==================
+
+     As soon as `gfortran' can parse all of the statements correctly,
+     it will be in the "larva" state.  When we generate code, the
+     "puppa" state.  When `gfortran' is done, we'll see if it will be a
+     beautiful butterfly, or just a big bug....
+
+     -Andy Vaught, April 2000
+
+   The start of the GNU Fortran 95 project was announced on the GCC
+homepage in March 18, 2000 (even though Andy had already been working
+on it for a while, of course).
+
+   The GNU Fortran compiler is able to compile nearly all
+standard-compliant Fortran 95, Fortran 90, and Fortran 77 programs,
+including a number of standard and non-standard extensions, and can be
+used on real-world programs.  In particular, the supported extensions
+include OpenMP, Cray-style pointers, and several Fortran 2003 and
+Fortran 2008 features, including TR 15581.  However, it is still under
+development and has a few remaining rough edges.
+
+   At present, the GNU Fortran compiler passes the NIST Fortran 77 Test
+Suite (http://www.fortran-2000.com/ArnaudRecipes/fcvs21_f95.html), and
+produces acceptable results on the LAPACK Test Suite
+(http://www.netlib.org/lapack/faq.html#1.21).  It also provides
+respectable performance on the Polyhedron Fortran compiler benchmarks
+(http://www.polyhedron.com/pb05.html) and the Livermore Fortran Kernels
+test
+(http://www.llnl.gov/asci_benchmarks/asci/limited/lfk/README.html).  It
+has been used to compile a number of large real-world programs,
+including the HIRLAM weather-forecasting code
+(http://mysite.verizon.net/serveall/moene.pdf) and the Tonto quantum
+chemistry package (http://www.theochem.uwa.edu.au/tonto/); see
+`http://gcc.gnu.org/wiki/GfortranApps' for an extended list.
+
+   Among other things, the GNU Fortran compiler is intended as a
+replacement for G77.  At this point, nearly all programs that could be
+compiled with G77 can be compiled with GNU Fortran, although there are
+a few minor known regressions.
+
+   The primary work remaining to be done on GNU Fortran falls into three
+categories: bug fixing (primarily regarding the treatment of invalid
+code and providing useful error messages), improving the compiler
+optimizations and the performance of compiled code, and extending the
+compiler to support future standards--in particular, Fortran 2003 and
+Fortran 2008.
+
+
+File: gfortran.info,  Node: Standards,  Prev: Project Status,  Up: Introduction
+
+1.6 Standards
+=============
+
+* Menu:
+
+* Varying Length Character Strings::
+
+   The GNU Fortran compiler implements ISO/IEC 1539:1997 (Fortran 95).
+As such, it can also compile essentially all standard-compliant Fortran
+90 and Fortran 77 programs.   It also supports the ISO/IEC TR-15581
+enhancements to allocatable arrays.
+
+   In the future, the GNU Fortran compiler will also support ISO/IEC
+1539-1:2004 (Fortran 2003), ISO/IEC 1539-1:2010 (Fortran 2008) and
+future Fortran standards.  Partial support of the Fortran 2003 and
+Fortran 2008 standard is already provided; the current status of the
+support is reported in the *note Fortran 2003 status:: and *note
+Fortran 2008 status:: sections of the documentation.
+
+   Additionally, the GNU Fortran compilers supports the OpenMP
+specification (version 3.0,
+`http://openmp.org/wp/openmp-specifications/').
+
+
+File: gfortran.info,  Node: Varying Length Character Strings,  Up: Standards
+
+1.6.1 Varying Length Character Strings
+--------------------------------------
+
+The Fortran 95 standard specifies in Part 2 (ISO/IEC 1539-2:2000)
+varying length character strings.  While GNU Fortran currently does not
+support such strings directly, there exist two Fortran implementations
+for them, which work with GNU Fortran.  They can be found at
+`http://www.fortran.com/iso_varying_string.f95' and at
+`ftp://ftp.nag.co.uk/sc22wg5/ISO_VARYING_STRING/'.
+
+
+File: gfortran.info,  Node: Invoking GNU Fortran,  Next: Runtime,  Prev: Introduction,  Up: Top
+
+2 GNU Fortran Command Options
+*****************************
+
+The `gfortran' command supports all the options supported by the `gcc'
+command.  Only options specific to GNU Fortran are documented here.
+
+   *Note GCC Command Options: (gcc)Invoking GCC, for information on the
+non-Fortran-specific aspects of the `gcc' command (and, therefore, the
+`gfortran' command).
+
+   All GCC and GNU Fortran options are accepted both by `gfortran' and
+by `gcc' (as well as any other drivers built at the same time, such as
+`g++'), since adding GNU Fortran to the GCC distribution enables
+acceptance of GNU Fortran options by all of the relevant drivers.
+
+   In some cases, options have positive and negative forms; the
+negative form of `-ffoo' would be `-fno-foo'.  This manual documents
+only one of these two forms, whichever one is not the default.
+
+* Menu:
+
+* Option Summary::      Brief list of all `gfortran' options,
+                        without explanations.
+* Fortran Dialect Options::  Controlling the variant of Fortran language
+                             compiled.
+* Preprocessing Options::  Enable and customize preprocessing.
+* Error and Warning Options::     How picky should the compiler be?
+* Debugging Options::   Symbol tables, measurements, and debugging dumps.
+* Directory Options::   Where to find module files
+* Link Options ::       Influencing the linking step
+* Runtime Options::     Influencing runtime behavior
+* Code Gen Options::    Specifying conventions for function calls, data layout
+                        and register usage.
+* Environment Variables:: Environment variables that affect `gfortran'.
+
+
+File: gfortran.info,  Node: Option Summary,  Next: Fortran Dialect Options,  Up: Invoking GNU Fortran
+
+2.1 Option summary
+==================
+
+Here is a summary of all the options specific to GNU Fortran, grouped
+by type.  Explanations are in the following sections.
+
+_Fortran Language Options_
+     *Note Options controlling Fortran dialect: Fortran Dialect Options.
+          -fall-intrinsics  -ffree-form  -fno-fixed-form
+          -fdollar-ok  -fimplicit-none  -fmax-identifier-length
+          -std=STD -fd-lines-as-code  -fd-lines-as-comments
+          -ffixed-line-length-N  -ffixed-line-length-none
+          -ffree-line-length-N  -ffree-line-length-none
+          -fdefault-double-8  -fdefault-integer-8  -fdefault-real-8
+          -fcray-pointer  -fopenmp  -fno-range-check -fbackslash -fmodule-private
+
+_Preprocessing Options_
+     *Note Enable and customize preprocessing: Preprocessing Options.
+          -cpp -dD -dI -dM -dN -dU -fworking-directory
+          -imultilib DIR -iprefix FILE -isysroot DIR
+          -iquote -isystem DIR -nocpp -nostdinc -undef
+          -AQUESTION=ANSWER -A-QUESTION[=ANSWER]
+          -C -CC -DMACRO[=DEFN] -UMACRO -H -P
+
+_Error and Warning Options_
+     *Note Options to request or suppress errors and warnings: Error
+     and Warning Options.
+          -fmax-errors=N
+          -fsyntax-only  -pedantic  -pedantic-errors
+          -Wall  -Waliasing  -Wampersand  -Warray-bounds -Wcharacter-truncation
+          -Wconversion -Wimplicit-interface  -Wimplicit-procedure  -Wline-truncation
+          -Wintrinsics-std  -Wsurprising  -Wno-tabs  -Wunderflow  -Wunused-parameter
+          -Wintrinsic-shadow  -Wno-align-commons
+
+_Debugging Options_
+     *Note Options for debugging your program or GNU Fortran: Debugging
+     Options.
+          -fdump-fortran-original  -fdump-fortran-optimized
+          -ffpe-trap=LIST  -fdump-core -fbacktrace -fdump-parse-tree
+
+_Directory Options_
+     *Note Options for directory search: Directory Options.
+          -IDIR  -JDIR -fintrinsic-modules-path DIR
+
+_Link Options_
+     *Note Options for influencing the linking step: Link Options.
+          -static-libgfortran
+
+_Runtime Options_
+     *Note Options for influencing runtime behavior: Runtime Options.
+          -fconvert=CONVERSION  -fno-range-check
+          -frecord-marker=LENGTH   -fmax-subrecord-length=LENGTH
+          -fsign-zero
+
+_Code Generation Options_
+     *Note Options for code generation conventions: Code Gen Options.
+          -fno-automatic  -ff2c  -fno-underscoring
+          -fno-whole-file -fsecond-underscore
+          -fbounds-check -fcheck-array-temporaries  -fmax-array-constructor =N
+          -fcheck=<ALL|ARRAY-TEMPS|BOUNDS|DO|MEM|POINTER|RECURSION>
+          -fcoarray=<NONE|SINGLE> -fmax-stack-var-size=N
+          -fpack-derived  -frepack-arrays  -fshort-enums  -fexternal-blas
+          -fblas-matmul-limit=N -frecursive -finit-local-zero
+          -finit-integer=N -finit-real=<ZERO|INF|-INF|NAN|SNAN>
+          -finit-logical=<TRUE|FALSE> -finit-character=N
+          -fno-align-commons -fno-protect-parens -frealloc-lhs
+
+
+* Menu:
+
+* Fortran Dialect Options::  Controlling the variant of Fortran language
+                             compiled.
+* Preprocessing Options::  Enable and customize preprocessing.
+* Error and Warning Options::     How picky should the compiler be?
+* Debugging Options::   Symbol tables, measurements, and debugging dumps.
+* Directory Options::   Where to find module files
+* Link Options ::       Influencing the linking step
+* Runtime Options::     Influencing runtime behavior
+* Code Gen Options::    Specifying conventions for function calls, data layout
+                        and register usage.
+
+
+File: gfortran.info,  Node: Fortran Dialect Options,  Next: Preprocessing Options,  Prev: Option Summary,  Up: Invoking GNU Fortran
+
+2.2 Options controlling Fortran dialect
+=======================================
+
+The following options control the details of the Fortran dialect
+accepted by the compiler:
+
+`-ffree-form'
+`-ffixed-form'
+     Specify the layout used by the source file.  The free form layout
+     was introduced in Fortran 90.  Fixed form was traditionally used in
+     older Fortran programs.  When neither option is specified, the
+     source form is determined by the file extension.
+
+`-fall-intrinsics'
+     This option causes all intrinsic procedures (including the
+     GNU-specific extensions) to be accepted.  This can be useful with
+     `-std=f95' to force standard-compliance but get access to the full
+     range of intrinsics available with `gfortran'.  As a consequence,
+     `-Wintrinsics-std' will be ignored and no user-defined procedure
+     with the same name as any intrinsic will be called except when it
+     is explicitly declared `EXTERNAL'.
+
+`-fd-lines-as-code'
+`-fd-lines-as-comments'
+     Enable special treatment for lines beginning with `d' or `D' in
+     fixed form sources.  If the `-fd-lines-as-code' option is given
+     they are treated as if the first column contained a blank.  If the
+     `-fd-lines-as-comments' option is given, they are treated as
+     comment lines.
+
+`-fdefault-double-8'
+     Set the `DOUBLE PRECISION' type to an 8 byte wide type.  If
+     `-fdefault-real-8' is given, `DOUBLE PRECISION' would instead be
+     promoted to 16 bytes if possible, and `-fdefault-double-8' can be
+     used to prevent this.  The kind of real constants like `1.d0' will
+     not be changed by `-fdefault-real-8' though, so also
+     `-fdefault-double-8' does not affect it.
+
+`-fdefault-integer-8'
+     Set the default integer and logical types to an 8 byte wide type.
+     Do nothing if this is already the default.  This option also
+     affects the kind of integer constants like `42'.
+
+`-fdefault-real-8'
+     Set the default real type to an 8 byte wide type.  Do nothing if
+     this is already the default.  This option also affects the kind of
+     non-double real constants like `1.0', and does promote the default
+     width of `DOUBLE PRECISION' to 16 bytes if possible, unless
+     `-fdefault-double-8' is given, too.
+
+`-fdollar-ok'
+     Allow `$' as a valid non-first character in a symbol name. Symbols
+     that start with `$' are rejected since it is unclear which rules to
+     apply to implicit typing as different vendors implement different
+     rules.  Using `$' in `IMPLICIT' statements is also rejected.
+
+`-fbackslash'
+     Change the interpretation of backslashes in string literals from a
+     single backslash character to "C-style" escape characters. The
+     following combinations are expanded `\a', `\b', `\f', `\n', `\r',
+     `\t', `\v', `\\', and `\0' to the ASCII characters alert,
+     backspace, form feed, newline, carriage return, horizontal tab,
+     vertical tab, backslash, and NUL, respectively.  Additionally,
+     `\x'NN, `\u'NNNN and `\U'NNNNNNNN (where each N is a hexadecimal
+     digit) are translated into the Unicode characters corresponding to
+     the specified code points. All other combinations of a character
+     preceded by \ are unexpanded.
+
+`-fmodule-private'
+     Set the default accessibility of module entities to `PRIVATE'.
+     Use-associated entities will not be accessible unless they are
+     explicitly declared as `PUBLIC'.
+
+`-ffixed-line-length-N'
+     Set column after which characters are ignored in typical fixed-form
+     lines in the source file, and through which spaces are assumed (as
+     if padded to that length) after the ends of short fixed-form lines.
+
+     Popular values for N include 72 (the standard and the default), 80
+     (card image), and 132 (corresponding to "extended-source" options
+     in some popular compilers).  N may also be `none', meaning that
+     the entire line is meaningful and that continued character
+     constants never have implicit spaces appended to them to fill out
+     the line.  `-ffixed-line-length-0' means the same thing as
+     `-ffixed-line-length-none'.
+
+`-ffree-line-length-N'
+     Set column after which characters are ignored in typical free-form
+     lines in the source file. The default value is 132.  N may be
+     `none', meaning that the entire line is meaningful.
+     `-ffree-line-length-0' means the same thing as
+     `-ffree-line-length-none'.
+
+`-fmax-identifier-length=N'
+     Specify the maximum allowed identifier length. Typical values are
+     31 (Fortran 95) and 63 (Fortran 2003 and Fortran 2008).
+
+`-fimplicit-none'
+     Specify that no implicit typing is allowed, unless overridden by
+     explicit `IMPLICIT' statements.  This is the equivalent of adding
+     `implicit none' to the start of every procedure.
+
+`-fcray-pointer'
+     Enable the Cray pointer extension, which provides C-like pointer
+     functionality.
+
+`-fopenmp'
+     Enable the OpenMP extensions.  This includes OpenMP `!$omp'
+     directives in free form and `c$omp', `*$omp' and `!$omp'
+     directives in fixed form, `!$' conditional compilation sentinels
+     in free form and `c$', `*$' and `!$' sentinels in fixed form, and
+     when linking arranges for the OpenMP runtime library to be linked
+     in.  The option `-fopenmp' implies `-frecursive'.
+
+`-fno-range-check'
+     Disable range checking on results of simplification of constant
+     expressions during compilation.  For example, GNU Fortran will give
+     an error at compile time when simplifying `a = 1. / 0'.  With this
+     option, no error will be given and `a' will be assigned the value
+     `+Infinity'.  If an expression evaluates to a value outside of the
+     relevant range of [`-HUGE()':`HUGE()'], then the expression will
+     be replaced by `-Inf' or `+Inf' as appropriate.  Similarly, `DATA
+     i/Z'FFFFFFFF'/' will result in an integer overflow on most
+     systems, but with `-fno-range-check' the value will "wrap around"
+     and `i' will be initialized to -1 instead.
+
+`-std=STD'
+     Specify the standard to which the program is expected to conform,
+     which may be one of `f95', `f2003', `f2008', `gnu', or `legacy'.
+     The default value for STD is `gnu', which specifies a superset of
+     the Fortran 95 standard that includes all of the extensions
+     supported by GNU Fortran, although warnings will be given for
+     obsolete extensions not recommended for use in new code.  The
+     `legacy' value is equivalent but without the warnings for obsolete
+     extensions, and may be useful for old non-standard programs.  The
+     `f95', `f2003' and `f2008' values specify strict conformance to
+     the Fortran 95, Fortran 2003 and Fortran 2008 standards,
+     respectively; errors are given for all extensions beyond the
+     relevant language standard, and warnings are given for the Fortran
+     77 features that are permitted but obsolescent in later standards.
+
+
+
+File: gfortran.info,  Node: Preprocessing Options,  Next: Error and Warning Options,  Prev: Fortran Dialect Options,  Up: Invoking GNU Fortran
+
+2.3 Enable and customize preprocessing
+======================================
+
+Preprocessor related options. See section *note Preprocessing and
+conditional compilation:: for more detailed information on
+preprocessing in `gfortran'.
+
+`-cpp'
+`-nocpp'
+     Enable preprocessing. The preprocessor is automatically invoked if
+     the file extension is `.fpp', `.FPP',  `.F', `.FOR', `.FTN',
+     `.F90', `.F95', `.F03' or `.F08'. Use this option to manually
+     enable preprocessing of any kind of Fortran file.
+
+     To disable preprocessing of files with any of the above listed
+     extensions, use the negative form: `-nocpp'.
+
+     The preprocessor is run in traditional mode. Any restrictions of
+     the file-format, especially the limits on line length, apply for
+     preprocessed output as well, so it might be advisable to use the
+     `-ffree-line-length-none' or `-ffixed-line-length-none' options.
+
+`-dM'
+     Instead of the normal output, generate a list of `'#define''
+     directives for all the macros defined during the execution of the
+     preprocessor, including predefined macros. This gives you a way of
+     finding out what is predefined in your version of the preprocessor.
+     Assuming you have no file `foo.f90', the command
+            touch foo.f90; gfortran -cpp -E -dM foo.f90
+     will show all the predefined macros.
+
+`-dD'
+     Like `-dM' except in two respects: it does not include the
+     predefined macros, and it outputs both the `#define' directives
+     and the result of preprocessing. Both kinds of output go to the
+     standard output file.
+
+`-dN'
+     Like `-dD', but emit only the macro names, not their expansions.
+
+`-dU'
+     Like `dD' except that only macros that are expanded, or whose
+     definedness is tested in preprocessor directives, are output; the
+     output is delayed until the use or test of the macro; and
+     `'#undef'' directives are also output for macros tested but
+     undefined at the time.
+
+`-dI'
+     Output `'#include'' directives in addition to the result of
+     preprocessing.
+
+`-fworking-directory'
+     Enable generation of linemarkers in the preprocessor output that
+     will let the compiler know the current working directory at the
+     time of preprocessing. When this option is enabled, the
+     preprocessor will emit, after the initial linemarker, a second
+     linemarker with the current working directory followed by two
+     slashes. GCC will use this directory, when it's present in the
+     preprocessed input, as the directory emitted as the current
+     working directory in some debugging information formats.  This
+     option is implicitly enabled if debugging information is enabled,
+     but this can be inhibited with the negated form
+     `-fno-working-directory'. If the `-P' flag is present in the
+     command line, this option has no effect, since no `#line'
+     directives are emitted whatsoever.
+
+`-idirafter DIR'
+     Search DIR for include files, but do it after all directories
+     specified with `-I' and the standard system directories have been
+     exhausted. DIR is treated as a system include directory.  If dir
+     begins with `=', then the `=' will be replaced by the sysroot
+     prefix; see `--sysroot' and `-isysroot'.
+
+`-imultilib DIR'
+     Use DIR as a subdirectory of the directory containing
+     target-specific C++ headers.
+
+`-iprefix PREFIX'
+     Specify PREFIX as the prefix for subsequent `-iwithprefix'
+     options. If the PREFIX represents a directory, you should include
+     the final `'/''.
+
+`-isysroot DIR'
+     This option is like the `--sysroot' option, but applies only to
+     header files. See the `--sysroot' option for more information.
+
+`-iquote DIR'
+     Search DIR only for header files requested with `#include "file"';
+     they are not searched for `#include <file>', before all directories
+     specified by `-I' and before the standard system directories. If
+     DIR begins with `=', then the `=' will be replaced by the sysroot
+     prefix; see `--sysroot' and `-isysroot'.
+
+`-isystem DIR'
+     Search DIR for header files, after all directories specified by
+     `-I' but before the standard system directories. Mark it as a
+     system directory, so that it gets the same special treatment as is
+     applied to the standard system directories. If DIR begins with
+     `=', then the `=' will be replaced by the sysroot prefix; see
+     `--sysroot' and `-isysroot'.
+
+`-nostdinc'
+     Do not search the standard system directories for header files.
+     Only the directories you have specified with `-I' options (and the
+     directory of the current file, if appropriate) are searched.
+
+`-undef'
+     Do not predefine any system-specific or GCC-specific macros.  The
+     standard predefined macros remain defined.
+
+`-APREDICATE=ANSWER'
+     Make an assertion with the predicate PREDICATE and answer ANSWER.
+     This form is preferred to the older form -A predicate(answer),
+     which is still supported, because it does not use shell special
+     characters.
+
+`-A-PREDICATE=ANSWER'
+     Cancel an assertion with the predicate PREDICATE and answer ANSWER.
+
+`-C'
+     Do not discard comments. All comments are passed through to the
+     output file, except for comments in processed directives, which
+     are deleted along with the directive.
+
+     You should be prepared for side effects when using `-C'; it causes
+     the preprocessor to treat comments as tokens in their own right.
+     For example, comments appearing at the start of what would be a
+     directive line have the effect of turning that line into an
+     ordinary source line, since the first token on the line is no
+     longer a `'#''.
+
+     Warning: this currently handles C-Style comments only. The
+     preprocessor does not yet recognize Fortran-style comments.
+
+`-CC'
+     Do not discard comments, including during macro expansion. This is
+     like `-C', except that comments contained within macros are also
+     passed through to the output file where the macro is expanded.
+
+     In addition to the side-effects of the `-C' option, the `-CC'
+     option causes all C++-style comments inside a macro to be
+     converted to C-style comments. This is to prevent later use of
+     that macro from inadvertently commenting out the remainder of the
+     source line. The `-CC' option is generally used to support lint
+     comments.
+
+     Warning: this currently handles C- and C++-Style comments only. The
+     preprocessor does not yet recognize Fortran-style comments.
+
+`-DNAME'
+     Predefine name as a macro, with definition `1'.
+
+`-DNAME=DEFINITION'
+     The contents of DEFINITION are tokenized and processed as if they
+     appeared during translation phase three in a `'#define'' directive.
+     In particular, the definition will be truncated by embedded newline
+     characters.
+
+     If you are invoking the preprocessor from a shell or shell-like
+     program you may need to use the shell's quoting syntax to protect
+     characters such as spaces that have a meaning in the shell syntax.
+
+     If you wish to define a function-like macro on the command line,
+     write its argument list with surrounding parentheses before the
+     equals sign (if any). Parentheses are meaningful to most shells,
+     so you will need to quote the option. With sh and csh,
+     `-D'name(args...)=definition'' works.
+
+     `-D' and `-U' options are processed in the order they are given on
+     the command line. All -imacros file and -include file options are
+     processed after all -D and -U options.
+
+`-H'
+     Print the name of each header file used, in addition to other
+     normal activities. Each name is indented to show how deep in the
+     `'#include'' stack it is.
+
+`-P'
+     Inhibit generation of linemarkers in the output from the
+     preprocessor.  This might be useful when running the preprocessor
+     on something that is not C code, and will be sent to a program
+     which might be confused by the linemarkers.
+
+`-UNAME'
+     Cancel any previous definition of NAME, either built in or provided
+     with a `-D' option.
+
+
+File: gfortran.info,  Node: Error and Warning Options,  Next: Debugging Options,  Prev: Preprocessing Options,  Up: Invoking GNU Fortran
+
+2.4 Options to request or suppress errors and warnings
+======================================================
+
+Errors are diagnostic messages that report that the GNU Fortran compiler
+cannot compile the relevant piece of source code.  The compiler will
+continue to process the program in an attempt to report further errors
+to aid in debugging, but will not produce any compiled output.
+
+   Warnings are diagnostic messages that report constructions which are
+not inherently erroneous but which are risky or suggest there is likely
+to be a bug in the program.  Unless `-Werror' is specified, they do not
+prevent compilation of the program.
+
+   You can request many specific warnings with options beginning `-W',
+for example `-Wimplicit' to request warnings on implicit declarations.
+Each of these specific warning options also has a negative form
+beginning `-Wno-' to turn off warnings; for example, `-Wno-implicit'.
+This manual lists only one of the two forms, whichever is not the
+default.
+
+   These options control the amount and kinds of errors and warnings
+produced by GNU Fortran:
+
+`-fmax-errors=N'
+     Limits the maximum number of error messages to N, at which point
+     GNU Fortran bails out rather than attempting to continue
+     processing the source code.  If N is 0, there is no limit on the
+     number of error messages produced.
+
+`-fsyntax-only'
+     Check the code for syntax errors, but don't actually compile it.
+     This will generate module files for each module present in the
+     code, but no other output file.
+
+`-pedantic'
+     Issue warnings for uses of extensions to Fortran 95.  `-pedantic'
+     also applies to C-language constructs where they occur in GNU
+     Fortran source files, such as use of `\e' in a character constant
+     within a directive like `#include'.
+
+     Valid Fortran 95 programs should compile properly with or without
+     this option.  However, without this option, certain GNU extensions
+     and traditional Fortran features are supported as well.  With this
+     option, many of them are rejected.
+
+     Some users try to use `-pedantic' to check programs for
+     conformance.  They soon find that it does not do quite what they
+     want--it finds some nonstandard practices, but not all.  However,
+     improvements to GNU Fortran in this area are welcome.
+
+     This should be used in conjunction with `-std=f95', `-std=f2003'
+     or `-std=f2008'.
+
+`-pedantic-errors'
+     Like `-pedantic', except that errors are produced rather than
+     warnings.
+
+`-Wall'
+     Enables commonly used warning options pertaining to usage that we
+     recommend avoiding and that we believe are easy to avoid.  This
+     currently includes `-Waliasing', `-Wampersand', `-Wconversion',
+     `-Wsurprising', `-Wintrinsics-std', `-Wno-tabs',
+     `-Wintrinsic-shadow', `-Wline-truncation', `-Wreal-q-constant' and
+     `-Wunused'.
+
+`-Waliasing'
+     Warn about possible aliasing of dummy arguments. Specifically, it
+     warns if the same actual argument is associated with a dummy
+     argument with `INTENT(IN)' and a dummy argument with `INTENT(OUT)'
+     in a call with an explicit interface.
+
+     The following example will trigger the warning.
+            interface
+              subroutine bar(a,b)
+                integer, intent(in) :: a
+                integer, intent(out) :: b
+              end subroutine
+            end interface
+            integer :: a
+
+            call bar(a,a)
+
+`-Wampersand'
+     Warn about missing ampersand in continued character constants. The
+     warning is given with `-Wampersand', `-pedantic', `-std=f95',
+     `-std=f2003' and `-std=f2008'. Note: With no ampersand given in a
+     continued character constant, GNU Fortran assumes continuation at
+     the first non-comment, non-whitespace character after the ampersand
+     that initiated the continuation.
+
+`-Warray-temporaries'
+     Warn about array temporaries generated by the compiler.  The
+     information generated by this warning is sometimes useful in
+     optimization, in order to avoid such temporaries.
+
+`-Wcharacter-truncation'
+     Warn when a character assignment will truncate the assigned string.
+
+`-Wline-truncation'
+     Warn when a source code line will be truncated.
+
+`-Wconversion'
+     Warn about implicit conversions that are likely to change the
+     value of the expression after conversion. Implied by `-Wall'.
+
+`-Wconversion-extra'
+     Warn about implicit conversions between different types and kinds.
+
+`-Wimplicit-interface'
+     Warn if a procedure is called without an explicit interface.  Note
+     this only checks that an explicit interface is present.  It does
+     not check that the declared interfaces are consistent across
+     program units.
+
+`-Wimplicit-procedure'
+     Warn if a procedure is called that has neither an explicit
+     interface nor has been declared as `EXTERNAL'.
+
+`-Wintrinsics-std'
+     Warn if `gfortran' finds a procedure named like an intrinsic not
+     available in the currently selected standard (with `-std') and
+     treats it as `EXTERNAL' procedure because of this.
+     `-fall-intrinsics' can be used to never trigger this behavior and
+     always link to the intrinsic regardless of the selected standard.
+
+`-Wreal-q-constant'
+     Produce a warning if a real-literal-constant contains a `q'
+     exponent-letter.
+
+`-Wsurprising'
+     Produce a warning when "suspicious" code constructs are
+     encountered.  While technically legal these usually indicate that
+     an error has been made.
+
+     This currently produces a warning under the following
+     circumstances:
+
+        * An INTEGER SELECT construct has a CASE that can never be
+          matched as its lower value is greater than its upper value.
+
+        * A LOGICAL SELECT construct has three CASE statements.
+
+        * A TRANSFER specifies a source that is shorter than the
+          destination.
+
+        * The type of a function result is declared more than once with
+          the same type.  If `-pedantic' or standard-conforming mode is
+          enabled, this is an error.
+
+        * A `CHARACTER' variable is declared with negative length.
+
+`-Wtabs'
+     By default, tabs are accepted as whitespace, but tabs are not
+     members of the Fortran Character Set.  For continuation lines, a
+     tab followed by a digit between 1 and 9 is supported.  `-Wno-tabs'
+     will cause a warning to be issued if a tab is encountered. Note,
+     `-Wno-tabs' is active for `-pedantic', `-std=f95', `-std=f2003',
+     `-std=f2008' and `-Wall'.
+
+`-Wunderflow'
+     Produce a warning when numerical constant expressions are
+     encountered, which yield an UNDERFLOW during compilation.
+
+`-Wintrinsic-shadow'
+     Warn if a user-defined procedure or module procedure has the same
+     name as an intrinsic; in this case, an explicit interface or
+     `EXTERNAL' or `INTRINSIC' declaration might be needed to get calls
+     later resolved to the desired intrinsic/procedure.
+
+`-Wunused-dummy-argument'
+     Warn about unused dummy arguments. This option is implied by
+     `-Wall'.
+
+`-Wunused-parameter'
+     Contrary to `gcc''s meaning of `-Wunused-parameter', `gfortran''s
+     implementation of this option does not warn about unused dummy
+     arguments (see `-Wunused-dummy-argument'), but about unused
+     `PARAMETER' values. `-Wunused-parameter' is not included in
+     `-Wall' but is implied by `-Wall -Wextra'.
+
+`-Walign-commons'
+     By default, `gfortran' warns about any occasion of variables being
+     padded for proper alignment inside a `COMMON' block. This warning
+     can be turned off via `-Wno-align-commons'. See also
+     `-falign-commons'.
+
+`-Werror'
+     Turns all warnings into errors.
+
+   *Note Options to Request or Suppress Errors and Warnings:
+(gcc)Warning Options, for information on more options offered by the
+GBE shared by `gfortran', `gcc' and other GNU compilers.
+
+   Some of these have no effect when compiling programs written in
+Fortran.
+
+
+File: gfortran.info,  Node: Debugging Options,  Next: Directory Options,  Prev: Error and Warning Options,  Up: Invoking GNU Fortran
+
+2.5 Options for debugging your program or GNU Fortran
+=====================================================
+
+GNU Fortran has various special options that are used for debugging
+either your program or the GNU Fortran compiler.
+
+`-fdump-fortran-original'
+     Output the internal parse tree after translating the source program
+     into internal representation.  Only really useful for debugging the
+     GNU Fortran compiler itself.
+
+`-fdump-optimized-tree'
+     Output the parse tree after front-end optimization.  Only really
+     useful for debugging the GNU Fortran compiler itself.
+
+     Output the internal parse tree after translating the source program
+     into internal representation.  Only really useful for debugging the
+     GNU Fortran compiler itself.  This option is deprecated; use
+     `-fdump-fortran-original' instead.
+
+`-ffpe-trap=LIST'
+     Specify a list of IEEE exceptions when a Floating Point Exception
+     (FPE) should be raised.  On most systems, this will result in a
+     SIGFPE signal being sent and the program being interrupted,
+     producing a core file useful for debugging.  LIST is a (possibly
+     empty) comma-separated list of the following IEEE exceptions:
+     `invalid' (invalid floating point operation, such as
+     `SQRT(-1.0)'), `zero' (division by zero), `overflow' (overflow in
+     a floating point operation), `underflow' (underflow in a floating
+     point operation), `precision' (loss of precision during operation)
+     and `denormal' (operation produced a denormal value).
+
+     Some of the routines in the Fortran runtime library, like
+     `CPU_TIME', are likely to trigger floating point exceptions when
+     `ffpe-trap=precision' is used. For this reason, the use of
+     `ffpe-trap=precision' is not recommended.
+
+`-fbacktrace'
+     Specify that, when a runtime error is encountered or a deadly
+     signal is emitted (segmentation fault, illegal instruction, bus
+     error or floating-point exception), the Fortran runtime library
+     should output a backtrace of the error.  This option only has
+     influence for compilation of the Fortran main program.
+
+`-fdump-core'
+     Request that a core-dump file is written to disk when a runtime
+     error is encountered on systems that support core dumps. This
+     option is only effective for the compilation of the Fortran main
+     program.
+
+   *Note Options for Debugging Your Program or GCC: (gcc)Debugging
+Options, for more information on debugging options.
+
+
+File: gfortran.info,  Node: Directory Options,  Next: Link Options,  Prev: Debugging Options,  Up: Invoking GNU Fortran
+
+2.6 Options for directory search
+================================
+
+These options affect how GNU Fortran searches for files specified by
+the `INCLUDE' directive and where it searches for previously compiled
+modules.
+
+   It also affects the search paths used by `cpp' when used to
+preprocess Fortran source.
+
+`-IDIR'
+     These affect interpretation of the `INCLUDE' directive (as well as
+     of the `#include' directive of the `cpp' preprocessor).
+
+     Also note that the general behavior of `-I' and `INCLUDE' is
+     pretty much the same as of `-I' with `#include' in the `cpp'
+     preprocessor, with regard to looking for `header.gcc' files and
+     other such things.
+
+     This path is also used to search for `.mod' files when previously
+     compiled modules are required by a `USE' statement.
+
+     *Note Options for Directory Search: (gcc)Directory Options, for
+     information on the `-I' option.
+
+`-JDIR'
+     This option specifies where to put `.mod' files for compiled
+     modules.  It is also added to the list of directories to searched
+     by an `USE' statement.
+
+     The default is the current directory.
+
+`-fintrinsic-modules-path DIR'
+     This option specifies the location of pre-compiled intrinsic
+     modules, if they are not in the default location expected by the
+     compiler.
+
+
+File: gfortran.info,  Node: Link Options,  Next: Runtime Options,  Prev: Directory Options,  Up: Invoking GNU Fortran
+
+2.7 Influencing the linking step
+================================
+
+These options come into play when the compiler links object files into
+an executable output file. They are meaningless if the compiler is not
+doing a link step.
+
+`-static-libgfortran'
+     On systems that provide `libgfortran' as a shared and a static
+     library, this option forces the use of the static version. If no
+     shared version of `libgfortran' was built when the compiler was
+     configured, this option has no effect.
+
+
+File: gfortran.info,  Node: Runtime Options,  Next: Code Gen Options,  Prev: Link Options,  Up: Invoking GNU Fortran
+
+2.8 Influencing runtime behavior
+================================
+
+These options affect the runtime behavior of programs compiled with GNU
+Fortran.
+
+`-fconvert=CONVERSION'
+     Specify the representation of data for unformatted files.  Valid
+     values for conversion are: `native', the default; `swap', swap
+     between big- and little-endian; `big-endian', use big-endian
+     representation for unformatted files; `little-endian', use
+     little-endian representation for unformatted files.
+
+     _This option has an effect only when used in the main program.
+     The `CONVERT' specifier and the GFORTRAN_CONVERT_UNIT environment
+     variable override the default specified by `-fconvert'._
+
+`-fno-range-check'
+     Disable range checking of input values during integer `READ'
+     operations.  For example, GNU Fortran will give an error if an
+     input value is outside of the relevant range of
+     [`-HUGE()':`HUGE()']. In other words, with `INTEGER (kind=4) :: i'
+     , attempting to read -2147483648 will give an error unless
+     `-fno-range-check' is given.
+
+`-frecord-marker=LENGTH'
+     Specify the length of record markers for unformatted files.  Valid
+     values for LENGTH are 4 and 8.  Default is 4.  _This is different
+     from previous versions of `gfortran'_, which specified a default
+     record marker length of 8 on most systems.  If you want to read or
+     write files compatible with earlier versions of `gfortran', use
+     `-frecord-marker=8'.
+
+`-fmax-subrecord-length=LENGTH'
+     Specify the maximum length for a subrecord.  The maximum permitted
+     value for length is 2147483639, which is also the default.  Only
+     really useful for use by the gfortran testsuite.
+
+`-fsign-zero'
+     When enabled, floating point numbers of value zero with the sign
+     bit set are written as negative number in formatted output and
+     treated as negative in the `SIGN' intrinsic.  `fno-sign-zero' does
+     not print the negative sign of zero values and regards zero as
+     positive number in the `SIGN' intrinsic for compatibility with F77.
+     Default behavior is to show the negative sign.
+
+
+File: gfortran.info,  Node: Code Gen Options,  Next: Environment Variables,  Prev: Runtime Options,  Up: Invoking GNU Fortran
+
+2.9 Options for code generation conventions
+===========================================
+
+These machine-independent options control the interface conventions
+used in code generation.
+
+   Most of them have both positive and negative forms; the negative form
+of `-ffoo' would be `-fno-foo'.  In the table below, only one of the
+forms is listed--the one which is not the default.  You can figure out
+the other form by either removing `no-' or adding it.
+
+`-fno-automatic'
+     Treat each program unit (except those marked as RECURSIVE) as if
+     the `SAVE' statement were specified for every local variable and
+     array referenced in it. Does not affect common blocks. (Some
+     Fortran compilers provide this option under the name `-static' or
+     `-save'.)  The default, which is `-fautomatic', uses the stack for
+     local variables smaller than the value given by
+     `-fmax-stack-var-size'.  Use the option `-frecursive' to use no
+     static memory.
+
+`-ff2c'
+     Generate code designed to be compatible with code generated by
+     `g77' and `f2c'.
+
+     The calling conventions used by `g77' (originally implemented in
+     `f2c') require functions that return type default `REAL' to
+     actually return the C type `double', and functions that return
+     type `COMPLEX' to return the values via an extra argument in the
+     calling sequence that points to where to store the return value.
+     Under the default GNU calling conventions, such functions simply
+     return their results as they would in GNU C--default `REAL'
+     functions return the C type `float', and `COMPLEX' functions
+     return the GNU C type `complex'.  Additionally, this option
+     implies the `-fsecond-underscore' option, unless
+     `-fno-second-underscore' is explicitly requested.
+
+     This does not affect the generation of code that interfaces with
+     the `libgfortran' library.
+
+     _Caution:_ It is not a good idea to mix Fortran code compiled with
+     `-ff2c' with code compiled with the default `-fno-f2c' calling
+     conventions as, calling `COMPLEX' or default `REAL' functions
+     between program parts which were compiled with different calling
+     conventions will break at execution time.
+
+     _Caution:_ This will break code which passes intrinsic functions
+     of type default `REAL' or `COMPLEX' as actual arguments, as the
+     library implementations use the `-fno-f2c' calling conventions.
+
+`-fno-underscoring'
+     Do not transform names of entities specified in the Fortran source
+     file by appending underscores to them.
+
+     With `-funderscoring' in effect, GNU Fortran appends one
+     underscore to external names with no underscores.  This is done to
+     ensure compatibility with code produced by many UNIX Fortran
+     compilers.
+
+     _Caution_: The default behavior of GNU Fortran is incompatible
+     with `f2c' and `g77', please use the `-ff2c' option if you want
+     object files compiled with GNU Fortran to be compatible with
+     object code created with these tools.
+
+     Use of `-fno-underscoring' is not recommended unless you are
+     experimenting with issues such as integration of GNU Fortran into
+     existing system environments (vis-a`-vis existing libraries, tools,
+     and so on).
+
+     For example, with `-funderscoring', and assuming other defaults
+     like `-fcase-lower' and that `j()' and `max_count()' are external
+     functions while `my_var' and `lvar' are local variables, a
+     statement like
+          I = J() + MAX_COUNT (MY_VAR, LVAR)
+     is implemented as something akin to:
+          i = j_() + max_count__(&my_var__, &lvar);
+
+     With `-fno-underscoring', the same statement is implemented as:
+
+          i = j() + max_count(&my_var, &lvar);
+
+     Use of `-fno-underscoring' allows direct specification of
+     user-defined names while debugging and when interfacing GNU Fortran
+     code with other languages.
+
+     Note that just because the names match does _not_ mean that the
+     interface implemented by GNU Fortran for an external name matches
+     the interface implemented by some other language for that same
+     name.  That is, getting code produced by GNU Fortran to link to
+     code produced by some other compiler using this or any other
+     method can be only a small part of the overall solution--getting
+     the code generated by both compilers to agree on issues other than
+     naming can require significant effort, and, unlike naming
+     disagreements, linkers normally cannot detect disagreements in
+     these other areas.
+
+     Also, note that with `-fno-underscoring', the lack of appended
+     underscores introduces the very real possibility that a
+     user-defined external name will conflict with a name in a system
+     library, which could make finding unresolved-reference bugs quite
+     difficult in some cases--they might occur at program run time, and
+     show up only as buggy behavior at run time.
+
+     In future versions of GNU Fortran we hope to improve naming and
+     linking issues so that debugging always involves using the names
+     as they appear in the source, even if the names as seen by the
+     linker are mangled to prevent accidental linking between
+     procedures with incompatible interfaces.
+
+`-fno-whole-file'
+     This flag causes the compiler to resolve and translate each
+     procedure in a file separately.
+
+     By default, the whole file is parsed and placed in a single
+     front-end tree.  During resolution, in addition to all the usual
+     checks and fixups, references to external procedures that are in
+     the same file effect resolution of that procedure, if not already
+     done, and a check of the interfaces.  The dependences are resolved
+     by changing the order in which the file is translated into the
+     backend tree.  Thus, a procedure that is referenced is translated
+     before the reference and the duplication of backend tree
+     declarations eliminated.
+
+     The `-fno-whole-file' option is deprecated and may lead to wrong
+     code.
+
+`-fsecond-underscore'
+     By default, GNU Fortran appends an underscore to external names.
+     If this option is used GNU Fortran appends two underscores to
+     names with underscores and one underscore to external names with
+     no underscores.  GNU Fortran also appends two underscores to
+     internal names with underscores to avoid naming collisions with
+     external names.
+
+     This option has no effect if `-fno-underscoring' is in effect.  It
+     is implied by the `-ff2c' option.
+
+     Otherwise, with this option, an external name such as `MAX_COUNT'
+     is implemented as a reference to the link-time external symbol
+     `max_count__', instead of `max_count_'.  This is required for
+     compatibility with `g77' and `f2c', and is implied by use of the
+     `-ff2c' option.
+
+`-fcoarray=<KEYWORD>'
+
+    `none'
+          Disable coarray support; using coarray declarations and
+          image-control statements will produce a compile-time error.
+          (Default)
+
+    `single'
+          Single-image mode, i.e. `num_images()' is always one.
+
+`-fcheck=<KEYWORD>'
+     Enable the generation of run-time checks; the argument shall be a
+     comma-delimited list of the following keywords.
+
+    `all'
+          Enable all run-time test of `-fcheck'.
+
+    `array-temps'
+          Warns at run time when for passing an actual argument a
+          temporary array had to be generated. The information
+          generated by this warning is sometimes useful in
+          optimization, in order to avoid such temporaries.
+
+          Note: The warning is only printed once per location.
+
+    `bounds'
+          Enable generation of run-time checks for array subscripts and
+          against the declared minimum and maximum values.  It also
+          checks array indices for assumed and deferred shape arrays
+          against the actual allocated bounds and ensures that all
+          string lengths are equal for character array constructors
+          without an explicit typespec.
+
+          Some checks require that `-fcheck=bounds' is set for the
+          compilation of the main program.
+
+          Note: In the future this may also include other forms of
+          checking, e.g., checking substring references.
+
+    `do'
+          Enable generation of run-time checks for invalid modification
+          of loop iteration variables.
+
+    `mem'
+          Enable generation of run-time checks for memory allocation.
+          Note: This option does not affect explicit allocations using
+          the `ALLOCATE' statement, which will be always checked.
+
+    `pointer'
+          Enable generation of run-time checks for pointers and
+          allocatables.
+
+    `recursion'
+          Enable generation of run-time checks for recursively called
+          subroutines and functions which are not marked as recursive.
+          See also `-frecursive'.  Note: This check does not work for
+          OpenMP programs and is disabled if used together with
+          `-frecursive' and `-fopenmp'.
+
+`-fbounds-check'
+     Deprecated alias for `-fcheck=bounds'.
+
+`-fcheck-array-temporaries'
+     Deprecated alias for `-fcheck=array-temps'.
+
+`-fmax-array-constructor=N'
+     This option can be used to increase the upper limit permitted in
+     array constructors.  The code below requires this option to expand
+     the array at compile time.
+
+          program test
+          implicit none
+          integer j
+          integer, parameter :: n = 100000
+          integer, parameter :: i(n) = (/ (2*j, j = 1, n) /)
+          print '(10(I0,1X))', i
+          end program test
+
+     _Caution:  This option can lead to long compile times and
+     excessively large object files._
+
+     The default value for N is 65535.
+
+`-fmax-stack-var-size=N'
+     This option specifies the size in bytes of the largest array that
+     will be put on the stack; if the size is exceeded static memory is
+     used (except in procedures marked as RECURSIVE). Use the option
+     `-frecursive' to allow for recursive procedures which do not have
+     a RECURSIVE attribute or for parallel programs. Use
+     `-fno-automatic' to never use the stack.
+
+     This option currently only affects local arrays declared with
+     constant bounds, and may not apply to all character variables.
+     Future versions of GNU Fortran may improve this behavior.
+
+     The default value for N is 32768.
+
+`-fpack-derived'
+     This option tells GNU Fortran to pack derived type members as
+     closely as possible.  Code compiled with this option is likely to
+     be incompatible with code compiled without this option, and may
+     execute slower.
+
+`-frepack-arrays'
+     In some circumstances GNU Fortran may pass assumed shape array
+     sections via a descriptor describing a noncontiguous area of
+     memory.  This option adds code to the function prologue to repack
+     the data into a contiguous block at runtime.
+
+     This should result in faster accesses to the array.  However it
+     can introduce significant overhead to the function call,
+     especially  when the passed data is noncontiguous.
+
+`-fshort-enums'
+     This option is provided for interoperability with C code that was
+     compiled with the `-fshort-enums' option.  It will make GNU
+     Fortran choose the smallest `INTEGER' kind a given enumerator set
+     will fit in, and give all its enumerators this kind.
+
+`-fexternal-blas'
+     This option will make `gfortran' generate calls to BLAS functions
+     for some matrix operations like `MATMUL', instead of using our own
+     algorithms, if the size of the matrices involved is larger than a
+     given limit (see `-fblas-matmul-limit').  This may be profitable
+     if an optimized vendor BLAS library is available.  The BLAS
+     library will have to be specified at link time.
+
+`-fblas-matmul-limit=N'
+     Only significant when `-fexternal-blas' is in effect.  Matrix
+     multiplication of matrices with size larger than (or equal to) N
+     will be performed by calls to BLAS functions, while others will be
+     handled by `gfortran' internal algorithms. If the matrices
+     involved are not square, the size comparison is performed using the
+     geometric mean of the dimensions of the argument and result
+     matrices.
+
+     The default value for N is 30.
+
+`-frecursive'
+     Allow indirect recursion by forcing all local arrays to be
+     allocated on the stack. This flag cannot be used together with
+     `-fmax-stack-var-size=' or `-fno-automatic'.
+
+`-finit-local-zero'
+`-finit-integer=N'
+`-finit-real=<ZERO|INF|-INF|NAN|SNAN>'
+`-finit-logical=<TRUE|FALSE>'
+`-finit-character=N'
+     The `-finit-local-zero' option instructs the compiler to
+     initialize local `INTEGER', `REAL', and `COMPLEX' variables to
+     zero, `LOGICAL' variables to false, and `CHARACTER' variables to a
+     string of null bytes.  Finer-grained initialization options are
+     provided by the `-finit-integer=N',
+     `-finit-real=<ZERO|INF|-INF|NAN|SNAN>' (which also initializes the
+     real and imaginary parts of local `COMPLEX' variables),
+     `-finit-logical=<TRUE|FALSE>', and `-finit-character=N' (where N
+     is an ASCII character value) options.  These options do not
+     initialize
+        * allocatable arrays
+
+        * components of derived type variables
+
+        * variables that appear in an `EQUIVALENCE' statement.
+     (These limitations may be removed in future releases).
+
+     Note that the `-finit-real=nan' option initializes `REAL' and
+     `COMPLEX' variables with a quiet NaN. For a signalling NaN use
+     `-finit-real=snan'; note, however, that compile-time optimizations
+     may convert them into quiet NaN and that trapping needs to be
+     enabled (e.g. via `-ffpe-trap').
+
+`-falign-commons'
+     By default, `gfortran' enforces proper alignment of all variables
+     in a `COMMON' block by padding them as needed. On certain
+     platforms this is mandatory, on others it increases performance.
+     If a `COMMON' block is not declared with consistent data types
+     everywhere, this padding can cause trouble, and
+     `-fno-align-commons' can be used to disable automatic alignment.
+     The same form of this option should be used for all files that
+     share a `COMMON' block.  To avoid potential alignment issues in
+     `COMMON' blocks, it is recommended to order objects from largest
+     to smallest.
+
+`-fno-protect-parens'
+     By default the parentheses in expression are honored for all
+     optimization levels such that the compiler does not do any
+     re-association. Using `-fno-protect-parens' allows the compiler to
+     reorder `REAL' and `COMPLEX' expressions to produce faster code.
+     Note that for the re-association optimization `-fno-signed-zeros'
+     and `-fno-trapping-math' need to be in effect.
+
+`-frealloc-lhs'
+     An allocatable left-hand side of an intrinsic assignment is
+     automatically (re)allocated if it is either unallocated or has a
+     different shape. The option is enabled by default except when
+     `-std=f95' is given.
+
+   *Note Options for Code Generation Conventions: (gcc)Code Gen
+Options, for information on more options offered by the GBE shared by
+`gfortran', `gcc', and other GNU compilers.
+
+
+File: gfortran.info,  Node: Environment Variables,  Prev: Code Gen Options,  Up: Invoking GNU Fortran
+
+2.10 Environment variables affecting `gfortran'
+===============================================
+
+The `gfortran' compiler currently does not make use of any environment
+variables to control its operation above and beyond those that affect
+the operation of `gcc'.
+
+   *Note Environment Variables Affecting GCC: (gcc)Environment
+Variables, for information on environment variables.
+
+   *Note Runtime::, for environment variables that affect the run-time
+behavior of programs compiled with GNU Fortran.
+
+
+File: gfortran.info,  Node: Runtime,  Next: Fortran 2003 and 2008 status,  Prev: Invoking GNU Fortran,  Up: Top
+
+3 Runtime:  Influencing runtime behavior with environment variables
+*******************************************************************
+
+The behavior of the `gfortran' can be influenced by environment
+variables.
+
+   Malformed environment variables are silently ignored.
+
+* Menu:
+
+* GFORTRAN_STDIN_UNIT:: Unit number for standard input
+* GFORTRAN_STDOUT_UNIT:: Unit number for standard output
+* GFORTRAN_STDERR_UNIT:: Unit number for standard error
+* GFORTRAN_USE_STDERR:: Send library output to standard error
+* GFORTRAN_TMPDIR:: Directory for scratch files
+* GFORTRAN_UNBUFFERED_ALL:: Don't buffer I/O for all units.
+* GFORTRAN_UNBUFFERED_PRECONNECTED:: Don't buffer I/O for preconnected units.
+* GFORTRAN_SHOW_LOCUS::  Show location for runtime errors
+* GFORTRAN_OPTIONAL_PLUS:: Print leading + where permitted
+* GFORTRAN_DEFAULT_RECL:: Default record length for new files
+* GFORTRAN_LIST_SEPARATOR::  Separator for list output
+* GFORTRAN_CONVERT_UNIT::  Set endianness for unformatted I/O
+* GFORTRAN_ERROR_DUMPCORE:: Dump core on run-time errors
+* GFORTRAN_ERROR_BACKTRACE:: Show backtrace on run-time errors
+
+
+File: gfortran.info,  Node: GFORTRAN_STDIN_UNIT,  Next: GFORTRAN_STDOUT_UNIT,  Up: Runtime
+
+3.1 `GFORTRAN_STDIN_UNIT'--Unit number for standard input
+=========================================================
+
+This environment variable can be used to select the unit number
+preconnected to standard input.  This must be a positive integer.  The
+default value is 5.
+
+
+File: gfortran.info,  Node: GFORTRAN_STDOUT_UNIT,  Next: GFORTRAN_STDERR_UNIT,  Prev: GFORTRAN_STDIN_UNIT,  Up: Runtime
+
+3.2 `GFORTRAN_STDOUT_UNIT'--Unit number for standard output
+===========================================================
+
+This environment variable can be used to select the unit number
+preconnected to standard output.  This must be a positive integer.  The
+default value is 6.
+
+
+File: gfortran.info,  Node: GFORTRAN_STDERR_UNIT,  Next: GFORTRAN_USE_STDERR,  Prev: GFORTRAN_STDOUT_UNIT,  Up: Runtime
+
+3.3 `GFORTRAN_STDERR_UNIT'--Unit number for standard error
+==========================================================
+
+This environment variable can be used to select the unit number
+preconnected to standard error.  This must be a positive integer.  The
+default value is 0.
+
+
+File: gfortran.info,  Node: GFORTRAN_USE_STDERR,  Next: GFORTRAN_TMPDIR,  Prev: GFORTRAN_STDERR_UNIT,  Up: Runtime
+
+3.4 `GFORTRAN_USE_STDERR'--Send library output to standard error
+================================================================
+
+This environment variable controls where library output is sent.  If
+the first letter is `y', `Y' or `1', standard error is used.  If the
+first letter is `n', `N' or `0', standard output is used.
+
+
+File: gfortran.info,  Node: GFORTRAN_TMPDIR,  Next: GFORTRAN_UNBUFFERED_ALL,  Prev: GFORTRAN_USE_STDERR,  Up: Runtime
+
+3.5 `GFORTRAN_TMPDIR'--Directory for scratch files
+==================================================
+
+This environment variable controls where scratch files are created.  If
+this environment variable is missing, GNU Fortran searches for the
+environment variable `TMP', then `TEMP'.  If these are missing, the
+default is `/tmp'.
+
+
+File: gfortran.info,  Node: GFORTRAN_UNBUFFERED_ALL,  Next: GFORTRAN_UNBUFFERED_PRECONNECTED,  Prev: GFORTRAN_TMPDIR,  Up: Runtime
+
+3.6 `GFORTRAN_UNBUFFERED_ALL'--Don't buffer I/O on all units
+============================================================
+
+This environment variable controls whether all I/O is unbuffered.  If
+the first letter is `y', `Y' or `1', all I/O is unbuffered.  This will
+slow down small sequential reads and writes.  If the first letter is
+`n', `N' or `0', I/O is buffered.  This is the default.
+
+
+File: gfortran.info,  Node: GFORTRAN_UNBUFFERED_PRECONNECTED,  Next: GFORTRAN_SHOW_LOCUS,  Prev: GFORTRAN_UNBUFFERED_ALL,  Up: Runtime
+
+3.7 `GFORTRAN_UNBUFFERED_PRECONNECTED'--Don't buffer I/O on preconnected units
+==============================================================================
+
+The environment variable named `GFORTRAN_UNBUFFERED_PRECONNECTED'
+controls whether I/O on a preconnected unit (i.e. STDOUT or STDERR) is
+unbuffered.  If the first letter is `y', `Y' or `1', I/O is unbuffered.
+This will slow down small sequential reads and writes.  If the first
+letter is `n', `N' or `0', I/O is buffered.  This is the default.
+
+
+File: gfortran.info,  Node: GFORTRAN_SHOW_LOCUS,  Next: GFORTRAN_OPTIONAL_PLUS,  Prev: GFORTRAN_UNBUFFERED_PRECONNECTED,  Up: Runtime
+
+3.8 `GFORTRAN_SHOW_LOCUS'--Show location for runtime errors
+===========================================================
+
+If the first letter is `y', `Y' or `1', filename and line numbers for
+runtime errors are printed.  If the first letter is `n', `N' or `0',
+don't print filename and line numbers for runtime errors.  The default
+is to print the location.
+
+
+File: gfortran.info,  Node: GFORTRAN_OPTIONAL_PLUS,  Next: GFORTRAN_DEFAULT_RECL,  Prev: GFORTRAN_SHOW_LOCUS,  Up: Runtime
+
+3.9 `GFORTRAN_OPTIONAL_PLUS'--Print leading + where permitted
+=============================================================
+
+If the first letter is `y', `Y' or `1', a plus sign is printed where
+permitted by the Fortran standard.  If the first letter is `n', `N' or
+`0', a plus sign is not printed in most cases.  Default is not to print
+plus signs.
+
+
+File: gfortran.info,  Node: GFORTRAN_DEFAULT_RECL,  Next: GFORTRAN_LIST_SEPARATOR,  Prev: GFORTRAN_OPTIONAL_PLUS,  Up: Runtime
+
+3.10 `GFORTRAN_DEFAULT_RECL'--Default record length for new files
+=================================================================
+
+This environment variable specifies the default record length, in
+bytes, for files which are opened without a `RECL' tag in the `OPEN'
+statement.  This must be a positive integer.  The default value is
+1073741824 bytes (1 GB).
+
+
+File: gfortran.info,  Node: GFORTRAN_LIST_SEPARATOR,  Next: GFORTRAN_CONVERT_UNIT,  Prev: GFORTRAN_DEFAULT_RECL,  Up: Runtime
+
+3.11 `GFORTRAN_LIST_SEPARATOR'--Separator for list output
+=========================================================
+
+This environment variable specifies the separator when writing
+list-directed output.  It may contain any number of spaces and at most
+one comma.  If you specify this on the command line, be sure to quote
+spaces, as in
+     $ GFORTRAN_LIST_SEPARATOR='  ,  ' ./a.out
+   when `a.out' is the compiled Fortran program that you want to run.
+Default is a single space.
+
+
+File: gfortran.info,  Node: GFORTRAN_CONVERT_UNIT,  Next: GFORTRAN_ERROR_DUMPCORE,  Prev: GFORTRAN_LIST_SEPARATOR,  Up: Runtime
+
+3.12 `GFORTRAN_CONVERT_UNIT'--Set endianness for unformatted I/O
+================================================================
+
+By setting the `GFORTRAN_CONVERT_UNIT' variable, it is possible to
+change the representation of data for unformatted files.  The syntax
+for the `GFORTRAN_CONVERT_UNIT' variable is:
+     GFORTRAN_CONVERT_UNIT: mode | mode ';' exception | exception ;
+     mode: 'native' | 'swap' | 'big_endian' | 'little_endian' ;
+     exception: mode ':' unit_list | unit_list ;
+     unit_list: unit_spec | unit_list unit_spec ;
+     unit_spec: INTEGER | INTEGER '-' INTEGER ;
+   The variable consists of an optional default mode, followed by a
+list of optional exceptions, which are separated by semicolons from the
+preceding default and each other.  Each exception consists of a format
+and a comma-separated list of units.  Valid values for the modes are
+the same as for the `CONVERT' specifier:
+
+     `NATIVE' Use the native format.  This is the default.
+
+     `SWAP' Swap between little- and big-endian.
+
+     `LITTLE_ENDIAN' Use the little-endian format for unformatted files.
+
+     `BIG_ENDIAN' Use the big-endian format for unformatted files.
+   A missing mode for an exception is taken to mean `BIG_ENDIAN'.
+Examples of values for `GFORTRAN_CONVERT_UNIT' are:
+     `'big_endian''  Do all unformatted I/O in big_endian mode.
+
+     `'little_endian;native:10-20,25''  Do all unformatted I/O in
+     little_endian mode, except for units 10 to 20 and 25, which are in
+     native format.
+
+     `'10-20''  Units 10 to 20 are big-endian, the rest is native.
+
+   Setting the environment variables should be done on the command line
+or via the `export' command for `sh'-compatible shells and via `setenv'
+for `csh'-compatible shells.
+
+   Example for `sh':
+     $ gfortran foo.f90
+     $ GFORTRAN_CONVERT_UNIT='big_endian;native:10-20' ./a.out
+
+   Example code for `csh':
+     % gfortran foo.f90
+     % setenv GFORTRAN_CONVERT_UNIT 'big_endian;native:10-20'
+     % ./a.out
+
+   Using anything but the native representation for unformatted data
+carries a significant speed overhead.  If speed in this area matters to
+you, it is best if you use this only for data that needs to be portable.
+
+   *Note CONVERT specifier::, for an alternative way to specify the
+data representation for unformatted files.  *Note Runtime Options::, for
+setting a default data representation for the whole program.  The
+`CONVERT' specifier overrides the `-fconvert' compile options.
+
+   _Note that the values specified via the GFORTRAN_CONVERT_UNIT
+environment variable will override the CONVERT specifier in the open
+statement_.  This is to give control over data formats to users who do
+not have the source code of their program available.
+
+
+File: gfortran.info,  Node: GFORTRAN_ERROR_DUMPCORE,  Next: GFORTRAN_ERROR_BACKTRACE,  Prev: GFORTRAN_CONVERT_UNIT,  Up: Runtime
+
+3.13 `GFORTRAN_ERROR_DUMPCORE'--Dump core on run-time errors
+============================================================
+
+If the `GFORTRAN_ERROR_DUMPCORE' variable is set to `y', `Y' or `1'
+(only the first letter is relevant) then library run-time errors cause
+core dumps.  To disable the core dumps, set the variable to `n', `N',
+`0'.  Default is not to core dump unless the `-fdump-core' compile
+option was used.
+
+
+File: gfortran.info,  Node: GFORTRAN_ERROR_BACKTRACE,  Prev: GFORTRAN_ERROR_DUMPCORE,  Up: Runtime
+
+3.14 `GFORTRAN_ERROR_BACKTRACE'--Show backtrace on run-time errors
+==================================================================
+
+If the `GFORTRAN_ERROR_BACKTRACE' variable is set to `y', `Y' or `1'
+(only the first letter is relevant) then a backtrace is printed when a
+run-time error occurs.  To disable the backtracing, set the variable to
+`n', `N', `0'.  Default is not to print a backtrace unless the
+`-fbacktrace' compile option was used.
+
+
+File: gfortran.info,  Node: Fortran 2003 and 2008 status,  Next: Compiler Characteristics,  Prev: Runtime,  Up: Top
+
+4 Fortran 2003 and 2008 Status
+******************************
+
+* Menu:
+
+* Fortran 2003 status::
+* Fortran 2008 status::
+
+
+File: gfortran.info,  Node: Fortran 2003 status,  Next: Fortran 2008 status,  Up: Fortran 2003 and 2008 status
+
+4.1 Fortran 2003 status
+=======================
+
+GNU Fortran supports several Fortran 2003 features; an incomplete list
+can be found below.  See also the wiki page
+(http://gcc.gnu.org/wiki/Fortran2003) about Fortran 2003.
+
+   * Procedure pointers including procedure-pointer components with
+     `PASS' attribute.
+
+   * Procedures which are bound to a derived type (type-bound
+     procedures) including `PASS', `PROCEDURE' and `GENERIC', and
+     operators bound to a type.
+
+   * Abstract interfaces and and type extension with the possibility to
+     override type-bound procedures or to have deferred binding.
+
+   * Polymorphic entities ("`CLASS'") for derived types - including
+     `SAME_TYPE_AS', `EXTENDS_TYPE_OF' and `SELECT TYPE'.  Note that
+     the support for array-valued polymorphic entities is incomplete
+     and unlimited polymophism is currently not supported.
+
+   * The `ASSOCIATE' construct.
+
+   * Interoperability with C including enumerations,
+
+   * In structure constructors the components with default values may be
+     omitted.
+
+   * Extensions to the `ALLOCATE' statement, allowing for a
+     type-specification with type parameter and for allocation and
+     initialization from a `SOURCE=' expression; `ALLOCATE' and
+     `DEALLOCATE' optionally return an error message string via
+     `ERRMSG='.
+
+   * Reallocation on assignment: If an intrinsic assignment is used, an
+     allocatable variable on the left-hand side is automatically
+     allocated (if unallocated) or reallocated (if the shape is
+     different). Currently, scalar deferred character length left-hand
+     sides are correctly handled but arrays are not yet fully
+     implemented.
+
+   * Transferring of allocations via `MOVE_ALLOC'.
+
+   * The `PRIVATE' and `PUBLIC' attributes may be given individually to
+     derived-type components.
+
+   * In pointer assignments, the lower bound may be specified and the
+     remapping of elements is supported.
+
+   * For pointers an `INTENT' may be specified which affect the
+     association status not the value of the pointer target.
+
+   * Intrinsics `command_argument_count', `get_command',
+     `get_command_argument', and `get_environment_variable'.
+
+   * Support for unicode characters (ISO 10646) and UTF-8, including
+     the `SELECTED_CHAR_KIND' and `NEW_LINE' intrinsic functions.
+
+   * Support for binary, octal and hexadecimal (BOZ) constants in the
+     intrinsic functions `INT', `REAL', `CMPLX' and `DBLE'.
+
+   * Support for namelist variables with allocatable and pointer
+     attribute and nonconstant length type parameter.
+
+   * Array constructors using square brackets.  That is, `[...]' rather
+     than `(/.../)'.  Type-specification for array constructors like
+     `(/ some-type :: ... /)'.
+
+   * Extensions to the specification and initialization expressions,
+     including the support for intrinsics with real and complex
+     arguments.
+
+   * Support for the asynchronous input/output syntax; however, the
+     data transfer is currently always synchronously performed.
+
+   * `FLUSH' statement.
+
+   * `IOMSG=' specifier for I/O statements.
+
+   * Support for the declaration of enumeration constants via the
+     `ENUM' and `ENUMERATOR' statements.  Interoperability with `gcc'
+     is guaranteed also for the case where the `-fshort-enums' command
+     line option is given.
+
+   * TR 15581:
+        * `ALLOCATABLE' dummy arguments.
+
+        * `ALLOCATABLE' function results
+
+        * `ALLOCATABLE' components of derived types
+
+   * The `OPEN' statement supports the `ACCESS='STREAM'' specifier,
+     allowing I/O without any record structure.
+
+   * Namelist input/output for internal files.
+
+   * Further I/O extensions: Rounding during formatted output, using of
+     a decimal comma instead of a decimal point, setting whether a plus
+     sign should appear for positive numbers.
+
+   * The `PROTECTED' statement and attribute.
+
+   * The `VALUE' statement and attribute.
+
+   * The `VOLATILE' statement and attribute.
+
+   * The `IMPORT' statement, allowing to import host-associated derived
+     types.
+
+   * The intrinsic modules `ISO_FORTRAN_ENVIRONMENT' is supported,
+     which contains parameters of the I/O units, storage sizes.
+     Additionally, procedures for C interoperability are available in
+     the `ISO_C_BINDING' module.
+
+   * `USE' statement with `INTRINSIC' and `NON_INTRINSIC' attribute;
+     supported intrinsic modules: `ISO_FORTRAN_ENV', `ISO_C_BINDING',
+     `OMP_LIB' and `OMP_LIB_KINDS'.
+
+   * Renaming of operators in the `USE' statement.
+
+
+
+File: gfortran.info,  Node: Fortran 2008 status,  Prev: Fortran 2003 status,  Up: Fortran 2003 and 2008 status
+
+4.2 Fortran 2008 status
+=======================
+
+The latest version of the Fortran standard is ISO/IEC 1539-1:2010,
+informally known as Fortran 2008.  The official version is available
+from International Organization for Standardization (ISO) or its
+national member organizations.  The the final draft (FDIS) can be
+downloaded free of charge from
+`http://www.nag.co.uk/sc22wg5/links.html'.  Fortran is developed by the
+Working Group 5 of Sub-Committee 22 of the Joint Technical Committee 1
+of the International Organization for Standardization and the
+International Electrotechnical Commission (IEC).  This group is known as
+WG5 (http://www.nag.co.uk/sc22wg5/).
+
+   The GNU Fortran supports several of the new features of Fortran
+2008; the wiki (http://gcc.gnu.org/wiki/Fortran2008Status) has some
+information about the current Fortran 2008 implementation status.  In
+particular, the following is implemented.
+
+   * The `-std=f2008' option and support for the file extensions `.f08'
+     and `.F08'.
+
+   * The `OPEN' statement now supports the `NEWUNIT=' option, which
+     returns a unique file unit, thus preventing inadvertent use of the
+     same unit in different parts of the program.
+
+   * The `g0' format descriptor and unlimited format items.
+
+   * The mathematical intrinsics `ASINH', `ACOSH', `ATANH', `ERF',
+     `ERFC', `GAMMA', `LOG_GAMMA', `BESSEL_J0', `BESSEL_J1',
+     `BESSEL_JN', `BESSEL_Y0', `BESSEL_Y1', `BESSEL_YN', `HYPOT',
+     `NORM2', and `ERFC_SCALED'.
+
+   * Using complex arguments with `TAN', `SINH', `COSH', `TANH',
+     `ASIN', `ACOS', and `ATAN' is now possible; `ATAN'(Y,X) is now an
+     alias for `ATAN2'(Y,X).
+
+   * Support of the `PARITY' intrinsic functions.
+
+   * The following bit intrinsics: `LEADZ' and `TRAILZ' for counting
+     the number of leading and trailing zero bits, `POPCNT' and
+     `POPPAR' for counting the number of one bits and returning the
+     parity; `BGE', `BGT', `BLE', and `BLT' for bitwise comparisons;
+     `DSHIFTL' and `DSHIFTR' for combined left and right shifts,
+     `MASKL' and `MASKR' for simple left and right justified masks,
+     `MERGE_BITS' for a bitwise merge using a mask, `SHIFTA', `SHIFTL'
+     and `SHIFTR' for shift operations, and the transformational bit
+     intrinsics `IALL', `IANY' and `IPARITY'.
+
+   * Support of the `EXECUTE_COMMAND_LINE' intrinsic subroutine.
+
+   * Support for the `STORAGE_SIZE' intrinsic inquiry function.
+
+   * The `INT{8,16,32}' and `REAL{32,64,128}' kind type parameters and
+     the array-valued named constants `INTEGER_KINDS', `LOGICAL_KINDS',
+     `REAL_KINDS' and `CHARACTER_KINDS' of the intrinsic module
+     `ISO_FORTRAN_ENV'.
+
+   * The module procedures `C_SIZEOF' of the intrinsic module
+     `ISO_C_BINDINGS' and `COMPILER_VERSION' and `COMPILER_OPTIONS' of
+     `ISO_FORTRAN_ENV'.
+
+   * Experimental coarray support (for one image only), use the
+     `-fcoarray=single' flag to enable it.
+
+   * The `BLOCK' construct is supported.
+
+   * The `STOP' and the new `ERROR STOP' statements now support all
+     constant expressions.
+
+   * Support for the `CONTIGUOUS' attribute.
+
+   * Support for `ALLOCATE' with `MOLD'.
+
+   * Support for the `IMPURE' attribute for procedures, which allows
+     for `ELEMENTAL' procedures without the restrictions of `PURE'.
+
+   * Null pointers (including `NULL()') and not-allocated variables can
+     be used as actual argument to optional non-pointer, non-allocatable
+     dummy arguments, denoting an absent argument.
+
+   * Non-pointer variables with `TARGET' attribute can be used as
+     actual argument to `POINTER' dummies with `INTENT(IN)'.
+
+   * Pointers including procedure pointers and those in a derived type
+     (pointer components) can now be initialized by a target instead of
+     only by `NULL'.
+
+   * The `EXIT' statement (with construct-name) can be now be used to
+     leave not only the `DO' but also the `ASSOCIATE', `BLOCK', `IF',
+     `SELECT CASE' and `SELECT TYPE' constructs.
+
+   * Internal procedures can now be used as actual argument.
+
+   * Minor features: obsolesce diagnostics for `ENTRY' with
+     `-std=f2008'; a line may start with a semicolon; for internal and
+     module procedures `END' can be used instead of `END SUBROUTINE'
+     and `END FUNCTION'; `SELECTED_REAL_KIND' now also takes a `RADIX'
+     argument; intrinsic types are supported for
+     `TYPE'(INTRINSIC-TYPE-SPEC); multiple type-bound procedures can be
+     declared in a single `PROCEDURE' statement; implied-shape arrays
+     are supported for named constants (`PARAMETER').
+
+
+File: gfortran.info,  Node: Compiler Characteristics,  Next: Mixed-Language Programming,  Prev: Fortran 2003 and 2008 status,  Up: Top
+
+5 Compiler Characteristics
+**************************
+
+This chapter describes certain characteristics of the GNU Fortran
+compiler, that are not specified by the Fortran standard, but which
+might in some way or another become visible to the programmer.
+
+* Menu:
+
+* KIND Type Parameters::
+* Internal representation of LOGICAL variables::
+* Thread-safety of the runtime library::
+
+
+File: gfortran.info,  Node: KIND Type Parameters,  Next: Internal representation of LOGICAL variables,  Up: Compiler Characteristics
+
+5.1 KIND Type Parameters
+========================
+
+The `KIND' type parameters supported by GNU Fortran for the primitive
+data types are:
+
+`INTEGER'
+     1, 2, 4, 8*, 16*, default: 4 (1)
+
+`LOGICAL'
+     1, 2, 4, 8*, 16*, default: 4 (1)
+
+`REAL'
+     4, 8, 10*, 16*, default: 4 (2)
+
+`COMPLEX'
+     4, 8, 10*, 16*, default: 4 (2)
+
+`CHARACTER'
+     1, 4, default: 1
+
+
+* = not available on all systems
+(1) Unless -fdefault-integer-8 is used
+(2) Unless -fdefault-real-8 is used
+
+The `KIND' value matches the storage size in bytes, except for
+`COMPLEX' where the storage size is twice as much (or both real and
+imaginary part are a real value of the given size).  It is recommended
+to use the `SELECTED_CHAR_KIND', `SELECTED_INT_KIND' and
+`SELECTED_REAL_KIND' intrinsics or the `INT8', `INT16', `INT32',
+`INT64', `REAL32', `REAL64', and `REAL128' parameters of the
+`ISO_FORTRAN_ENV' module instead of the concrete values.  The available
+kind parameters can be found in the constant arrays `CHARACTER_KINDS',
+`INTEGER_KINDS', `LOGICAL_KINDS' and `REAL_KINDS' in the
+`ISO_FORTRAN_ENV' module (see *note ISO_FORTRAN_ENV::).
+
+
+File: gfortran.info,  Node: Internal representation of LOGICAL variables,  Next: Thread-safety of the runtime library,  Prev: KIND Type Parameters,  Up: Compiler Characteristics
+
+5.2 Internal representation of LOGICAL variables
+================================================
+
+The Fortran standard does not specify how variables of `LOGICAL' type
+are represented, beyond requiring that `LOGICAL' variables of default
+kind have the same storage size as default `INTEGER' and `REAL'
+variables.  The GNU Fortran internal representation is as follows.
+
+   A `LOGICAL(KIND=N)' variable is represented as an `INTEGER(KIND=N)'
+variable, however, with only two permissible values: `1' for `.TRUE.'
+and `0' for `.FALSE.'.  Any other integer value results in undefined
+behavior.
+
+   Note that for mixed-language programming using the `ISO_C_BINDING'
+feature, there is a `C_BOOL' kind that can be used to create
+`LOGICAL(KIND=C_BOOL)' variables which are interoperable with the C99
+_Bool type.  The C99 _Bool type has an internal representation
+described in the C99 standard, which is identical to the above
+description, i.e. with 1 for true and 0 for false being the only
+permissible values.  Thus the internal representation of `LOGICAL'
+variables in GNU Fortran is identical to C99 _Bool, except for a
+possible difference in storage size depending on the kind.
+
+
+File: gfortran.info,  Node: Thread-safety of the runtime library,  Prev: Internal representation of LOGICAL variables,  Up: Compiler Characteristics
+
+5.3 Thread-safety of the runtime library
+========================================
+
+GNU Fortran can be used in programs with multiple threads, e.g. by
+using OpenMP, by calling OS thread handling functions via the
+`ISO_C_BINDING' facility, or by GNU Fortran compiled library code being
+called from a multi-threaded program.
+
+   The GNU Fortran runtime library, (`libgfortran'), supports being
+called concurrently from multiple threads with the following exceptions.
+
+   During library initialization, the C `getenv' function is used,
+which need not be thread-safe.  Similarly, the `getenv' function is
+used to implement the `GET_ENVIRONMENT_VARIABLE' and `GETENV'
+intrinsics.  It is the responsibility of the user to ensure that the
+environment is not being updated concurrently when any of these actions
+are taking place.
+
+   The `EXECUTE_COMMAND_LINE' and `SYSTEM' intrinsics are implemented
+with the `system' function, which need not be thread-safe.  It is the
+responsibility of the user to ensure that `system' is not called
+concurrently.
+
+   Finally, for platforms not supporting thread-safe POSIX functions,
+further functionality might not be thread-safe.  For details, please
+consult the documentation for your operating system.
+
+
+File: gfortran.info,  Node: Extensions,  Next: Intrinsic Procedures,  Prev: Mixed-Language Programming,  Up: Top
+
+6 Extensions
+************
+
+The two sections below detail the extensions to standard Fortran that
+are implemented in GNU Fortran, as well as some of the popular or
+historically important extensions that are not (or not yet) implemented.
+For the latter case, we explain the alternatives available to GNU
+Fortran users, including replacement by standard-conforming code or GNU
+extensions.
+
+* Menu:
+
+* Extensions implemented in GNU Fortran::
+* Extensions not implemented in GNU Fortran::
+
+
+File: gfortran.info,  Node: Extensions implemented in GNU Fortran,  Next: Extensions not implemented in GNU Fortran,  Up: Extensions
+
+6.1 Extensions implemented in GNU Fortran
+=========================================
+
+GNU Fortran implements a number of extensions over standard Fortran.
+This chapter contains information on their syntax and meaning.  There
+are currently two categories of GNU Fortran extensions, those that
+provide functionality beyond that provided by any standard, and those
+that are supported by GNU Fortran purely for backward compatibility
+with legacy compilers.  By default, `-std=gnu' allows the compiler to
+accept both types of extensions, but to warn about the use of the
+latter.  Specifying either `-std=f95', `-std=f2003' or `-std=f2008'
+disables both types of extensions, and `-std=legacy' allows both
+without warning.
+
+* Menu:
+
+* Old-style kind specifications::
+* Old-style variable initialization::
+* Extensions to namelist::
+* X format descriptor without count field::
+* Commas in FORMAT specifications::
+* Missing period in FORMAT specifications::
+* I/O item lists::
+* BOZ literal constants::
+* `Q' exponent-letter::
+* Real array indices::
+* Unary operators::
+* Implicitly convert LOGICAL and INTEGER values::
+* Hollerith constants support::
+* Cray pointers::
+* CONVERT specifier::
+* OpenMP::
+* Argument list functions::
+
+
+File: gfortran.info,  Node: Old-style kind specifications,  Next: Old-style variable initialization,  Up: Extensions implemented in GNU Fortran
+
+6.1.1 Old-style kind specifications
+-----------------------------------
+
+GNU Fortran allows old-style kind specifications in declarations.  These
+look like:
+           TYPESPEC*size x,y,z
+   where `TYPESPEC' is a basic type (`INTEGER', `REAL', etc.), and
+where `size' is a byte count corresponding to the storage size of a
+valid kind for that type.  (For `COMPLEX' variables, `size' is the
+total size of the real and imaginary parts.)  The statement then
+declares `x', `y' and `z' to be of type `TYPESPEC' with the appropriate
+kind.  This is equivalent to the standard-conforming declaration
+           TYPESPEC(k) x,y,z
+   where `k' is the kind parameter suitable for the intended precision.
+As kind parameters are implementation-dependent, use the `KIND',
+`SELECTED_INT_KIND' and `SELECTED_REAL_KIND' intrinsics to retrieve the
+correct value, for instance `REAL*8 x' can be replaced by:
+     INTEGER, PARAMETER :: dbl = KIND(1.0d0)
+     REAL(KIND=dbl) :: x
+
+
+File: gfortran.info,  Node: Old-style variable initialization,  Next: Extensions to namelist,  Prev: Old-style kind specifications,  Up: Extensions implemented in GNU Fortran
+
+6.1.2 Old-style variable initialization
+---------------------------------------
+
+GNU Fortran allows old-style initialization of variables of the form:
+           INTEGER i/1/,j/2/
+           REAL x(2,2) /3*0.,1./
+   The syntax for the initializers is as for the `DATA' statement, but
+unlike in a `DATA' statement, an initializer only applies to the
+variable immediately preceding the initialization.  In other words,
+something like `INTEGER I,J/2,3/' is not valid.  This style of
+initialization is only allowed in declarations without double colons
+(`::'); the double colons were introduced in Fortran 90, which also
+introduced a standard syntax for initializing variables in type
+declarations.
+
+   Examples of standard-conforming code equivalent to the above example
+are:
+     ! Fortran 90
+           INTEGER :: i = 1, j = 2
+           REAL :: x(2,2) = RESHAPE((/0.,0.,0.,1./),SHAPE(x))
+     ! Fortran 77
+           INTEGER i, j
+           REAL x(2,2)
+           DATA i/1/, j/2/, x/3*0.,1./
+
+   Note that variables which are explicitly initialized in declarations
+or in `DATA' statements automatically acquire the `SAVE' attribute.
+
+
+File: gfortran.info,  Node: Extensions to namelist,  Next: X format descriptor without count field,  Prev: Old-style variable initialization,  Up: Extensions implemented in GNU Fortran
+
+6.1.3 Extensions to namelist
+----------------------------
+
+GNU Fortran fully supports the Fortran 95 standard for namelist I/O
+including array qualifiers, substrings and fully qualified derived
+types.  The output from a namelist write is compatible with namelist
+read.  The output has all names in upper case and indentation to column
+1 after the namelist name.  Two extensions are permitted:
+
+   Old-style use of `$' instead of `&'
+     $MYNML
+      X(:)%Y(2) = 1.0 2.0 3.0
+      CH(1:4) = "abcd"
+     $END
+
+   It should be noted that the default terminator is `/' rather than
+`&END'.
+
+   Querying of the namelist when inputting from stdin.  After at least
+one space, entering `?' sends to stdout the namelist name and the names
+of the variables in the namelist:
+      ?
+
+     &mynml
+      x
+      x%y
+      ch
+     &end
+
+   Entering `=?' outputs the namelist to stdout, as if `WRITE(*,NML =
+mynml)' had been called:
+     =?
+
+     &MYNML
+      X(1)%Y=  0.000000    ,  1.000000    ,  0.000000    ,
+      X(2)%Y=  0.000000    ,  2.000000    ,  0.000000    ,
+      X(3)%Y=  0.000000    ,  3.000000    ,  0.000000    ,
+      CH=abcd,  /
+
+   To aid this dialog, when input is from stdin, errors send their
+messages to stderr and execution continues, even if `IOSTAT' is set.
+
+   `PRINT' namelist is permitted.  This causes an error if `-std=f95'
+is used.
+     PROGRAM test_print
+       REAL, dimension (4)  ::  x = (/1.0, 2.0, 3.0, 4.0/)
+       NAMELIST /mynml/ x
+       PRINT mynml
+     END PROGRAM test_print
+
+   Expanded namelist reads are permitted.  This causes an error if
+`-std=f95' is used.  In the following example, the first element of the
+array will be given the value 0.00 and the two succeeding elements will
+be given the values 1.00 and 2.00.
+     &MYNML
+       X(1,1) = 0.00 , 1.00 , 2.00
+     /
+
+
+File: gfortran.info,  Node: X format descriptor without count field,  Next: Commas in FORMAT specifications,  Prev: Extensions to namelist,  Up: Extensions implemented in GNU Fortran
+
+6.1.4 `X' format descriptor without count field
+-----------------------------------------------
+
+To support legacy codes, GNU Fortran permits the count field of the `X'
+edit descriptor in `FORMAT' statements to be omitted.  When omitted,
+the count is implicitly assumed to be one.
+
+            PRINT 10, 2, 3
+     10     FORMAT (I1, X, I1)
+
+
+File: gfortran.info,  Node: Commas in FORMAT specifications,  Next: Missing period in FORMAT specifications,  Prev: X format descriptor without count field,  Up: Extensions implemented in GNU Fortran
+
+6.1.5 Commas in `FORMAT' specifications
+---------------------------------------
+
+To support legacy codes, GNU Fortran allows the comma separator to be
+omitted immediately before and after character string edit descriptors
+in `FORMAT' statements.
+
+            PRINT 10, 2, 3
+     10     FORMAT ('FOO='I1' BAR='I2)
+
+
+File: gfortran.info,  Node: Missing period in FORMAT specifications,  Next: I/O item lists,  Prev: Commas in FORMAT specifications,  Up: Extensions implemented in GNU Fortran
+
+6.1.6 Missing period in `FORMAT' specifications
+-----------------------------------------------
+
+To support legacy codes, GNU Fortran allows missing periods in format
+specifications if and only if `-std=legacy' is given on the command
+line.  This is considered non-conforming code and is discouraged.
+
+            REAL :: value
+            READ(*,10) value
+     10     FORMAT ('F4')
+
+
+File: gfortran.info,  Node: I/O item lists,  Next: BOZ literal constants,  Prev: Missing period in FORMAT specifications,  Up: Extensions implemented in GNU Fortran
+
+6.1.7 I/O item lists
+--------------------
+
+To support legacy codes, GNU Fortran allows the input item list of the
+`READ' statement, and the output item lists of the `WRITE' and `PRINT'
+statements, to start with a comma.
+
+
+File: gfortran.info,  Node: `Q' exponent-letter,  Next: Real array indices,  Prev: BOZ literal constants,  Up: Extensions implemented in GNU Fortran
+
+6.1.8 `Q' exponent-letter
+-------------------------
+
+GNU Fortran accepts real literal constants with an exponent-letter of
+`Q', for example, `1.23Q45'.  The constant is interpreted as a
+`REAL(16)' entity on targets that suppports this type.  If the target
+does not support `REAL(16)' but has a `REAL(10)' type, then the
+real-literal-constant will be interpreted as a `REAL(10)' entity.  In
+the absence of `REAL(16)' and `REAL(10)', an error will occur.
+
+
+File: gfortran.info,  Node: BOZ literal constants,  Next: `Q' exponent-letter,  Prev: I/O item lists,  Up: Extensions implemented in GNU Fortran
+
+6.1.9 BOZ literal constants
+---------------------------
+
+Besides decimal constants, Fortran also supports binary (`b'), octal
+(`o') and hexadecimal (`z') integer constants.  The syntax is: `prefix
+quote digits quote', were the prefix is either `b', `o' or `z', quote
+is either `'' or `"' and the digits are for binary `0' or `1', for
+octal between `0' and `7', and for hexadecimal between `0' and `F'.
+(Example: `b'01011101''.)
+
+   Up to Fortran 95, BOZ literals were only allowed to initialize
+integer variables in DATA statements.  Since Fortran 2003 BOZ literals
+are also allowed as argument of `REAL', `DBLE', `INT' and `CMPLX'; the
+result is the same as if the integer BOZ literal had been converted by
+`TRANSFER' to, respectively, `real', `double precision', `integer' or
+`complex'.  As GNU Fortran extension the intrinsic procedures `FLOAT',
+`DFLOAT', `COMPLEX' and `DCMPLX' are treated alike.
+
+   As an extension, GNU Fortran allows hexadecimal BOZ literal
+constants to be specified using the `X' prefix, in addition to the
+standard `Z' prefix.  The BOZ literal can also be specified by adding a
+suffix to the string, for example, `Z'ABC'' and `'ABC'Z' are equivalent.
+
+   Furthermore, GNU Fortran allows using BOZ literal constants outside
+DATA statements and the four intrinsic functions allowed by Fortran
+2003.  In DATA statements, in direct assignments, where the right-hand
+side only contains a BOZ literal constant, and for old-style
+initializers of the form `integer i /o'0173'/', the constant is
+transferred as if `TRANSFER' had been used; for `COMPLEX' numbers, only
+the real part is initialized unless `CMPLX' is used.  In all other
+cases, the BOZ literal constant is converted to an `INTEGER' value with
+the largest decimal representation.  This value is then converted
+numerically to the type and kind of the variable in question.  (For
+instance, `real :: r = b'0000001' + 1' initializes `r' with `2.0'.) As
+different compilers implement the extension differently, one should be
+careful when doing bitwise initialization of non-integer variables.
+
+   Note that initializing an `INTEGER' variable with a statement such
+as `DATA i/Z'FFFFFFFF'/' will give an integer overflow error rather
+than the desired result of -1 when `i' is a 32-bit integer on a system
+that supports 64-bit integers.  The `-fno-range-check' option can be
+used as a workaround for legacy code that initializes integers in this
+manner.
+
+
+File: gfortran.info,  Node: Real array indices,  Next: Unary operators,  Prev: `Q' exponent-letter,  Up: Extensions implemented in GNU Fortran
+
+6.1.10 Real array indices
+-------------------------
+
+As an extension, GNU Fortran allows the use of `REAL' expressions or
+variables as array indices.
+
+
+File: gfortran.info,  Node: Unary operators,  Next: Implicitly convert LOGICAL and INTEGER values,  Prev: Real array indices,  Up: Extensions implemented in GNU Fortran
+
+6.1.11 Unary operators
+----------------------
+
+As an extension, GNU Fortran allows unary plus and unary minus operators
+to appear as the second operand of binary arithmetic operators without
+the need for parenthesis.
+
+            X = Y * -Z
+
+
+File: gfortran.info,  Node: Implicitly convert LOGICAL and INTEGER values,  Next: Hollerith constants support,  Prev: Unary operators,  Up: Extensions implemented in GNU Fortran
+
+6.1.12 Implicitly convert `LOGICAL' and `INTEGER' values
+--------------------------------------------------------
+
+As an extension for backwards compatibility with other compilers, GNU
+Fortran allows the implicit conversion of `LOGICAL' values to `INTEGER'
+values and vice versa.  When converting from a `LOGICAL' to an
+`INTEGER', `.FALSE.' is interpreted as zero, and `.TRUE.' is
+interpreted as one.  When converting from `INTEGER' to `LOGICAL', the
+value zero is interpreted as `.FALSE.' and any nonzero value is
+interpreted as `.TRUE.'.
+
+             LOGICAL :: l
+             l = 1
+
+             INTEGER :: i
+             i = .TRUE.
+
+   However, there is no implicit conversion of `INTEGER' values in
+`if'-statements, nor of `LOGICAL' or `INTEGER' values in I/O operations.
+
+
+File: gfortran.info,  Node: Hollerith constants support,  Next: Cray pointers,  Prev: Implicitly convert LOGICAL and INTEGER values,  Up: Extensions implemented in GNU Fortran
+
+6.1.13 Hollerith constants support
+----------------------------------
+
+GNU Fortran supports Hollerith constants in assignments, function
+arguments, and `DATA' and `ASSIGN' statements.  A Hollerith constant is
+written as a string of characters preceded by an integer constant
+indicating the character count, and the letter `H' or `h', and stored
+in bytewise fashion in a numeric (`INTEGER', `REAL', or `complex') or
+`LOGICAL' variable.  The constant will be padded or truncated to fit
+the size of the variable in which it is stored.
+
+   Examples of valid uses of Hollerith constants:
+           complex*16 x(2)
+           data x /16Habcdefghijklmnop, 16Hqrstuvwxyz012345/
+           x(1) = 16HABCDEFGHIJKLMNOP
+           call foo (4h abc)
+
+   Invalid Hollerith constants examples:
+           integer*4 a
+           a = 8H12345678 ! Valid, but the Hollerith constant will be truncated.
+           a = 0H         ! At least one character is needed.
+
+   In general, Hollerith constants were used to provide a rudimentary
+facility for handling character strings in early Fortran compilers,
+prior to the introduction of `CHARACTER' variables in Fortran 77; in
+those cases, the standard-compliant equivalent is to convert the
+program to use proper character strings.  On occasion, there may be a
+case where the intent is specifically to initialize a numeric variable
+with a given byte sequence.  In these cases, the same result can be
+obtained by using the `TRANSFER' statement, as in this example.
+           INTEGER(KIND=4) :: a
+           a = TRANSFER ("abcd", a)     ! equivalent to: a = 4Habcd
+
+
+File: gfortran.info,  Node: Cray pointers,  Next: CONVERT specifier,  Prev: Hollerith constants support,  Up: Extensions implemented in GNU Fortran
+
+6.1.14 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:
+             pointer ( <pointer> , <pointee> )
+   or,
+             pointer ( <pointer1> , <pointee1> ), ( <pointer2> , <pointee2> ), ...
+   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:
+             integer ipt
+             pointer (ipt, iarr)
+   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:
+             real target(10)
+             real pointee(10)
+             pointer (ipt, pointee)
+             ipt = loc (target)
+             ipt = ipt + 1
+   The last statement does not set `ipt' to the address of `target(1)',
+as it would in C pointer arithmetic.  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.
+
+   To get the address of elements, this extension provides an intrinsic
+function `LOC()'.  The `LOC()' function is equivalent to the `&'
+operator in C, except the address is cast to an integer type:
+             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
+   The pointer can also be set by a call to the `MALLOC' intrinsic (see
+*note MALLOC::).
+
+   Cray pointees often are used to alias an existing variable.  For
+example:
+             integer target(10)
+             integer iarr(10)
+             pointer (ipt, iarr)
+             ipt = loc(target)
+   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 are 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 GNU Fortran; 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
+`ALLOCATABLE', `INTENT', `OPTIONAL', `DUMMY', `TARGET', `INTRINSIC', or
+`POINTER' attributes.  Pointers may not have the `DIMENSION',
+`POINTER', `TARGET', `ALLOCATABLE', `EXTERNAL', or `INTRINSIC'
+attributes, nor may they be function results.  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 Cray pointer may also point to a function or a subroutine.  For
+example, the following excerpt is valid:
+       implicit none
+       external sub
+       pointer (subptr,subpte)
+       external subpte
+       subptr = loc(sub)
+       call subpte()
+       [...]
+       subroutine sub
+       [...]
+       end subroutine sub
+
+   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.
+
+
+File: gfortran.info,  Node: CONVERT specifier,  Next: OpenMP,  Prev: Cray pointers,  Up: Extensions implemented in GNU Fortran
+
+6.1.15 `CONVERT' specifier
+--------------------------
+
+GNU Fortran allows the conversion of unformatted data between little-
+and big-endian representation to facilitate moving of data between
+different systems.  The conversion can be indicated with the `CONVERT'
+specifier on the `OPEN' statement.  *Note GFORTRAN_CONVERT_UNIT::, for
+an alternative way of specifying the data format via an environment
+variable.
+
+   Valid values for `CONVERT' are:
+     `CONVERT='NATIVE'' Use the native format.  This is the default.
+
+     `CONVERT='SWAP'' Swap between little- and big-endian.
+
+     `CONVERT='LITTLE_ENDIAN'' Use the little-endian representation for
+     unformatted files.
+
+     `CONVERT='BIG_ENDIAN'' Use the big-endian representation for
+     unformatted files.
+
+   Using the option could look like this:
+       open(file='big.dat',form='unformatted',access='sequential', &
+            convert='big_endian')
+
+   The value of the conversion can be queried by using
+`INQUIRE(CONVERT=ch)'.  The values returned are `'BIG_ENDIAN'' and
+`'LITTLE_ENDIAN''.
+
+   `CONVERT' works between big- and little-endian for `INTEGER' values
+of all supported kinds and for `REAL' on IEEE systems of kinds 4 and 8.
+Conversion between different "extended double" types on different
+architectures such as m68k and x86_64, which GNU Fortran supports as
+`REAL(KIND=10)' and `REAL(KIND=16)', will probably not work.
+
+   _Note that the values specified via the GFORTRAN_CONVERT_UNIT
+environment variable will override the CONVERT specifier in the open
+statement_.  This is to give control over data formats to users who do
+not have the source code of their program available.
+
+   Using anything but the native representation for unformatted data
+carries a significant speed overhead.  If speed in this area matters to
+you, it is best if you use this only for data that needs to be portable.
+
+
+File: gfortran.info,  Node: OpenMP,  Next: Argument list functions,  Prev: CONVERT specifier,  Up: Extensions implemented in GNU Fortran
+
+6.1.16 OpenMP
+-------------
+
+OpenMP (Open Multi-Processing) is an application programming interface
+(API) that supports multi-platform shared memory multiprocessing
+programming in C/C++ and Fortran on many architectures, including Unix
+and Microsoft Windows platforms.  It consists of a set of compiler
+directives, library routines, and environment variables that influence
+run-time behavior.
+
+   GNU Fortran strives to be compatible to the OpenMP Application
+Program Interface v3.0 (http://www.openmp.org/mp-documents/spec30.pdf).
+
+   To enable the processing of the OpenMP directive `!$omp' in
+free-form source code; the `c$omp', `*$omp' and `!$omp' directives in
+fixed form; the `!$' conditional compilation sentinels in free form;
+and the `c$', `*$' and `!$' sentinels in fixed form, `gfortran' needs
+to be invoked with the `-fopenmp'.  This also arranges for automatic
+linking of the GNU OpenMP runtime library *note libgomp: (libgomp)Top.
+
+   The OpenMP Fortran runtime library routines are provided both in a
+form of a Fortran 90 module named `omp_lib' and in a form of a Fortran
+`include' file named `omp_lib.h'.
+
+   An example of a parallelized loop taken from Appendix A.1 of the
+OpenMP Application Program Interface v2.5:
+     SUBROUTINE A1(N, A, B)
+       INTEGER I, N
+       REAL B(N), A(N)
+     !$OMP PARALLEL DO !I is private by default
+       DO I=2,N
+         B(I) = (A(I) + A(I-1)) / 2.0
+       ENDDO
+     !$OMP END PARALLEL DO
+     END SUBROUTINE A1
+
+   Please note:
+   * `-fopenmp' implies `-frecursive', i.e., all local arrays will be
+     allocated on the stack.  When porting existing code to OpenMP,
+     this may lead to surprising results, especially to segmentation
+     faults if the stacksize is limited.
+
+   * On glibc-based systems, OpenMP enabled applications cannot be
+     statically linked due to limitations of the underlying
+     pthreads-implementation.  It might be possible to get a working
+     solution if `-Wl,--whole-archive -lpthread -Wl,--no-whole-archive'
+     is added to the command line.  However, this is not supported by
+     `gcc' and thus not recommended.
+
+
+File: gfortran.info,  Node: Argument list functions,  Prev: OpenMP,  Up: Extensions implemented in GNU Fortran
+
+6.1.17 Argument list functions `%VAL', `%REF' and `%LOC'
+--------------------------------------------------------
+
+GNU Fortran supports argument list functions `%VAL', `%REF' and `%LOC'
+statements, for backward compatibility with g77.  It is recommended
+that these should be used only for code that is accessing facilities
+outside of GNU Fortran, such as operating system or windowing
+facilities.  It is best to constrain such uses to isolated portions of
+a program-portions that deal specifically and exclusively with
+low-level, system-dependent facilities.  Such portions might well
+provide a portable interface for use by the program as a whole, but are
+themselves not portable, and should be thoroughly tested each time they
+are rebuilt using a new compiler or version of a compiler.
+
+   `%VAL' passes a scalar argument by value, `%REF' passes it by
+reference and `%LOC' passes its memory location.  Since gfortran
+already passes scalar arguments by reference, `%REF' is in effect a
+do-nothing.  `%LOC' has the same effect as a Fortran pointer.
+
+   An example of passing an argument by value to a C subroutine foo.:
+     C
+     C prototype      void foo_ (float x);
+     C
+           external foo
+           real*4 x
+           x = 3.14159
+           call foo (%VAL (x))
+           end
+
+   For details refer to the g77 manual
+`http://gcc.gnu.org/onlinedocs/gcc-3.4.6/g77/index.html#Top'.
+
+   Also, `c_by_val.f' and its partner `c_by_val.c' of the GNU Fortran
+testsuite are worth a look.
+
+
+File: gfortran.info,  Node: Extensions not implemented in GNU Fortran,  Prev: Extensions implemented in GNU Fortran,  Up: Extensions
+
+6.2 Extensions not implemented in GNU Fortran
+=============================================
+
+The long history of the Fortran language, its wide use and broad
+userbase, the large number of different compiler vendors and the lack of
+some features crucial to users in the first standards have lead to the
+existence of a number of important extensions to the language.  While
+some of the most useful or popular extensions are supported by the GNU
+Fortran compiler, not all existing extensions are supported.  This
+section aims at listing these extensions and offering advice on how
+best make code that uses them running with the GNU Fortran compiler.
+
+* Menu:
+
+* STRUCTURE and RECORD::
+* ENCODE and DECODE statements::
+* Variable FORMAT expressions::
+* Alternate complex function syntax::
+
+
+File: gfortran.info,  Node: STRUCTURE and RECORD,  Next: ENCODE and DECODE statements,  Up: Extensions not implemented in GNU Fortran
+
+6.2.1 `STRUCTURE' and `RECORD'
+------------------------------
+
+Structures are user-defined aggregate data types; this functionality was
+standardized in Fortran 90 with an different syntax, under the name of
+"derived types".  Here is an example of code using the non portable
+structure syntax:
+
+     ! Declaring a structure named ``item'' and containing three fields:
+     ! an integer ID, an description string and a floating-point price.
+     STRUCTURE /item/
+       INTEGER id
+       CHARACTER(LEN=200) description
+       REAL price
+     END STRUCTURE
+
+     ! Define two variables, an single record of type ``item''
+     ! named ``pear'', and an array of items named ``store_catalog''
+     RECORD /item/ pear, store_catalog(100)
+
+     ! We can directly access the fields of both variables
+     pear.id = 92316
+     pear.description = "juicy D'Anjou pear"
+     pear.price = 0.15
+     store_catalog(7).id = 7831
+     store_catalog(7).description = "milk bottle"
+     store_catalog(7).price = 1.2
+
+     ! We can also manipulate the whole structure
+     store_catalog(12) = pear
+     print *, store_catalog(12)
+
+This code can easily be rewritten in the Fortran 90 syntax as following:
+
+     ! ``STRUCTURE /name/ ... END STRUCTURE'' becomes
+     ! ``TYPE name ... END TYPE''
+     TYPE item
+       INTEGER id
+       CHARACTER(LEN=200) description
+       REAL price
+     END TYPE
+
+     ! ``RECORD /name/ variable'' becomes ``TYPE(name) variable''
+     TYPE(item) pear, store_catalog(100)
+
+     ! Instead of using a dot (.) to access fields of a record, the
+     ! standard syntax uses a percent sign (%)
+     pear%id = 92316
+     pear%description = "juicy D'Anjou pear"
+     pear%price = 0.15
+     store_catalog(7)%id = 7831
+     store_catalog(7)%description = "milk bottle"
+     store_catalog(7)%price = 1.2
+
+     ! Assignments of a whole variable don't change
+     store_catalog(12) = pear
+     print *, store_catalog(12)
+
+
+File: gfortran.info,  Node: ENCODE and DECODE statements,  Next: Variable FORMAT expressions,  Prev: STRUCTURE and RECORD,  Up: Extensions not implemented in GNU Fortran
+
+6.2.2 `ENCODE' and `DECODE' statements
+--------------------------------------
+
+GNU Fortran doesn't support the `ENCODE' and `DECODE' statements.
+These statements are best replaced by `READ' and `WRITE' statements
+involving internal files (`CHARACTER' variables and arrays), which have
+been part of the Fortran standard since Fortran 77.  For example,
+replace a code fragment like
+
+           INTEGER*1 LINE(80)
+           REAL A, B, C
+     c     ... Code that sets LINE
+           DECODE (80, 9000, LINE) A, B, C
+      9000 FORMAT (1X, 3(F10.5))
+
+with the following:
+
+           CHARACTER(LEN=80) LINE
+           REAL A, B, C
+     c     ... Code that sets LINE
+           READ (UNIT=LINE, FMT=9000) A, B, C
+      9000 FORMAT (1X, 3(F10.5))
+
+   Similarly, replace a code fragment like
+
+           INTEGER*1 LINE(80)
+           REAL A, B, C
+     c     ... Code that sets A, B and C
+           ENCODE (80, 9000, LINE) A, B, C
+      9000 FORMAT (1X, 'OUTPUT IS ', 3(F10.5))
+
+with the following:
+
+           CHARACTER(LEN=80) LINE
+           REAL A, B, C
+     c     ... Code that sets A, B and C
+           WRITE (UNIT=LINE, FMT=9000) A, B, C
+      9000 FORMAT (1X, 'OUTPUT IS ', 3(F10.5))
+
+
+File: gfortran.info,  Node: Variable FORMAT expressions,  Next: Alternate complex function syntax,  Prev: ENCODE and DECODE statements,  Up: Extensions not implemented in GNU Fortran
+
+6.2.3 Variable `FORMAT' expressions
+-----------------------------------
+
+A variable `FORMAT' expression is format statement which includes angle
+brackets enclosing a Fortran expression: `FORMAT(I<N>)'.  GNU Fortran
+does not support this legacy extension.  The effect of variable format
+expressions can be reproduced by using the more powerful (and standard)
+combination of internal output and string formats.  For example,
+replace a code fragment like this:
+
+           WRITE(6,20) INT1
+      20   FORMAT(I<N+1>)
+
+with the following:
+
+     c     Variable declaration
+           CHARACTER(LEN=20) FMT
+     c
+     c     Other code here...
+     c
+           WRITE(FMT,'("(I", I0, ")")') N+1
+           WRITE(6,FMT) INT1
+
+or with:
+
+     c     Variable declaration
+           CHARACTER(LEN=20) FMT
+     c
+     c     Other code here...
+     c
+           WRITE(FMT,*) N+1
+           WRITE(6,"(I" // ADJUSTL(FMT) // ")") INT1
+
+
+File: gfortran.info,  Node: Alternate complex function syntax,  Prev: Variable FORMAT expressions,  Up: Extensions not implemented in GNU Fortran
+
+6.2.4 Alternate complex function syntax
+---------------------------------------
+
+Some Fortran compilers, including `g77', let the user declare complex
+functions with the syntax `COMPLEX FUNCTION name*16()', as well as
+`COMPLEX*16 FUNCTION name()'.  Both are non-standard, legacy
+extensions.  `gfortran' accepts the latter form, which is more common,
+but not the former.
+
+
+File: gfortran.info,  Node: Mixed-Language Programming,  Next: Extensions,  Prev: Compiler Characteristics,  Up: Top
+
+7 Mixed-Language Programming
+****************************
+
+* Menu:
+
+* Interoperability with C::
+* GNU Fortran Compiler Directives::
+* Non-Fortran Main Program::
+
+   This chapter is about mixed-language interoperability, but also
+applies if one links Fortran code compiled by different compilers.  In
+most cases, use of the C Binding features of the Fortran 2003 standard
+is sufficient, and their use is highly recommended.
+
+
+File: gfortran.info,  Node: Interoperability with C,  Next: GNU Fortran Compiler Directives,  Up: Mixed-Language Programming
+
+7.1 Interoperability with C
+===========================
+
+* Menu:
+
+* Intrinsic Types::
+* Derived Types and struct::
+* Interoperable Global Variables::
+* Interoperable Subroutines and Functions::
+* Working with Pointers::
+* Further Interoperability of Fortran with C::
+
+   Since Fortran 2003 (ISO/IEC 1539-1:2004(E)) there is a standardized
+way to generate procedure and derived-type declarations and global
+variables which are interoperable with C (ISO/IEC 9899:1999).  The
+`bind(C)' attribute has been added to inform the compiler that a symbol
+shall be interoperable with C; also, some constraints are added.  Note,
+however, that not all C features have a Fortran equivalent or vice
+versa.  For instance, neither C's unsigned integers nor C's functions
+with variable number of arguments have an equivalent in Fortran.
+
+   Note that array dimensions are reversely ordered in C and that
+arrays in C always start with index 0 while in Fortran they start by
+default with 1.  Thus, an array declaration `A(n,m)' in Fortran matches
+`A[m][n]' in C and accessing the element `A(i,j)' matches
+`A[j-1][i-1]'.  The element following `A(i,j)' (C: `A[j-1][i-1]';
+assuming i < n) in memory is `A(i+1,j)' (C: `A[j-1][i]').
+
+
+File: gfortran.info,  Node: Intrinsic Types,  Next: Derived Types and struct,  Up: Interoperability with C
+
+7.1.1 Intrinsic Types
+---------------------
+
+In order to ensure that exactly the same variable type and kind is used
+in C and Fortran, the named constants shall be used which are defined
+in the `ISO_C_BINDING' intrinsic module.  That module contains named
+constants for kind parameters and character named constants for the
+escape sequences in C.  For a list of the constants, see *note
+ISO_C_BINDING::.
+
+
+File: gfortran.info,  Node: Derived Types and struct,  Next: Interoperable Global Variables,  Prev: Intrinsic Types,  Up: Interoperability with C
+
+7.1.2 Derived Types and struct
+------------------------------
+
+For compatibility of derived types with `struct', one needs to use the
+`BIND(C)' attribute in the type declaration.  For instance, the
+following type declaration
+
+      USE ISO_C_BINDING
+      TYPE, BIND(C) :: myType
+        INTEGER(C_INT) :: i1, i2
+        INTEGER(C_SIGNED_CHAR) :: i3
+        REAL(C_DOUBLE) :: d1
+        COMPLEX(C_FLOAT_COMPLEX) :: c1
+        CHARACTER(KIND=C_CHAR) :: str(5)
+      END TYPE
+
+   matches the following `struct' declaration in C
+
+      struct {
+        int i1, i2;
+        /* Note: "char" might be signed or unsigned.  */
+        signed char i3;
+        double d1;
+        float _Complex c1;
+        char str[5];
+      } myType;
+
+   Derived types with the C binding attribute shall not have the
+`sequence' attribute, type parameters, the `extends' attribute, nor
+type-bound procedures.  Every component must be of interoperable type
+and kind and may not have the `pointer' or `allocatable' attribute.
+The names of the variables are irrelevant for interoperability.
+
+   As there exist no direct Fortran equivalents, neither unions nor
+structs with bit field or variable-length array members are
+interoperable.
+
+
+File: gfortran.info,  Node: Interoperable Global Variables,  Next: Interoperable Subroutines and Functions,  Prev: Derived Types and struct,  Up: Interoperability with C
+
+7.1.3 Interoperable Global Variables
+------------------------------------
+
+Variables can be made accessible from C using the C binding attribute,
+optionally together with specifying a binding name.  Those variables
+have to be declared in the declaration part of a `MODULE', be of
+interoperable type, and have neither the `pointer' nor the
+`allocatable' attribute.
+
+       MODULE m
+         USE myType_module
+         USE ISO_C_BINDING
+         integer(C_INT), bind(C, name="_MyProject_flags") :: global_flag
+         type(myType), bind(C) :: tp
+       END MODULE
+
+   Here, `_MyProject_flags' is the case-sensitive name of the variable
+as seen from C programs while `global_flag' is the case-insensitive
+name as seen from Fortran.  If no binding name is specified, as for TP,
+the C binding name is the (lowercase) Fortran binding name.  If a
+binding name is specified, only a single variable may be after the
+double colon.  Note of warning: You cannot use a global variable to
+access ERRNO of the C library as the C standard allows it to be a
+macro.  Use the `IERRNO' intrinsic (GNU extension) instead.
+
+
+File: gfortran.info,  Node: Interoperable Subroutines and Functions,  Next: Working with Pointers,  Prev: Interoperable Global Variables,  Up: Interoperability with C
+
+7.1.4 Interoperable Subroutines and Functions
+---------------------------------------------
+
+Subroutines and functions have to have the `BIND(C)' attribute to be
+compatible with C.  The dummy argument declaration is relatively
+straightforward.  However, one needs to be careful because C uses
+call-by-value by default while Fortran behaves usually similar to
+call-by-reference.  Furthermore, strings and pointers are handled
+differently.  Note that only explicit size and assumed-size arrays are
+supported but not assumed-shape or allocatable arrays.
+
+   To pass a variable by value, use the `VALUE' attribute.  Thus the
+following C prototype
+
+     `int func(int i, int *j)'
+
+   matches the Fortran declaration
+
+       integer(c_int) function func(i,j)
+         use iso_c_binding, only: c_int
+         integer(c_int), VALUE :: i
+         integer(c_int) :: j
+
+   Note that pointer arguments also frequently need the `VALUE'
+attribute, see *note Working with Pointers::.
+
+   Strings are handled quite differently in C and Fortran.  In C a
+string is a `NUL'-terminated array of characters while in Fortran each
+string has a length associated with it and is thus not terminated (by
+e.g.  `NUL').  For example, if one wants to use the following C
+function,
+
+       #include <stdio.h>
+       void print_C(char *string) /* equivalent: char string[]  */
+       {
+          printf("%s\n", string);
+       }
+
+   to print "Hello World" from Fortran, one can call it using
+
+       use iso_c_binding, only: C_CHAR, C_NULL_CHAR
+       interface
+         subroutine print_c(string) bind(C, name="print_C")
+           use iso_c_binding, only: c_char
+           character(kind=c_char) :: string(*)
+         end subroutine print_c
+       end interface
+       call print_c(C_CHAR_"Hello World"//C_NULL_CHAR)
+
+   As the example shows, one needs to ensure that the string is `NUL'
+terminated.  Additionally, the dummy argument STRING of `print_C' is a
+length-one assumed-size array; using `character(len=*)' is not allowed.
+The example above uses `c_char_"Hello World"' to ensure the string
+literal has the right type; typically the default character kind and
+`c_char' are the same and thus `"Hello World"' is equivalent.  However,
+the standard does not guarantee this.
+
+   The use of strings is now further illustrated using the C library
+function `strncpy', whose prototype is
+
+       char *strncpy(char *restrict s1, const char *restrict s2, size_t n);
+
+   The function `strncpy' copies at most N characters from string S2 to
+S1 and returns S1.  In the following example, we ignore the return
+value:
+
+       use iso_c_binding
+       implicit none
+       character(len=30) :: str,str2
+       interface
+         ! Ignore the return value of strncpy -> subroutine
+         ! "restrict" is always assumed if we do not pass a pointer
+         subroutine strncpy(dest, src, n) bind(C)
+           import
+           character(kind=c_char),  intent(out) :: dest(*)
+           character(kind=c_char),  intent(in)  :: src(*)
+           integer(c_size_t), value, intent(in) :: n
+         end subroutine strncpy
+       end interface
+       str = repeat('X',30) ! Initialize whole string with 'X'
+       call strncpy(str, c_char_"Hello World"//C_NULL_CHAR, &
+                    len(c_char_"Hello World",kind=c_size_t))
+       print '(a)', str ! prints: "Hello WorldXXXXXXXXXXXXXXXXXXX"
+       end
+
+   The intrinsic procedures are described in *note Intrinsic
+Procedures::.
+
+
+File: gfortran.info,  Node: Working with Pointers,  Next: Further Interoperability of Fortran with C,  Prev: Interoperable Subroutines and Functions,  Up: Interoperability with C
+
+7.1.5 Working with Pointers
+---------------------------
+
+C pointers are represented in Fortran via the special opaque derived
+type `type(c_ptr)' (with private components).  Thus one needs to use
+intrinsic conversion procedures to convert from or to C pointers.  For
+example,
+
+       use iso_c_binding
+       type(c_ptr) :: cptr1, cptr2
+       integer, target :: array(7), scalar
+       integer, pointer :: pa(:), ps
+       cptr1 = c_loc(array(1)) ! The programmer needs to ensure that the
+                               ! array is contiguous if required by the C
+                               ! procedure
+       cptr2 = c_loc(scalar)
+       call c_f_pointer(cptr2, ps)
+       call c_f_pointer(cptr2, pa, shape=[7])
+
+   When converting C to Fortran arrays, the one-dimensional `SHAPE'
+argument has to be passed.
+
+   If a pointer is a dummy-argument of an interoperable procedure, it
+usually has to be declared using the `VALUE' attribute.  `void*'
+matches `TYPE(C_PTR), VALUE', while `TYPE(C_PTR)' alone matches
+`void**'.
+
+   Procedure pointers are handled analogously to pointers; the C type is
+`TYPE(C_FUNPTR)' and the intrinsic conversion procedures are
+`C_F_PROCPOINTER' and `C_FUNLOC'.
+
+   Let's consider two examples of actually passing a procedure pointer
+from C to Fortran and vice versa.  Note that these examples are also
+very similar to passing ordinary pointers between both languages.
+First, consider this code in C:
+
+     /* Procedure implemented in Fortran.  */
+     void get_values (void (*)(double));
+
+     /* Call-back routine we want called from Fortran.  */
+     void
+     print_it (double x)
+     {
+       printf ("Number is %f.\n", x);
+     }
+
+     /* Call Fortran routine and pass call-back to it.  */
+     void
+     foobar ()
+     {
+       get_values (&print_it);
+     }
+
+   A matching implementation for `get_values' in Fortran, that correctly
+receives the procedure pointer from C and is able to call it, is given
+in the following `MODULE':
+
+     MODULE m
+       IMPLICIT NONE
+
+       ! Define interface of call-back routine.
+       ABSTRACT INTERFACE
+         SUBROUTINE callback (x)
+           USE, INTRINSIC :: ISO_C_BINDING
+           REAL(KIND=C_DOUBLE), INTENT(IN), VALUE :: x
+         END SUBROUTINE callback
+       END INTERFACE
+
+     CONTAINS
+
+       ! Define C-bound procedure.
+       SUBROUTINE get_values (cproc) BIND(C)
+         USE, INTRINSIC :: ISO_C_BINDING
+         TYPE(C_FUNPTR), INTENT(IN), VALUE :: cproc
+
+         PROCEDURE(callback), POINTER :: proc
+
+         ! Convert C to Fortran procedure pointer.
+         CALL C_F_PROCPOINTER (cproc, proc)
+
+         ! Call it.
+         CALL proc (1.0_C_DOUBLE)
+         CALL proc (-42.0_C_DOUBLE)
+         CALL proc (18.12_C_DOUBLE)
+       END SUBROUTINE get_values
+
+     END MODULE m
+
+   Next, we want to call a C routine that expects a procedure pointer
+argument and pass it a Fortran procedure (which clearly must be
+interoperable!).  Again, the C function may be:
+
+     int
+     call_it (int (*func)(int), int arg)
+     {
+       return func (arg);
+     }
+
+   It can be used as in the following Fortran code:
+
+     MODULE m
+       USE, INTRINSIC :: ISO_C_BINDING
+       IMPLICIT NONE
+
+       ! Define interface of C function.
+       INTERFACE
+         INTEGER(KIND=C_INT) FUNCTION call_it (func, arg) BIND(C)
+           USE, INTRINSIC :: ISO_C_BINDING
+           TYPE(C_FUNPTR), INTENT(IN), VALUE :: func
+           INTEGER(KIND=C_INT), INTENT(IN), VALUE :: arg
+         END FUNCTION call_it
+       END INTERFACE
+
+     CONTAINS
+
+       ! Define procedure passed to C function.
+       ! It must be interoperable!
+       INTEGER(KIND=C_INT) FUNCTION double_it (arg) BIND(C)
+         INTEGER(KIND=C_INT), INTENT(IN), VALUE :: arg
+         double_it = arg + arg
+       END FUNCTION double_it
+
+       ! Call C function.
+       SUBROUTINE foobar ()
+         TYPE(C_FUNPTR) :: cproc
+         INTEGER(KIND=C_INT) :: i
+
+         ! Get C procedure pointer.
+         cproc = C_FUNLOC (double_it)
+
+         ! Use it.
+         DO i = 1_C_INT, 10_C_INT
+           PRINT *, call_it (cproc, i)
+         END DO
+       END SUBROUTINE foobar
+
+     END MODULE m
+
+
+File: gfortran.info,  Node: Further Interoperability of Fortran with C,  Prev: Working with Pointers,  Up: Interoperability with C
+
+7.1.6 Further Interoperability of Fortran with C
+------------------------------------------------
+
+Assumed-shape and allocatable arrays are passed using an array
+descriptor (dope vector).  The internal structure of the array
+descriptor used by GNU Fortran is not yet documented and will change.
+There will also be a Technical Report (TR 29113) which standardizes an
+interoperable array descriptor.  Until then, you can use the Chasm
+Language Interoperability Tools,
+`http://chasm-interop.sourceforge.net/', which provide an interface to
+GNU Fortran's array descriptor.
+
+   The technical report 29113 will presumably also include support for
+C-interoperable `OPTIONAL' and for assumed-rank and assumed-type dummy
+arguments.  However, the TR has neither been approved nor implemented
+in GNU Fortran; therefore, these features are not yet available.
+
+
+File: gfortran.info,  Node: GNU Fortran Compiler Directives,  Next: Non-Fortran Main Program,  Prev: Interoperability with C,  Up: Mixed-Language Programming
+
+7.2 GNU Fortran Compiler Directives
+===================================
+
+The Fortran standard standard describes how a conforming program shall
+behave; however, the exact implementation is not standardized.  In order
+to allow the user to choose specific implementation details, compiler
+directives can be used to set attributes of variables and procedures
+which are not part of the standard.  Whether a given attribute is
+supported and its exact effects depend on both the operating system and
+on the processor; see *note C Extensions: (gcc)Top.  for details.
+
+   For procedures and procedure pointers, the following attributes can
+be used to change the calling convention:
+
+   * `CDECL' - standard C calling convention
+
+   * `STDCALL' - convention where the called procedure pops the stack
+
+   * `FASTCALL' - part of the arguments are passed via registers
+     instead using the stack
+
+   Besides changing the calling convention, the attributes also
+influence the decoration of the symbol name, e.g., by a leading
+underscore or by a trailing at-sign followed by the number of bytes on
+the stack.  When assigning a procedure to a procedure pointer, both
+should use the same calling convention.
+
+   On some systems, procedures and global variables (module variables
+and `COMMON' blocks) need special handling to be accessible when they
+are in a shared library.  The following attributes are available:
+
+   * `DLLEXPORT' - provide a global pointer to a pointer in the DLL
+
+   * `DLLIMPORT' - reference the function or variable using a global
+     pointer
+
+   The attributes are specified using the syntax
+
+   `!GCC$ ATTRIBUTES' ATTRIBUTE-LIST `::' VARIABLE-LIST
+
+   where in free-form source code only whitespace is allowed before
+`!GCC$' and in fixed-form source code `!GCC$', `cGCC$' or `*GCC$' shall
+start in the first column.
+
+   For procedures, the compiler directives shall be placed into the body
+of the procedure; for variables and procedure pointers, they shall be in
+the same declaration part as the variable or procedure pointer.
+
+
+File: gfortran.info,  Node: Non-Fortran Main Program,  Prev: GNU Fortran Compiler Directives,  Up: Mixed-Language Programming
+
+7.3 Non-Fortran Main Program
+============================
+
+* Menu:
+
+* _gfortran_set_args:: Save command-line arguments
+* _gfortran_set_options:: Set library option flags
+* _gfortran_set_convert:: Set endian conversion
+* _gfortran_set_record_marker:: Set length of record markers
+* _gfortran_set_max_subrecord_length:: Set subrecord length
+* _gfortran_set_fpe:: Set when a Floating Point Exception should be raised
+
+   Even if you are doing mixed-language programming, it is very likely
+that you do not need to know or use the information in this section.
+Since it is about the internal structure of GNU Fortran, it may also
+change in GCC minor releases.
+
+   When you compile a `PROGRAM' with GNU Fortran, a function with the
+name `main' (in the symbol table of the object file) is generated,
+which initializes the libgfortran library and then calls the actual
+program which uses the name `MAIN__', for historic reasons.  If you
+link GNU Fortran compiled procedures to, e.g., a C or C++ program or to
+a Fortran program compiled by a different compiler, the libgfortran
+library is not initialized and thus a few intrinsic procedures do not
+work properly, e.g.  those for obtaining the command-line arguments.
+
+   Therefore, if your `PROGRAM' is not compiled with GNU Fortran and
+the GNU Fortran compiled procedures require intrinsics relying on the
+library initialization, you need to initialize the library yourself.
+Using the default options, gfortran calls `_gfortran_set_args' and
+`_gfortran_set_options'.  The initialization of the former is needed if
+the called procedures access the command line (and for backtracing);
+the latter sets some flags based on the standard chosen or to enable
+backtracing.  In typical programs, it is not necessary to call any
+initialization function.
+
+   If your `PROGRAM' is compiled with GNU Fortran, you shall not call
+any of the following functions.  The libgfortran initialization
+functions are shown in C syntax but using C bindings they are also
+accessible from Fortran.
+
+
+File: gfortran.info,  Node: _gfortran_set_args,  Next: _gfortran_set_options,  Up: Non-Fortran Main Program
+
+7.3.1 `_gfortran_set_args' -- Save command-line arguments
+---------------------------------------------------------
+
+_Description_:
+     `_gfortran_set_args' saves the command-line arguments; this
+     initialization is required if any of the command-line intrinsics
+     is called.  Additionally, it shall be called if backtracing is
+     enabled (see `_gfortran_set_options').
+
+_Syntax_:
+     `void _gfortran_set_args (int argc, char *argv[])'
+
+_Arguments_:
+     ARGC       number of command line argument strings
+     ARGV       the command-line argument strings; argv[0] is
+                the pathname of the executable itself.
+
+_Example_:
+          int main (int argc, char *argv[])
+          {
+            /* Initialize libgfortran.  */
+            _gfortran_set_args (argc, argv);
+            return 0;
+          }
+
+
+File: gfortran.info,  Node: _gfortran_set_options,  Next: _gfortran_set_convert,  Prev: _gfortran_set_args,  Up: Non-Fortran Main Program
+
+7.3.2 `_gfortran_set_options' -- Set library option flags
+---------------------------------------------------------
+
+_Description_:
+     `_gfortran_set_options' sets several flags related to the Fortran
+     standard to be used, whether backtracing or core dumps should be
+     enabled and whether range checks should be performed.  The syntax
+     allows for upward compatibility since the number of passed flags
+     is specified; for non-passed flags, the default value is used.
+     See also *note Code Gen Options::.  Please note that not all flags
+     are actually used.
+
+_Syntax_:
+     `void _gfortran_set_options (int num, int options[])'
+
+_Arguments_:
+     NUM        number of options passed
+     ARGV       The list of flag values
+
+_option flag list_:
+     OPTION[0]  Allowed standard; can give run-time errors if
+                e.g. an input-output edit descriptor is
+                invalid in a given standard.  Possible values
+                are (bitwise or-ed) `GFC_STD_F77' (1),
+                `GFC_STD_F95_OBS' (2), `GFC_STD_F95_DEL' (4),
+                `GFC_STD_F95' (8), `GFC_STD_F2003' (16),
+                `GFC_STD_GNU' (32), `GFC_STD_LEGACY' (64),
+                `GFC_STD_F2008' (128), and `GFC_STD_F2008_OBS'
+                (256).  Default: `GFC_STD_F95_OBS |
+                GFC_STD_F95_DEL | GFC_STD_F95 | GFC_STD_F2003
+                | GFC_STD_F2008 | GFC_STD_F2008_OBS |
+                GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY'.
+     OPTION[1]  Standard-warning flag; prints a warning to
+                standard error.  Default: `GFC_STD_F95_DEL |
+                GFC_STD_LEGACY'.
+     OPTION[2]  If non zero, enable pedantic checking.
+                Default: off.
+     OPTION[3]  If non zero, enable core dumps on run-time
+                errors.  Default: off.
+     OPTION[4]  If non zero, enable backtracing on run-time
+                errors.  Default: off.  Note: Installs a
+                signal handler and requires command-line
+                initialization using `_gfortran_set_args'.
+     OPTION[5]  If non zero, supports signed zeros.  Default:
+                enabled.
+     OPTION[6]  Enables run-time checking.  Possible values
+                are (bitwise or-ed): GFC_RTCHECK_BOUNDS (1),
+                GFC_RTCHECK_ARRAY_TEMPS (2),
+                GFC_RTCHECK_RECURSION (4), GFC_RTCHECK_DO
+                (16), GFC_RTCHECK_POINTER (32).  Default:
+                disabled.
+     OPTION[7]  If non zero, range checking is enabled.
+                Default: enabled.  See -frange-check (*note
+                Code Gen Options::).
+
+_Example_:
+            /* Use gfortran 4.5 default options.  */
+            static int options[] = {68, 255, 0, 0, 0, 1, 0, 1};
+            _gfortran_set_options (8, &options);
+
+
+File: gfortran.info,  Node: _gfortran_set_convert,  Next: _gfortran_set_record_marker,  Prev: _gfortran_set_options,  Up: Non-Fortran Main Program
+
+7.3.3 `_gfortran_set_convert' -- Set endian conversion
+------------------------------------------------------
+
+_Description_:
+     `_gfortran_set_convert' set the representation of data for
+     unformatted files.
+
+_Syntax_:
+     `void _gfortran_set_convert (int conv)'
+
+_Arguments_:
+     CONV       Endian conversion, possible values:
+                GFC_CONVERT_NATIVE (0, default),
+                GFC_CONVERT_SWAP (1), GFC_CONVERT_BIG (2),
+                GFC_CONVERT_LITTLE (3).
+
+_Example_:
+          int main (int argc, char *argv[])
+          {
+            /* Initialize libgfortran.  */
+            _gfortran_set_args (argc, argv);
+            _gfortran_set_convert (1);
+            return 0;
+          }
+
+
+File: gfortran.info,  Node: _gfortran_set_record_marker,  Next: _gfortran_set_max_subrecord_length,  Prev: _gfortran_set_convert,  Up: Non-Fortran Main Program
+
+7.3.4 `_gfortran_set_record_marker' -- Set length of record markers
+-------------------------------------------------------------------
+
+_Description_:
+     `_gfortran_set_record_marker' sets the length of record markers
+     for unformatted files.
+
+_Syntax_:
+     `void _gfortran_set_record_marker (int val)'
+
+_Arguments_:
+     VAL        Length of the record marker; valid values are
+                4 and 8.  Default is 4.
+
+_Example_:
+          int main (int argc, char *argv[])
+          {
+            /* Initialize libgfortran.  */
+            _gfortran_set_args (argc, argv);
+            _gfortran_set_record_marker (8);
+            return 0;
+          }
+
+
+File: gfortran.info,  Node: _gfortran_set_fpe,  Prev: _gfortran_set_max_subrecord_length,  Up: Non-Fortran Main Program
+
+7.3.5 `_gfortran_set_fpe' -- Set when a Floating Point Exception should be raised
+---------------------------------------------------------------------------------
+
+_Description_:
+     `_gfortran_set_fpe' sets the IEEE exceptions for which a Floating
+     Point Exception (FPE) should be raised.  On most systems, this
+     will result in a SIGFPE signal being sent and the program being
+     interrupted.
+
+_Syntax_:
+     `void _gfortran_set_fpe (int val)'
+
+_Arguments_:
+     OPTION[0]  IEEE exceptions.  Possible values are (bitwise
+                or-ed) zero (0, default) no trapping,
+                `GFC_FPE_INVALID' (1), `GFC_FPE_DENORMAL' (2),
+                `GFC_FPE_ZERO' (4), `GFC_FPE_OVERFLOW' (8),
+                `GFC_FPE_UNDERFLOW' (16), and
+                `GFC_FPE_PRECISION' (32).
+
+_Example_:
+          int main (int argc, char *argv[])
+          {
+            /* Initialize libgfortran.  */
+            _gfortran_set_args (argc, argv);
+            /* FPE for invalid operations such as SQRT(-1.0).  */
+            _gfortran_set_fpe (1);
+            return 0;
+          }
+
+
+File: gfortran.info,  Node: _gfortran_set_max_subrecord_length,  Next: _gfortran_set_fpe,  Prev: _gfortran_set_record_marker,  Up: Non-Fortran Main Program
+
+7.3.6 `_gfortran_set_max_subrecord_length' -- Set subrecord length
+------------------------------------------------------------------
+
+_Description_:
+     `_gfortran_set_max_subrecord_length' set the maximum length for a
+     subrecord.  This option only makes sense for testing and debugging
+     of unformatted I/O.
+
+_Syntax_:
+     `void _gfortran_set_max_subrecord_length (int val)'
+
+_Arguments_:
+     VAL        the maximum length for a subrecord; the
+                maximum permitted value is 2147483639, which
+                is also the default.
+
+_Example_:
+          int main (int argc, char *argv[])
+          {
+            /* Initialize libgfortran.  */
+            _gfortran_set_args (argc, argv);
+            _gfortran_set_max_subrecord_length (8);
+            return 0;
+          }
+
+
+File: gfortran.info,  Node: Intrinsic Procedures,  Next: Intrinsic Modules,  Prev: Extensions,  Up: Top
+
+8 Intrinsic Procedures
+**********************
+
+* Menu:
+
+* Introduction:         Introduction to Intrinsics
+* `ABORT':         ABORT,     Abort the program
+* `ABS':           ABS,       Absolute value
+* `ACCESS':        ACCESS,    Checks file access modes
+* `ACHAR':         ACHAR,     Character in ASCII collating sequence
+* `ACOS':          ACOS,      Arccosine function
+* `ACOSH':         ACOSH,     Inverse hyperbolic cosine function
+* `ADJUSTL':       ADJUSTL,   Left adjust a string
+* `ADJUSTR':       ADJUSTR,   Right adjust a string
+* `AIMAG':         AIMAG,     Imaginary part of complex number
+* `AINT':          AINT,      Truncate to a whole number
+* `ALARM':         ALARM,     Set an alarm clock
+* `ALL':           ALL,       Determine if all values are true
+* `ALLOCATED':     ALLOCATED, Status of allocatable entity
+* `AND':           AND,       Bitwise logical AND
+* `ANINT':         ANINT,     Nearest whole number
+* `ANY':           ANY,       Determine if any values are true
+* `ASIN':          ASIN,      Arcsine function
+* `ASINH':         ASINH,     Inverse hyperbolic sine function
+* `ASSOCIATED':    ASSOCIATED, Status of a pointer or pointer/target pair
+* `ATAN':          ATAN,      Arctangent function
+* `ATAN2':         ATAN2,     Arctangent function
+* `ATANH':         ATANH,     Inverse hyperbolic tangent function
+* `BESSEL_J0':     BESSEL_J0, Bessel function of the first kind of order 0
+* `BESSEL_J1':     BESSEL_J1, Bessel function of the first kind of order 1
+* `BESSEL_JN':     BESSEL_JN, Bessel function of the first kind
+* `BESSEL_Y0':     BESSEL_Y0, Bessel function of the second kind of order 0
+* `BESSEL_Y1':     BESSEL_Y1, Bessel function of the second kind of order 1
+* `BESSEL_YN':     BESSEL_YN, Bessel function of the second kind
+* `BGE':           BGE,       Bitwise greater than or equal to
+* `BGT':           BGT,       Bitwise greater than
+* `BIT_SIZE':      BIT_SIZE,  Bit size inquiry function
+* `BLE':           BLE,       Bitwise less than or equal to
+* `BLT':           BLT,       Bitwise less than
+* `BTEST':         BTEST,     Bit test function
+* `C_ASSOCIATED':  C_ASSOCIATED, Status of a C pointer
+* `C_F_POINTER':   C_F_POINTER, Convert C into Fortran pointer
+* `C_F_PROCPOINTER': C_F_PROCPOINTER, Convert C into Fortran procedure pointer
+* `C_FUNLOC':      C_FUNLOC,  Obtain the C address of a procedure
+* `C_LOC':         C_LOC,     Obtain the C address of an object
+* `C_SIZEOF':      C_SIZEOF,  Size in bytes of an expression
+* `CEILING':       CEILING,   Integer ceiling function
+* `CHAR':          CHAR,      Integer-to-character conversion function
+* `CHDIR':         CHDIR,     Change working directory
+* `CHMOD':         CHMOD,     Change access permissions of files
+* `CMPLX':         CMPLX,     Complex conversion function
+* `COMMAND_ARGUMENT_COUNT': COMMAND_ARGUMENT_COUNT, Get number of command line arguments
+* `COMPLEX':       COMPLEX,   Complex conversion function
+* `COMPILER_VERSION': COMPILER_VERSION, Compiler version string
+* `COMPILER_OPTIONS': COMPILER_OPTIONS, Options passed to the compiler
+* `CONJG':         CONJG,     Complex conjugate function
+* `COS':           COS,       Cosine function
+* `COSH':          COSH,      Hyperbolic cosine function
+* `COUNT':         COUNT,     Count occurrences of TRUE in an array
+* `CPU_TIME':      CPU_TIME,  CPU time subroutine
+* `CSHIFT':        CSHIFT,    Circular shift elements of an array
+* `CTIME':         CTIME,     Subroutine (or function) to convert a time into a string
+* `DATE_AND_TIME': DATE_AND_TIME, Date and time subroutine
+* `DBLE':          DBLE,      Double precision conversion function
+* `DCMPLX':        DCMPLX,    Double complex conversion function
+* `DIGITS':        DIGITS,    Significant digits function
+* `DIM':           DIM,       Positive difference
+* `DOT_PRODUCT':   DOT_PRODUCT, Dot product function
+* `DPROD':         DPROD,     Double product function
+* `DREAL':         DREAL,     Double real part function
+* `DSHIFTL':       DSHIFTL,   Combined left shift
+* `DSHIFTR':       DSHIFTR,   Combined right shift
+* `DTIME':         DTIME,     Execution time subroutine (or function)
+* `EOSHIFT':       EOSHIFT,   End-off shift elements of an array
+* `EPSILON':       EPSILON,   Epsilon function
+* `ERF':           ERF,       Error function
+* `ERFC':          ERFC,      Complementary error function
+* `ERFC_SCALED':   ERFC_SCALED, Exponentially-scaled complementary error function
+* `ETIME':         ETIME,     Execution time subroutine (or function)
+* `EXECUTE_COMMAND_LINE': EXECUTE_COMMAND_LINE, Execute a shell command
+* `EXIT':          EXIT,      Exit the program with status.
+* `EXP':           EXP,       Exponential function
+* `EXPONENT':      EXPONENT,  Exponent function
+* `EXTENDS_TYPE_OF': EXTENDS_TYPE_OF,  Query dynamic type for extension
+* `FDATE':         FDATE,     Subroutine (or function) to get the current time as a string
+* `FGET':          FGET,      Read a single character in stream mode from stdin
+* `FGETC':         FGETC,     Read a single character in stream mode
+* `FLOOR':         FLOOR,     Integer floor function
+* `FLUSH':         FLUSH,     Flush I/O unit(s)
+* `FNUM':          FNUM,      File number function
+* `FPUT':          FPUT,      Write a single character in stream mode to stdout
+* `FPUTC':         FPUTC,     Write a single character in stream mode
+* `FRACTION':      FRACTION,  Fractional part of the model representation
+* `FREE':          FREE,      Memory de-allocation subroutine
+* `FSEEK':         FSEEK,     Low level file positioning subroutine
+* `FSTAT':         FSTAT,     Get file status
+* `FTELL':         FTELL,     Current stream position
+* `GAMMA':         GAMMA,     Gamma function
+* `GERROR':        GERROR,    Get last system error message
+* `GETARG':        GETARG,    Get command line arguments
+* `GET_COMMAND':   GET_COMMAND, Get the entire command line
+* `GET_COMMAND_ARGUMENT': GET_COMMAND_ARGUMENT, Get command line arguments
+* `GETCWD':        GETCWD,    Get current working directory
+* `GETENV':        GETENV,    Get an environmental variable
+* `GET_ENVIRONMENT_VARIABLE': GET_ENVIRONMENT_VARIABLE, Get an environmental variable
+* `GETGID':        GETGID,    Group ID function
+* `GETLOG':        GETLOG,    Get login name
+* `GETPID':        GETPID,    Process ID function
+* `GETUID':        GETUID,    User ID function
+* `GMTIME':        GMTIME,    Convert time to GMT info
+* `HOSTNM':        HOSTNM,    Get system host name
+* `HUGE':          HUGE,      Largest number of a kind
+* `HYPOT':         HYPOT,     Euclidean distance function
+* `IACHAR':        IACHAR,    Code in ASCII collating sequence
+* `IALL':          IALL,      Bitwise AND of array elements
+* `IAND':          IAND,      Bitwise logical and
+* `IANY':          IANY,      Bitwise OR of array elements
+* `IARGC':         IARGC,     Get the number of command line arguments
+* `IBCLR':         IBCLR,     Clear bit
+* `IBITS':         IBITS,     Bit extraction
+* `IBSET':         IBSET,     Set bit
+* `ICHAR':         ICHAR,     Character-to-integer conversion function
+* `IDATE':         IDATE,     Current local time (day/month/year)
+* `IEOR':          IEOR,      Bitwise logical exclusive or
+* `IERRNO':        IERRNO,    Function to get the last system error number
+* `IMAGE_INDEX':   IMAGE_INDEX, Cosubscript to image index conversion
+* `INDEX':         INDEX intrinsic, Position of a substring within a string
+* `INT':           INT,       Convert to integer type
+* `INT2':          INT2,      Convert to 16-bit integer type
+* `INT8':          INT8,      Convert to 64-bit integer type
+* `IOR':           IOR,       Bitwise logical or
+* `IPARITY':       IPARITY,   Bitwise XOR of array elements
+* `IRAND':         IRAND,     Integer pseudo-random number
+* `IS_IOSTAT_END':  IS_IOSTAT_END, Test for end-of-file value
+* `IS_IOSTAT_EOR':  IS_IOSTAT_EOR, Test for end-of-record value
+* `ISATTY':        ISATTY,    Whether a unit is a terminal device
+* `ISHFT':         ISHFT,     Shift bits
+* `ISHFTC':        ISHFTC,    Shift bits circularly
+* `ISNAN':         ISNAN,     Tests for a NaN
+* `ITIME':         ITIME,     Current local time (hour/minutes/seconds)
+* `KILL':          KILL,      Send a signal to a process
+* `KIND':          KIND,      Kind of an entity
+* `LBOUND':        LBOUND,    Lower dimension bounds of an array
+* `LCOBOUND':      LCOBOUND,  Lower codimension bounds of an array
+* `LEADZ':         LEADZ,     Number of leading zero bits of an integer
+* `LEN':           LEN,       Length of a character entity
+* `LEN_TRIM':      LEN_TRIM,  Length of a character entity without trailing blank characters
+* `LGE':           LGE,       Lexical greater than or equal
+* `LGT':           LGT,       Lexical greater than
+* `LINK':          LINK,      Create a hard link
+* `LLE':           LLE,       Lexical less than or equal
+* `LLT':           LLT,       Lexical less than
+* `LNBLNK':        LNBLNK,    Index of the last non-blank character in a string
+* `LOC':           LOC,       Returns the address of a variable
+* `LOG':           LOG,       Logarithm function
+* `LOG10':         LOG10,     Base 10 logarithm function
+* `LOG_GAMMA':     LOG_GAMMA, Logarithm of the Gamma function
+* `LOGICAL':       LOGICAL,   Convert to logical type
+* `LONG':          LONG,      Convert to integer type
+* `LSHIFT':        LSHIFT,    Left shift bits
+* `LSTAT':         LSTAT,     Get file status
+* `LTIME':         LTIME,     Convert time to local time info
+* `MALLOC':        MALLOC,    Dynamic memory allocation function
+* `MASKL':         MASKL,     Left justified mask
+* `MASKR':         MASKR,     Right justified mask
+* `MATMUL':        MATMUL,    matrix multiplication
+* `MAX':           MAX,       Maximum value of an argument list
+* `MAXEXPONENT':   MAXEXPONENT, Maximum exponent of a real kind
+* `MAXLOC':        MAXLOC,    Location of the maximum value within an array
+* `MAXVAL':        MAXVAL,    Maximum value of an array
+* `MCLOCK':        MCLOCK,    Time function
+* `MCLOCK8':       MCLOCK8,   Time function (64-bit)
+* `MERGE':         MERGE,     Merge arrays
+* `MERGE_BITS':    MERGE_BITS, Merge of bits under mask
+* `MIN':           MIN,       Minimum value of an argument list
+* `MINEXPONENT':   MINEXPONENT, Minimum exponent of a real kind
+* `MINLOC':        MINLOC,    Location of the minimum value within an array
+* `MINVAL':        MINVAL,    Minimum value of an array
+* `MOD':           MOD,       Remainder function
+* `MODULO':        MODULO,    Modulo function
+* `MOVE_ALLOC':    MOVE_ALLOC, Move allocation from one object to another
+* `MVBITS':        MVBITS,    Move bits from one integer to another
+* `NEAREST':       NEAREST,   Nearest representable number
+* `NEW_LINE':      NEW_LINE,  New line character
+* `NINT':          NINT,      Nearest whole number
+* `NORM2':         NORM2,     Euclidean vector norm
+* `NOT':           NOT,       Logical negation
+* `NULL':          NULL,      Function that returns an disassociated pointer
+* `NUM_IMAGES':    NUM_IMAGES, Number of images
+* `OR':            OR,        Bitwise logical OR
+* `PACK':          PACK,      Pack an array into an array of rank one
+* `PARITY':        PARITY,    Reduction with exclusive OR
+* `PERROR':        PERROR,    Print system error message
+* `POPCNT':        POPCNT,    Number of bits set
+* `POPPAR':        POPPAR,    Parity of the number of bits set
+* `PRECISION':     PRECISION, Decimal precision of a real kind
+* `PRESENT':       PRESENT,   Determine whether an optional dummy argument is specified
+* `PRODUCT':       PRODUCT,   Product of array elements
+* `RADIX':         RADIX,     Base of a data model
+* `RANDOM_NUMBER': RANDOM_NUMBER, Pseudo-random number
+* `RANDOM_SEED':   RANDOM_SEED, Initialize a pseudo-random number sequence
+* `RAND':          RAND,      Real pseudo-random number
+* `RANGE':         RANGE,     Decimal exponent range
+* `RAN':           RAN,       Real pseudo-random number
+* `REAL':          REAL,      Convert to real type
+* `RENAME':        RENAME,    Rename a file
+* `REPEAT':        REPEAT,    Repeated string concatenation
+* `RESHAPE':       RESHAPE,   Function to reshape an array
+* `RRSPACING':     RRSPACING, Reciprocal of the relative spacing
+* `RSHIFT':        RSHIFT,    Right shift bits
+* `SAME_TYPE_AS':  SAME_TYPE_AS,  Query dynamic types for equality
+* `SCALE':         SCALE,     Scale a real value
+* `SCAN':          SCAN,      Scan a string for the presence of a set of characters
+* `SECNDS':        SECNDS,    Time function
+* `SECOND':        SECOND,    CPU time function
+* `SELECTED_CHAR_KIND': SELECTED_CHAR_KIND,  Choose character kind
+* `SELECTED_INT_KIND': SELECTED_INT_KIND,  Choose integer kind
+* `SELECTED_REAL_KIND': SELECTED_REAL_KIND,  Choose real kind
+* `SET_EXPONENT':  SET_EXPONENT, Set the exponent of the model
+* `SHAPE':         SHAPE,     Determine the shape of an array
+* `SHIFTA':        SHIFTA,    Right shift with fill
+* `SHIFTL':        SHIFTL,    Left shift
+* `SHIFTR':        SHIFTR,    Right shift
+* `SIGN':          SIGN,      Sign copying function
+* `SIGNAL':        SIGNAL,    Signal handling subroutine (or function)
+* `SIN':           SIN,       Sine function
+* `SINH':          SINH,      Hyperbolic sine function
+* `SIZE':          SIZE,      Function to determine the size of an array
+* `SIZEOF':        SIZEOF,    Determine the size in bytes of an expression
+* `SLEEP':         SLEEP,     Sleep for the specified number of seconds
+* `SPACING':       SPACING,   Smallest distance between two numbers of a given type
+* `SPREAD':        SPREAD,    Add a dimension to an array
+* `SQRT':          SQRT,      Square-root function
+* `SRAND':         SRAND,     Reinitialize the random number generator
+* `STAT':          STAT,      Get file status
+* `STORAGE_SIZE':  STORAGE_SIZE, Storage size in bits
+* `SUM':           SUM,       Sum of array elements
+* `SYMLNK':        SYMLNK,    Create a symbolic link
+* `SYSTEM':        SYSTEM,    Execute a shell command
+* `SYSTEM_CLOCK':  SYSTEM_CLOCK, Time function
+* `TAN':           TAN,       Tangent function
+* `TANH':          TANH,      Hyperbolic tangent function
+* `THIS_IMAGE':    THIS_IMAGE, Cosubscript index of this image
+* `TIME':          TIME,      Time function
+* `TIME8':         TIME8,     Time function (64-bit)
+* `TINY':          TINY,      Smallest positive number of a real kind
+* `TRAILZ':        TRAILZ,    Number of trailing zero bits of an integer
+* `TRANSFER':      TRANSFER,  Transfer bit patterns
+* `TRANSPOSE':     TRANSPOSE, Transpose an array of rank two
+* `TRIM':          TRIM,      Remove trailing blank characters of a string
+* `TTYNAM':        TTYNAM,    Get the name of a terminal device.
+* `UBOUND':        UBOUND,    Upper dimension bounds of an array
+* `UCOBOUND':      UCOBOUND,  Upper codimension bounds of an array
+* `UMASK':         UMASK,     Set the file creation mask
+* `UNLINK':        UNLINK,    Remove a file from the file system
+* `UNPACK':        UNPACK,    Unpack an array of rank one into an array
+* `VERIFY':        VERIFY,    Scan a string for the absence of a set of characters
+* `XOR':           XOR,       Bitwise logical exclusive or
+
+
+File: gfortran.info,  Node: Introduction to Intrinsics,  Next: ABORT,  Up: Intrinsic Procedures
+
+8.1 Introduction to intrinsic procedures
+========================================
+
+The intrinsic procedures provided by GNU Fortran include all of the
+intrinsic procedures required by the Fortran 95 standard, a set of
+intrinsic procedures for backwards compatibility with G77, and a
+selection of intrinsic procedures from the Fortran 2003 and Fortran 2008
+standards.  Any conflict between a description here and a description in
+either the Fortran 95 standard, the Fortran 2003 standard or the Fortran
+2008 standard is unintentional, and the standard(s) should be considered
+authoritative.
+
+   The enumeration of the `KIND' type parameter is processor defined in
+the Fortran 95 standard.  GNU Fortran defines the default integer type
+and default real type by `INTEGER(KIND=4)' and `REAL(KIND=4)',
+respectively.  The standard mandates that both data types shall have
+another kind, which have more precision.  On typical target
+architectures supported by `gfortran', this kind type parameter is
+`KIND=8'.  Hence, `REAL(KIND=8)' and `DOUBLE PRECISION' are equivalent.
+In the description of generic intrinsic procedures, the kind type
+parameter will be specified by `KIND=*', and in the description of
+specific names for an intrinsic procedure the kind type parameter will
+be explicitly given (e.g., `REAL(KIND=4)' or `REAL(KIND=8)').  Finally,
+for brevity the optional `KIND=' syntax will be omitted.
+
+   Many of the intrinsic procedures take one or more optional arguments.
+This document follows the convention used in the Fortran 95 standard,
+and denotes such arguments by square brackets.
+
+   GNU Fortran offers the `-std=f95' and `-std=gnu' options, which can
+be used to restrict the set of intrinsic procedures to a given
+standard.  By default, `gfortran' sets the `-std=gnu' option, and so
+all intrinsic procedures described here are accepted.  There is one
+caveat.  For a select group of intrinsic procedures, `g77' implemented
+both a function and a subroutine.  Both classes have been implemented
+in `gfortran' for backwards compatibility with `g77'.  It is noted here
+that these functions and subroutines cannot be intermixed in a given
+subprogram.  In the descriptions that follow, the applicable standard
+for each intrinsic procedure is noted.
+
+
+File: gfortran.info,  Node: ABORT,  Next: ABS,  Prev: Introduction to Intrinsics,  Up: Intrinsic Procedures
+
+8.2 `ABORT' -- Abort the program
+================================
+
+_Description_:
+     `ABORT' causes immediate termination of the program.  On operating
+     systems that support a core dump, `ABORT' will produce a core dump
+     even if the option `-fno-dump-core' is in effect, which is
+     suitable for debugging purposes.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL ABORT'
+
+_Return value_:
+     Does not return.
+
+_Example_:
+          program test_abort
+            integer :: i = 1, j = 2
+            if (i /= j) call abort
+          end program test_abort
+
+_See also_:
+     *note EXIT::, *note KILL::
+
+
+
+File: gfortran.info,  Node: ABS,  Next: ACCESS,  Prev: ABORT,  Up: Intrinsic Procedures
+
+8.3 `ABS' -- Absolute value
+===========================
+
+_Description_:
+     `ABS(A)' computes the absolute value of `A'.
+
+_Standard_:
+     Fortran 77 and later, has overloads that are GNU extensions
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ABS(A)'
+
+_Arguments_:
+     A          The type of the argument shall be an `INTEGER',
+                `REAL', or `COMPLEX'.
+
+_Return value_:
+     The return value is of the same type and kind as the argument
+     except the return value is `REAL' for a `COMPLEX' argument.
+
+_Example_:
+          program test_abs
+            integer :: i = -1
+            real :: x = -1.e0
+            complex :: z = (-1.e0,0.e0)
+            i = abs(i)
+            x = abs(x)
+            x = abs(z)
+          end program test_abs
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `ABS(A)'      `REAL(4) A'   `REAL(4)'     Fortran 77 and
+                                               later
+     `CABS(A)'     `COMPLEX(4)   `REAL(4)'     Fortran 77 and
+                   A'                          later
+     `DABS(A)'     `REAL(8) A'   `REAL(8)'     Fortran 77 and
+                                               later
+     `IABS(A)'     `INTEGER(4)   `INTEGER(4)'  Fortran 77 and
+                   A'                          later
+     `ZABS(A)'     `COMPLEX(8)   `COMPLEX(8)'  GNU extension
+                   A'                          
+     `CDABS(A)'    `COMPLEX(8)   `COMPLEX(8)'  GNU extension
+                   A'                          
+
+
+File: gfortran.info,  Node: ACCESS,  Next: ACHAR,  Prev: ABS,  Up: Intrinsic Procedures
+
+8.4 `ACCESS' -- Checks file access modes
+========================================
+
+_Description_:
+     `ACCESS(NAME, MODE)' checks whether the file NAME exists, is
+     readable, writable or executable. Except for the executable check,
+     `ACCESS' can be replaced by Fortran 95's `INQUIRE'.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = ACCESS(NAME, MODE)'
+
+_Arguments_:
+     NAME       Scalar `CHARACTER' of default kind with the
+                file name. Tailing blank are ignored unless
+                the character `achar(0)' is present, then all
+                characters up to and excluding `achar(0)' are
+                used as file name.
+     MODE       Scalar `CHARACTER' of default kind with the
+                file access mode, may be any concatenation of
+                `"r"' (readable), `"w"' (writable) and `"x"'
+                (executable), or `" "' to check for existence.
+
+_Return value_:
+     Returns a scalar `INTEGER', which is `0' if the file is accessible
+     in the given mode; otherwise or if an invalid argument has been
+     given for `MODE' the value `1' is returned.
+
+_Example_:
+          program access_test
+            implicit none
+            character(len=*), parameter :: file  = 'test.dat'
+            character(len=*), parameter :: file2 = 'test.dat  '//achar(0)
+            if(access(file,' ') == 0) print *, trim(file),' is exists'
+            if(access(file,'r') == 0) print *, trim(file),' is readable'
+            if(access(file,'w') == 0) print *, trim(file),' is writable'
+            if(access(file,'x') == 0) print *, trim(file),' is executable'
+            if(access(file2,'rwx') == 0) &
+              print *, trim(file2),' is readable, writable and executable'
+          end program access_test
+
+_Specific names_:
+
+_See also_:
+
+
+File: gfortran.info,  Node: ACHAR,  Next: ACOS,  Prev: ACCESS,  Up: Intrinsic Procedures
+
+8.5 `ACHAR' -- Character in ASCII collating sequence
+====================================================
+
+_Description_:
+     `ACHAR(I)' returns the character located at position `I' in the
+     ASCII collating sequence.
+
+_Standard_:
+     Fortran 77 and later, with KIND argument Fortran 2003 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ACHAR(I [, KIND])'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `CHARACTER' with a length of one.  If
+     the KIND argument is present, the return value is of the specified
+     kind and of the default kind otherwise.
+
+_Example_:
+          program test_achar
+            character c
+            c = achar(32)
+          end program test_achar
+
+_Note_:
+     See *note ICHAR:: for a discussion of converting between numerical
+     values and formatted string representations.
+
+_See also_:
+     *note CHAR::, *note IACHAR::, *note ICHAR::
+
+
+
+File: gfortran.info,  Node: ACOS,  Next: ACOSH,  Prev: ACHAR,  Up: Intrinsic Procedures
+
+8.6 `ACOS' -- Arccosine function
+================================
+
+_Description_:
+     `ACOS(X)' computes the arccosine of X (inverse of `COS(X)').
+
+_Standard_:
+     Fortran 77 and later, for a complex argument Fortran 2008 or later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ACOS(X)'
+
+_Arguments_:
+     X          The type shall either be `REAL' with a
+                magnitude that is less than or equal to one -
+                or the type shall be `COMPLEX'.
+
+_Return value_:
+     The return value is of the same type and kind as X.  The real part
+     of the result is in radians and lies in the range 0 \leq \Re
+     \acos(x) \leq \pi.
+
+_Example_:
+          program test_acos
+            real(8) :: x = 0.866_8
+            x = acos(x)
+          end program test_acos
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `ACOS(X)'     `REAL(4) X'   `REAL(4)'     Fortran 77 and
+                                               later
+     `DACOS(X)'    `REAL(8) X'   `REAL(8)'     Fortran 77 and
+                                               later
+
+_See also_:
+     Inverse function: *note COS::
+
+
+
+File: gfortran.info,  Node: ACOSH,  Next: ADJUSTL,  Prev: ACOS,  Up: Intrinsic Procedures
+
+8.7 `ACOSH' -- Inverse hyperbolic cosine function
+=================================================
+
+_Description_:
+     `ACOSH(X)' computes the inverse hyperbolic cosine of X.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ACOSH(X)'
+
+_Arguments_:
+     X          The type shall be `REAL' or `COMPLEX'.
+
+_Return value_:
+     The return value has the same type and kind as X. If X is complex,
+     the imaginary part of the result is in radians and lies between  0
+     \leq \Im \acosh(x) \leq \pi.
+
+_Example_:
+          PROGRAM test_acosh
+            REAL(8), DIMENSION(3) :: x = (/ 1.0, 2.0, 3.0 /)
+            WRITE (*,*) ACOSH(x)
+          END PROGRAM
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `DACOSH(X)'   `REAL(8) X'   `REAL(8)'     GNU extension
+
+_See also_:
+     Inverse function: *note COSH::
+
+
+File: gfortran.info,  Node: ADJUSTL,  Next: ADJUSTR,  Prev: ACOSH,  Up: Intrinsic Procedures
+
+8.8 `ADJUSTL' -- Left adjust a string
+=====================================
+
+_Description_:
+     `ADJUSTL(STRING)' will left adjust a string by removing leading
+     spaces.  Spaces are inserted at the end of the string as needed.
+
+_Standard_:
+     Fortran 90 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ADJUSTL(STRING)'
+
+_Arguments_:
+     STRING     The type shall be `CHARACTER'.
+
+_Return value_:
+     The return value is of type `CHARACTER' and of the same kind as
+     STRING where leading spaces are removed and the same number of
+     spaces are inserted on the end of STRING.
+
+_Example_:
+          program test_adjustl
+            character(len=20) :: str = '   gfortran'
+            str = adjustl(str)
+            print *, str
+          end program test_adjustl
+
+_See also_:
+     *note ADJUSTR::, *note TRIM::
+
+
+File: gfortran.info,  Node: ADJUSTR,  Next: AIMAG,  Prev: ADJUSTL,  Up: Intrinsic Procedures
+
+8.9 `ADJUSTR' -- Right adjust a string
+======================================
+
+_Description_:
+     `ADJUSTR(STRING)' will right adjust a string by removing trailing
+     spaces.  Spaces are inserted at the start of the string as needed.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ADJUSTR(STRING)'
+
+_Arguments_:
+     STR        The type shall be `CHARACTER'.
+
+_Return value_:
+     The return value is of type `CHARACTER' and of the same kind as
+     STRING where trailing spaces are removed and the same number of
+     spaces are inserted at the start of STRING.
+
+_Example_:
+          program test_adjustr
+            character(len=20) :: str = 'gfortran'
+            str = adjustr(str)
+            print *, str
+          end program test_adjustr
+
+_See also_:
+     *note ADJUSTL::, *note TRIM::
+
+
+File: gfortran.info,  Node: AIMAG,  Next: AINT,  Prev: ADJUSTR,  Up: Intrinsic Procedures
+
+8.10 `AIMAG' -- Imaginary part of complex number
+================================================
+
+_Description_:
+     `AIMAG(Z)' yields the imaginary part of complex argument `Z'.  The
+     `IMAG(Z)' and `IMAGPART(Z)' intrinsic functions are provided for
+     compatibility with `g77', and their use in new code is strongly
+     discouraged.
+
+_Standard_:
+     Fortran 77 and later, has overloads that are GNU extensions
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = AIMAG(Z)'
+
+_Arguments_:
+     Z          The type of the argument shall be `COMPLEX'.
+
+_Return value_:
+     The return value is of type `REAL' with the kind type parameter of
+     the argument.
+
+_Example_:
+          program test_aimag
+            complex(4) z4
+            complex(8) z8
+            z4 = cmplx(1.e0_4, 0.e0_4)
+            z8 = cmplx(0.e0_8, 1.e0_8)
+            print *, aimag(z4), dimag(z8)
+          end program test_aimag
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `AIMAG(Z)'    `COMPLEX Z'   `REAL'        GNU extension
+     `DIMAG(Z)'    `COMPLEX(8)   `REAL(8)'     GNU extension
+                   Z'                          
+     `IMAG(Z)'     `COMPLEX Z'   `REAL'        GNU extension
+     `IMAGPART(Z)' `COMPLEX Z'   `REAL'        GNU extension
+
+
+File: gfortran.info,  Node: AINT,  Next: ALARM,  Prev: AIMAG,  Up: Intrinsic Procedures
+
+8.11 `AINT' -- Truncate to a whole number
+=========================================
+
+_Description_:
+     `AINT(A [, KIND])' truncates its argument to a whole number.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = AINT(A [, KIND])'
+
+_Arguments_:
+     A          The type of the argument shall be `REAL'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `REAL' with the kind type parameter of
+     the argument if the optional KIND is absent; otherwise, the kind
+     type parameter will be given by KIND.  If the magnitude of X is
+     less than one, `AINT(X)' returns zero.  If the magnitude is equal
+     to or greater than one then it returns the largest whole number
+     that does not exceed its magnitude.  The sign is the same as the
+     sign of X.
+
+_Example_:
+          program test_aint
+            real(4) x4
+            real(8) x8
+            x4 = 1.234E0_4
+            x8 = 4.321_8
+            print *, aint(x4), dint(x8)
+            x8 = aint(x4,8)
+          end program test_aint
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `AINT(A)'     `REAL(4) A'   `REAL(4)'     Fortran 77 and
+                                               later
+     `DINT(A)'     `REAL(8) A'   `REAL(8)'     Fortran 77 and
+                                               later
+
+
+File: gfortran.info,  Node: ALARM,  Next: ALL,  Prev: AINT,  Up: Intrinsic Procedures
+
+8.12 `ALARM' -- Execute a routine after a given delay
+=====================================================
+
+_Description_:
+     `ALARM(SECONDS, HANDLER [, STATUS])' causes external subroutine
+     HANDLER to be executed after a delay of SECONDS by using
+     `alarm(2)' to set up a signal and `signal(2)' to catch it. If
+     STATUS is supplied, it will be returned with the number of seconds
+     remaining until any previously scheduled alarm was due to be
+     delivered, or zero if there was no previously scheduled alarm.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL ALARM(SECONDS, HANDLER [, STATUS])'
+
+_Arguments_:
+     SECONDS    The type of the argument shall be a scalar
+                `INTEGER'. It is `INTENT(IN)'.
+     HANDLER    Signal handler (`INTEGER FUNCTION' or
+                `SUBROUTINE') or dummy/global `INTEGER'
+                scalar. The scalar values may be either
+                `SIG_IGN=1' to ignore the alarm generated or
+                `SIG_DFL=0' to set the default action. It is
+                `INTENT(IN)'.
+     STATUS     (Optional) STATUS shall be a scalar variable
+                of the default `INTEGER' kind. It is
+                `INTENT(OUT)'.
+
+_Example_:
+          program test_alarm
+            external handler_print
+            integer i
+            call alarm (3, handler_print, i)
+            print *, i
+            call sleep(10)
+          end program test_alarm
+     This will cause the external routine HANDLER_PRINT to be called
+     after 3 seconds.
+
+
+File: gfortran.info,  Node: ALL,  Next: ALLOCATED,  Prev: ALARM,  Up: Intrinsic Procedures
+
+8.13 `ALL' -- All values in MASK along DIM are true
+===================================================
+
+_Description_:
+     `ALL(MASK [, DIM])' determines if all the values are true in MASK
+     in the array along dimension DIM.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = ALL(MASK [, DIM])'
+
+_Arguments_:
+     MASK       The type of the argument shall be `LOGICAL' and
+                it shall not be scalar.
+     DIM        (Optional) DIM shall be a scalar integer with
+                a value that lies between one and the rank of
+                MASK.
+
+_Return value_:
+     `ALL(MASK)' returns a scalar value of type `LOGICAL' where the
+     kind type parameter is the same as the kind type parameter of
+     MASK.  If DIM is present, then `ALL(MASK, DIM)' returns an array
+     with the rank of MASK minus 1.  The shape is determined from the
+     shape of MASK where the DIM dimension is elided.
+
+    (A)
+          `ALL(MASK)' is true if all elements of MASK are true.  It
+          also is true if MASK has zero size; otherwise, it is false.
+
+    (B)
+          If the rank of MASK is one, then `ALL(MASK,DIM)' is equivalent
+          to `ALL(MASK)'.  If the rank is greater than one, then
+          `ALL(MASK,DIM)' is determined by applying `ALL' to the array
+          sections.
+
+_Example_:
+          program test_all
+            logical l
+            l = all((/.true., .true., .true./))
+            print *, l
+            call section
+            contains
+              subroutine section
+                integer a(2,3), b(2,3)
+                a = 1
+                b = 1
+                b(2,2) = 2
+                print *, all(a .eq. b, 1)
+                print *, all(a .eq. b, 2)
+              end subroutine section
+          end program test_all
+
+
+File: gfortran.info,  Node: ALLOCATED,  Next: AND,  Prev: ALL,  Up: Intrinsic Procedures
+
+8.14 `ALLOCATED' -- Status of an allocatable entity
+===================================================
+
+_Description_:
+     `ALLOCATED(ARRAY)' and `ALLOCATED(SCALAR)' check the allocation
+     status of ARRAY and SCALAR, respectively.
+
+_Standard_:
+     Fortran 95 and later.  Note, the `SCALAR=' keyword and allocatable
+     scalar entities are available in Fortran 2003 and later.
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = ALLOCATED(ARRAY)'
+     `RESULT = ALLOCATED(SCALAR)'
+
+_Arguments_:
+     ARRAY      The argument shall be an `ALLOCATABLE' array.
+     SCALAR     The argument shall be an `ALLOCATABLE' scalar.
+
+_Return value_:
+     The return value is a scalar `LOGICAL' with the default logical
+     kind type parameter.  If the argument is allocated, then the
+     result is `.TRUE.'; otherwise, it returns `.FALSE.'
+
+_Example_:
+          program test_allocated
+            integer :: i = 4
+            real(4), allocatable :: x(:)
+            if (.not. allocated(x)) allocate(x(i))
+          end program test_allocated
+
+
+File: gfortran.info,  Node: AND,  Next: ANINT,  Prev: ALLOCATED,  Up: Intrinsic Procedures
+
+8.15 `AND' -- Bitwise logical AND
+=================================
+
+_Description_:
+     Bitwise logical `AND'.
+
+     This intrinsic routine is provided for backwards compatibility with
+     GNU Fortran 77.  For integer arguments, programmers should consider
+     the use of the *note IAND:: intrinsic defined by the Fortran
+     standard.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = AND(I, J)'
+
+_Arguments_:
+     I          The type shall be either a scalar `INTEGER'
+                type or a scalar `LOGICAL' type.
+     J          The type shall be the same as the type of I.
+
+_Return value_:
+     The return type is either a scalar `INTEGER' or a scalar
+     `LOGICAL'.  If the kind type parameters differ, then the smaller
+     kind type is implicitly converted to larger kind, and the return
+     has the larger kind.
+
+_Example_:
+          PROGRAM test_and
+            LOGICAL :: T = .TRUE., F = .FALSE.
+            INTEGER :: a, b
+            DATA a / Z'F' /, b / Z'3' /
+
+            WRITE (*,*) AND(T, T), AND(T, F), AND(F, T), AND(F, F)
+            WRITE (*,*) AND(a, b)
+          END PROGRAM
+
+_See also_:
+     Fortran 95 elemental function: *note IAND::
+
+
+File: gfortran.info,  Node: ANINT,  Next: ANY,  Prev: AND,  Up: Intrinsic Procedures
+
+8.16 `ANINT' -- Nearest whole number
+====================================
+
+_Description_:
+     `ANINT(A [, KIND])' rounds its argument to the nearest whole
+     number.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ANINT(A [, KIND])'
+
+_Arguments_:
+     A          The type of the argument shall be `REAL'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type real with the kind type parameter of
+     the argument if the optional KIND is absent; otherwise, the kind
+     type parameter will be given by KIND.  If A is greater than zero,
+     `ANINT(A)' returns `AINT(X+0.5)'.  If A is less than or equal to
+     zero then it returns `AINT(X-0.5)'.
+
+_Example_:
+          program test_anint
+            real(4) x4
+            real(8) x8
+            x4 = 1.234E0_4
+            x8 = 4.321_8
+            print *, anint(x4), dnint(x8)
+            x8 = anint(x4,8)
+          end program test_anint
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `AINT(A)'     `REAL(4) A'   `REAL(4)'     Fortran 77 and
+                                               later
+     `DNINT(A)'    `REAL(8) A'   `REAL(8)'     Fortran 77 and
+                                               later
+
+
+File: gfortran.info,  Node: ANY,  Next: ASIN,  Prev: ANINT,  Up: Intrinsic Procedures
+
+8.17 `ANY' -- Any value in MASK along DIM is true
+=================================================
+
+_Description_:
+     `ANY(MASK [, DIM])' determines if any of the values in the logical
+     array MASK along dimension DIM are `.TRUE.'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = ANY(MASK [, DIM])'
+
+_Arguments_:
+     MASK       The type of the argument shall be `LOGICAL' and
+                it shall not be scalar.
+     DIM        (Optional) DIM shall be a scalar integer with
+                a value that lies between one and the rank of
+                MASK.
+
+_Return value_:
+     `ANY(MASK)' returns a scalar value of type `LOGICAL' where the
+     kind type parameter is the same as the kind type parameter of
+     MASK.  If DIM is present, then `ANY(MASK, DIM)' returns an array
+     with the rank of MASK minus 1.  The shape is determined from the
+     shape of MASK where the DIM dimension is elided.
+
+    (A)
+          `ANY(MASK)' is true if any element of MASK is true;
+          otherwise, it is false.  It also is false if MASK has zero
+          size.
+
+    (B)
+          If the rank of MASK is one, then `ANY(MASK,DIM)' is equivalent
+          to `ANY(MASK)'.  If the rank is greater than one, then
+          `ANY(MASK,DIM)' is determined by applying `ANY' to the array
+          sections.
+
+_Example_:
+          program test_any
+            logical l
+            l = any((/.true., .true., .true./))
+            print *, l
+            call section
+            contains
+              subroutine section
+                integer a(2,3), b(2,3)
+                a = 1
+                b = 1
+                b(2,2) = 2
+                print *, any(a .eq. b, 1)
+                print *, any(a .eq. b, 2)
+              end subroutine section
+          end program test_any
+
+
+File: gfortran.info,  Node: ASIN,  Next: ASINH,  Prev: ANY,  Up: Intrinsic Procedures
+
+8.18 `ASIN' -- Arcsine function
+===============================
+
+_Description_:
+     `ASIN(X)' computes the arcsine of its X (inverse of `SIN(X)').
+
+_Standard_:
+     Fortran 77 and later, for a complex argument Fortran 2008 or later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ASIN(X)'
+
+_Arguments_:
+     X          The type shall be either `REAL' and a
+                magnitude that is less than or equal to one -
+                or be `COMPLEX'.
+
+_Return value_:
+     The return value is of the same type and kind as X.  The real part
+     of the result is in radians and lies in the range -\pi/2 \leq \Re
+     \asin(x) \leq \pi/2.
+
+_Example_:
+          program test_asin
+            real(8) :: x = 0.866_8
+            x = asin(x)
+          end program test_asin
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `ASIN(X)'     `REAL(4) X'   `REAL(4)'     Fortran 77 and
+                                               later
+     `DASIN(X)'    `REAL(8) X'   `REAL(8)'     Fortran 77 and
+                                               later
+
+_See also_:
+     Inverse function: *note SIN::
+
+
+
+File: gfortran.info,  Node: ASINH,  Next: ASSOCIATED,  Prev: ASIN,  Up: Intrinsic Procedures
+
+8.19 `ASINH' -- Inverse hyperbolic sine function
+================================================
+
+_Description_:
+     `ASINH(X)' computes the inverse hyperbolic sine of X.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ASINH(X)'
+
+_Arguments_:
+     X          The type shall be `REAL' or `COMPLEX'.
+
+_Return value_:
+     The return value is of the same type and kind as  X. If X is
+     complex, the imaginary part of the result is in radians and lies
+     between -\pi/2 \leq \Im \asinh(x) \leq \pi/2.
+
+_Example_:
+          PROGRAM test_asinh
+            REAL(8), DIMENSION(3) :: x = (/ -1.0, 0.0, 1.0 /)
+            WRITE (*,*) ASINH(x)
+          END PROGRAM
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `DASINH(X)'   `REAL(8) X'   `REAL(8)'     GNU extension.
+
+_See also_:
+     Inverse function: *note SINH::
+
+
+File: gfortran.info,  Node: ASSOCIATED,  Next: ATAN,  Prev: ASINH,  Up: Intrinsic Procedures
+
+8.20 `ASSOCIATED' -- Status of a pointer or pointer/target pair
+===============================================================
+
+_Description_:
+     `ASSOCIATED(POINTER [, TARGET])' determines the status of the
+     pointer POINTER or if POINTER is associated with the target TARGET.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = ASSOCIATED(POINTER [, TARGET])'
+
+_Arguments_:
+     POINTER    POINTER shall have the `POINTER' attribute and
+                it can be of any type.
+     TARGET     (Optional) TARGET shall be a pointer or a
+                target.  It must have the same type, kind type
+                parameter, and array rank as POINTER.
+     The association status of neither POINTER nor TARGET shall be
+     undefined.
+
+_Return value_:
+     `ASSOCIATED(POINTER)' returns a scalar value of type `LOGICAL(4)'.
+     There are several cases:
+    (A) When the optional TARGET is not present then
+          `ASSOCIATED(POINTER)' is true if POINTER is associated with a
+          target; otherwise, it returns false.
+
+    (B) If TARGET is present and a scalar target, the result is true if
+          TARGET is not a zero-sized storage sequence and the target
+          associated with POINTER occupies the same storage units.  If
+          POINTER is disassociated, the result is false.
+
+    (C) If TARGET is present and an array target, the result is true if
+          TARGET and POINTER have the same shape, are not zero-sized
+          arrays, are arrays whose elements are not zero-sized storage
+          sequences, and TARGET and POINTER occupy the same storage
+          units in array element order.  As in case(B), the result is
+          false, if POINTER is disassociated.
+
+    (D) If TARGET is present and an scalar pointer, the result is true
+          if TARGET is associated with POINTER, the target associated
+          with TARGET are not zero-sized storage sequences and occupy
+          the same storage units.  The result is false, if either
+          TARGET or POINTER is disassociated.
+
+    (E) If TARGET is present and an array pointer, the result is true if
+          target associated with POINTER and the target associated with
+          TARGET have the same shape, are not zero-sized arrays, are
+          arrays whose elements are not zero-sized storage sequences,
+          and TARGET and POINTER occupy the same storage units in array
+          element order.  The result is false, if either TARGET or
+          POINTER is disassociated.
+
+_Example_:
+          program test_associated
+             implicit none
+             real, target  :: tgt(2) = (/1., 2./)
+             real, pointer :: ptr(:)
+             ptr => tgt
+             if (associated(ptr)     .eqv. .false.) call abort
+             if (associated(ptr,tgt) .eqv. .false.) call abort
+          end program test_associated
+
+_See also_:
+     *note NULL::
+
+
+File: gfortran.info,  Node: ATAN,  Next: ATAN2,  Prev: ASSOCIATED,  Up: Intrinsic Procedures
+
+8.21 `ATAN' -- Arctangent function
+==================================
+
+_Description_:
+     `ATAN(X)' computes the arctangent of X.
+
+_Standard_:
+     Fortran 77 and later, for a complex argument and for two arguments
+     Fortran 2008 or later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ATAN(X)'
+     `RESULT = ATAN(Y, X)'
+
+_Arguments_:
+     X          The type shall be `REAL' or `COMPLEX'; if Y is
+                present, X shall be REAL.
+     Y shall    
+     be of the  
+     same type  
+     and kind   
+     as X.      
+
+_Return value_:
+     The return value is of the same type and kind as X.  If Y is
+     present, the result is identical to `ATAN2(Y,X)'.  Otherwise, it
+     the arcus tangent of X, where the real part of the result is in
+     radians and lies in the range -\pi/2 \leq \Re \atan(x) \leq \pi/2.
+
+_Example_:
+          program test_atan
+            real(8) :: x = 2.866_8
+            x = atan(x)
+          end program test_atan
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `ATAN(X)'     `REAL(4) X'   `REAL(4)'     Fortran 77 and
+                                               later
+     `DATAN(X)'    `REAL(8) X'   `REAL(8)'     Fortran 77 and
+                                               later
+
+_See also_:
+     Inverse function: *note TAN::
+
+
+
+File: gfortran.info,  Node: ATAN2,  Next: ATANH,  Prev: ATAN,  Up: Intrinsic Procedures
+
+8.22 `ATAN2' -- Arctangent function
+===================================
+
+_Description_:
+     `ATAN2(Y, X)' computes the principal value of the argument
+     function of the complex number X + i Y. This function can be used
+     to transform from Cartesian into polar coordinates and allows to
+     determine the angle in the correct quadrant.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ATAN2(Y, X)'
+
+_Arguments_:
+     Y          The type shall be `REAL'.
+     X          The type and kind type parameter shall be the
+                same as Y.  If Y is zero, then X must be
+                nonzero.
+
+_Return value_:
+     The return value has the same type and kind type parameter as Y.
+     It is the principal value of the complex number X + i Y.  If X is
+     nonzero, then it lies in the range -\pi \le \atan (x) \leq \pi.
+     The sign is positive if Y is positive.  If Y is zero, then the
+     return value is zero if X is positive and \pi if X is negative.
+     Finally, if X is zero, then the magnitude of the result is \pi/2.
+
+_Example_:
+          program test_atan2
+            real(4) :: x = 1.e0_4, y = 0.5e0_4
+            x = atan2(y,x)
+          end program test_atan2
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `ATAN2(X,     `REAL(4) X,   `REAL(4)'     Fortran 77 and
+     Y)'           Y'                          later
+     `DATAN2(X,    `REAL(8) X,   `REAL(8)'     Fortran 77 and
+     Y)'           Y'                          later
+
+
+File: gfortran.info,  Node: ATANH,  Next: BESSEL_J0,  Prev: ATAN2,  Up: Intrinsic Procedures
+
+8.23 `ATANH' -- Inverse hyperbolic tangent function
+===================================================
+
+_Description_:
+     `ATANH(X)' computes the inverse hyperbolic tangent of X.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ATANH(X)'
+
+_Arguments_:
+     X          The type shall be `REAL' or `COMPLEX'.
+
+_Return value_:
+     The return value has same type and kind as X. If X is complex, the
+     imaginary part of the result is in radians and lies between -\pi/2
+     \leq \Im \atanh(x) \leq \pi/2.
+
+_Example_:
+          PROGRAM test_atanh
+            REAL, DIMENSION(3) :: x = (/ -1.0, 0.0, 1.0 /)
+            WRITE (*,*) ATANH(x)
+          END PROGRAM
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `DATANH(X)'   `REAL(8) X'   `REAL(8)'     GNU extension
+
+_See also_:
+     Inverse function: *note TANH::
+
+
+File: gfortran.info,  Node: BESSEL_J0,  Next: BESSEL_J1,  Prev: ATANH,  Up: Intrinsic Procedures
+
+8.24 `BESSEL_J0' -- Bessel function of the first kind of order 0
+================================================================
+
+_Description_:
+     `BESSEL_J0(X)' computes the Bessel function of the first kind of
+     order 0 of X. This function is available under the name `BESJ0' as
+     a GNU extension.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = BESSEL_J0(X)'
+
+_Arguments_:
+     X          The type shall be `REAL', and it shall be
+                scalar.
+
+_Return value_:
+     The return value is of type `REAL' and lies in the range  -
+     0.4027... \leq Bessel (0,x) \leq 1. It has the same kind as X.
+
+_Example_:
+          program test_besj0
+            real(8) :: x = 0.0_8
+            x = bessel_j0(x)
+          end program test_besj0
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `DBESJ0(X)'   `REAL(8) X'   `REAL(8)'     GNU extension
+
+
+File: gfortran.info,  Node: BESSEL_J1,  Next: BESSEL_JN,  Prev: BESSEL_J0,  Up: Intrinsic Procedures
+
+8.25 `BESSEL_J1' -- Bessel function of the first kind of order 1
+================================================================
+
+_Description_:
+     `BESSEL_J1(X)' computes the Bessel function of the first kind of
+     order 1 of X. This function is available under the name `BESJ1' as
+     a GNU extension.
+
+_Standard_:
+     Fortran 2008
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = BESSEL_J1(X)'
+
+_Arguments_:
+     X          The type shall be `REAL', and it shall be
+                scalar.
+
+_Return value_:
+     The return value is of type `REAL' and it lies in the range  -
+     0.5818... \leq Bessel (0,x) \leq 0.5818 . It has the same kind as
+     X.
+
+_Example_:
+          program test_besj1
+            real(8) :: x = 1.0_8
+            x = bessel_j1(x)
+          end program test_besj1
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `DBESJ1(X)'   `REAL(8) X'   `REAL(8)'     GNU extension
+
+
+File: gfortran.info,  Node: BESSEL_JN,  Next: BESSEL_Y0,  Prev: BESSEL_J1,  Up: Intrinsic Procedures
+
+8.26 `BESSEL_JN' -- Bessel function of the first kind
+=====================================================
+
+_Description_:
+     `BESSEL_JN(N, X)' computes the Bessel function of the first kind of
+     order N of X. This function is available under the name `BESJN' as
+     a GNU extension.  If N and X are arrays, their ranks and shapes
+     shall conform.
+
+     `BESSEL_JN(N1, N2, X)' returns an array with the Bessel functions
+     of the first kind of the orders N1 to N2.
+
+_Standard_:
+     Fortran 2008 and later, negative N is allowed as GNU extension
+
+_Class_:
+     Elemental function, except for the transformational function
+     `BESSEL_JN(N1, N2, X)'
+
+_Syntax_:
+     `RESULT = BESSEL_JN(N, X)'
+     `RESULT = BESSEL_JN(N1, N2, X)'
+
+_Arguments_:
+     N          Shall be a scalar or an array of type
+                `INTEGER'.
+     N1         Shall be a non-negative scalar of type
+                `INTEGER'.
+     N2         Shall be a non-negative scalar of type
+                `INTEGER'.
+     X          Shall be a scalar or an array of type  `REAL';
+                for `BESSEL_JN(N1, N2, X)' it shall be scalar.
+
+_Return value_:
+     The return value is a scalar of type `REAL'. It has the same kind
+     as X.
+
+_Note_:
+     The transformational function uses a recurrence algorithm which
+     might, for some values of X, lead to different results than calls
+     to the elemental function.
+
+_Example_:
+          program test_besjn
+            real(8) :: x = 1.0_8
+            x = bessel_jn(5,x)
+          end program test_besjn
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `DBESJN(N,    `INTEGER N'   `REAL(8)'     GNU extension
+     X)'                                       
+                   `REAL(8) X'                 
+
+
+File: gfortran.info,  Node: BESSEL_Y0,  Next: BESSEL_Y1,  Prev: BESSEL_JN,  Up: Intrinsic Procedures
+
+8.27 `BESSEL_Y0' -- Bessel function of the second kind of order 0
+=================================================================
+
+_Description_:
+     `BESSEL_Y0(X)' computes the Bessel function of the second kind of
+     order 0 of X. This function is available under the name `BESY0' as
+     a GNU extension.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = BESSEL_Y0(X)'
+
+_Arguments_:
+     X          The type shall be `REAL', and it shall be
+                scalar.
+
+_Return value_:
+     The return value is a scalar of type `REAL'. It has the same kind
+     as X.
+
+_Example_:
+          program test_besy0
+            real(8) :: x = 0.0_8
+            x = bessel_y0(x)
+          end program test_besy0
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `DBESY0(X)'   `REAL(8) X'   `REAL(8)'     GNU extension
+
+
+File: gfortran.info,  Node: BESSEL_Y1,  Next: BESSEL_YN,  Prev: BESSEL_Y0,  Up: Intrinsic Procedures
+
+8.28 `BESSEL_Y1' -- Bessel function of the second kind of order 1
+=================================================================
+
+_Description_:
+     `BESSEL_Y1(X)' computes the Bessel function of the second kind of
+     order 1 of X. This function is available under the name `BESY1' as
+     a GNU extension.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = BESSEL_Y1(X)'
+
+_Arguments_:
+     X          The type shall be `REAL', and it shall be
+                scalar.
+
+_Return value_:
+     The return value is a scalar of type `REAL'. It has the same kind
+     as X.
+
+_Example_:
+          program test_besy1
+            real(8) :: x = 1.0_8
+            x = bessel_y1(x)
+          end program test_besy1
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `DBESY1(X)'   `REAL(8) X'   `REAL(8)'     GNU extension
+
+
+File: gfortran.info,  Node: BESSEL_YN,  Next: BGE,  Prev: BESSEL_Y1,  Up: Intrinsic Procedures
+
+8.29 `BESSEL_YN' -- Bessel function of the second kind
+======================================================
+
+_Description_:
+     `BESSEL_YN(N, X)' computes the Bessel function of the second kind
+     of order N of X. This function is available under the name `BESYN'
+     as a GNU extension.  If N and X are arrays, their ranks and shapes
+     shall conform.
+
+     `BESSEL_YN(N1, N2, X)' returns an array with the Bessel functions
+     of the first kind of the orders N1 to N2.
+
+_Standard_:
+     Fortran 2008 and later, negative N is allowed as GNU extension
+
+_Class_:
+     Elemental function, except for the transformational function
+     `BESSEL_YN(N1, N2, X)'
+
+_Syntax_:
+     `RESULT = BESSEL_YN(N, X)'
+     `RESULT = BESSEL_YN(N1, N2, X)'
+
+_Arguments_:
+     N          Shall be a scalar or an array of type
+                `INTEGER' .
+     N1         Shall be a non-negative scalar of type
+                `INTEGER'.
+     N2         Shall be a non-negative scalar of type
+                `INTEGER'.
+     X          Shall be a scalar or an array of type  `REAL';
+                for `BESSEL_YN(N1, N2, X)' it shall be scalar.
+
+_Return value_:
+     The return value is a scalar of type `REAL'. It has the same kind
+     as X.
+
+_Note_:
+     The transformational function uses a recurrence algorithm which
+     might, for some values of X, lead to different results than calls
+     to the elemental function.
+
+_Example_:
+          program test_besyn
+            real(8) :: x = 1.0_8
+            x = bessel_yn(5,x)
+          end program test_besyn
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `DBESYN(N,X)' `INTEGER N'   `REAL(8)'     GNU extension
+                   `REAL(8) X'                 
+
+
+File: gfortran.info,  Node: BGE,  Next: BGT,  Prev: BESSEL_YN,  Up: Intrinsic Procedures
+
+8.30 `BGE' -- Bitwise greater than or equal to
+==============================================
+
+_Description_:
+     Determines whether an integral is a bitwise greater than or equal
+     to another.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = BGE(I, J)'
+
+_Arguments_:
+     I          Shall be of `INTEGER' type.
+     J          Shall be of `INTEGER' type, and of the same
+                kind as I.
+
+_Return value_:
+     The return value is of type `LOGICAL' and of the default kind.
+
+_See also_:
+     *note BGT::, *note BLE::, *note BLT::
+
+
+File: gfortran.info,  Node: BGT,  Next: BIT_SIZE,  Prev: BGE,  Up: Intrinsic Procedures
+
+8.31 `BGT' -- Bitwise greater than
+==================================
+
+_Description_:
+     Determines whether an integral is a bitwise greater than another.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = BGT(I, J)'
+
+_Arguments_:
+     I          Shall be of `INTEGER' type.
+     J          Shall be of `INTEGER' type, and of the same
+                kind as I.
+
+_Return value_:
+     The return value is of type `LOGICAL' and of the default kind.
+
+_See also_:
+     *note BGE::, *note BLE::, *note BLT::
+
+
+File: gfortran.info,  Node: BIT_SIZE,  Next: BLE,  Prev: BGT,  Up: Intrinsic Procedures
+
+8.32 `BIT_SIZE' -- Bit size inquiry function
+============================================
+
+_Description_:
+     `BIT_SIZE(I)' returns the number of bits (integer precision plus
+     sign bit) represented by the type of I.  The result of
+     `BIT_SIZE(I)' is independent of the actual value of I.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = BIT_SIZE(I)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER'
+
+_Example_:
+          program test_bit_size
+              integer :: i = 123
+              integer :: size
+              size = bit_size(i)
+              print *, size
+          end program test_bit_size
+
+
+File: gfortran.info,  Node: BLE,  Next: BLT,  Prev: BIT_SIZE,  Up: Intrinsic Procedures
+
+8.33 `BLE' -- Bitwise less than or equal to
+===========================================
+
+_Description_:
+     Determines whether an integral is a bitwise less than or equal to
+     another.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = BLE(I, J)'
+
+_Arguments_:
+     I          Shall be of `INTEGER' type.
+     J          Shall be of `INTEGER' type, and of the same
+                kind as I.
+
+_Return value_:
+     The return value is of type `LOGICAL' and of the default kind.
+
+_See also_:
+     *note BGT::, *note BGE::, *note BLT::
+
+
+File: gfortran.info,  Node: BLT,  Next: BTEST,  Prev: BLE,  Up: Intrinsic Procedures
+
+8.34 `BLT' -- Bitwise less than
+===============================
+
+_Description_:
+     Determines whether an integral is a bitwise less than another.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = BLT(I, J)'
+
+_Arguments_:
+     I          Shall be of `INTEGER' type.
+     J          Shall be of `INTEGER' type, and of the same
+                kind as I.
+
+_Return value_:
+     The return value is of type `LOGICAL' and of the default kind.
+
+_See also_:
+     *note BGE::, *note BGT::, *note BLE::
+
+
+File: gfortran.info,  Node: BTEST,  Next: C_ASSOCIATED,  Prev: BLT,  Up: Intrinsic Procedures
+
+8.35 `BTEST' -- Bit test function
+=================================
+
+_Description_:
+     `BTEST(I,POS)' returns logical `.TRUE.' if the bit at POS in I is
+     set.  The counting of the bits starts at 0.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = BTEST(I, POS)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     POS        The type shall be `INTEGER'.
+
+_Return value_:
+     The return value is of type `LOGICAL'
+
+_Example_:
+          program test_btest
+              integer :: i = 32768 + 1024 + 64
+              integer :: pos
+              logical :: bool
+              do pos=0,16
+                  bool = btest(i, pos)
+                  print *, pos, bool
+              end do
+          end program test_btest
+
+
+File: gfortran.info,  Node: C_ASSOCIATED,  Next: C_F_POINTER,  Prev: BTEST,  Up: Intrinsic Procedures
+
+8.36 `C_ASSOCIATED' -- Status of a C pointer
+============================================
+
+_Description_:
+     `C_ASSOCIATED(c_prt_1[, c_ptr_2])' determines the status of the C
+     pointer C_PTR_1 or if C_PTR_1 is associated with the target
+     C_PTR_2.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = C_ASSOCIATED(c_prt_1[, c_ptr_2])'
+
+_Arguments_:
+     C_PTR_1    Scalar of the type `C_PTR' or `C_FUNPTR'.
+     C_PTR_2    (Optional) Scalar of the same type as C_PTR_1.
+
+_Return value_:
+     The return value is of type `LOGICAL'; it is `.false.' if either
+     C_PTR_1 is a C NULL pointer or if C_PTR1 and C_PTR_2 point to
+     different addresses.
+
+_Example_:
+          subroutine association_test(a,b)
+            use iso_c_binding, only: c_associated, c_loc, c_ptr
+            implicit none
+            real, pointer :: a
+            type(c_ptr) :: b
+            if(c_associated(b, c_loc(a))) &
+               stop 'b and a do not point to same target'
+          end subroutine association_test
+
+_See also_:
+     *note C_LOC::, *note C_FUNLOC::
+
+
+File: gfortran.info,  Node: C_FUNLOC,  Next: C_LOC,  Prev: C_F_PROCPOINTER,  Up: Intrinsic Procedures
+
+8.37 `C_FUNLOC' -- Obtain the C address of a procedure
+======================================================
+
+_Description_:
+     `C_FUNLOC(x)' determines the C address of the argument.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = C_FUNLOC(x)'
+
+_Arguments_:
+     X          Interoperable function or pointer to such
+                function.
+
+_Return value_:
+     The return value is of type `C_FUNPTR' and contains the C address
+     of the argument.
+
+_Example_:
+          module x
+            use iso_c_binding
+            implicit none
+          contains
+            subroutine sub(a) bind(c)
+              real(c_float) :: a
+              a = sqrt(a)+5.0
+            end subroutine sub
+          end module x
+          program main
+            use iso_c_binding
+            use x
+            implicit none
+            interface
+              subroutine my_routine(p) bind(c,name='myC_func')
+                import :: c_funptr
+                type(c_funptr), intent(in) :: p
+              end subroutine
+            end interface
+            call my_routine(c_funloc(sub))
+          end program main
+
+_See also_:
+     *note C_ASSOCIATED::, *note C_LOC::, *note C_F_POINTER::, *note
+     C_F_PROCPOINTER::
+
+
+File: gfortran.info,  Node: C_F_PROCPOINTER,  Next: C_FUNLOC,  Prev: C_F_POINTER,  Up: Intrinsic Procedures
+
+8.38 `C_F_PROCPOINTER' -- Convert C into Fortran procedure pointer
+==================================================================
+
+_Description_:
+     `C_F_PROCPOINTER(CPTR, FPTR)' Assign the target of the C function
+     pointer CPTR to the Fortran procedure pointer FPTR.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL C_F_PROCPOINTER(cptr, fptr)'
+
+_Arguments_:
+     CPTR       scalar of the type `C_FUNPTR'. It is
+                `INTENT(IN)'.
+     FPTR       procedure pointer interoperable with CPTR. It
+                is `INTENT(OUT)'.
+
+_Example_:
+          program main
+            use iso_c_binding
+            implicit none
+            abstract interface
+              function func(a)
+                import :: c_float
+                real(c_float), intent(in) :: a
+                real(c_float) :: func
+              end function
+            end interface
+            interface
+               function getIterFunc() bind(c,name="getIterFunc")
+                 import :: c_funptr
+                 type(c_funptr) :: getIterFunc
+               end function
+            end interface
+            type(c_funptr) :: cfunptr
+            procedure(func), pointer :: myFunc
+            cfunptr = getIterFunc()
+            call c_f_procpointer(cfunptr, myFunc)
+          end program main
+
+_See also_:
+     *note C_LOC::, *note C_F_POINTER::
+
+
+File: gfortran.info,  Node: C_F_POINTER,  Next: C_F_PROCPOINTER,  Prev: C_ASSOCIATED,  Up: Intrinsic Procedures
+
+8.39 `C_F_POINTER' -- Convert C into Fortran pointer
+====================================================
+
+_Description_:
+     `C_F_POINTER(CPTR, FPTR[, SHAPE])' Assign the target the C pointer
+     CPTR to the Fortran pointer FPTR and specify its shape.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL C_F_POINTER(CPTR, FPTR[, SHAPE])'
+
+_Arguments_:
+     CPTR       scalar of the type `C_PTR'. It is `INTENT(IN)'.
+     FPTR       pointer interoperable with CPTR. It is
+                `INTENT(OUT)'.
+     SHAPE      (Optional) Rank-one array of type `INTEGER'
+                with `INTENT(IN)'. It shall be present if and
+                only if FPTR is an array. The size must be
+                equal to the rank of FPTR.
+
+_Example_:
+          program main
+            use iso_c_binding
+            implicit none
+            interface
+              subroutine my_routine(p) bind(c,name='myC_func')
+                import :: c_ptr
+                type(c_ptr), intent(out) :: p
+              end subroutine
+            end interface
+            type(c_ptr) :: cptr
+            real,pointer :: a(:)
+            call my_routine(cptr)
+            call c_f_pointer(cptr, a, [12])
+          end program main
+
+_See also_:
+     *note C_LOC::, *note C_F_PROCPOINTER::
+
+
+File: gfortran.info,  Node: C_LOC,  Next: C_SIZEOF,  Prev: C_FUNLOC,  Up: Intrinsic Procedures
+
+8.40 `C_LOC' -- Obtain the C address of an object
+=================================================
+
+_Description_:
+     `C_LOC(X)' determines the C address of the argument.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = C_LOC(X)'
+
+_Arguments_:
+     X       Shall have either the POINTER or TARGET
+             attribute. It shall not be a coindexed object. It
+             shall either be a variable with interoperable
+             type and kind type parameters, or be a scalar,
+             nonpolymorphic variable with no length type
+             parameters.
+
+_Return value_:
+     The return value is of type `C_PTR' and contains the C address of
+     the argument.
+
+_Example_:
+          subroutine association_test(a,b)
+            use iso_c_binding, only: c_associated, c_loc, c_ptr
+            implicit none
+            real, pointer :: a
+            type(c_ptr) :: b
+            if(c_associated(b, c_loc(a))) &
+               stop 'b and a do not point to same target'
+          end subroutine association_test
+
+_See also_:
+     *note C_ASSOCIATED::, *note C_FUNLOC::, *note C_F_POINTER::, *note
+     C_F_PROCPOINTER::
+
+
+File: gfortran.info,  Node: C_SIZEOF,  Next: CEILING,  Prev: C_LOC,  Up: Intrinsic Procedures
+
+8.41 `C_SIZEOF' -- Size in bytes of an expression
+=================================================
+
+_Description_:
+     `C_SIZEOF(X)' calculates the number of bytes of storage the
+     expression `X' occupies.
+
+_Standard_:
+     Fortran 2008
+
+_Class_:
+     Inquiry function of the module `ISO_C_BINDING'
+
+_Syntax_:
+     `N = C_SIZEOF(X)'
+
+_Arguments_:
+     X          The argument shall be an interoperable data
+                entity.
+
+_Return value_:
+     The return value is of type integer and of the system-dependent
+     kind `C_SIZE_T' (from the `ISO_C_BINDING' module). Its value is the
+     number of bytes occupied by the argument.  If the argument has the
+     `POINTER' attribute, the number of bytes of the storage area
+     pointed to is returned.  If the argument is of a derived type with
+     `POINTER' or `ALLOCATABLE' components, the return value doesn't
+     account for the sizes of the data pointed to by these components.
+
+_Example_:
+             use iso_c_binding
+             integer(c_int) :: i
+             real(c_float) :: r, s(5)
+             print *, (c_sizeof(s)/c_sizeof(r) == 5)
+             end
+     The example will print `.TRUE.' unless you are using a platform
+     where default `REAL' variables are unusually padded.
+
+_See also_:
+     *note SIZEOF::, *note STORAGE_SIZE::
+
+
+File: gfortran.info,  Node: CEILING,  Next: CHAR,  Prev: C_SIZEOF,  Up: Intrinsic Procedures
+
+8.42 `CEILING' -- Integer ceiling function
+==========================================
+
+_Description_:
+     `CEILING(A)' returns the least integer greater than or equal to A.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = CEILING(A [, KIND])'
+
+_Arguments_:
+     A          The type shall be `REAL'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER(KIND)' if KIND is present and
+     a default-kind `INTEGER' otherwise.
+
+_Example_:
+          program test_ceiling
+              real :: x = 63.29
+              real :: y = -63.59
+              print *, ceiling(x) ! returns 64
+              print *, ceiling(y) ! returns -63
+          end program test_ceiling
+
+_See also_:
+     *note FLOOR::, *note NINT::
+
+
+
+File: gfortran.info,  Node: CHAR,  Next: CHDIR,  Prev: CEILING,  Up: Intrinsic Procedures
+
+8.43 `CHAR' -- Character conversion function
+============================================
+
+_Description_:
+     `CHAR(I [, KIND])' returns the character represented by the
+     integer I.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = CHAR(I [, KIND])'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `CHARACTER(1)'
+
+_Example_:
+          program test_char
+              integer :: i = 74
+              character(1) :: c
+              c = char(i)
+              print *, i, c ! returns 'J'
+          end program test_char
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `CHAR(I)'     `INTEGER I'   `CHARACTER(LEN=1)'F77 and later
+
+_Note_:
+     See *note ICHAR:: for a discussion of converting between numerical
+     values and formatted string representations.
+
+_See also_:
+     *note ACHAR::, *note IACHAR::, *note ICHAR::
+
+
+
+File: gfortran.info,  Node: CHDIR,  Next: CHMOD,  Prev: CHAR,  Up: Intrinsic Procedures
+
+8.44 `CHDIR' -- Change working directory
+========================================
+
+_Description_:
+     Change current working directory to a specified path.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL CHDIR(NAME [, STATUS])'
+     `STATUS = CHDIR(NAME)'
+
+_Arguments_:
+     NAME       The type shall be `CHARACTER' of default kind
+                and shall specify a valid path within the file
+                system.
+     STATUS     (Optional) `INTEGER' status flag of the default
+                kind.  Returns 0 on success, and a system
+                specific and nonzero error code otherwise.
+
+_Example_:
+          PROGRAM test_chdir
+            CHARACTER(len=255) :: path
+            CALL getcwd(path)
+            WRITE(*,*) TRIM(path)
+            CALL chdir("/tmp")
+            CALL getcwd(path)
+            WRITE(*,*) TRIM(path)
+          END PROGRAM
+
+_See also_:
+     *note GETCWD::
+
+
+File: gfortran.info,  Node: CHMOD,  Next: CMPLX,  Prev: CHDIR,  Up: Intrinsic Procedures
+
+8.45 `CHMOD' -- Change access permissions of files
+==================================================
+
+_Description_:
+     `CHMOD' changes the permissions of a file. This function invokes
+     `/bin/chmod' and might therefore not work on all platforms.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL CHMOD(NAME, MODE[, STATUS])'
+     `STATUS = CHMOD(NAME, MODE)'
+
+_Arguments_:
+     NAME       Scalar `CHARACTER' of default kind with the
+                file name. Trailing blanks are ignored unless
+                the character `achar(0)' is present, then all
+                characters up to and excluding `achar(0)' are
+                used as the file name.
+     MODE       Scalar `CHARACTER' of default kind giving the
+                file permission. MODE uses the same syntax as
+                the MODE argument of `/bin/chmod'.
+     STATUS     (optional) scalar `INTEGER', which is `0' on
+                success and nonzero otherwise.
+
+_Return value_:
+     In either syntax, STATUS is set to `0' on success and nonzero
+     otherwise.
+
+_Example_:
+     `CHMOD' as subroutine
+          program chmod_test
+            implicit none
+            integer :: status
+            call chmod('test.dat','u+x',status)
+            print *, 'Status: ', status
+          end program chmod_test
+     `CHMOD' as function:
+          program chmod_test
+            implicit none
+            integer :: status
+            status = chmod('test.dat','u+x')
+            print *, 'Status: ', status
+          end program chmod_test
+
+
+
+File: gfortran.info,  Node: CMPLX,  Next: COMMAND_ARGUMENT_COUNT,  Prev: CHMOD,  Up: Intrinsic Procedures
+
+8.46 `CMPLX' -- Complex conversion function
+===========================================
+
+_Description_:
+     `CMPLX(X [, Y [, KIND]])' returns a complex number where X is
+     converted to the real component.  If Y is present it is converted
+     to the imaginary component.  If Y is not present then the
+     imaginary component is set to 0.0.  If X is complex then Y must
+     not be present.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = CMPLX(X [, Y [, KIND]])'
+
+_Arguments_:
+     X          The type may be `INTEGER', `REAL', or
+                `COMPLEX'.
+     Y          (Optional; only allowed if X is not
+                `COMPLEX'.)  May be `INTEGER' or `REAL'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of `COMPLEX' type, with a kind equal to KIND
+     if it is specified.  If KIND is not specified, the result is of
+     the default `COMPLEX' kind, regardless of the kinds of X and Y.
+
+_Example_:
+          program test_cmplx
+              integer :: i = 42
+              real :: x = 3.14
+              complex :: z
+              z = cmplx(i, x)
+              print *, z, cmplx(x)
+          end program test_cmplx
+
+_See also_:
+     *note COMPLEX::
+
+
+File: gfortran.info,  Node: COMMAND_ARGUMENT_COUNT,  Next: COMPLEX,  Prev: CMPLX,  Up: Intrinsic Procedures
+
+8.47 `COMMAND_ARGUMENT_COUNT' -- Get number of command line arguments
+=====================================================================
+
+_Description_:
+     `COMMAND_ARGUMENT_COUNT' returns the number of arguments passed on
+     the command line when the containing program was invoked.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = COMMAND_ARGUMENT_COUNT()'
+
+_Arguments_:
+     None       
+
+_Return value_:
+     The return value is an `INTEGER' of default kind.
+
+_Example_:
+          program test_command_argument_count
+              integer :: count
+              count = command_argument_count()
+              print *, count
+          end program test_command_argument_count
+
+_See also_:
+     *note GET_COMMAND::, *note GET_COMMAND_ARGUMENT::
+
+
+File: gfortran.info,  Node: COMPILER_OPTIONS,  Next: CONJG,  Prev: COMPILER_VERSION,  Up: Intrinsic Procedures
+
+8.48 `COMPILER_OPTIONS' -- Options passed to the compiler
+=========================================================
+
+_Description_:
+     `COMPILER_OPTIONS' returns a string with the options used for
+     compiling.
+
+_Standard_:
+     Fortran 2008
+
+_Class_:
+     Inquiry function of the module `ISO_FORTRAN_ENV'
+
+_Syntax_:
+     `STR = COMPILER_OPTIONS()'
+
+_Arguments_:
+     None.
+
+_Return value_:
+     The return value is a default-kind string with system-dependent
+     length.  It contains the compiler flags used to compile the file,
+     which called the `COMPILER_OPTIONS' intrinsic.
+
+_Example_:
+             use iso_fortran_env
+             print '(4a)', 'This file was compiled by ', &
+                           compiler_version(), ' using the the options ', &
+                           compiler_options()
+             end
+
+_See also_:
+     *note COMPILER_VERSION::, *note ISO_FORTRAN_ENV::
+
+
+File: gfortran.info,  Node: COMPILER_VERSION,  Next: COMPILER_OPTIONS,  Prev: COMPLEX,  Up: Intrinsic Procedures
+
+8.49 `COMPILER_VERSION' -- Compiler version string
+==================================================
+
+_Description_:
+     `COMPILER_VERSION' returns a string with the name and the version
+     of the compiler.
+
+_Standard_:
+     Fortran 2008
+
+_Class_:
+     Inquiry function of the module `ISO_FORTRAN_ENV'
+
+_Syntax_:
+     `STR = COMPILER_VERSION()'
+
+_Arguments_:
+     None.
+
+_Return value_:
+     The return value is a default-kind string with system-dependent
+     length.  It contains the name of the compiler and its version
+     number.
+
+_Example_:
+             use iso_fortran_env
+             print '(4a)', 'This file was compiled by ', &
+                           compiler_version(), ' using the the options ', &
+                           compiler_options()
+             end
+
+_See also_:
+     *note COMPILER_OPTIONS::, *note ISO_FORTRAN_ENV::
+
+
+File: gfortran.info,  Node: COMPLEX,  Next: COMPILER_VERSION,  Prev: COMMAND_ARGUMENT_COUNT,  Up: Intrinsic Procedures
+
+8.50 `COMPLEX' -- Complex conversion function
+=============================================
+
+_Description_:
+     `COMPLEX(X, Y)' returns a complex number where X is converted to
+     the real component and Y is converted to the imaginary component.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = COMPLEX(X, Y)'
+
+_Arguments_:
+     X          The type may be `INTEGER' or `REAL'.
+     Y          The type may be `INTEGER' or `REAL'.
+
+_Return value_:
+     If X and Y are both of `INTEGER' type, then the return value is of
+     default `COMPLEX' type.
+
+     If X and Y are of `REAL' type, or one is of `REAL' type and one is
+     of `INTEGER' type, then the return value is of `COMPLEX' type with
+     a kind equal to that of the `REAL' argument with the highest
+     precision.
+
+_Example_:
+          program test_complex
+              integer :: i = 42
+              real :: x = 3.14
+              print *, complex(i, x)
+          end program test_complex
+
+_See also_:
+     *note CMPLX::
+
+
+File: gfortran.info,  Node: CONJG,  Next: COS,  Prev: COMPILER_OPTIONS,  Up: Intrinsic Procedures
+
+8.51 `CONJG' -- Complex conjugate function
+==========================================
+
+_Description_:
+     `CONJG(Z)' returns the conjugate of Z.  If Z is `(x, y)' then the
+     result is `(x, -y)'
+
+_Standard_:
+     Fortran 77 and later, has overloads that are GNU extensions
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `Z = CONJG(Z)'
+
+_Arguments_:
+     Z          The type shall be `COMPLEX'.
+
+_Return value_:
+     The return value is of type `COMPLEX'.
+
+_Example_:
+          program test_conjg
+              complex :: z = (2.0, 3.0)
+              complex(8) :: dz = (2.71_8, -3.14_8)
+              z= conjg(z)
+              print *, z
+              dz = dconjg(dz)
+              print *, dz
+          end program test_conjg
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `CONJG(Z)'    `COMPLEX Z'   `COMPLEX'     GNU extension
+     `DCONJG(Z)'   `COMPLEX(8)   `COMPLEX(8)'  GNU extension
+                   Z'                          
+
+
+File: gfortran.info,  Node: COS,  Next: COSH,  Prev: CONJG,  Up: Intrinsic Procedures
+
+8.52 `COS' -- Cosine function
+=============================
+
+_Description_:
+     `COS(X)' computes the cosine of X.
+
+_Standard_:
+     Fortran 77 and later, has overloads that are GNU extensions
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = COS(X)'
+
+_Arguments_:
+     X          The type shall be `REAL' or `COMPLEX'.
+
+_Return value_:
+     The return value is of the same type and kind as X. The real part
+     of the result is in radians. If X is of the type `REAL', the
+     return value lies in the range  -1 \leq \cos (x) \leq 1.
+
+_Example_:
+          program test_cos
+            real :: x = 0.0
+            x = cos(x)
+          end program test_cos
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `COS(X)'      `REAL(4) X'   `REAL(4)'     Fortran 77 and
+                                               later
+     `DCOS(X)'     `REAL(8) X'   `REAL(8)'     Fortran 77 and
+                                               later
+     `CCOS(X)'     `COMPLEX(4)   `COMPLEX(4)'  Fortran 77 and
+                   X'                          later
+     `ZCOS(X)'     `COMPLEX(8)   `COMPLEX(8)'  GNU extension
+                   X'                          
+     `CDCOS(X)'    `COMPLEX(8)   `COMPLEX(8)'  GNU extension
+                   X'                          
+
+_See also_:
+     Inverse function: *note ACOS::
+
+
+
+File: gfortran.info,  Node: COSH,  Next: COUNT,  Prev: COS,  Up: Intrinsic Procedures
+
+8.53 `COSH' -- Hyperbolic cosine function
+=========================================
+
+_Description_:
+     `COSH(X)' computes the hyperbolic cosine of X.
+
+_Standard_:
+     Fortran 77 and later, for a complex argument Fortran 2008 or later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `X = COSH(X)'
+
+_Arguments_:
+     X          The type shall be `REAL' or `COMPLEX'.
+
+_Return value_:
+     The return value has same type and kind as X. If X is complex, the
+     imaginary part of the result is in radians. If X is `REAL', the
+     return value has a lower bound of one, \cosh (x) \geq 1.
+
+_Example_:
+          program test_cosh
+            real(8) :: x = 1.0_8
+            x = cosh(x)
+          end program test_cosh
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `COSH(X)'     `REAL(4) X'   `REAL(4)'     Fortran 77 and
+                                               later
+     `DCOSH(X)'    `REAL(8) X'   `REAL(8)'     Fortran 77 and
+                                               later
+
+_See also_:
+     Inverse function: *note ACOSH::
+
+
+
+File: gfortran.info,  Node: COUNT,  Next: CPU_TIME,  Prev: COSH,  Up: Intrinsic Procedures
+
+8.54 `COUNT' -- Count function
+==============================
+
+_Description_:
+     Counts the number of `.TRUE.' elements in a logical MASK, or, if
+     the DIM argument is supplied, counts the number of elements along
+     each row of the array in the DIM direction.  If the array has zero
+     size, or all of the elements of MASK are `.FALSE.', then the
+     result is `0'.
+
+_Standard_:
+     Fortran 95 and later, with KIND argument Fortran 2003 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = COUNT(MASK [, DIM, KIND])'
+
+_Arguments_:
+     MASK       The type shall be `LOGICAL'.
+     DIM        (Optional) The type shall be `INTEGER'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER' and of kind KIND. If KIND is
+     absent, the return value is of default integer kind.  If DIM is
+     present, the result is an array with a rank one less than the rank
+     of ARRAY, and a size corresponding to the shape of ARRAY with the
+     DIM dimension removed.
+
+_Example_:
+          program test_count
+              integer, dimension(2,3) :: a, b
+              logical, dimension(2,3) :: mask
+              a = reshape( (/ 1, 2, 3, 4, 5, 6 /), (/ 2, 3 /))
+              b = reshape( (/ 0, 7, 3, 4, 5, 8 /), (/ 2, 3 /))
+              print '(3i3)', a(1,:)
+              print '(3i3)', a(2,:)
+              print *
+              print '(3i3)', b(1,:)
+              print '(3i3)', b(2,:)
+              print *
+              mask = a.ne.b
+              print '(3l3)', mask(1,:)
+              print '(3l3)', mask(2,:)
+              print *
+              print '(3i3)', count(mask)
+              print *
+              print '(3i3)', count(mask, 1)
+              print *
+              print '(3i3)', count(mask, 2)
+          end program test_count
+
+
+File: gfortran.info,  Node: CPU_TIME,  Next: CSHIFT,  Prev: COUNT,  Up: Intrinsic Procedures
+
+8.55 `CPU_TIME' -- CPU elapsed time in seconds
+==============================================
+
+_Description_:
+     Returns a `REAL' value representing the elapsed CPU time in
+     seconds.  This is useful for testing segments of code to determine
+     execution time.
+
+     If a time source is available, time will be reported with
+     microsecond resolution. If no time source is available, TIME is
+     set to `-1.0'.
+
+     Note that TIME may contain a, system dependent, arbitrary offset
+     and may not start with `0.0'. For `CPU_TIME', the absolute value
+     is meaningless, only differences between subsequent calls to this
+     subroutine, as shown in the example below, should be used.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL CPU_TIME(TIME)'
+
+_Arguments_:
+     TIME       The type shall be `REAL' with `INTENT(OUT)'.
+
+_Return value_:
+     None
+
+_Example_:
+          program test_cpu_time
+              real :: start, finish
+              call cpu_time(start)
+                  ! put code to test here
+              call cpu_time(finish)
+              print '("Time = ",f6.3," seconds.")',finish-start
+          end program test_cpu_time
+
+_See also_:
+     *note SYSTEM_CLOCK::, *note DATE_AND_TIME::
+
+
+File: gfortran.info,  Node: CSHIFT,  Next: CTIME,  Prev: CPU_TIME,  Up: Intrinsic Procedures
+
+8.56 `CSHIFT' -- Circular shift elements of an array
+====================================================
+
+_Description_:
+     `CSHIFT(ARRAY, SHIFT [, DIM])' performs a circular shift on
+     elements of ARRAY along the dimension of DIM.  If DIM is omitted
+     it is taken to be `1'.  DIM is a scalar of type `INTEGER' in the
+     range of 1 \leq DIM \leq n) where n is the rank of ARRAY.  If the
+     rank of ARRAY is one, then all elements of ARRAY are shifted by
+     SHIFT places.  If rank is greater than one, then all complete rank
+     one sections of ARRAY along the given dimension are shifted.
+     Elements shifted out one end of each rank one section are shifted
+     back in the other end.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = CSHIFT(ARRAY, SHIFT [, DIM])'
+
+_Arguments_:
+     ARRAY      Shall be an array of any type.
+     SHIFT      The type shall be `INTEGER'.
+     DIM        The type shall be `INTEGER'.
+
+_Return value_:
+     Returns an array of same type and rank as the ARRAY argument.
+
+_Example_:
+          program test_cshift
+              integer, dimension(3,3) :: a
+              a = reshape( (/ 1, 2, 3, 4, 5, 6, 7, 8, 9 /), (/ 3, 3 /))
+              print '(3i3)', a(1,:)
+              print '(3i3)', a(2,:)
+              print '(3i3)', a(3,:)
+              a = cshift(a, SHIFT=(/1, 2, -1/), DIM=2)
+              print *
+              print '(3i3)', a(1,:)
+              print '(3i3)', a(2,:)
+              print '(3i3)', a(3,:)
+          end program test_cshift
+
+
+File: gfortran.info,  Node: CTIME,  Next: DATE_AND_TIME,  Prev: CSHIFT,  Up: Intrinsic Procedures
+
+8.57 `CTIME' -- Convert a time into a string
+============================================
+
+_Description_:
+     `CTIME' converts a system time value, such as returned by `TIME8',
+     to a string. Unless the application has called `setlocale', the
+     output will be in the default locale, of length 24 and of the form
+     `Sat Aug 19 18:13:14 1995'. In other locales, a longer string may
+     result.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL CTIME(TIME, RESULT)'.
+     `RESULT = CTIME(TIME)'.
+
+_Arguments_:
+     TIME       The type shall be of type `INTEGER'.
+     RESULT     The type shall be of type `CHARACTER' and of
+                default kind. It is an `INTENT(OUT)' argument.
+                If the length of this variable is too short
+                for the time and date string to fit
+                completely, it will be blank on procedure
+                return.
+
+_Return value_:
+     The converted date and time as a string.
+
+_Example_:
+          program test_ctime
+              integer(8) :: i
+              character(len=30) :: date
+              i = time8()
+
+              ! Do something, main part of the program
+
+              call ctime(i,date)
+              print *, 'Program was started on ', date
+          end program test_ctime
+
+_See Also_:
+     *note DATE_AND_TIME::, *note GMTIME::, *note LTIME::, *note
+     TIME::, *note TIME8::
+
+
+File: gfortran.info,  Node: DATE_AND_TIME,  Next: DBLE,  Prev: CTIME,  Up: Intrinsic Procedures
+
+8.58 `DATE_AND_TIME' -- Date and time subroutine
+================================================
+
+_Description_:
+     `DATE_AND_TIME(DATE, TIME, ZONE, VALUES)' gets the corresponding
+     date and time information from the real-time system clock.  DATE is
+     `INTENT(OUT)' and has form ccyymmdd.  TIME is `INTENT(OUT)' and
+     has form hhmmss.sss.  ZONE is `INTENT(OUT)' and has form (+-)hhmm,
+     representing the difference with respect to Coordinated Universal
+     Time (UTC).  Unavailable time and date parameters return blanks.
+
+     VALUES is `INTENT(OUT)' and provides the following:
+
+                `VALUE(1)':          The year
+                `VALUE(2)':          The month
+                `VALUE(3)':          The day of the month
+                `VALUE(4)':          Time difference with UTC
+                                     in minutes
+                `VALUE(5)':          The hour of the day
+                `VALUE(6)':          The minutes of the hour
+                `VALUE(7)':          The seconds of the minute
+                `VALUE(8)':          The milliseconds of the
+                                     second
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL DATE_AND_TIME([DATE, TIME, ZONE, VALUES])'
+
+_Arguments_:
+     DATE       (Optional) The type shall be `CHARACTER(LEN=8)'
+                or larger, and of default kind.
+     TIME       (Optional) The type shall be
+                `CHARACTER(LEN=10)' or larger, and of default
+                kind.
+     ZONE       (Optional) The type shall be `CHARACTER(LEN=5)'
+                or larger, and of default kind.
+     VALUES     (Optional) The type shall be `INTEGER(8)'.
+
+_Return value_:
+     None
+
+_Example_:
+          program test_time_and_date
+              character(8)  :: date
+              character(10) :: time
+              character(5)  :: zone
+              integer,dimension(8) :: values
+              ! using keyword arguments
+              call date_and_time(date,time,zone,values)
+              call date_and_time(DATE=date,ZONE=zone)
+              call date_and_time(TIME=time)
+              call date_and_time(VALUES=values)
+              print '(a,2x,a,2x,a)', date, time, zone
+              print '(8i5))', values
+          end program test_time_and_date
+
+_See also_:
+     *note CPU_TIME::, *note SYSTEM_CLOCK::
+
+
+File: gfortran.info,  Node: DBLE,  Next: DCMPLX,  Prev: DATE_AND_TIME,  Up: Intrinsic Procedures
+
+8.59 `DBLE' -- Double conversion function
+=========================================
+
+_Description_:
+     `DBLE(A)' Converts A to double precision real type.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = DBLE(A)'
+
+_Arguments_:
+     A          The type shall be `INTEGER', `REAL', or
+                `COMPLEX'.
+
+_Return value_:
+     The return value is of type double precision real.
+
+_Example_:
+          program test_dble
+              real    :: x = 2.18
+              integer :: i = 5
+              complex :: z = (2.3,1.14)
+              print *, dble(x), dble(i), dble(z)
+          end program test_dble
+
+_See also_:
+     *note REAL::
+
+
+File: gfortran.info,  Node: DCMPLX,  Next: DIGITS,  Prev: DBLE,  Up: Intrinsic Procedures
+
+8.60 `DCMPLX' -- Double complex conversion function
+===================================================
+
+_Description_:
+     `DCMPLX(X [,Y])' returns a double complex number where X is
+     converted to the real component.  If Y is present it is converted
+     to the imaginary component.  If Y is not present then the
+     imaginary component is set to 0.0.  If X is complex then Y must
+     not be present.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = DCMPLX(X [, Y])'
+
+_Arguments_:
+     X          The type may be `INTEGER', `REAL', or
+                `COMPLEX'.
+     Y          (Optional if X is not `COMPLEX'.) May be
+                `INTEGER' or `REAL'.
+
+_Return value_:
+     The return value is of type `COMPLEX(8)'
+
+_Example_:
+          program test_dcmplx
+              integer :: i = 42
+              real :: x = 3.14
+              complex :: z
+              z = cmplx(i, x)
+              print *, dcmplx(i)
+              print *, dcmplx(x)
+              print *, dcmplx(z)
+              print *, dcmplx(x,i)
+          end program test_dcmplx
+
+
+File: gfortran.info,  Node: DIGITS,  Next: DIM,  Prev: DCMPLX,  Up: Intrinsic Procedures
+
+8.61 `DIGITS' -- Significant binary digits function
+===================================================
+
+_Description_:
+     `DIGITS(X)' returns the number of significant binary digits of the
+     internal model representation of X.  For example, on a system
+     using a 32-bit floating point representation, a default real
+     number would likely return 24.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = DIGITS(X)'
+
+_Arguments_:
+     X          The type may be `INTEGER' or `REAL'.
+
+_Return value_:
+     The return value is of type `INTEGER'.
+
+_Example_:
+          program test_digits
+              integer :: i = 12345
+              real :: x = 3.143
+              real(8) :: y = 2.33
+              print *, digits(i)
+              print *, digits(x)
+              print *, digits(y)
+          end program test_digits
+
+
+File: gfortran.info,  Node: DIM,  Next: DOT_PRODUCT,  Prev: DIGITS,  Up: Intrinsic Procedures
+
+8.62 `DIM' -- Positive difference
+=================================
+
+_Description_:
+     `DIM(X,Y)' returns the difference `X-Y' if the result is positive;
+     otherwise returns zero.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = DIM(X, Y)'
+
+_Arguments_:
+     X          The type shall be `INTEGER' or `REAL'
+     Y          The type shall be the same type and kind as X.
+
+_Return value_:
+     The return value is of type `INTEGER' or `REAL'.
+
+_Example_:
+          program test_dim
+              integer :: i
+              real(8) :: x
+              i = dim(4, 15)
+              x = dim(4.345_8, 2.111_8)
+              print *, i
+              print *, x
+          end program test_dim
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `DIM(X,Y)'    `REAL(4) X,   `REAL(4)'     Fortran 77 and
+                   Y'                          later
+     `IDIM(X,Y)'   `INTEGER(4)   `INTEGER(4)'  Fortran 77 and
+                   X, Y'                       later
+     `DDIM(X,Y)'   `REAL(8) X,   `REAL(8)'     Fortran 77 and
+                   Y'                          later
+
+
+File: gfortran.info,  Node: DOT_PRODUCT,  Next: DPROD,  Prev: DIM,  Up: Intrinsic Procedures
+
+8.63 `DOT_PRODUCT' -- Dot product function
+==========================================
+
+_Description_:
+     `DOT_PRODUCT(VECTOR_A, VECTOR_B)' computes the dot product
+     multiplication of two vectors VECTOR_A and VECTOR_B.  The two
+     vectors may be either numeric or logical and must be arrays of
+     rank one and of equal size. If the vectors are `INTEGER' or
+     `REAL', the result is `SUM(VECTOR_A*VECTOR_B)'. If the vectors are
+     `COMPLEX', the result is `SUM(CONJG(VECTOR_A)*VECTOR_B)'. If the
+     vectors are `LOGICAL', the result is `ANY(VECTOR_A .AND.
+     VECTOR_B)'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = DOT_PRODUCT(VECTOR_A, VECTOR_B)'
+
+_Arguments_:
+     VECTOR_A   The type shall be numeric or `LOGICAL', rank 1.
+     VECTOR_B   The type shall be numeric if VECTOR_A is of
+                numeric type or `LOGICAL' if VECTOR_A is of
+                type `LOGICAL'. VECTOR_B shall be a rank-one
+                array.
+
+_Return value_:
+     If the arguments are numeric, the return value is a scalar of
+     numeric type, `INTEGER', `REAL', or `COMPLEX'.  If the arguments
+     are `LOGICAL', the return value is `.TRUE.' or `.FALSE.'.
+
+_Example_:
+          program test_dot_prod
+              integer, dimension(3) :: a, b
+              a = (/ 1, 2, 3 /)
+              b = (/ 4, 5, 6 /)
+              print '(3i3)', a
+              print *
+              print '(3i3)', b
+              print *
+              print *, dot_product(a,b)
+          end program test_dot_prod
+
+
+File: gfortran.info,  Node: DPROD,  Next: DREAL,  Prev: DOT_PRODUCT,  Up: Intrinsic Procedures
+
+8.64 `DPROD' -- Double product function
+=======================================
+
+_Description_:
+     `DPROD(X,Y)' returns the product `X*Y'.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = DPROD(X, Y)'
+
+_Arguments_:
+     X          The type shall be `REAL'.
+     Y          The type shall be `REAL'.
+
+_Return value_:
+     The return value is of type `REAL(8)'.
+
+_Example_:
+          program test_dprod
+              real :: x = 5.2
+              real :: y = 2.3
+              real(8) :: d
+              d = dprod(x,y)
+              print *, d
+          end program test_dprod
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `DPROD(X,Y)'  `REAL(4) X,   `REAL(4)'     Fortran 77 and
+                   Y'                          later
+
+
+
+File: gfortran.info,  Node: DREAL,  Next: DSHIFTL,  Prev: DPROD,  Up: Intrinsic Procedures
+
+8.65 `DREAL' -- Double real part function
+=========================================
+
+_Description_:
+     `DREAL(Z)' returns the real part of complex variable Z.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = DREAL(A)'
+
+_Arguments_:
+     A          The type shall be `COMPLEX(8)'.
+
+_Return value_:
+     The return value is of type `REAL(8)'.
+
+_Example_:
+          program test_dreal
+              complex(8) :: z = (1.3_8,7.2_8)
+              print *, dreal(z)
+          end program test_dreal
+
+_See also_:
+     *note AIMAG::
+
+
+
+File: gfortran.info,  Node: DSHIFTL,  Next: DSHIFTR,  Prev: DREAL,  Up: Intrinsic Procedures
+
+8.66 `DSHIFTL' -- Combined left shift
+=====================================
+
+_Description_:
+     `DSHIFTL(I, J, SHIFT)' combines bits of I and J. The rightmost
+     SHIFT bits of the result are the leftmost SHIFT bits of J, and the
+     remaining bits are the rightmost bits of I.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = DSHIFTL(I, J, SHIFT)'
+
+_Arguments_:
+     I          Shall be of type `INTEGER'.
+     J          Shall be of type `INTEGER', and of the same
+                kind as I.
+     SHIFT      Shall be of type `INTEGER'.
+
+_Return value_:
+     The return value has same type and kind as I.
+
+_See also_:
+     *note DSHIFTR::
+
+
+
+File: gfortran.info,  Node: DSHIFTR,  Next: DTIME,  Prev: DSHIFTL,  Up: Intrinsic Procedures
+
+8.67 `DSHIFTR' -- Combined right shift
+======================================
+
+_Description_:
+     `DSHIFTR(I, J, SHIFT)' combines bits of I and J. The leftmost
+     SHIFT bits of the result are the rightmost SHIFT bits of I, and
+     the remaining bits are the leftmost bits of J.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = DSHIFTR(I, J, SHIFT)'
+
+_Arguments_:
+     I          Shall be of type `INTEGER'.
+     J          Shall be of type `INTEGER', and of the same
+                kind as I.
+     SHIFT      Shall be of type `INTEGER'.
+
+_Return value_:
+     The return value has same type and kind as I.
+
+_See also_:
+     *note DSHIFTL::
+
+
+
+File: gfortran.info,  Node: DTIME,  Next: EOSHIFT,  Prev: DSHIFTR,  Up: Intrinsic Procedures
+
+8.68 `DTIME' -- Execution time subroutine (or function)
+=======================================================
+
+_Description_:
+     `DTIME(VALUES, TIME)' initially returns the number of seconds of
+     runtime since the start of the process's execution in TIME.  VALUES
+     returns the user and system components of this time in `VALUES(1)'
+     and `VALUES(2)' respectively. TIME is equal to `VALUES(1) +
+     VALUES(2)'.
+
+     Subsequent invocations of `DTIME' return values accumulated since
+     the previous invocation.
+
+     On some systems, the underlying timings are represented using
+     types with sufficiently small limits that overflows (wrap around)
+     are possible, such as 32-bit types. Therefore, the values returned
+     by this intrinsic might be, or become, negative, or numerically
+     less than previous values, during a single run of the compiled
+     program.
+
+     Please note, that this implementation is thread safe if used
+     within OpenMP directives, i.e., its state will be consistent while
+     called from multiple threads. However, if `DTIME' is called from
+     multiple threads, the result is still the time since the last
+     invocation. This may not give the intended results. If possible,
+     use `CPU_TIME' instead.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+     VALUES and TIME are `INTENT(OUT)' and provide the following:
+
+                `VALUES(1)':         User time in seconds.
+                `VALUES(2)':         System time in seconds.
+                `TIME':              Run time since start in
+                                     seconds.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL DTIME(VALUES, TIME)'.
+     `TIME = DTIME(VALUES)', (not recommended).
+
+_Arguments_:
+     VALUES     The type shall be `REAL(4), DIMENSION(2)'.
+     TIME       The type shall be `REAL(4)'.
+
+_Return value_:
+     Elapsed time in seconds since the last invocation or since the
+     start of program execution if not called before.
+
+_Example_:
+          program test_dtime
+              integer(8) :: i, j
+              real, dimension(2) :: tarray
+              real :: result
+              call dtime(tarray, result)
+              print *, result
+              print *, tarray(1)
+              print *, tarray(2)
+              do i=1,100000000    ! Just a delay
+                  j = i * i - i
+              end do
+              call dtime(tarray, result)
+              print *, result
+              print *, tarray(1)
+              print *, tarray(2)
+          end program test_dtime
+
+_See also_:
+     *note CPU_TIME::
+
+
+
+File: gfortran.info,  Node: EOSHIFT,  Next: EPSILON,  Prev: DTIME,  Up: Intrinsic Procedures
+
+8.69 `EOSHIFT' -- End-off shift elements of an array
+====================================================
+
+_Description_:
+     `EOSHIFT(ARRAY, SHIFT[, BOUNDARY, DIM])' performs an end-off shift
+     on elements of ARRAY along the dimension of DIM.  If DIM is
+     omitted it is taken to be `1'.  DIM is a scalar of type `INTEGER'
+     in the range of 1 \leq DIM \leq n) where n is the rank of ARRAY.
+     If the rank of ARRAY is one, then all elements of ARRAY are
+     shifted by SHIFT places.  If rank is greater than one, then all
+     complete rank one sections of ARRAY along the given dimension are
+     shifted.  Elements shifted out one end of each rank one section
+     are dropped.  If BOUNDARY is present then the corresponding value
+     of from BOUNDARY is copied back in the other end.  If BOUNDARY is
+     not present then the following are copied in depending on the type
+     of ARRAY.
+
+     _Array     _Boundary Value_
+     Type_      
+     Numeric    0 of the type and kind of ARRAY.
+     Logical    `.FALSE.'.
+     Character(LEN)LEN blanks.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = EOSHIFT(ARRAY, SHIFT [, BOUNDARY, DIM])'
+
+_Arguments_:
+     ARRAY      May be any type, not scalar.
+     SHIFT      The type shall be `INTEGER'.
+     BOUNDARY   Same type as ARRAY.
+     DIM        The type shall be `INTEGER'.
+
+_Return value_:
+     Returns an array of same type and rank as the ARRAY argument.
+
+_Example_:
+          program test_eoshift
+              integer, dimension(3,3) :: a
+              a = reshape( (/ 1, 2, 3, 4, 5, 6, 7, 8, 9 /), (/ 3, 3 /))
+              print '(3i3)', a(1,:)
+              print '(3i3)', a(2,:)
+              print '(3i3)', a(3,:)
+              a = EOSHIFT(a, SHIFT=(/1, 2, 1/), BOUNDARY=-5, DIM=2)
+              print *
+              print '(3i3)', a(1,:)
+              print '(3i3)', a(2,:)
+              print '(3i3)', a(3,:)
+          end program test_eoshift
+
+
+File: gfortran.info,  Node: EPSILON,  Next: ERF,  Prev: EOSHIFT,  Up: Intrinsic Procedures
+
+8.70 `EPSILON' -- Epsilon function
+==================================
+
+_Description_:
+     `EPSILON(X)' returns the smallest number E of the same kind as X
+     such that 1 + E > 1.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = EPSILON(X)'
+
+_Arguments_:
+     X          The type shall be `REAL'.
+
+_Return value_:
+     The return value is of same type as the argument.
+
+_Example_:
+          program test_epsilon
+              real :: x = 3.143
+              real(8) :: y = 2.33
+              print *, EPSILON(x)
+              print *, EPSILON(y)
+          end program test_epsilon
+
+
+File: gfortran.info,  Node: ERF,  Next: ERFC,  Prev: EPSILON,  Up: Intrinsic Procedures
+
+8.71 `ERF' -- Error function
+============================
+
+_Description_:
+     `ERF(X)' computes the error function of X.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ERF(X)'
+
+_Arguments_:
+     X          The type shall be `REAL'.
+
+_Return value_:
+     The return value is of type `REAL', of the same kind as X and lies
+     in the range -1 \leq erf (x) \leq 1 .
+
+_Example_:
+          program test_erf
+            real(8) :: x = 0.17_8
+            x = erf(x)
+          end program test_erf
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `DERF(X)'     `REAL(8) X'   `REAL(8)'     GNU extension
+
+
+File: gfortran.info,  Node: ERFC,  Next: ERFC_SCALED,  Prev: ERF,  Up: Intrinsic Procedures
+
+8.72 `ERFC' -- Error function
+=============================
+
+_Description_:
+     `ERFC(X)' computes the complementary error function of X.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ERFC(X)'
+
+_Arguments_:
+     X          The type shall be `REAL'.
+
+_Return value_:
+     The return value is of type `REAL' and of the same kind as X.  It
+     lies in the range  0 \leq erfc (x) \leq 2 .
+
+_Example_:
+          program test_erfc
+            real(8) :: x = 0.17_8
+            x = erfc(x)
+          end program test_erfc
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `DERFC(X)'    `REAL(8) X'   `REAL(8)'     GNU extension
+
+
+File: gfortran.info,  Node: ERFC_SCALED,  Next: ETIME,  Prev: ERFC,  Up: Intrinsic Procedures
+
+8.73 `ERFC_SCALED' -- Error function
+====================================
+
+_Description_:
+     `ERFC_SCALED(X)' computes the exponentially-scaled complementary
+     error function of X.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ERFC_SCALED(X)'
+
+_Arguments_:
+     X          The type shall be `REAL'.
+
+_Return value_:
+     The return value is of type `REAL' and of the same kind as X.
+
+_Example_:
+          program test_erfc_scaled
+            real(8) :: x = 0.17_8
+            x = erfc_scaled(x)
+          end program test_erfc_scaled
+
+
+File: gfortran.info,  Node: ETIME,  Next: EXECUTE_COMMAND_LINE,  Prev: ERFC_SCALED,  Up: Intrinsic Procedures
+
+8.74 `ETIME' -- Execution time subroutine (or function)
+=======================================================
+
+_Description_:
+     `ETIME(VALUES, TIME)' returns the number of seconds of runtime
+     since the start of the process's execution in TIME.  VALUES
+     returns the user and system components of this time in `VALUES(1)'
+     and `VALUES(2)' respectively. TIME is equal to `VALUES(1) +
+     VALUES(2)'.
+
+     On some systems, the underlying timings are represented using
+     types with sufficiently small limits that overflows (wrap around)
+     are possible, such as 32-bit types. Therefore, the values returned
+     by this intrinsic might be, or become, negative, or numerically
+     less than previous values, during a single run of the compiled
+     program.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+     VALUES and TIME are `INTENT(OUT)' and provide the following:
+
+                `VALUES(1)':         User time in seconds.
+                `VALUES(2)':         System time in seconds.
+                `TIME':              Run time since start in seconds.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL ETIME(VALUES, TIME)'.
+     `TIME = ETIME(VALUES)', (not recommended).
+
+_Arguments_:
+     VALUES     The type shall be `REAL(4), DIMENSION(2)'.
+     TIME       The type shall be `REAL(4)'.
+
+_Return value_:
+     Elapsed time in seconds since the start of program execution.
+
+_Example_:
+          program test_etime
+              integer(8) :: i, j
+              real, dimension(2) :: tarray
+              real :: result
+              call ETIME(tarray, result)
+              print *, result
+              print *, tarray(1)
+              print *, tarray(2)
+              do i=1,100000000    ! Just a delay
+                  j = i * i - i
+              end do
+              call ETIME(tarray, result)
+              print *, result
+              print *, tarray(1)
+              print *, tarray(2)
+          end program test_etime
+
+_See also_:
+     *note CPU_TIME::
+
+
+
+File: gfortran.info,  Node: EXECUTE_COMMAND_LINE,  Next: EXIT,  Prev: ETIME,  Up: Intrinsic Procedures
+
+8.75 `EXECUTE_COMMAND_LINE' -- Execute a shell command
+======================================================
+
+_Description_:
+     `EXECUTE_COMMAND_LINE' runs a shell command, synchronously or
+     asynchronously.
+
+     The `COMMAND' argument is passed to the shell and executed, using
+     the C library's `system' call.  (The shell is `sh' on Unix
+     systems, and `cmd.exe' on Windows.)  If `WAIT' is present and has
+     the value false, the execution of the command is asynchronous if
+     the system supports it; otherwise, the command is executed
+     synchronously.
+
+     The three last arguments allow the user to get status information.
+     After synchronous execution, `EXITSTAT' contains the integer exit
+     code of the command, as returned by `system'.  `CMDSTAT' is set to
+     zero if the command line was executed (whatever its exit status
+     was).  `CMDMSG' is assigned an error message if an error has
+     occurred.
+
+     Note that the `system' function need not be thread-safe. It is the
+     responsibility of the user to ensure that `system' is not called
+     concurrently.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL EXECUTE_COMMAND_LINE(COMMAND [, WAIT, EXITSTAT, CMDSTAT,
+     CMDMSG ])'
+
+_Arguments_:
+     COMMAND    Shall be a default `CHARACTER' scalar.
+     WAIT       (Optional) Shall be a default `LOGICAL' scalar.
+     EXITSTAT   (Optional) Shall be an `INTEGER' of the
+                default kind.
+     CMDSTAT    (Optional) Shall be an `INTEGER' of the
+                default kind.
+     CMDMSG     (Optional) Shall be an `CHARACTER' scalar of
+                the default kind.
+
+_Example_:
+          program test_exec
+            integer :: i
+
+            call execute_command_line ("external_prog.exe", exitstat=i)
+            print *, "Exit status of external_prog.exe was ", i
+
+            call execute_command_line ("reindex_files.exe", wait=.false.)
+            print *, "Now reindexing files in the background"
+
+          end program test_exec
+
+_Note_:
+     Because this intrinsic is implemented in terms of the `system'
+     function call, its behavior with respect to signaling is processor
+     dependent. In particular, on POSIX-compliant systems, the SIGINT
+     and SIGQUIT signals will be ignored, and the SIGCHLD will be
+     blocked. As such, if the parent process is terminated, the child
+     process might not be terminated alongside.
+
+_See also_:
+     *note SYSTEM::
+
+
+File: gfortran.info,  Node: EXIT,  Next: EXP,  Prev: EXECUTE_COMMAND_LINE,  Up: Intrinsic Procedures
+
+8.76 `EXIT' -- Exit the program with status.
+============================================
+
+_Description_:
+     `EXIT' causes immediate termination of the program with status.
+     If status is omitted it returns the canonical _success_ for the
+     system.  All Fortran I/O units are closed.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL EXIT([STATUS])'
+
+_Arguments_:
+     STATUS     Shall be an `INTEGER' of the default kind.
+
+_Return value_:
+     `STATUS' is passed to the parent process on exit.
+
+_Example_:
+          program test_exit
+            integer :: STATUS = 0
+            print *, 'This program is going to exit.'
+            call EXIT(STATUS)
+          end program test_exit
+
+_See also_:
+     *note ABORT::, *note KILL::
+
+
+File: gfortran.info,  Node: EXP,  Next: EXPONENT,  Prev: EXIT,  Up: Intrinsic Procedures
+
+8.77 `EXP' -- Exponential function
+==================================
+
+_Description_:
+     `EXP(X)' computes the base e exponential of X.
+
+_Standard_:
+     Fortran 77 and later, has overloads that are GNU extensions
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = EXP(X)'
+
+_Arguments_:
+     X          The type shall be `REAL' or `COMPLEX'.
+
+_Return value_:
+     The return value has same type and kind as X.
+
+_Example_:
+          program test_exp
+            real :: x = 1.0
+            x = exp(x)
+          end program test_exp
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `EXP(X)'      `REAL(4) X'   `REAL(4)'     Fortran 77 and
+                                               later
+     `DEXP(X)'     `REAL(8) X'   `REAL(8)'     Fortran 77 and
+                                               later
+     `CEXP(X)'     `COMPLEX(4)   `COMPLEX(4)'  Fortran 77 and
+                   X'                          later
+     `ZEXP(X)'     `COMPLEX(8)   `COMPLEX(8)'  GNU extension
+                   X'                          
+     `CDEXP(X)'    `COMPLEX(8)   `COMPLEX(8)'  GNU extension
+                   X'                          
+
+
+File: gfortran.info,  Node: EXPONENT,  Next: EXTENDS_TYPE_OF,  Prev: EXP,  Up: Intrinsic Procedures
+
+8.78 `EXPONENT' -- Exponent function
+====================================
+
+_Description_:
+     `EXPONENT(X)' returns the value of the exponent part of X. If X is
+     zero the value returned is zero.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = EXPONENT(X)'
+
+_Arguments_:
+     X          The type shall be `REAL'.
+
+_Return value_:
+     The return value is of type default `INTEGER'.
+
+_Example_:
+          program test_exponent
+            real :: x = 1.0
+            integer :: i
+            i = exponent(x)
+            print *, i
+            print *, exponent(0.0)
+          end program test_exponent
+
+
+File: gfortran.info,  Node: EXTENDS_TYPE_OF,  Next: FDATE,  Prev: EXPONENT,  Up: Intrinsic Procedures
+
+8.79 `EXTENDS_TYPE_OF' --  Query dynamic type for extension
+===========================================================
+
+_Description_:
+     Query dynamic type for extension.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = EXTENDS_TYPE_OF(A, MOLD)'
+
+_Arguments_:
+     A          Shall be an object of extensible declared type
+                or unlimited polymorphic.
+     MOLD       Shall be an object of extensible declared type
+                or unlimited polymorphic.
+
+_Return value_:
+     The return value is a scalar of type default logical. It is true
+     if and only if the dynamic type of A is an extension type of the
+     dynamic type of MOLD.
+
+_See also_:
+     *note SAME_TYPE_AS::
+
+
+File: gfortran.info,  Node: FDATE,  Next: FGET,  Prev: EXTENDS_TYPE_OF,  Up: Intrinsic Procedures
+
+8.80 `FDATE' -- Get the current time as a string
+================================================
+
+_Description_:
+     `FDATE(DATE)' returns the current date (using the same format as
+     `CTIME') in DATE. It is equivalent to `CALL CTIME(DATE, TIME())'.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL FDATE(DATE)'.
+     `DATE = FDATE()'.
+
+_Arguments_:
+     DATE       The type shall be of type `CHARACTER' of the
+                default kind. It is an `INTENT(OUT)' argument.
+                If the length of this variable is too short
+                for the date and time string to fit
+                completely, it will be blank on procedure
+                return.
+
+_Return value_:
+     The current date and time as a string.
+
+_Example_:
+          program test_fdate
+              integer(8) :: i, j
+              character(len=30) :: date
+              call fdate(date)
+              print *, 'Program started on ', date
+              do i = 1, 100000000 ! Just a delay
+                  j = i * i - i
+              end do
+              call fdate(date)
+              print *, 'Program ended on ', date
+          end program test_fdate
+
+_See also_:
+     *note DATE_AND_TIME::, *note CTIME::
+
+
+File: gfortran.info,  Node: FGET,  Next: FGETC,  Prev: FDATE,  Up: Intrinsic Procedures
+
+8.81 `FGET' -- Read a single character in stream mode from stdin
+================================================================
+
+_Description_:
+     Read a single character in stream mode from stdin by bypassing
+     normal formatted output. Stream I/O should not be mixed with
+     normal record-oriented (formatted or unformatted) I/O on the same
+     unit; the results are unpredictable.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+     Note that the `FGET' intrinsic is provided for backwards
+     compatibility with `g77'.  GNU Fortran provides the Fortran 2003
+     Stream facility.  Programmers should consider the use of new
+     stream IO feature in new code for future portability. See also
+     *note Fortran 2003 status::.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL FGET(C [, STATUS])'
+     `STATUS = FGET(C)'
+
+_Arguments_:
+     C          The type shall be `CHARACTER' and of default
+                kind.
+     STATUS     (Optional) status flag of type `INTEGER'.
+                Returns 0 on success, -1 on end-of-file, and a
+                system specific positive error code otherwise.
+
+_Example_:
+          PROGRAM test_fget
+            INTEGER, PARAMETER :: strlen = 100
+            INTEGER :: status, i = 1
+            CHARACTER(len=strlen) :: str = ""
+
+            WRITE (*,*) 'Enter text:'
+            DO
+              CALL fget(str(i:i), status)
+              if (status /= 0 .OR. i > strlen) exit
+              i = i + 1
+            END DO
+            WRITE (*,*) TRIM(str)
+          END PROGRAM
+
+_See also_:
+     *note FGETC::, *note FPUT::, *note FPUTC::
+
+
+File: gfortran.info,  Node: FGETC,  Next: FLOOR,  Prev: FGET,  Up: Intrinsic Procedures
+
+8.82 `FGETC' -- Read a single character in stream mode
+======================================================
+
+_Description_:
+     Read a single character in stream mode by bypassing normal
+     formatted output.  Stream I/O should not be mixed with normal
+     record-oriented (formatted or unformatted) I/O on the same unit;
+     the results are unpredictable.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+     Note that the `FGET' intrinsic is provided for backwards
+     compatibility with `g77'.  GNU Fortran provides the Fortran 2003
+     Stream facility.  Programmers should consider the use of new
+     stream IO feature in new code for future portability. See also
+     *note Fortran 2003 status::.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL FGETC(UNIT, C [, STATUS])'
+     `STATUS = FGETC(UNIT, C)'
+
+_Arguments_:
+     UNIT       The type shall be `INTEGER'.
+     C          The type shall be `CHARACTER' and of default
+                kind.
+     STATUS     (Optional) status flag of type `INTEGER'.
+                Returns 0 on success, -1 on end-of-file and a
+                system specific positive error code otherwise.
+
+_Example_:
+          PROGRAM test_fgetc
+            INTEGER :: fd = 42, status
+            CHARACTER :: c
+
+            OPEN(UNIT=fd, FILE="/etc/passwd", ACTION="READ", STATUS = "OLD")
+            DO
+              CALL fgetc(fd, c, status)
+              IF (status /= 0) EXIT
+              call fput(c)
+            END DO
+            CLOSE(UNIT=fd)
+          END PROGRAM
+
+_See also_:
+     *note FGET::, *note FPUT::, *note FPUTC::
+
+
+File: gfortran.info,  Node: FLOOR,  Next: FLUSH,  Prev: FGETC,  Up: Intrinsic Procedures
+
+8.83 `FLOOR' -- Integer floor function
+======================================
+
+_Description_:
+     `FLOOR(A)' returns the greatest integer less than or equal to X.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = FLOOR(A [, KIND])'
+
+_Arguments_:
+     A          The type shall be `REAL'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER(KIND)' if KIND is present and
+     of default-kind `INTEGER' otherwise.
+
+_Example_:
+          program test_floor
+              real :: x = 63.29
+              real :: y = -63.59
+              print *, floor(x) ! returns 63
+              print *, floor(y) ! returns -64
+          end program test_floor
+
+_See also_:
+     *note CEILING::, *note NINT::
+
+
+
+File: gfortran.info,  Node: FLUSH,  Next: FNUM,  Prev: FLOOR,  Up: Intrinsic Procedures
+
+8.84 `FLUSH' -- Flush I/O unit(s)
+=================================
+
+_Description_:
+     Flushes Fortran unit(s) currently open for output. Without the
+     optional argument, all units are flushed, otherwise just the unit
+     specified.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL FLUSH(UNIT)'
+
+_Arguments_:
+     UNIT       (Optional) The type shall be `INTEGER'.
+
+_Note_:
+     Beginning with the Fortran 2003 standard, there is a `FLUSH'
+     statement that should be preferred over the `FLUSH' intrinsic.
+
+     The `FLUSH' intrinsic and the Fortran 2003 `FLUSH' statement have
+     identical effect: they flush the runtime library's I/O buffer so
+     that the data becomes visible to other processes. This does not
+     guarantee that the data is committed to disk.
+
+     On POSIX systems, you can request that all data is transferred  to
+     the storage device by calling the `fsync' function, with the POSIX
+     file descriptor of the I/O unit as argument (retrieved with GNU
+     intrinsic `FNUM'). The following example shows how:
+
+            ! Declare the interface for POSIX fsync function
+            interface
+              function fsync (fd) bind(c,name="fsync")
+              use iso_c_binding, only: c_int
+                integer(c_int), value :: fd
+                integer(c_int) :: fsync
+              end function fsync
+            end interface
+
+            ! Variable declaration
+            integer :: ret
+
+            ! Opening unit 10
+            open (10,file="foo")
+
+            ! ...
+            ! Perform I/O on unit 10
+            ! ...
+
+            ! Flush and sync
+            flush(10)
+            ret = fsync(fnum(10))
+
+            ! Handle possible error
+            if (ret /= 0) stop "Error calling FSYNC"
+
+
+
+File: gfortran.info,  Node: FNUM,  Next: FPUT,  Prev: FLUSH,  Up: Intrinsic Procedures
+
+8.85 `FNUM' -- File number function
+===================================
+
+_Description_:
+     `FNUM(UNIT)' returns the POSIX file descriptor number
+     corresponding to the open Fortran I/O unit `UNIT'.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = FNUM(UNIT)'
+
+_Arguments_:
+     UNIT       The type shall be `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER'
+
+_Example_:
+          program test_fnum
+            integer :: i
+            open (unit=10, status = "scratch")
+            i = fnum(10)
+            print *, i
+            close (10)
+          end program test_fnum
+
+
+File: gfortran.info,  Node: FPUT,  Next: FPUTC,  Prev: FNUM,  Up: Intrinsic Procedures
+
+8.86 `FPUT' -- Write a single character in stream mode to stdout
+================================================================
+
+_Description_:
+     Write a single character in stream mode to stdout by bypassing
+     normal formatted output. Stream I/O should not be mixed with
+     normal record-oriented (formatted or unformatted) I/O on the same
+     unit; the results are unpredictable.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+     Note that the `FGET' intrinsic is provided for backwards
+     compatibility with `g77'.  GNU Fortran provides the Fortran 2003
+     Stream facility.  Programmers should consider the use of new
+     stream IO feature in new code for future portability. See also
+     *note Fortran 2003 status::.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL FPUT(C [, STATUS])'
+     `STATUS = FPUT(C)'
+
+_Arguments_:
+     C          The type shall be `CHARACTER' and of default
+                kind.
+     STATUS     (Optional) status flag of type `INTEGER'.
+                Returns 0 on success, -1 on end-of-file and a
+                system specific positive error code otherwise.
+
+_Example_:
+          PROGRAM test_fput
+            CHARACTER(len=10) :: str = "gfortran"
+            INTEGER :: i
+            DO i = 1, len_trim(str)
+              CALL fput(str(i:i))
+            END DO
+          END PROGRAM
+
+_See also_:
+     *note FPUTC::, *note FGET::, *note FGETC::
+
+
+File: gfortran.info,  Node: FPUTC,  Next: FRACTION,  Prev: FPUT,  Up: Intrinsic Procedures
+
+8.87 `FPUTC' -- Write a single character in stream mode
+=======================================================
+
+_Description_:
+     Write a single character in stream mode by bypassing normal
+     formatted output. Stream I/O should not be mixed with normal
+     record-oriented (formatted or unformatted) I/O on the same unit;
+     the results are unpredictable.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+     Note that the `FGET' intrinsic is provided for backwards
+     compatibility with `g77'.  GNU Fortran provides the Fortran 2003
+     Stream facility.  Programmers should consider the use of new
+     stream IO feature in new code for future portability. See also
+     *note Fortran 2003 status::.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL FPUTC(UNIT, C [, STATUS])'
+     `STATUS = FPUTC(UNIT, C)'
+
+_Arguments_:
+     UNIT       The type shall be `INTEGER'.
+     C          The type shall be `CHARACTER' and of default
+                kind.
+     STATUS     (Optional) status flag of type `INTEGER'.
+                Returns 0 on success, -1 on end-of-file and a
+                system specific positive error code otherwise.
+
+_Example_:
+          PROGRAM test_fputc
+            CHARACTER(len=10) :: str = "gfortran"
+            INTEGER :: fd = 42, i
+
+            OPEN(UNIT = fd, FILE = "out", ACTION = "WRITE", STATUS="NEW")
+            DO i = 1, len_trim(str)
+              CALL fputc(fd, str(i:i))
+            END DO
+            CLOSE(fd)
+          END PROGRAM
+
+_See also_:
+     *note FPUT::, *note FGET::, *note FGETC::
+
+
+File: gfortran.info,  Node: FRACTION,  Next: FREE,  Prev: FPUTC,  Up: Intrinsic Procedures
+
+8.88 `FRACTION' -- Fractional part of the model representation
+==============================================================
+
+_Description_:
+     `FRACTION(X)' returns the fractional part of the model
+     representation of `X'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `Y = FRACTION(X)'
+
+_Arguments_:
+     X          The type of the argument shall be a `REAL'.
+
+_Return value_:
+     The return value is of the same type and kind as the argument.
+     The fractional part of the model representation of `X' is returned;
+     it is `X * RADIX(X)**(-EXPONENT(X))'.
+
+_Example_:
+          program test_fraction
+            real :: x
+            x = 178.1387e-4
+            print *, fraction(x), x * radix(x)**(-exponent(x))
+          end program test_fraction
+
+
+
+File: gfortran.info,  Node: FREE,  Next: FSEEK,  Prev: FRACTION,  Up: Intrinsic Procedures
+
+8.89 `FREE' -- Frees memory
+===========================
+
+_Description_:
+     Frees memory previously allocated by `MALLOC'. The `FREE'
+     intrinsic is an extension intended to be used with Cray pointers,
+     and is provided in GNU Fortran to allow user to compile legacy
+     code. For new code using Fortran 95 pointers, the memory
+     de-allocation intrinsic is `DEALLOCATE'.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL FREE(PTR)'
+
+_Arguments_:
+     PTR        The type shall be `INTEGER'. It represents the
+                location of the memory that should be
+                de-allocated.
+
+_Return value_:
+     None
+
+_Example_:
+     See `MALLOC' for an example.
+
+_See also_:
+     *note MALLOC::
+
+
+File: gfortran.info,  Node: FSEEK,  Next: FSTAT,  Prev: FREE,  Up: Intrinsic Procedures
+
+8.90 `FSEEK' -- Low level file positioning subroutine
+=====================================================
+
+_Description_:
+     Moves UNIT to the specified OFFSET. If WHENCE is set to 0, the
+     OFFSET is taken as an absolute value `SEEK_SET', if set to 1,
+     OFFSET is taken to be relative to the current position `SEEK_CUR',
+     and if set to 2 relative to the end of the file `SEEK_END'.  On
+     error, STATUS is set to a nonzero value. If STATUS the seek fails
+     silently.
+
+     This intrinsic routine is not fully backwards compatible with
+     `g77'.  In `g77', the `FSEEK' takes a statement label instead of a
+     STATUS variable. If FSEEK is used in old code, change
+            CALL FSEEK(UNIT, OFFSET, WHENCE, *label)
+     to
+            INTEGER :: status
+            CALL FSEEK(UNIT, OFFSET, WHENCE, status)
+            IF (status /= 0) GOTO label
+
+     Please note that GNU Fortran provides the Fortran 2003 Stream
+     facility.  Programmers should consider the use of new stream IO
+     feature in new code for future portability. See also *note Fortran
+     2003 status::.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL FSEEK(UNIT, OFFSET, WHENCE[, STATUS])'
+
+_Arguments_:
+     UNIT       Shall be a scalar of type `INTEGER'.
+     OFFSET     Shall be a scalar of type `INTEGER'.
+     WHENCE     Shall be a scalar of type `INTEGER'.  Its
+                value shall be either 0, 1 or 2.
+     STATUS     (Optional) shall be a scalar of type
+                `INTEGER(4)'.
+
+_Example_:
+          PROGRAM test_fseek
+            INTEGER, PARAMETER :: SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2
+            INTEGER :: fd, offset, ierr
+
+            ierr   = 0
+            offset = 5
+            fd     = 10
+
+            OPEN(UNIT=fd, FILE="fseek.test")
+            CALL FSEEK(fd, offset, SEEK_SET, ierr)  ! move to OFFSET
+            print *, FTELL(fd), ierr
+
+            CALL FSEEK(fd, 0, SEEK_END, ierr)       ! move to end
+            print *, FTELL(fd), ierr
+
+            CALL FSEEK(fd, 0, SEEK_SET, ierr)       ! move to beginning
+            print *, FTELL(fd), ierr
+
+            CLOSE(UNIT=fd)
+          END PROGRAM
+
+_See also_:
+     *note FTELL::
+
+
+File: gfortran.info,  Node: FSTAT,  Next: FTELL,  Prev: FSEEK,  Up: Intrinsic Procedures
+
+8.91 `FSTAT' -- Get file status
+===============================
+
+_Description_:
+     `FSTAT' is identical to *note STAT::, except that information
+     about an already opened file is obtained.
+
+     The elements in `VALUES' are the same as described by *note STAT::.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL FSTAT(UNIT, VALUES [, STATUS])'
+     `STATUS = FSTAT(UNIT, VALUES)'
+
+_Arguments_:
+     UNIT       An open I/O unit number of type `INTEGER'.
+     VALUES     The type shall be `INTEGER(4), DIMENSION(13)'.
+     STATUS     (Optional) status flag of type `INTEGER(4)'.
+                Returns 0 on success and a system specific
+                error code otherwise.
+
+_Example_:
+     See *note STAT:: for an example.
+
+_See also_:
+     To stat a link: *note LSTAT::, to stat a file: *note STAT::
+
+
+File: gfortran.info,  Node: FTELL,  Next: GAMMA,  Prev: FSTAT,  Up: Intrinsic Procedures
+
+8.92 `FTELL' -- Current stream position
+=======================================
+
+_Description_:
+     Retrieves the current position within an open file.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL FTELL(UNIT, OFFSET)'
+     `OFFSET = FTELL(UNIT)'
+
+_Arguments_:
+     OFFSET     Shall of type `INTEGER'.
+     UNIT       Shall of type `INTEGER'.
+
+_Return value_:
+     In either syntax, OFFSET is set to the current offset of unit
+     number UNIT, or to -1 if the unit is not currently open.
+
+_Example_:
+          PROGRAM test_ftell
+            INTEGER :: i
+            OPEN(10, FILE="temp.dat")
+            CALL ftell(10,i)
+            WRITE(*,*) i
+          END PROGRAM
+
+_See also_:
+     *note FSEEK::
+
+
+File: gfortran.info,  Node: GAMMA,  Next: GERROR,  Prev: FTELL,  Up: Intrinsic Procedures
+
+8.93 `GAMMA' -- Gamma function
+==============================
+
+_Description_:
+     `GAMMA(X)' computes Gamma (\Gamma) of X. For positive, integer
+     values of X the Gamma function simplifies to the factorial
+     function \Gamma(x)=(x-1)!.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `X = GAMMA(X)'
+
+_Arguments_:
+     X          Shall be of type `REAL' and neither zero nor a
+                negative integer.
+
+_Return value_:
+     The return value is of type `REAL' of the same kind as X.
+
+_Example_:
+          program test_gamma
+            real :: x = 1.0
+            x = gamma(x) ! returns 1.0
+          end program test_gamma
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `GAMMA(X)'    `REAL(4) X'   `REAL(4)'     GNU Extension
+     `DGAMMA(X)'   `REAL(8) X'   `REAL(8)'     GNU Extension
+
+_See also_:
+     Logarithm of the Gamma function: *note LOG_GAMMA::
+
+
+
+File: gfortran.info,  Node: GERROR,  Next: GETARG,  Prev: GAMMA,  Up: Intrinsic Procedures
+
+8.94 `GERROR' -- Get last system error message
+==============================================
+
+_Description_:
+     Returns the system error message corresponding to the last system
+     error.  This resembles the functionality of `strerror(3)' in C.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL GERROR(RESULT)'
+
+_Arguments_:
+     RESULT     Shall of type `CHARACTER' and of default
+
+_Example_:
+          PROGRAM test_gerror
+            CHARACTER(len=100) :: msg
+            CALL gerror(msg)
+            WRITE(*,*) msg
+          END PROGRAM
+
+_See also_:
+     *note IERRNO::, *note PERROR::
+
+
+File: gfortran.info,  Node: GETARG,  Next: GET_COMMAND,  Prev: GERROR,  Up: Intrinsic Procedures
+
+8.95 `GETARG' -- Get command line arguments
+===========================================
+
+_Description_:
+     Retrieve the POS-th argument that was passed on the command line
+     when the containing program was invoked.
+
+     This intrinsic routine is provided for backwards compatibility with
+     GNU Fortran 77.  In new code, programmers should consider the use
+     of the *note GET_COMMAND_ARGUMENT:: intrinsic defined by the
+     Fortran 2003 standard.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL GETARG(POS, VALUE)'
+
+_Arguments_:
+     POS        Shall be of type `INTEGER' and not wider than
+                the default integer kind; POS \geq 0
+     VALUE      Shall be of type `CHARACTER' and of default
+                kind.
+     VALUE      Shall be of type `CHARACTER'.
+
+_Return value_:
+     After `GETARG' returns, the VALUE argument holds the POSth command
+     line argument. If VALUE can not hold the argument, it is truncated
+     to fit the length of VALUE. If there are less than POS arguments
+     specified at the command line, VALUE will be filled with blanks.
+     If POS = 0, VALUE is set to the name of the program (on systems
+     that support this feature).
+
+_Example_:
+          PROGRAM test_getarg
+            INTEGER :: i
+            CHARACTER(len=32) :: arg
+
+            DO i = 1, iargc()
+              CALL getarg(i, arg)
+              WRITE (*,*) arg
+            END DO
+          END PROGRAM
+
+_See also_:
+     GNU Fortran 77 compatibility function: *note IARGC::
+
+     Fortran 2003 functions and subroutines: *note GET_COMMAND::, *note
+     GET_COMMAND_ARGUMENT::, *note COMMAND_ARGUMENT_COUNT::
+
+
+File: gfortran.info,  Node: GET_COMMAND,  Next: GET_COMMAND_ARGUMENT,  Prev: GETARG,  Up: Intrinsic Procedures
+
+8.96 `GET_COMMAND' -- Get the entire command line
+=================================================
+
+_Description_:
+     Retrieve the entire command line that was used to invoke the
+     program.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL GET_COMMAND([COMMAND, LENGTH, STATUS])'
+
+_Arguments_:
+     COMMAND    (Optional) shall be of type `CHARACTER' and of
+                default kind.
+     LENGTH     (Optional) Shall be of type `INTEGER' and of
+                default kind.
+     STATUS     (Optional) Shall be of type `INTEGER' and of
+                default kind.
+
+_Return value_:
+     If COMMAND is present, stores the entire command line that was used
+     to invoke the program in COMMAND. If LENGTH is present, it is
+     assigned the length of the command line. If STATUS is present, it
+     is assigned 0 upon success of the command, -1 if COMMAND is too
+     short to store the command line, or a positive value in case of an
+     error.
+
+_Example_:
+          PROGRAM test_get_command
+            CHARACTER(len=255) :: cmd
+            CALL get_command(cmd)
+            WRITE (*,*) TRIM(cmd)
+          END PROGRAM
+
+_See also_:
+     *note GET_COMMAND_ARGUMENT::, *note COMMAND_ARGUMENT_COUNT::
+
+
+File: gfortran.info,  Node: GET_COMMAND_ARGUMENT,  Next: GETCWD,  Prev: GET_COMMAND,  Up: Intrinsic Procedures
+
+8.97 `GET_COMMAND_ARGUMENT' -- Get command line arguments
+=========================================================
+
+_Description_:
+     Retrieve the NUMBER-th argument that was passed on the command
+     line when the containing program was invoked.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL GET_COMMAND_ARGUMENT(NUMBER [, VALUE, LENGTH, STATUS])'
+
+_Arguments_:
+     NUMBER     Shall be a scalar of type `INTEGER' and of
+                default kind, NUMBER \geq 0
+     VALUE      (Optional) Shall be a scalar of type
+                `CHARACTER' and of default kind.
+     LENGTH     (Optional) Shall be a scalar of type `INTEGER'
+                and of default kind.
+     STATUS     (Optional) Shall be a scalar of type `INTEGER'
+                and of default kind.
+
+_Return value_:
+     After `GET_COMMAND_ARGUMENT' returns, the VALUE argument holds the
+     NUMBER-th command line argument. If VALUE can not hold the
+     argument, it is truncated to fit the length of VALUE. If there are
+     less than NUMBER arguments specified at the command line, VALUE
+     will be filled with blanks.  If NUMBER = 0, VALUE is set to the
+     name of the program (on systems that support this feature). The
+     LENGTH argument contains the length of the NUMBER-th command line
+     argument. If the argument retrieval fails, STATUS is a positive
+     number; if VALUE contains a truncated command line argument,
+     STATUS is -1; and otherwise the STATUS is zero.
+
+_Example_:
+          PROGRAM test_get_command_argument
+            INTEGER :: i
+            CHARACTER(len=32) :: arg
+
+            i = 0
+            DO
+              CALL get_command_argument(i, arg)
+              IF (LEN_TRIM(arg) == 0) EXIT
+
+              WRITE (*,*) TRIM(arg)
+              i = i+1
+            END DO
+          END PROGRAM
+
+_See also_:
+     *note GET_COMMAND::, *note COMMAND_ARGUMENT_COUNT::
+
+
+File: gfortran.info,  Node: GETCWD,  Next: GETENV,  Prev: GET_COMMAND_ARGUMENT,  Up: Intrinsic Procedures
+
+8.98 `GETCWD' -- Get current working directory
+==============================================
+
+_Description_:
+     Get current working directory.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL GETCWD(C [, STATUS])'
+     `STATUS = GETCWD(C)'
+
+_Arguments_:
+     C          The type shall be `CHARACTER' and of default
+                kind.
+     STATUS     (Optional) status flag. Returns 0 on success,
+                a system specific and nonzero error code
+                otherwise.
+
+_Example_:
+          PROGRAM test_getcwd
+            CHARACTER(len=255) :: cwd
+            CALL getcwd(cwd)
+            WRITE(*,*) TRIM(cwd)
+          END PROGRAM
+
+_See also_:
+     *note CHDIR::
+
+
+File: gfortran.info,  Node: GETENV,  Next: GET_ENVIRONMENT_VARIABLE,  Prev: GETCWD,  Up: Intrinsic Procedures
+
+8.99 `GETENV' -- Get an environmental variable
+==============================================
+
+_Description_:
+     Get the VALUE of the environmental variable NAME.
+
+     This intrinsic routine is provided for backwards compatibility with
+     GNU Fortran 77.  In new code, programmers should consider the use
+     of the *note GET_ENVIRONMENT_VARIABLE:: intrinsic defined by the
+     Fortran 2003 standard.
+
+     Note that `GETENV' need not be thread-safe. It is the
+     responsibility of the user to ensure that the environment is not
+     being updated concurrently with a call to the `GETENV' intrinsic.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL GETENV(NAME, VALUE)'
+
+_Arguments_:
+     NAME       Shall be of type `CHARACTER' and of default
+                kind.
+     VALUE      Shall be of type `CHARACTER' and of default
+                kind.
+
+_Return value_:
+     Stores the value of NAME in VALUE. If VALUE is not large enough to
+     hold the data, it is truncated. If NAME is not set, VALUE will be
+     filled with blanks.
+
+_Example_:
+          PROGRAM test_getenv
+            CHARACTER(len=255) :: homedir
+            CALL getenv("HOME", homedir)
+            WRITE (*,*) TRIM(homedir)
+          END PROGRAM
+
+_See also_:
+     *note GET_ENVIRONMENT_VARIABLE::
+
+
+File: gfortran.info,  Node: GET_ENVIRONMENT_VARIABLE,  Next: GETGID,  Prev: GETENV,  Up: Intrinsic Procedures
+
+8.100 `GET_ENVIRONMENT_VARIABLE' -- Get an environmental variable
+=================================================================
+
+_Description_:
+     Get the VALUE of the environmental variable NAME.
+
+     Note that `GET_ENVIRONMENT_VARIABLE' need not be thread-safe. It
+     is the responsibility of the user to ensure that the environment is
+     not being updated concurrently with a call to the
+     `GET_ENVIRONMENT_VARIABLE' intrinsic.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL GET_ENVIRONMENT_VARIABLE(NAME[, VALUE, LENGTH, STATUS,
+     TRIM_NAME)'
+
+_Arguments_:
+     NAME       Shall be a scalar of type `CHARACTER' and of
+                default kind.
+     VALUE      (Optional) Shall be a scalar of type
+                `CHARACTER' and of default kind.
+     LENGTH     (Optional) Shall be a scalar of type `INTEGER'
+                and of default kind.
+     STATUS     (Optional) Shall be a scalar of type `INTEGER'
+                and of default kind.
+     TRIM_NAME  (Optional) Shall be a scalar of type `LOGICAL'
+                and of default kind.
+
+_Return value_:
+     Stores the value of NAME in VALUE. If VALUE is not large enough to
+     hold the data, it is truncated. If NAME is not set, VALUE will be
+     filled with blanks. Argument LENGTH contains the length needed for
+     storing the environment variable NAME or zero if it is not
+     present. STATUS is -1 if VALUE is present but too short for the
+     environment variable; it is 1 if the environment variable does not
+     exist and 2 if the processor does not support environment
+     variables; in all other cases STATUS is zero. If TRIM_NAME is
+     present with the value `.FALSE.', the trailing blanks in NAME are
+     significant; otherwise they are not part of the environment
+     variable name.
+
+_Example_:
+          PROGRAM test_getenv
+            CHARACTER(len=255) :: homedir
+            CALL get_environment_variable("HOME", homedir)
+            WRITE (*,*) TRIM(homedir)
+          END PROGRAM
+
+
+File: gfortran.info,  Node: GETGID,  Next: GETLOG,  Prev: GET_ENVIRONMENT_VARIABLE,  Up: Intrinsic Procedures
+
+8.101 `GETGID' -- Group ID function
+===================================
+
+_Description_:
+     Returns the numerical group ID of the current process.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = GETGID()'
+
+_Return value_:
+     The return value of `GETGID' is an `INTEGER' of the default kind.
+
+_Example_:
+     See `GETPID' for an example.
+
+_See also_:
+     *note GETPID::, *note GETUID::
+
+
+File: gfortran.info,  Node: GETLOG,  Next: GETPID,  Prev: GETGID,  Up: Intrinsic Procedures
+
+8.102 `GETLOG' -- Get login name
+================================
+
+_Description_:
+     Gets the username under which the program is running.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL GETLOG(C)'
+
+_Arguments_:
+     C          Shall be of type `CHARACTER' and of default
+                kind.
+
+_Return value_:
+     Stores the current user name in LOGIN.  (On systems where POSIX
+     functions `geteuid' and `getpwuid' are not available, and the
+     `getlogin' function is not implemented either, this will return a
+     blank string.)
+
+_Example_:
+          PROGRAM TEST_GETLOG
+            CHARACTER(32) :: login
+            CALL GETLOG(login)
+            WRITE(*,*) login
+          END PROGRAM
+
+_See also_:
+     *note GETUID::
+
+
+File: gfortran.info,  Node: GETPID,  Next: GETUID,  Prev: GETLOG,  Up: Intrinsic Procedures
+
+8.103 `GETPID' -- Process ID function
+=====================================
+
+_Description_:
+     Returns the numerical process identifier of the current process.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = GETPID()'
+
+_Return value_:
+     The return value of `GETPID' is an `INTEGER' of the default kind.
+
+_Example_:
+          program info
+            print *, "The current process ID is ", getpid()
+            print *, "Your numerical user ID is ", getuid()
+            print *, "Your numerical group ID is ", getgid()
+          end program info
+
+_See also_:
+     *note GETGID::, *note GETUID::
+
+
+File: gfortran.info,  Node: GETUID,  Next: GMTIME,  Prev: GETPID,  Up: Intrinsic Procedures
+
+8.104 `GETUID' -- User ID function
+==================================
+
+_Description_:
+     Returns the numerical user ID of the current process.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = GETUID()'
+
+_Return value_:
+     The return value of `GETUID' is an `INTEGER' of the default kind.
+
+_Example_:
+     See `GETPID' for an example.
+
+_See also_:
+     *note GETPID::, *note GETLOG::
+
+
+File: gfortran.info,  Node: GMTIME,  Next: HOSTNM,  Prev: GETUID,  Up: Intrinsic Procedures
+
+8.105 `GMTIME' -- Convert time to GMT info
+==========================================
+
+_Description_:
+     Given a system time value TIME (as provided by the `TIME8'
+     intrinsic), fills VALUES with values extracted from it appropriate
+     to the UTC time zone (Universal Coordinated Time, also known in
+     some countries as GMT, Greenwich Mean Time), using `gmtime(3)'.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL GMTIME(TIME, VALUES)'
+
+_Arguments_:
+     TIME       An `INTEGER' scalar expression corresponding
+                to a system time, with `INTENT(IN)'.
+     VALUES     A default `INTEGER' array with 9 elements,
+                with `INTENT(OUT)'.
+
+_Return value_:
+     The elements of VALUES are assigned as follows:
+       1. Seconds after the minute, range 0-59 or 0-61 to allow for leap
+          seconds
+
+       2. Minutes after the hour, range 0-59
+
+       3. Hours past midnight, range 0-23
+
+       4. Day of month, range 0-31
+
+       5. Number of months since January, range 0-12
+
+       6. Years since 1900
+
+       7. Number of days since Sunday, range 0-6
+
+       8. Days since January 1
+
+       9. Daylight savings indicator: positive if daylight savings is in
+          effect, zero if not, and negative if the information is not
+          available.
+
+_See also_:
+     *note CTIME::, *note LTIME::, *note TIME::, *note TIME8::
+
+
+
+File: gfortran.info,  Node: HOSTNM,  Next: HUGE,  Prev: GMTIME,  Up: Intrinsic Procedures
+
+8.106 `HOSTNM' -- Get system host name
+======================================
+
+_Description_:
+     Retrieves the host name of the system on which the program is
+     running.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL HOSTNM(C [, STATUS])'
+     `STATUS = HOSTNM(NAME)'
+
+_Arguments_:
+     C          Shall of type `CHARACTER' and of default kind.
+     STATUS     (Optional) status flag of type `INTEGER'.
+                Returns 0 on success, or a system specific
+                error code otherwise.
+
+_Return value_:
+     In either syntax, NAME is set to the current hostname if it can be
+     obtained, or to a blank string otherwise.
+
+
+
+File: gfortran.info,  Node: HUGE,  Next: HYPOT,  Prev: HOSTNM,  Up: Intrinsic Procedures
+
+8.107 `HUGE' -- Largest number of a kind
+========================================
+
+_Description_:
+     `HUGE(X)' returns the largest number that is not an infinity in
+     the model of the type of `X'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = HUGE(X)'
+
+_Arguments_:
+     X          Shall be of type `REAL' or `INTEGER'.
+
+_Return value_:
+     The return value is of the same type and kind as X
+
+_Example_:
+          program test_huge_tiny
+            print *, huge(0), huge(0.0), huge(0.0d0)
+            print *, tiny(0.0), tiny(0.0d0)
+          end program test_huge_tiny
+
+
+File: gfortran.info,  Node: HYPOT,  Next: IACHAR,  Prev: HUGE,  Up: Intrinsic Procedures
+
+8.108 `HYPOT' -- Euclidean distance function
+============================================
+
+_Description_:
+     `HYPOT(X,Y)' is the Euclidean distance function. It is equal to
+     \sqrtX^2 + Y^2, without undue underflow or overflow.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = HYPOT(X, Y)'
+
+_Arguments_:
+     X          The type shall be `REAL'.
+     Y          The type and kind type parameter shall be the
+                same as X.
+
+_Return value_:
+     The return value has the same type and kind type parameter as X.
+
+_Example_:
+          program test_hypot
+            real(4) :: x = 1.e0_4, y = 0.5e0_4
+            x = hypot(x,y)
+          end program test_hypot
+
+
+File: gfortran.info,  Node: IACHAR,  Next: IALL,  Prev: HYPOT,  Up: Intrinsic Procedures
+
+8.109 `IACHAR' -- Code in ASCII collating sequence
+==================================================
+
+_Description_:
+     `IACHAR(C)' returns the code for the ASCII character in the first
+     character position of `C'.
+
+_Standard_:
+     Fortran 95 and later, with KIND argument Fortran 2003 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = IACHAR(C [, KIND])'
+
+_Arguments_:
+     C          Shall be a scalar `CHARACTER', with
+                `INTENT(IN)'
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER' and of kind KIND. If KIND is
+     absent, the return value is of default integer kind.
+
+_Example_:
+          program test_iachar
+            integer i
+            i = iachar(' ')
+          end program test_iachar
+
+_Note_:
+     See *note ICHAR:: for a discussion of converting between numerical
+     values and formatted string representations.
+
+_See also_:
+     *note ACHAR::, *note CHAR::, *note ICHAR::
+
+
+
+File: gfortran.info,  Node: IALL,  Next: IAND,  Prev: IACHAR,  Up: Intrinsic Procedures
+
+8.110 `IALL' -- Bitwise AND of array elements
+=============================================
+
+_Description_:
+     Reduces with bitwise AND the elements of ARRAY along dimension DIM
+     if the corresponding element in MASK is `TRUE'.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = IALL(ARRAY[, MASK])'
+     `RESULT = IALL(ARRAY, DIM[, MASK])'
+
+_Arguments_:
+     ARRAY      Shall be an array of type `INTEGER'
+     DIM        (Optional) shall be a scalar of type `INTEGER'
+                with a value in the range from 1 to n, where n
+                equals the rank of ARRAY.
+     MASK       (Optional) shall be of type `LOGICAL' and
+                either be a scalar or an array of the same
+                shape as ARRAY.
+
+_Return value_:
+     The result is of the same type as ARRAY.
+
+     If DIM is absent, a scalar with the bitwise ALL of all elements in
+     ARRAY is returned. Otherwise, an array of rank n-1, where n equals
+     the rank of ARRAY, and a shape similar to that of ARRAY with
+     dimension DIM dropped is returned.
+
+_Example_:
+          PROGRAM test_iall
+            INTEGER(1) :: a(2)
+
+            a(1) = b'00100100'
+            a(2) = b'01101010'
+
+            ! prints 00100000
+            PRINT '(b8.8)', IALL(a)
+          END PROGRAM
+
+_See also_:
+     *note IANY::, *note IPARITY::, *note IAND::
+
+
+File: gfortran.info,  Node: IAND,  Next: IANY,  Prev: IALL,  Up: Intrinsic Procedures
+
+8.111 `IAND' -- Bitwise logical and
+===================================
+
+_Description_:
+     Bitwise logical `AND'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = IAND(I, J)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     J          The type shall be `INTEGER', of the same kind
+                as I.  (As a GNU extension, different kinds
+                are also permitted.)
+
+_Return value_:
+     The return type is `INTEGER', of the same kind as the arguments.
+     (If the argument kinds differ, it is of the same kind as the
+     larger argument.)
+
+_Example_:
+          PROGRAM test_iand
+            INTEGER :: a, b
+            DATA a / Z'F' /, b / Z'3' /
+            WRITE (*,*) IAND(a, b)
+          END PROGRAM
+
+_See also_:
+     *note IOR::, *note IEOR::, *note IBITS::, *note IBSET::, *note
+     IBCLR::, *note NOT::
+
+
+
+File: gfortran.info,  Node: IANY,  Next: IARGC,  Prev: IAND,  Up: Intrinsic Procedures
+
+8.112 `IANY' -- Bitwise OR of array elements
+============================================
+
+_Description_:
+     Reduces with bitwise OR (inclusive or) the elements of ARRAY along
+     dimension DIM if the corresponding element in MASK is `TRUE'.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = IANY(ARRAY[, MASK])'
+     `RESULT = IANY(ARRAY, DIM[, MASK])'
+
+_Arguments_:
+     ARRAY      Shall be an array of type `INTEGER'
+     DIM        (Optional) shall be a scalar of type `INTEGER'
+                with a value in the range from 1 to n, where n
+                equals the rank of ARRAY.
+     MASK       (Optional) shall be of type `LOGICAL' and
+                either be a scalar or an array of the same
+                shape as ARRAY.
+
+_Return value_:
+     The result is of the same type as ARRAY.
+
+     If DIM is absent, a scalar with the bitwise OR of all elements in
+     ARRAY is returned. Otherwise, an array of rank n-1, where n equals
+     the rank of ARRAY, and a shape similar to that of ARRAY with
+     dimension DIM dropped is returned.
+
+_Example_:
+          PROGRAM test_iany
+            INTEGER(1) :: a(2)
+
+            a(1) = b'00100100'
+            a(2) = b'01101010'
+
+            ! prints 01101110
+            PRINT '(b8.8)', IANY(a)
+          END PROGRAM
+
+_See also_:
+     *note IPARITY::, *note IALL::, *note IOR::
+
+
+File: gfortran.info,  Node: IARGC,  Next: IBCLR,  Prev: IANY,  Up: Intrinsic Procedures
+
+8.113 `IARGC' -- Get the number of command line arguments
+=========================================================
+
+_Description_:
+     `IARGC' returns the number of arguments passed on the command line
+     when the containing program was invoked.
+
+     This intrinsic routine is provided for backwards compatibility with
+     GNU Fortran 77.  In new code, programmers should consider the use
+     of the *note COMMAND_ARGUMENT_COUNT:: intrinsic defined by the
+     Fortran 2003 standard.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = IARGC()'
+
+_Arguments_:
+     None.
+
+_Return value_:
+     The number of command line arguments, type `INTEGER(4)'.
+
+_Example_:
+     See *note GETARG::
+
+_See also_:
+     GNU Fortran 77 compatibility subroutine: *note GETARG::
+
+     Fortran 2003 functions and subroutines: *note GET_COMMAND::, *note
+     GET_COMMAND_ARGUMENT::, *note COMMAND_ARGUMENT_COUNT::
+
+
+File: gfortran.info,  Node: IBCLR,  Next: IBITS,  Prev: IARGC,  Up: Intrinsic Procedures
+
+8.114 `IBCLR' -- Clear bit
+==========================
+
+_Description_:
+     `IBCLR' returns the value of I with the bit at position POS set to
+     zero.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = IBCLR(I, POS)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     POS        The type shall be `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the same kind as I.
+
+_See also_:
+     *note IBITS::, *note IBSET::, *note IAND::, *note IOR::, *note
+     IEOR::, *note MVBITS::
+
+
+
+File: gfortran.info,  Node: IBITS,  Next: IBSET,  Prev: IBCLR,  Up: Intrinsic Procedures
+
+8.115 `IBITS' -- Bit extraction
+===============================
+
+_Description_:
+     `IBITS' extracts a field of length LEN from I, starting from bit
+     position POS and extending left for LEN bits.  The result is
+     right-justified and the remaining bits are zeroed.  The value of
+     `POS+LEN' must be less than or equal to the value `BIT_SIZE(I)'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = IBITS(I, POS, LEN)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     POS        The type shall be `INTEGER'.
+     LEN        The type shall be `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the same kind as I.
+
+_See also_:
+     *note BIT_SIZE::, *note IBCLR::, *note IBSET::, *note IAND::,
+     *note IOR::, *note IEOR::
+
+
+File: gfortran.info,  Node: IBSET,  Next: ICHAR,  Prev: IBITS,  Up: Intrinsic Procedures
+
+8.116 `IBSET' -- Set bit
+========================
+
+_Description_:
+     `IBSET' returns the value of I with the bit at position POS set to
+     one.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = IBSET(I, POS)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     POS        The type shall be `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the same kind as I.
+
+_See also_:
+     *note IBCLR::, *note IBITS::, *note IAND::, *note IOR::, *note
+     IEOR::, *note MVBITS::
+
+
+
+File: gfortran.info,  Node: ICHAR,  Next: IDATE,  Prev: IBSET,  Up: Intrinsic Procedures
+
+8.117 `ICHAR' -- Character-to-integer conversion function
+=========================================================
+
+_Description_:
+     `ICHAR(C)' returns the code for the character in the first
+     character position of `C' in the system's native character set.
+     The correspondence between characters and their codes is not
+     necessarily the same across different GNU Fortran implementations.
+
+_Standard_:
+     Fortran 95 and later, with KIND argument Fortran 2003 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ICHAR(C [, KIND])'
+
+_Arguments_:
+     C          Shall be a scalar `CHARACTER', with
+                `INTENT(IN)'
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER' and of kind KIND. If KIND is
+     absent, the return value is of default integer kind.
+
+_Example_:
+          program test_ichar
+            integer i
+            i = ichar(' ')
+          end program test_ichar
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `ICHAR(C)'    `CHARACTER    `INTEGER(4)'  Fortran 77 and
+                   C'                          later
+
+_Note_:
+     No intrinsic exists to convert between a numeric value and a
+     formatted character string representation - for instance, given the
+     `CHARACTER' value `'154'', obtaining an `INTEGER' or `REAL' value
+     with the value 154, or vice versa. Instead, this functionality is
+     provided by internal-file I/O, as in the following example:
+          program read_val
+            integer value
+            character(len=10) string, string2
+            string = '154'
+
+            ! Convert a string to a numeric value
+            read (string,'(I10)') value
+            print *, value
+
+            ! Convert a value to a formatted string
+            write (string2,'(I10)') value
+            print *, string2
+          end program read_val
+
+_See also_:
+     *note ACHAR::, *note CHAR::, *note IACHAR::
+
+
+
+File: gfortran.info,  Node: IDATE,  Next: IEOR,  Prev: ICHAR,  Up: Intrinsic Procedures
+
+8.118 `IDATE' -- Get current local time subroutine (day/month/year)
+===================================================================
+
+_Description_:
+     `IDATE(VALUES)' Fills VALUES with the numerical values at the
+     current local time. The day (in the range 1-31), month (in the
+     range 1-12), and year appear in elements 1, 2, and 3 of VALUES,
+     respectively.  The year has four significant digits.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL IDATE(VALUES)'
+
+_Arguments_:
+     VALUES     The type shall be `INTEGER, DIMENSION(3)' and
+                the kind shall be the default integer kind.
+
+_Return value_:
+     Does not return anything.
+
+_Example_:
+          program test_idate
+            integer, dimension(3) :: tarray
+            call idate(tarray)
+            print *, tarray(1)
+            print *, tarray(2)
+            print *, tarray(3)
+          end program test_idate
+
+
+File: gfortran.info,  Node: IEOR,  Next: IERRNO,  Prev: IDATE,  Up: Intrinsic Procedures
+
+8.119 `IEOR' -- Bitwise logical exclusive or
+============================================
+
+_Description_:
+     `IEOR' returns the bitwise Boolean exclusive-OR of I and J.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = IEOR(I, J)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     J          The type shall be `INTEGER', of the same kind
+                as I.  (As a GNU extension, different kinds
+                are also permitted.)
+
+_Return value_:
+     The return type is `INTEGER', of the same kind as the arguments.
+     (If the argument kinds differ, it is of the same kind as the
+     larger argument.)
+
+_See also_:
+     *note IOR::, *note IAND::, *note IBITS::, *note IBSET::, *note
+     IBCLR::, *note NOT::
+
+
+File: gfortran.info,  Node: IERRNO,  Next: IMAGE_INDEX,  Prev: IEOR,  Up: Intrinsic Procedures
+
+8.120 `IERRNO' -- Get the last system error number
+==================================================
+
+_Description_:
+     Returns the last system error number, as given by the C `errno'
+     variable.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = IERRNO()'
+
+_Arguments_:
+     None.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the default integer
+     kind.
+
+_See also_:
+     *note PERROR::
+
+
+File: gfortran.info,  Node: IMAGE_INDEX,  Next: INDEX intrinsic,  Prev: IERRNO,  Up: Intrinsic Procedures
+
+8.121 `IMAGE_INDEX' -- Function that converts a cosubscript to an image index
+=============================================================================
+
+_Description_:
+     Returns the image index belonging to a cosubscript.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Inquiry function.
+
+_Syntax_:
+     `RESULT = IMAGE_INDEX(COARRAY, SUB)'
+
+_Arguments_: None.
+     COARRAY    Coarray of any type.
+     SUB        default integer rank-1 array of a size equal to
+                the corank of COARRAY.
+
+_Return value_:
+     Scalar default integer with the value of the image index which
+     corresponds to the cosubscripts. For invalid cosubscripts the
+     result is zero.
+
+_Example_:
+          INTEGER :: array[2,-1:4,8,*]
+          ! Writes  28 (or 0 if there are fewer than 28 images)
+          WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1])
+
+_See also_:
+     *note THIS_IMAGE::, *note NUM_IMAGES::
+
+
+File: gfortran.info,  Node: INDEX intrinsic,  Next: INT,  Prev: IMAGE_INDEX,  Up: Intrinsic Procedures
+
+8.122 `INDEX' -- Position of a substring within a string
+========================================================
+
+_Description_:
+     Returns the position of the start of the first occurrence of string
+     SUBSTRING as a substring in STRING, counting from one.  If
+     SUBSTRING is not present in STRING, zero is returned.  If the BACK
+     argument is present and true, the return value is the start of the
+     last occurrence rather than the first.
+
+_Standard_:
+     Fortran 77 and later, with KIND argument Fortran 2003 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = INDEX(STRING, SUBSTRING [, BACK [, KIND]])'
+
+_Arguments_:
+     STRING     Shall be a scalar `CHARACTER', with
+                `INTENT(IN)'
+     SUBSTRING  Shall be a scalar `CHARACTER', with
+                `INTENT(IN)'
+     BACK       (Optional) Shall be a scalar `LOGICAL', with
+                `INTENT(IN)'
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER' and of kind KIND. If KIND is
+     absent, the return value is of default integer kind.
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `INDEX(STRING,`CHARACTER'   `INTEGER(4)'  Fortran 77 and
+     SUBSTRING)'                               later
+
+_See also_:
+     *note SCAN::, *note VERIFY::
+
+
+File: gfortran.info,  Node: INT,  Next: INT2,  Prev: INDEX intrinsic,  Up: Intrinsic Procedures
+
+8.123 `INT' -- Convert to integer type
+======================================
+
+_Description_:
+     Convert to integer type
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = INT(A [, KIND))'
+
+_Arguments_:
+     A          Shall be of type `INTEGER', `REAL', or
+                `COMPLEX'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     These functions return a `INTEGER' variable or array under the
+     following rules:
+
+    (A)
+          If A is of type `INTEGER', `INT(A) = A'
+
+    (B)
+          If A is of type `REAL' and |A| < 1, `INT(A)' equals `0'.  If
+          |A| \geq 1, then `INT(A)' equals the largest integer that
+          does not exceed the range of A and whose sign is the same as
+          the sign of A.
+
+    (C)
+          If A is of type `COMPLEX', rule B is applied to the real part
+          of A.
+
+_Example_:
+          program test_int
+            integer :: i = 42
+            complex :: z = (-3.7, 1.0)
+            print *, int(i)
+            print *, int(z), int(z,8)
+          end program
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `INT(A)'      `REAL(4) A'   `INTEGER'     Fortran 77 and
+                                               later
+     `IFIX(A)'     `REAL(4) A'   `INTEGER'     Fortran 77 and
+                                               later
+     `IDINT(A)'    `REAL(8) A'   `INTEGER'     Fortran 77 and
+                                               later
+
+
+
+File: gfortran.info,  Node: INT2,  Next: INT8,  Prev: INT,  Up: Intrinsic Procedures
+
+8.124 `INT2' -- Convert to 16-bit integer type
+==============================================
+
+_Description_:
+     Convert to a `KIND=2' integer type. This is equivalent to the
+     standard `INT' intrinsic with an optional argument of `KIND=2',
+     and is only included for backwards compatibility.
+
+     The `SHORT' intrinsic is equivalent to `INT2'.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = INT2(A)'
+
+_Arguments_:
+     A          Shall be of type `INTEGER', `REAL', or
+                `COMPLEX'.
+
+_Return value_:
+     The return value is a `INTEGER(2)' variable.
+
+_See also_:
+     *note INT::, *note INT8::, *note LONG::
+
+
+File: gfortran.info,  Node: INT8,  Next: IOR,  Prev: INT2,  Up: Intrinsic Procedures
+
+8.125 `INT8' -- Convert to 64-bit integer type
+==============================================
+
+_Description_:
+     Convert to a `KIND=8' integer type. This is equivalent to the
+     standard `INT' intrinsic with an optional argument of `KIND=8',
+     and is only included for backwards compatibility.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = INT8(A)'
+
+_Arguments_:
+     A          Shall be of type `INTEGER', `REAL', or
+                `COMPLEX'.
+
+_Return value_:
+     The return value is a `INTEGER(8)' variable.
+
+_See also_:
+     *note INT::, *note INT2::, *note LONG::
+
+
+File: gfortran.info,  Node: IOR,  Next: IPARITY,  Prev: INT8,  Up: Intrinsic Procedures
+
+8.126 `IOR' -- Bitwise logical or
+=================================
+
+_Description_:
+     `IOR' returns the bitwise Boolean inclusive-OR of I and J.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = IOR(I, J)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     J          The type shall be `INTEGER', of the same kind
+                as I.  (As a GNU extension, different kinds
+                are also permitted.)
+
+_Return value_:
+     The return type is `INTEGER', of the same kind as the arguments.
+     (If the argument kinds differ, it is of the same kind as the
+     larger argument.)
+
+_See also_:
+     *note IEOR::, *note IAND::, *note IBITS::, *note IBSET::, *note
+     IBCLR::, *note NOT::
+
+
+File: gfortran.info,  Node: IPARITY,  Next: IRAND,  Prev: IOR,  Up: Intrinsic Procedures
+
+8.127 `IPARITY' -- Bitwise XOR of array elements
+================================================
+
+_Description_:
+     Reduces with bitwise XOR (exclusive or) the elements of ARRAY along
+     dimension DIM if the corresponding element in MASK is `TRUE'.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = IPARITY(ARRAY[, MASK])'
+     `RESULT = IPARITY(ARRAY, DIM[, MASK])'
+
+_Arguments_:
+     ARRAY      Shall be an array of type `INTEGER'
+     DIM        (Optional) shall be a scalar of type `INTEGER'
+                with a value in the range from 1 to n, where n
+                equals the rank of ARRAY.
+     MASK       (Optional) shall be of type `LOGICAL' and
+                either be a scalar or an array of the same
+                shape as ARRAY.
+
+_Return value_:
+     The result is of the same type as ARRAY.
+
+     If DIM is absent, a scalar with the bitwise XOR of all elements in
+     ARRAY is returned. Otherwise, an array of rank n-1, where n equals
+     the rank of ARRAY, and a shape similar to that of ARRAY with
+     dimension DIM dropped is returned.
+
+_Example_:
+          PROGRAM test_iparity
+            INTEGER(1) :: a(2)
+
+            a(1) = b'00100100'
+            a(2) = b'01101010'
+
+            ! prints 01001110
+            PRINT '(b8.8)', IPARITY(a)
+          END PROGRAM
+
+_See also_:
+     *note IANY::, *note IALL::, *note IEOR::, *note PARITY::
+
+
+File: gfortran.info,  Node: IRAND,  Next: IS_IOSTAT_END,  Prev: IPARITY,  Up: Intrinsic Procedures
+
+8.128 `IRAND' -- Integer pseudo-random number
+=============================================
+
+_Description_:
+     `IRAND(FLAG)' returns a pseudo-random number from a uniform
+     distribution between 0 and a system-dependent limit (which is in
+     most cases 2147483647). If FLAG is 0, the next number in the
+     current sequence is returned; if FLAG is 1, the generator is
+     restarted by `CALL SRAND(0)'; if FLAG has any other value, it is
+     used as a new seed with `SRAND'.
+
+     This intrinsic routine is provided for backwards compatibility with
+     GNU Fortran 77. It implements a simple modulo generator as provided
+     by `g77'. For new code, one should consider the use of *note
+     RANDOM_NUMBER:: as it implements a superior algorithm.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = IRAND(I)'
+
+_Arguments_:
+     I          Shall be a scalar `INTEGER' of kind 4.
+
+_Return value_:
+     The return value is of `INTEGER(kind=4)' type.
+
+_Example_:
+          program test_irand
+            integer,parameter :: seed = 86456
+
+            call srand(seed)
+            print *, irand(), irand(), irand(), irand()
+            print *, irand(seed), irand(), irand(), irand()
+          end program test_irand
+
+
+
+File: gfortran.info,  Node: IS_IOSTAT_END,  Next: IS_IOSTAT_EOR,  Prev: IRAND,  Up: Intrinsic Procedures
+
+8.129 `IS_IOSTAT_END' -- Test for end-of-file value
+===================================================
+
+_Description_:
+     `IS_IOSTAT_END' tests whether an variable has the value of the I/O
+     status "end of file". The function is equivalent to comparing the
+     variable with the `IOSTAT_END' parameter of the intrinsic module
+     `ISO_FORTRAN_ENV'.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = IS_IOSTAT_END(I)'
+
+_Arguments_:
+     I          Shall be of the type `INTEGER'.
+
+_Return value_:
+     Returns a `LOGICAL' of the default kind, which `.TRUE.' if I has
+     the value which indicates an end of file condition for `IOSTAT='
+     specifiers, and is `.FALSE.' otherwise.
+
+_Example_:
+          PROGRAM iostat
+            IMPLICIT NONE
+            INTEGER :: stat, i
+            OPEN(88, FILE='test.dat')
+            READ(88, *, IOSTAT=stat) i
+            IF(IS_IOSTAT_END(stat)) STOP 'END OF FILE'
+          END PROGRAM
+
+
+File: gfortran.info,  Node: IS_IOSTAT_EOR,  Next: ISATTY,  Prev: IS_IOSTAT_END,  Up: Intrinsic Procedures
+
+8.130 `IS_IOSTAT_EOR' -- Test for end-of-record value
+=====================================================
+
+_Description_:
+     `IS_IOSTAT_EOR' tests whether an variable has the value of the I/O
+     status "end of record". The function is equivalent to comparing the
+     variable with the `IOSTAT_EOR' parameter of the intrinsic module
+     `ISO_FORTRAN_ENV'.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = IS_IOSTAT_EOR(I)'
+
+_Arguments_:
+     I          Shall be of the type `INTEGER'.
+
+_Return value_:
+     Returns a `LOGICAL' of the default kind, which `.TRUE.' if I has
+     the value which indicates an end of file condition for `IOSTAT='
+     specifiers, and is `.FALSE.' otherwise.
+
+_Example_:
+          PROGRAM iostat
+            IMPLICIT NONE
+            INTEGER :: stat, i(50)
+            OPEN(88, FILE='test.dat', FORM='UNFORMATTED')
+            READ(88, IOSTAT=stat) i
+            IF(IS_IOSTAT_EOR(stat)) STOP 'END OF RECORD'
+          END PROGRAM
+
+
+File: gfortran.info,  Node: ISATTY,  Next: ISHFT,  Prev: IS_IOSTAT_EOR,  Up: Intrinsic Procedures
+
+8.131 `ISATTY' -- Whether a unit is a terminal device.
+======================================================
+
+_Description_:
+     Determine whether a unit is connected to a terminal device.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = ISATTY(UNIT)'
+
+_Arguments_:
+     UNIT       Shall be a scalar `INTEGER'.
+
+_Return value_:
+     Returns `.TRUE.' if the UNIT is connected to a terminal device,
+     `.FALSE.' otherwise.
+
+_Example_:
+          PROGRAM test_isatty
+            INTEGER(kind=1) :: unit
+            DO unit = 1, 10
+              write(*,*) isatty(unit=unit)
+            END DO
+          END PROGRAM
+
+_See also_:
+     *note TTYNAM::
+
+
+File: gfortran.info,  Node: ISHFT,  Next: ISHFTC,  Prev: ISATTY,  Up: Intrinsic Procedures
+
+8.132 `ISHFT' -- Shift bits
+===========================
+
+_Description_:
+     `ISHFT' returns a value corresponding to I with all of the bits
+     shifted SHIFT places.  A value of SHIFT greater than zero
+     corresponds to a left shift, a value of zero corresponds to no
+     shift, and a value less than zero corresponds to a right shift.
+     If the absolute value of SHIFT is greater than `BIT_SIZE(I)', the
+     value is undefined.  Bits shifted out from the left end or right
+     end are lost; zeros are shifted in from the opposite end.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ISHFT(I, SHIFT)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     SHIFT      The type shall be `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the same kind as I.
+
+_See also_:
+     *note ISHFTC::
+
+
+File: gfortran.info,  Node: ISHFTC,  Next: ISNAN,  Prev: ISHFT,  Up: Intrinsic Procedures
+
+8.133 `ISHFTC' -- Shift bits circularly
+=======================================
+
+_Description_:
+     `ISHFTC' returns a value corresponding to I with the rightmost
+     SIZE bits shifted circularly SHIFT places; that is, bits shifted
+     out one end are shifted into the opposite end.  A value of SHIFT
+     greater than zero corresponds to a left shift, a value of zero
+     corresponds to no shift, and a value less than zero corresponds to
+     a right shift.  The absolute value of SHIFT must be less than
+     SIZE.  If the SIZE argument is omitted, it is taken to be
+     equivalent to `BIT_SIZE(I)'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = ISHFTC(I, SHIFT [, SIZE])'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     SHIFT      The type shall be `INTEGER'.
+     SIZE       (Optional) The type shall be `INTEGER'; the
+                value must be greater than zero and less than
+                or equal to `BIT_SIZE(I)'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the same kind as I.
+
+_See also_:
+     *note ISHFT::
+
+
+File: gfortran.info,  Node: ISNAN,  Next: ITIME,  Prev: ISHFTC,  Up: Intrinsic Procedures
+
+8.134 `ISNAN' -- Test for a NaN
+===============================
+
+_Description_:
+     `ISNAN' tests whether a floating-point value is an IEEE
+     Not-a-Number (NaN).
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `ISNAN(X)'
+
+_Arguments_:
+     X          Variable of the type `REAL'.
+
+_Return value_:
+     Returns a default-kind `LOGICAL'. The returned value is `TRUE' if
+     X is a NaN and `FALSE' otherwise.
+
+_Example_:
+          program test_nan
+            implicit none
+            real :: x
+            x = -1.0
+            x = sqrt(x)
+            if (isnan(x)) stop '"x" is a NaN'
+          end program test_nan
+
+
+File: gfortran.info,  Node: ITIME,  Next: KILL,  Prev: ISNAN,  Up: Intrinsic Procedures
+
+8.135 `ITIME' -- Get current local time subroutine (hour/minutes/seconds)
+=========================================================================
+
+_Description_:
+     `IDATE(VALUES)' Fills VALUES with the numerical values at the
+     current local time. The hour (in the range 1-24), minute (in the
+     range 1-60), and seconds (in the range 1-60) appear in elements 1,
+     2, and 3 of VALUES, respectively.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL ITIME(VALUES)'
+
+_Arguments_:
+     VALUES     The type shall be `INTEGER, DIMENSION(3)' and
+                the kind shall be the default integer kind.
+
+_Return value_:
+     Does not return anything.
+
+_Example_:
+          program test_itime
+            integer, dimension(3) :: tarray
+            call itime(tarray)
+            print *, tarray(1)
+            print *, tarray(2)
+            print *, tarray(3)
+          end program test_itime
+
+
+File: gfortran.info,  Node: KILL,  Next: KIND,  Prev: ITIME,  Up: Intrinsic Procedures
+
+8.136 `KILL' -- Send a signal to a process
+==========================================
+
+_Description_:
+
+_Standard_:
+     Sends the signal specified by SIGNAL to the process PID.  See
+     `kill(2)'.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL KILL(C, VALUE [, STATUS])'
+     `STATUS = KILL(C, VALUE)'
+
+_Arguments_:
+     C          Shall be a scalar `INTEGER', with `INTENT(IN)'
+     VALUE      Shall be a scalar `INTEGER', with `INTENT(IN)'
+     STATUS     (Optional) status flag of type `INTEGER(4)' or
+                `INTEGER(8)'. Returns 0 on success, or a
+                system-specific error code otherwise.
+
+_See also_:
+     *note ABORT::, *note EXIT::
+
+
+File: gfortran.info,  Node: KIND,  Next: LBOUND,  Prev: KILL,  Up: Intrinsic Procedures
+
+8.137 `KIND' -- Kind of an entity
+=================================
+
+_Description_:
+     `KIND(X)' returns the kind value of the entity X.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `K = KIND(X)'
+
+_Arguments_:
+     X          Shall be of type `LOGICAL', `INTEGER', `REAL',
+                `COMPLEX' or `CHARACTER'.
+
+_Return value_:
+     The return value is a scalar of type `INTEGER' and of the default
+     integer kind.
+
+_Example_:
+          program test_kind
+            integer,parameter :: kc = kind(' ')
+            integer,parameter :: kl = kind(.true.)
+
+            print *, "The default character kind is ", kc
+            print *, "The default logical kind is ", kl
+          end program test_kind
+
+
+
+File: gfortran.info,  Node: LBOUND,  Next: LCOBOUND,  Prev: KIND,  Up: Intrinsic Procedures
+
+8.138 `LBOUND' -- Lower dimension bounds of an array
+====================================================
+
+_Description_:
+     Returns the lower bounds of an array, or a single lower bound
+     along the DIM dimension.
+
+_Standard_:
+     Fortran 95 and later, with KIND argument Fortran 2003 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = LBOUND(ARRAY [, DIM [, KIND]])'
+
+_Arguments_:
+     ARRAY      Shall be an array, of any type.
+     DIM        (Optional) Shall be a scalar `INTEGER'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER' and of kind KIND. If KIND is
+     absent, the return value is of default integer kind.  If DIM is
+     absent, the result is an array of the lower bounds of ARRAY.  If
+     DIM is present, the result is a scalar corresponding to the lower
+     bound of the array along that dimension.  If ARRAY is an
+     expression rather than a whole array or array structure component,
+     or if it has a zero extent along the relevant dimension, the lower
+     bound is taken to be 1.
+
+_See also_:
+     *note UBOUND::, *note LCOBOUND::
+
+
+File: gfortran.info,  Node: LCOBOUND,  Next: LEADZ,  Prev: LBOUND,  Up: Intrinsic Procedures
+
+8.139 `LCOBOUND' -- Lower codimension bounds of an array
+========================================================
+
+_Description_:
+     Returns the lower bounds of a coarray, or a single lower cobound
+     along the DIM codimension.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = LCOBOUND(COARRAY [, DIM [, KIND]])'
+
+_Arguments_:
+     ARRAY      Shall be an coarray, of any type.
+     DIM        (Optional) Shall be a scalar `INTEGER'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER' and of kind KIND. If KIND is
+     absent, the return value is of default integer kind.  If DIM is
+     absent, the result is an array of the lower cobounds of COARRAY.
+     If DIM is present, the result is a scalar corresponding to the
+     lower cobound of the array along that codimension.
+
+_See also_:
+     *note UCOBOUND::, *note LBOUND::
+
+
+File: gfortran.info,  Node: LEADZ,  Next: LEN,  Prev: LCOBOUND,  Up: Intrinsic Procedures
+
+8.140 `LEADZ' -- Number of leading zero bits of an integer
+==========================================================
+
+_Description_:
+     `LEADZ' returns the number of leading zero bits of an integer.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = LEADZ(I)'
+
+_Arguments_:
+     I          Shall be of type `INTEGER'.
+
+_Return value_:
+     The type of the return value is the default `INTEGER'.  If all the
+     bits of `I' are zero, the result value is `BIT_SIZE(I)'.
+
+_Example_:
+          PROGRAM test_leadz
+            WRITE (*,*) BIT_SIZE(1)  ! prints 32
+            WRITE (*,*) LEADZ(1)     ! prints 31
+          END PROGRAM
+
+_See also_:
+     *note BIT_SIZE::, *note TRAILZ::, *note POPCNT::, *note POPPAR::
+
+
+File: gfortran.info,  Node: LEN,  Next: LEN_TRIM,  Prev: LEADZ,  Up: Intrinsic Procedures
+
+8.141 `LEN' -- Length of a character entity
+===========================================
+
+_Description_:
+     Returns the length of a character string.  If STRING is an array,
+     the length of an element of STRING is returned.  Note that STRING
+     need not be defined when this intrinsic is invoked, since only the
+     length, not the content, of STRING is needed.
+
+_Standard_:
+     Fortran 77 and later, with KIND argument Fortran 2003 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `L = LEN(STRING [, KIND])'
+
+_Arguments_:
+     STRING     Shall be a scalar or array of type
+                `CHARACTER', with `INTENT(IN)'
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER' and of kind KIND. If KIND is
+     absent, the return value is of default integer kind.
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `LEN(STRING)' `CHARACTER'   `INTEGER'     Fortran 77 and
+                                               later
+
+_See also_:
+     *note LEN_TRIM::, *note ADJUSTL::, *note ADJUSTR::
+
+
+File: gfortran.info,  Node: LEN_TRIM,  Next: LGE,  Prev: LEN,  Up: Intrinsic Procedures
+
+8.142 `LEN_TRIM' -- Length of a character entity without trailing blank characters
+==================================================================================
+
+_Description_:
+     Returns the length of a character string, ignoring any trailing
+     blanks.
+
+_Standard_:
+     Fortran 95 and later, with KIND argument Fortran 2003 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = LEN_TRIM(STRING [, KIND])'
+
+_Arguments_:
+     STRING     Shall be a scalar of type `CHARACTER', with
+                `INTENT(IN)'
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER' and of kind KIND. If KIND is
+     absent, the return value is of default integer kind.
+
+_See also_:
+     *note LEN::, *note ADJUSTL::, *note ADJUSTR::
+
+
+File: gfortran.info,  Node: LGE,  Next: LGT,  Prev: LEN_TRIM,  Up: Intrinsic Procedures
+
+8.143 `LGE' -- Lexical greater than or equal
+============================================
+
+_Description_:
+     Determines whether one string is lexically greater than or equal to
+     another string, where the two strings are interpreted as containing
+     ASCII character codes.  If the String A and String B are not the
+     same length, the shorter is compared as if spaces were appended to
+     it to form a value that has the same length as the longer.
+
+     In general, the lexical comparison intrinsics `LGE', `LGT', `LLE',
+     and `LLT' differ from the corresponding intrinsic operators
+     `.GE.', `.GT.', `.LE.', and `.LT.', in that the latter use the
+     processor's character ordering (which is not ASCII on some
+     targets), whereas the former always use the ASCII ordering.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = LGE(STRING_A, STRING_B)'
+
+_Arguments_:
+     STRING_A   Shall be of default `CHARACTER' type.
+     STRING_B   Shall be of default `CHARACTER' type.
+
+_Return value_:
+     Returns `.TRUE.' if `STRING_A >= STRING_B', and `.FALSE.'
+     otherwise, based on the ASCII ordering.
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `LGE(STRING_A,`CHARACTER'   `LOGICAL'     Fortran 77 and
+     STRING_B)'                                later
+
+_See also_:
+     *note LGT::, *note LLE::, *note LLT::
+
+
+File: gfortran.info,  Node: LGT,  Next: LINK,  Prev: LGE,  Up: Intrinsic Procedures
+
+8.144 `LGT' -- Lexical greater than
+===================================
+
+_Description_:
+     Determines whether one string is lexically greater than another
+     string, where the two strings are interpreted as containing ASCII
+     character codes.  If the String A and String B are not the same
+     length, the shorter is compared as if spaces were appended to it
+     to form a value that has the same length as the longer.
+
+     In general, the lexical comparison intrinsics `LGE', `LGT', `LLE',
+     and `LLT' differ from the corresponding intrinsic operators
+     `.GE.', `.GT.', `.LE.', and `.LT.', in that the latter use the
+     processor's character ordering (which is not ASCII on some
+     targets), whereas the former always use the ASCII ordering.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = LGT(STRING_A, STRING_B)'
+
+_Arguments_:
+     STRING_A   Shall be of default `CHARACTER' type.
+     STRING_B   Shall be of default `CHARACTER' type.
+
+_Return value_:
+     Returns `.TRUE.' if `STRING_A > STRING_B', and `.FALSE.'
+     otherwise, based on the ASCII ordering.
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `LGT(STRING_A,`CHARACTER'   `LOGICAL'     Fortran 77 and
+     STRING_B)'                                later
+
+_See also_:
+     *note LGE::, *note LLE::, *note LLT::
+
+
+File: gfortran.info,  Node: LINK,  Next: LLE,  Prev: LGT,  Up: Intrinsic Procedures
+
+8.145 `LINK' -- Create a hard link
+==================================
+
+_Description_:
+     Makes a (hard) link from file PATH1 to PATH2. A null character
+     (`CHAR(0)') can be used to mark the end of the names in PATH1 and
+     PATH2; otherwise, trailing blanks in the file names are ignored.
+     If the STATUS argument is supplied, it contains 0 on success or a
+     nonzero error code upon return; see `link(2)'.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL LINK(PATH1, PATH2 [, STATUS])'
+     `STATUS = LINK(PATH1, PATH2)'
+
+_Arguments_:
+     PATH1      Shall be of default `CHARACTER' type.
+     PATH2      Shall be of default `CHARACTER' type.
+     STATUS     (Optional) Shall be of default `INTEGER' type.
+
+_See also_:
+     *note SYMLNK::, *note UNLINK::
+
+
+File: gfortran.info,  Node: LLE,  Next: LLT,  Prev: LINK,  Up: Intrinsic Procedures
+
+8.146 `LLE' -- Lexical less than or equal
+=========================================
+
+_Description_:
+     Determines whether one string is lexically less than or equal to
+     another string, where the two strings are interpreted as
+     containing ASCII character codes.  If the String A and String B
+     are not the same length, the shorter is compared as if spaces were
+     appended to it to form a value that has the same length as the
+     longer.
+
+     In general, the lexical comparison intrinsics `LGE', `LGT', `LLE',
+     and `LLT' differ from the corresponding intrinsic operators
+     `.GE.', `.GT.', `.LE.', and `.LT.', in that the latter use the
+     processor's character ordering (which is not ASCII on some
+     targets), whereas the former always use the ASCII ordering.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = LLE(STRING_A, STRING_B)'
+
+_Arguments_:
+     STRING_A   Shall be of default `CHARACTER' type.
+     STRING_B   Shall be of default `CHARACTER' type.
+
+_Return value_:
+     Returns `.TRUE.' if `STRING_A <= STRING_B', and `.FALSE.'
+     otherwise, based on the ASCII ordering.
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `LLE(STRING_A,`CHARACTER'   `LOGICAL'     Fortran 77 and
+     STRING_B)'                                later
+
+_See also_:
+     *note LGE::, *note LGT::, *note LLT::
+
+
+File: gfortran.info,  Node: LLT,  Next: LNBLNK,  Prev: LLE,  Up: Intrinsic Procedures
+
+8.147 `LLT' -- Lexical less than
+================================
+
+_Description_:
+     Determines whether one string is lexically less than another
+     string, where the two strings are interpreted as containing ASCII
+     character codes.  If the String A and String B are not the same
+     length, the shorter is compared as if spaces were appended to it
+     to form a value that has the same length as the longer.
+
+     In general, the lexical comparison intrinsics `LGE', `LGT', `LLE',
+     and `LLT' differ from the corresponding intrinsic operators
+     `.GE.', `.GT.', `.LE.', and `.LT.', in that the latter use the
+     processor's character ordering (which is not ASCII on some
+     targets), whereas the former always use the ASCII ordering.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = LLT(STRING_A, STRING_B)'
+
+_Arguments_:
+     STRING_A   Shall be of default `CHARACTER' type.
+     STRING_B   Shall be of default `CHARACTER' type.
+
+_Return value_:
+     Returns `.TRUE.' if `STRING_A < STRING_B', and `.FALSE.'
+     otherwise, based on the ASCII ordering.
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `LLT(STRING_A,`CHARACTER'   `LOGICAL'     Fortran 77 and
+     STRING_B)'                                later
+
+_See also_:
+     *note LGE::, *note LGT::, *note LLE::
+
+
+File: gfortran.info,  Node: LNBLNK,  Next: LOC,  Prev: LLT,  Up: Intrinsic Procedures
+
+8.148 `LNBLNK' -- Index of the last non-blank character in a string
+===================================================================
+
+_Description_:
+     Returns the length of a character string, ignoring any trailing
+     blanks.  This is identical to the standard `LEN_TRIM' intrinsic,
+     and is only included for backwards compatibility.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = LNBLNK(STRING)'
+
+_Arguments_:
+     STRING     Shall be a scalar of type `CHARACTER', with
+                `INTENT(IN)'
+
+_Return value_:
+     The return value is of `INTEGER(kind=4)' type.
+
+_See also_:
+     *note INDEX intrinsic::, *note LEN_TRIM::
+
+
+File: gfortran.info,  Node: LOC,  Next: LOG,  Prev: LNBLNK,  Up: Intrinsic Procedures
+
+8.149 `LOC' -- Returns the address of a variable
+================================================
+
+_Description_:
+     `LOC(X)' returns the address of X as an integer.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = LOC(X)'
+
+_Arguments_:
+     X          Variable of any type.
+
+_Return value_:
+     The return value is of type `INTEGER', with a `KIND' corresponding
+     to the size (in bytes) of a memory address on the target machine.
+
+_Example_:
+          program test_loc
+            integer :: i
+            real :: r
+            i = loc(r)
+            print *, i
+          end program test_loc
+
+
+File: gfortran.info,  Node: LOG,  Next: LOG10,  Prev: LOC,  Up: Intrinsic Procedures
+
+8.150 `LOG' -- Natural logarithm function
+=========================================
+
+_Description_:
+     `LOG(X)' computes the natural logarithm of X, i.e. the logarithm
+     to the base e.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = LOG(X)'
+
+_Arguments_:
+     X          The type shall be `REAL' or `COMPLEX'.
+
+_Return value_:
+     The return value is of type `REAL' or `COMPLEX'.  The kind type
+     parameter is the same as X.  If X is `COMPLEX', the imaginary part
+     \omega is in the range -\pi \leq \omega \leq \pi.
+
+_Example_:
+          program test_log
+            real(8) :: x = 2.7182818284590451_8
+            complex :: z = (1.0, 2.0)
+            x = log(x)    ! will yield (approximately) 1
+            z = log(z)
+          end program test_log
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `ALOG(X)'     `REAL(4) X'   `REAL(4)'     f95, gnu
+     `DLOG(X)'     `REAL(8) X'   `REAL(8)'     f95, gnu
+     `CLOG(X)'     `COMPLEX(4)   `COMPLEX(4)'  f95, gnu
+                   X'                          
+     `ZLOG(X)'     `COMPLEX(8)   `COMPLEX(8)'  f95, gnu
+                   X'                          
+     `CDLOG(X)'    `COMPLEX(8)   `COMPLEX(8)'  f95, gnu
+                   X'                          
+
+
+File: gfortran.info,  Node: LOG10,  Next: LOG_GAMMA,  Prev: LOG,  Up: Intrinsic Procedures
+
+8.151 `LOG10' -- Base 10 logarithm function
+===========================================
+
+_Description_:
+     `LOG10(X)' computes the base 10 logarithm of X.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = LOG10(X)'
+
+_Arguments_:
+     X          The type shall be `REAL'.
+
+_Return value_:
+     The return value is of type `REAL' or `COMPLEX'.  The kind type
+     parameter is the same as X.
+
+_Example_:
+          program test_log10
+            real(8) :: x = 10.0_8
+            x = log10(x)
+          end program test_log10
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `ALOG10(X)'   `REAL(4) X'   `REAL(4)'     Fortran 95 and
+                                               later
+     `DLOG10(X)'   `REAL(8) X'   `REAL(8)'     Fortran 95 and
+                                               later
+
+
+File: gfortran.info,  Node: LOG_GAMMA,  Next: LOGICAL,  Prev: LOG10,  Up: Intrinsic Procedures
+
+8.152 `LOG_GAMMA' -- Logarithm of the Gamma function
+====================================================
+
+_Description_:
+     `LOG_GAMMA(X)' computes the natural logarithm of the absolute value
+     of the Gamma (\Gamma) function.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `X = LOG_GAMMA(X)'
+
+_Arguments_:
+     X          Shall be of type `REAL' and neither zero nor a
+                negative integer.
+
+_Return value_:
+     The return value is of type `REAL' of the same kind as X.
+
+_Example_:
+          program test_log_gamma
+            real :: x = 1.0
+            x = lgamma(x) ! returns 0.0
+          end program test_log_gamma
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `LGAMMA(X)'   `REAL(4) X'   `REAL(4)'     GNU Extension
+     `ALGAMA(X)'   `REAL(4) X'   `REAL(4)'     GNU Extension
+     `DLGAMA(X)'   `REAL(8) X'   `REAL(8)'     GNU Extension
+
+_See also_:
+     Gamma function: *note GAMMA::
+
+
+
+File: gfortran.info,  Node: LOGICAL,  Next: LONG,  Prev: LOG_GAMMA,  Up: Intrinsic Procedures
+
+8.153 `LOGICAL' -- Convert to logical type
+==========================================
+
+_Description_:
+     Converts one kind of `LOGICAL' variable to another.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = LOGICAL(L [, KIND])'
+
+_Arguments_:
+     L          The type shall be `LOGICAL'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is a `LOGICAL' value equal to L, with a kind
+     corresponding to KIND, or of the default logical kind if KIND is
+     not given.
+
+_See also_:
+     *note INT::, *note REAL::, *note CMPLX::
+
+
+File: gfortran.info,  Node: LONG,  Next: LSHIFT,  Prev: LOGICAL,  Up: Intrinsic Procedures
+
+8.154 `LONG' -- Convert to integer type
+=======================================
+
+_Description_:
+     Convert to a `KIND=4' integer type, which is the same size as a C
+     `long' integer.  This is equivalent to the standard `INT'
+     intrinsic with an optional argument of `KIND=4', and is only
+     included for backwards compatibility.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = LONG(A)'
+
+_Arguments_:
+     A          Shall be of type `INTEGER', `REAL', or
+                `COMPLEX'.
+
+_Return value_:
+     The return value is a `INTEGER(4)' variable.
+
+_See also_:
+     *note INT::, *note INT2::, *note INT8::
+
+
+File: gfortran.info,  Node: LSHIFT,  Next: LSTAT,  Prev: LONG,  Up: Intrinsic Procedures
+
+8.155 `LSHIFT' -- Left shift bits
+=================================
+
+_Description_:
+     `LSHIFT' returns a value corresponding to I with all of the bits
+     shifted left by SHIFT places.  If the absolute value of SHIFT is
+     greater than `BIT_SIZE(I)', the value is undefined.  Bits shifted
+     out from the left end are lost; zeros are shifted in from the
+     opposite end.
+
+     This function has been superseded by the `ISHFT' intrinsic, which
+     is standard in Fortran 95 and later, and the `SHIFTL' intrinsic,
+     which is standard in Fortran 2008 and later.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = LSHIFT(I, SHIFT)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     SHIFT      The type shall be `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the same kind as I.
+
+_See also_:
+     *note ISHFT::, *note ISHFTC::, *note RSHIFT::, *note SHIFTA::,
+     *note SHIFTL::, *note SHIFTR::
+
+
+
+File: gfortran.info,  Node: LSTAT,  Next: LTIME,  Prev: LSHIFT,  Up: Intrinsic Procedures
+
+8.156 `LSTAT' -- Get file status
+================================
+
+_Description_:
+     `LSTAT' is identical to *note STAT::, except that if path is a
+     symbolic link, then the link itself is statted, not the file that
+     it refers to.
+
+     The elements in `VALUES' are the same as described by *note STAT::.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL LSTAT(NAME, VALUES [, STATUS])'
+     `STATUS = LSTAT(NAME, VALUES)'
+
+_Arguments_:
+     NAME       The type shall be `CHARACTER' of the default
+                kind, a valid path within the file system.
+     VALUES     The type shall be `INTEGER(4), DIMENSION(13)'.
+     STATUS     (Optional) status flag of type `INTEGER(4)'.
+                Returns 0 on success and a system specific
+                error code otherwise.
+
+_Example_:
+     See *note STAT:: for an example.
+
+_See also_:
+     To stat an open file: *note FSTAT::, to stat a file: *note STAT::
+
+
+File: gfortran.info,  Node: LTIME,  Next: MALLOC,  Prev: LSTAT,  Up: Intrinsic Procedures
+
+8.157 `LTIME' -- Convert time to local time info
+================================================
+
+_Description_:
+     Given a system time value TIME (as provided by the `TIME8'
+     intrinsic), fills VALUES with values extracted from it appropriate
+     to the local time zone using `localtime(3)'.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL LTIME(TIME, VALUES)'
+
+_Arguments_:
+     TIME       An `INTEGER' scalar expression corresponding
+                to a system time, with `INTENT(IN)'.
+     VALUES     A default `INTEGER' array with 9 elements,
+                with `INTENT(OUT)'.
+
+_Return value_:
+     The elements of VALUES are assigned as follows:
+       1. Seconds after the minute, range 0-59 or 0-61 to allow for leap
+          seconds
+
+       2. Minutes after the hour, range 0-59
+
+       3. Hours past midnight, range 0-23
+
+       4. Day of month, range 0-31
+
+       5. Number of months since January, range 0-12
+
+       6. Years since 1900
+
+       7. Number of days since Sunday, range 0-6
+
+       8. Days since January 1
+
+       9. Daylight savings indicator: positive if daylight savings is in
+          effect, zero if not, and negative if the information is not
+          available.
+
+_See also_:
+     *note CTIME::, *note GMTIME::, *note TIME::, *note TIME8::
+
+
+
+File: gfortran.info,  Node: MALLOC,  Next: MASKL,  Prev: LTIME,  Up: Intrinsic Procedures
+
+8.158 `MALLOC' -- Allocate dynamic memory
+=========================================
+
+_Description_:
+     `MALLOC(SIZE)' allocates SIZE bytes of dynamic memory and returns
+     the address of the allocated memory. The `MALLOC' intrinsic is an
+     extension intended to be used with Cray pointers, and is provided
+     in GNU Fortran to allow the user to compile legacy code. For new
+     code using Fortran 95 pointers, the memory allocation intrinsic is
+     `ALLOCATE'.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `PTR = MALLOC(SIZE)'
+
+_Arguments_:
+     SIZE       The type shall be `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER(K)', with K such that
+     variables of type `INTEGER(K)' have the same size as C pointers
+     (`sizeof(void *)').
+
+_Example_:
+     The following example demonstrates the use of `MALLOC' and `FREE'
+     with Cray pointers.
+
+          program test_malloc
+            implicit none
+            integer i
+            real*8 x(*), z
+            pointer(ptr_x,x)
+
+            ptr_x = malloc(20*8)
+            do i = 1, 20
+              x(i) = sqrt(1.0d0 / i)
+            end do
+            z = 0
+            do i = 1, 20
+              z = z + x(i)
+              print *, z
+            end do
+            call free(ptr_x)
+          end program test_malloc
+
+_See also_:
+     *note FREE::
+
+
+File: gfortran.info,  Node: MASKL,  Next: MASKR,  Prev: MALLOC,  Up: Intrinsic Procedures
+
+8.159 `MASKL' -- Left justified mask
+====================================
+
+_Description_:
+     `MASKL(I[, KIND])' has its leftmost I bits set to 1, and the
+     remaining bits set to 0.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = MASKL(I[, KIND])'
+
+_Arguments_:
+     I          Shall be of type `INTEGER'.
+     KIND       Shall be a scalar constant expression of type
+                `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER'. If KIND is present, it
+     specifies the kind value of the return type; otherwise, it is of
+     the default integer kind.
+
+_See also_:
+     *note MASKR::
+
+
+File: gfortran.info,  Node: MASKR,  Next: MATMUL,  Prev: MASKL,  Up: Intrinsic Procedures
+
+8.160 `MASKR' -- Right justified mask
+=====================================
+
+_Description_:
+     `MASKL(I[, KIND])' has its rightmost I bits set to 1, and the
+     remaining bits set to 0.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = MASKR(I[, KIND])'
+
+_Arguments_:
+     I          Shall be of type `INTEGER'.
+     KIND       Shall be a scalar constant expression of type
+                `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER'. If KIND is present, it
+     specifies the kind value of the return type; otherwise, it is of
+     the default integer kind.
+
+_See also_:
+     *note MASKL::
+
+
+File: gfortran.info,  Node: MATMUL,  Next: MAX,  Prev: MASKR,  Up: Intrinsic Procedures
+
+8.161 `MATMUL' -- matrix multiplication
+=======================================
+
+_Description_:
+     Performs a matrix multiplication on numeric or logical arguments.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = MATMUL(MATRIX_A, MATRIX_B)'
+
+_Arguments_:
+     MATRIX_A   An array of `INTEGER', `REAL', `COMPLEX', or
+                `LOGICAL' type, with a rank of one or two.
+     MATRIX_B   An array of `INTEGER', `REAL', or `COMPLEX'
+                type if MATRIX_A is of a numeric type;
+                otherwise, an array of `LOGICAL' type. The
+                rank shall be one or two, and the first (or
+                only) dimension of MATRIX_B shall be equal to
+                the last (or only) dimension of MATRIX_A.
+
+_Return value_:
+     The matrix product of MATRIX_A and MATRIX_B.  The type and kind of
+     the result follow the usual type and kind promotion rules, as for
+     the `*' or `.AND.' operators.
+
+_See also_:
+
+
+File: gfortran.info,  Node: MAX,  Next: MAXEXPONENT,  Prev: MATMUL,  Up: Intrinsic Procedures
+
+8.162 `MAX' -- Maximum value of an argument list
+================================================
+
+_Description_:
+     Returns the argument with the largest (most positive) value.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = MAX(A1, A2 [, A3 [, ...]])'
+
+_Arguments_:
+     A1         The type shall be `INTEGER' or `REAL'.
+     A2, A3,    An expression of the same type and kind as A1.
+     ...        (As a GNU extension, arguments of different
+                kinds are permitted.)
+
+_Return value_:
+     The return value corresponds to the maximum value among the
+     arguments, and has the same type and kind as the first argument.
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `MAX0(A1)'    `INTEGER(4)   `INTEGER(4)'  Fortran 77 and
+                   A1'                         later
+     `AMAX0(A1)'   `INTEGER(4)   `REAL(MAX(X))'Fortran 77 and
+                   A1'                         later
+     `MAX1(A1)'    `REAL A1'     `INT(MAX(X))' Fortran 77 and
+                                               later
+     `AMAX1(A1)'   `REAL(4) A1'  `REAL(4)'     Fortran 77 and
+                                               later
+     `DMAX1(A1)'   `REAL(8) A1'  `REAL(8)'     Fortran 77 and
+                                               later
+
+_See also_:
+     *note MAXLOC:: *note MAXVAL::, *note MIN::
+
+
+
+File: gfortran.info,  Node: MAXEXPONENT,  Next: MAXLOC,  Prev: MAX,  Up: Intrinsic Procedures
+
+8.163 `MAXEXPONENT' -- Maximum exponent of a real kind
+======================================================
+
+_Description_:
+     `MAXEXPONENT(X)' returns the maximum exponent in the model of the
+     type of `X'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = MAXEXPONENT(X)'
+
+_Arguments_:
+     X          Shall be of type `REAL'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the default integer
+     kind.
+
+_Example_:
+          program exponents
+            real(kind=4) :: x
+            real(kind=8) :: y
+
+            print *, minexponent(x), maxexponent(x)
+            print *, minexponent(y), maxexponent(y)
+          end program exponents
+
+
+File: gfortran.info,  Node: MAXLOC,  Next: MAXVAL,  Prev: MAXEXPONENT,  Up: Intrinsic Procedures
+
+8.164 `MAXLOC' -- Location of the maximum value within an array
+===============================================================
+
+_Description_:
+     Determines the location of the element in the array with the
+     maximum value, or, if the DIM argument is supplied, determines the
+     locations of the maximum element along each row of the array in the
+     DIM direction.  If MASK is present, only the elements for which
+     MASK is `.TRUE.' are considered.  If more than one element in the
+     array has the maximum value, the location returned is that of the
+     first such element in array element order.  If the array has zero
+     size, or all of the elements of MASK are `.FALSE.', then the
+     result is an array of zeroes.  Similarly, if DIM is supplied and
+     all of the elements of MASK along a given row are zero, the result
+     value for that row is zero.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = MAXLOC(ARRAY, DIM [, MASK])'
+     `RESULT = MAXLOC(ARRAY [, MASK])'
+
+_Arguments_:
+     ARRAY      Shall be an array of type `INTEGER' or `REAL'.
+     DIM        (Optional) Shall be a scalar of type
+                `INTEGER', with a value between one and the
+                rank of ARRAY, inclusive.  It may not be an
+                optional dummy argument.
+     MASK       Shall be an array of type `LOGICAL', and
+                conformable with ARRAY.
+
+_Return value_:
+     If DIM is absent, the result is a rank-one array with a length
+     equal to the rank of ARRAY.  If DIM is present, the result is an
+     array with a rank one less than the rank of ARRAY, and a size
+     corresponding to the size of ARRAY with the DIM dimension removed.
+     If DIM is present and ARRAY has a rank of one, the result is a
+     scalar.  In all cases, the result is of default `INTEGER' type.
+
+_See also_:
+     *note MAX::, *note MAXVAL::
+
+
+
+File: gfortran.info,  Node: MAXVAL,  Next: MCLOCK,  Prev: MAXLOC,  Up: Intrinsic Procedures
+
+8.165 `MAXVAL' -- Maximum value of an array
+===========================================
+
+_Description_:
+     Determines the maximum value of the elements in an array value,
+     or, if the DIM argument is supplied, determines the maximum value
+     along each row of the array in the DIM direction.  If MASK is
+     present, only the elements for which MASK is `.TRUE.' are
+     considered.  If the array has zero size, or all of the elements of
+     MASK are `.FALSE.', then the result is `-HUGE(ARRAY)' if ARRAY is
+     numeric, or a string of nulls if ARRAY is of character type.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = MAXVAL(ARRAY, DIM [, MASK])'
+     `RESULT = MAXVAL(ARRAY [, MASK])'
+
+_Arguments_:
+     ARRAY      Shall be an array of type `INTEGER' or `REAL'.
+     DIM        (Optional) Shall be a scalar of type
+                `INTEGER', with a value between one and the
+                rank of ARRAY, inclusive.  It may not be an
+                optional dummy argument.
+     MASK       Shall be an array of type `LOGICAL', and
+                conformable with ARRAY.
+
+_Return value_:
+     If DIM is absent, or if ARRAY has a rank of one, the result is a
+     scalar.  If DIM is present, the result is an array with a rank one
+     less than the rank of ARRAY, and a size corresponding to the size
+     of ARRAY with the DIM dimension removed.  In all cases, the result
+     is of the same type and kind as ARRAY.
+
+_See also_:
+     *note MAX::, *note MAXLOC::
+
+
+File: gfortran.info,  Node: MCLOCK,  Next: MCLOCK8,  Prev: MAXVAL,  Up: Intrinsic Procedures
+
+8.166 `MCLOCK' -- Time function
+===============================
+
+_Description_:
+     Returns the number of clock ticks since the start of the process,
+     based on the UNIX function `clock(3)'.
+
+     This intrinsic is not fully portable, such as to systems with
+     32-bit `INTEGER' types but supporting times wider than 32 bits.
+     Therefore, the values returned by this intrinsic might be, or
+     become, negative, or numerically less than previous values, during
+     a single run of the compiled program.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = MCLOCK()'
+
+_Return value_:
+     The return value is a scalar of type `INTEGER(4)', equal to the
+     number of clock ticks since the start of the process, or `-1' if
+     the system does not support `clock(3)'.
+
+_See also_:
+     *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK::,
+     *note TIME::
+
+
+
+File: gfortran.info,  Node: MCLOCK8,  Next: MERGE,  Prev: MCLOCK,  Up: Intrinsic Procedures
+
+8.167 `MCLOCK8' -- Time function (64-bit)
+=========================================
+
+_Description_:
+     Returns the number of clock ticks since the start of the process,
+     based on the UNIX function `clock(3)'.
+
+     _Warning:_ this intrinsic does not increase the range of the timing
+     values over that returned by `clock(3)'. On a system with a 32-bit
+     `clock(3)', `MCLOCK8' will return a 32-bit value, even though it
+     is converted to a 64-bit `INTEGER(8)' value. That means overflows
+     of the 32-bit value can still occur. Therefore, the values
+     returned by this intrinsic might be or become negative or
+     numerically less than previous values during a single run of the
+     compiled program.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = MCLOCK8()'
+
+_Return value_:
+     The return value is a scalar of type `INTEGER(8)', equal to the
+     number of clock ticks since the start of the process, or `-1' if
+     the system does not support `clock(3)'.
+
+_See also_:
+     *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK::,
+     *note TIME8::
+
+
+
+File: gfortran.info,  Node: MERGE,  Next: MERGE_BITS,  Prev: MCLOCK8,  Up: Intrinsic Procedures
+
+8.168 `MERGE' -- Merge variables
+================================
+
+_Description_:
+     Select values from two arrays according to a logical mask.  The
+     result is equal to TSOURCE if MASK is `.TRUE.', or equal to
+     FSOURCE if it is `.FALSE.'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = MERGE(TSOURCE, FSOURCE, MASK)'
+
+_Arguments_:
+     TSOURCE    May be of any type.
+     FSOURCE    Shall be of the same type and type parameters
+                as TSOURCE.
+     MASK       Shall be of type `LOGICAL'.
+
+_Return value_:
+     The result is of the same type and type parameters as TSOURCE.
+
+
+
+File: gfortran.info,  Node: MERGE_BITS,  Next: MIN,  Prev: MERGE,  Up: Intrinsic Procedures
+
+8.169 `MERGE_BITS' -- Merge of bits under mask
+==============================================
+
+_Description_:
+     `MERGE_BITS(I, J, MASK)' merges the bits of I and J as determined
+     by the mask.  The i-th bit of the result is equal to the i-th bit
+     of I if the i-th bit of MASK is 1; it is equal to the i-th bit of
+     J otherwise.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = MERGE_BITS(I, J, MASK)'
+
+_Arguments_:
+     I          Shall be of type `INTEGER'.
+     J          Shall be of type `INTEGER' and of the same
+                kind as I.
+     MASK       Shall be of type `INTEGER' and of the same
+                kind as I.
+
+_Return value_:
+     The result is of the same type and kind as I.
+
+
+
+File: gfortran.info,  Node: MIN,  Next: MINEXPONENT,  Prev: MERGE_BITS,  Up: Intrinsic Procedures
+
+8.170 `MIN' -- Minimum value of an argument list
+================================================
+
+_Description_:
+     Returns the argument with the smallest (most negative) value.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = MIN(A1, A2 [, A3, ...])'
+
+_Arguments_:
+     A1         The type shall be `INTEGER' or `REAL'.
+     A2, A3,    An expression of the same type and kind as A1.
+     ...        (As a GNU extension, arguments of different
+                kinds are permitted.)
+
+_Return value_:
+     The return value corresponds to the maximum value among the
+     arguments, and has the same type and kind as the first argument.
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `MIN0(A1)'    `INTEGER(4)   `INTEGER(4)'  Fortran 77 and
+                   A1'                         later
+     `AMIN0(A1)'   `INTEGER(4)   `REAL(4)'     Fortran 77 and
+                   A1'                         later
+     `MIN1(A1)'    `REAL A1'     `INTEGER(4)'  Fortran 77 and
+                                               later
+     `AMIN1(A1)'   `REAL(4) A1'  `REAL(4)'     Fortran 77 and
+                                               later
+     `DMIN1(A1)'   `REAL(8) A1'  `REAL(8)'     Fortran 77 and
+                                               later
+
+_See also_:
+     *note MAX::, *note MINLOC::, *note MINVAL::
+
+
+File: gfortran.info,  Node: MINEXPONENT,  Next: MINLOC,  Prev: MIN,  Up: Intrinsic Procedures
+
+8.171 `MINEXPONENT' -- Minimum exponent of a real kind
+======================================================
+
+_Description_:
+     `MINEXPONENT(X)' returns the minimum exponent in the model of the
+     type of `X'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = MINEXPONENT(X)'
+
+_Arguments_:
+     X          Shall be of type `REAL'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the default integer
+     kind.
+
+_Example_:
+     See `MAXEXPONENT' for an example.
+
+
+File: gfortran.info,  Node: MINLOC,  Next: MINVAL,  Prev: MINEXPONENT,  Up: Intrinsic Procedures
+
+8.172 `MINLOC' -- Location of the minimum value within an array
+===============================================================
+
+_Description_:
+     Determines the location of the element in the array with the
+     minimum value, or, if the DIM argument is supplied, determines the
+     locations of the minimum element along each row of the array in the
+     DIM direction.  If MASK is present, only the elements for which
+     MASK is `.TRUE.' are considered.  If more than one element in the
+     array has the minimum value, the location returned is that of the
+     first such element in array element order.  If the array has zero
+     size, or all of the elements of MASK are `.FALSE.', then the
+     result is an array of zeroes.  Similarly, if DIM is supplied and
+     all of the elements of MASK along a given row are zero, the result
+     value for that row is zero.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = MINLOC(ARRAY, DIM [, MASK])'
+     `RESULT = MINLOC(ARRAY [, MASK])'
+
+_Arguments_:
+     ARRAY      Shall be an array of type `INTEGER' or `REAL'.
+     DIM        (Optional) Shall be a scalar of type
+                `INTEGER', with a value between one and the
+                rank of ARRAY, inclusive.  It may not be an
+                optional dummy argument.
+     MASK       Shall be an array of type `LOGICAL', and
+                conformable with ARRAY.
+
+_Return value_:
+     If DIM is absent, the result is a rank-one array with a length
+     equal to the rank of ARRAY.  If DIM is present, the result is an
+     array with a rank one less than the rank of ARRAY, and a size
+     corresponding to the size of ARRAY with the DIM dimension removed.
+     If DIM is present and ARRAY has a rank of one, the result is a
+     scalar.  In all cases, the result is of default `INTEGER' type.
+
+_See also_:
+     *note MIN::, *note MINVAL::
+
+
+
+File: gfortran.info,  Node: MINVAL,  Next: MOD,  Prev: MINLOC,  Up: Intrinsic Procedures
+
+8.173 `MINVAL' -- Minimum value of an array
+===========================================
+
+_Description_:
+     Determines the minimum value of the elements in an array value,
+     or, if the DIM argument is supplied, determines the minimum value
+     along each row of the array in the DIM direction.  If MASK is
+     present, only the elements for which MASK is `.TRUE.' are
+     considered.  If the array has zero size, or all of the elements of
+     MASK are `.FALSE.', then the result is `HUGE(ARRAY)' if ARRAY is
+     numeric, or a string of `CHAR(255)' characters if ARRAY is of
+     character type.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = MINVAL(ARRAY, DIM [, MASK])'
+     `RESULT = MINVAL(ARRAY [, MASK])'
+
+_Arguments_:
+     ARRAY      Shall be an array of type `INTEGER' or `REAL'.
+     DIM        (Optional) Shall be a scalar of type
+                `INTEGER', with a value between one and the
+                rank of ARRAY, inclusive.  It may not be an
+                optional dummy argument.
+     MASK       Shall be an array of type `LOGICAL', and
+                conformable with ARRAY.
+
+_Return value_:
+     If DIM is absent, or if ARRAY has a rank of one, the result is a
+     scalar.  If DIM is present, the result is an array with a rank one
+     less than the rank of ARRAY, and a size corresponding to the size
+     of ARRAY with the DIM dimension removed.  In all cases, the result
+     is of the same type and kind as ARRAY.
+
+_See also_:
+     *note MIN::, *note MINLOC::
+
+
+
+File: gfortran.info,  Node: MOD,  Next: MODULO,  Prev: MINVAL,  Up: Intrinsic Procedures
+
+8.174 `MOD' -- Remainder function
+=================================
+
+_Description_:
+     `MOD(A,P)' computes the remainder of the division of A by P. It is
+     calculated as `A - (INT(A/P) * P)'.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = MOD(A, P)'
+
+_Arguments_:
+     A          Shall be a scalar of type `INTEGER' or `REAL'
+     P          Shall be a scalar of the same type as A and not
+                equal to zero
+
+_Return value_:
+     The kind of the return value is the result of cross-promoting the
+     kinds of the arguments.
+
+_Example_:
+          program test_mod
+            print *, mod(17,3)
+            print *, mod(17.5,5.5)
+            print *, mod(17.5d0,5.5)
+            print *, mod(17.5,5.5d0)
+
+            print *, mod(-17,3)
+            print *, mod(-17.5,5.5)
+            print *, mod(-17.5d0,5.5)
+            print *, mod(-17.5,5.5d0)
+
+            print *, mod(17,-3)
+            print *, mod(17.5,-5.5)
+            print *, mod(17.5d0,-5.5)
+            print *, mod(17.5,-5.5d0)
+          end program test_mod
+
+_Specific names_:
+     Name          Arguments     Return type   Standard
+     `MOD(A,P)'    `INTEGER      `INTEGER'     Fortran 95 and
+                   A,P'                        later
+     `AMOD(A,P)'   `REAL(4)      `REAL(4)'     Fortran 95 and
+                   A,P'                        later
+     `DMOD(A,P)'   `REAL(8)      `REAL(8)'     Fortran 95 and
+                   A,P'                        later
+
+
+File: gfortran.info,  Node: MODULO,  Next: MOVE_ALLOC,  Prev: MOD,  Up: Intrinsic Procedures
+
+8.175 `MODULO' -- Modulo function
+=================================
+
+_Description_:
+     `MODULO(A,P)' computes the A modulo P.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = MODULO(A, P)'
+
+_Arguments_:
+     A          Shall be a scalar of type `INTEGER' or `REAL'
+     P          Shall be a scalar of the same type and kind as
+                A
+
+_Return value_:
+     The type and kind of the result are those of the arguments.
+    If A and P are of type `INTEGER':
+          `MODULO(A,P)' has the value R such that `A=Q*P+R', where Q is
+          an integer and R is between 0 (inclusive) and P (exclusive).
+
+    If A and P are of type `REAL':
+          `MODULO(A,P)' has the value of `A - FLOOR (A / P) * P'.
+     In all cases, if P is zero the result is processor-dependent.
+
+_Example_:
+          program test_modulo
+            print *, modulo(17,3)
+            print *, modulo(17.5,5.5)
+
+            print *, modulo(-17,3)
+            print *, modulo(-17.5,5.5)
+
+            print *, modulo(17,-3)
+            print *, modulo(17.5,-5.5)
+          end program
+
+
+
+File: gfortran.info,  Node: MOVE_ALLOC,  Next: MVBITS,  Prev: MODULO,  Up: Intrinsic Procedures
+
+8.176 `MOVE_ALLOC' -- Move allocation from one object to another
+================================================================
+
+_Description_:
+     `MOVE_ALLOC(FROM, TO)' moves the allocation from FROM to TO.  FROM
+     will become deallocated in the process.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Pure subroutine
+
+_Syntax_:
+     `CALL MOVE_ALLOC(FROM, TO)'
+
+_Arguments_:
+     FROM       `ALLOCATABLE', `INTENT(INOUT)', may be of any
+                type and kind.
+     TO         `ALLOCATABLE', `INTENT(OUT)', shall be of the
+                same type, kind and rank as FROM.
+
+_Return value_:
+     None
+
+_Example_:
+          program test_move_alloc
+              integer, allocatable :: a(:), b(:)
+
+              allocate(a(3))
+              a = [ 1, 2, 3 ]
+              call move_alloc(a, b)
+              print *, allocated(a), allocated(b)
+              print *, b
+          end program test_move_alloc
+
+
+File: gfortran.info,  Node: MVBITS,  Next: NEAREST,  Prev: MOVE_ALLOC,  Up: Intrinsic Procedures
+
+8.177 `MVBITS' -- Move bits from one integer to another
+=======================================================
+
+_Description_:
+     Moves LEN bits from positions FROMPOS through `FROMPOS+LEN-1' of
+     FROM to positions TOPOS through `TOPOS+LEN-1' of TO. The portion
+     of argument TO not affected by the movement of bits is unchanged.
+     The values of `FROMPOS+LEN-1' and `TOPOS+LEN-1' must be less than
+     `BIT_SIZE(FROM)'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental subroutine
+
+_Syntax_:
+     `CALL MVBITS(FROM, FROMPOS, LEN, TO, TOPOS)'
+
+_Arguments_:
+     FROM       The type shall be `INTEGER'.
+     FROMPOS    The type shall be `INTEGER'.
+     LEN        The type shall be `INTEGER'.
+     TO         The type shall be `INTEGER', of the same kind
+                as FROM.
+     TOPOS      The type shall be `INTEGER'.
+
+_See also_:
+     *note IBCLR::, *note IBSET::, *note IBITS::, *note IAND::, *note
+     IOR::, *note IEOR::
+
+
+File: gfortran.info,  Node: NEAREST,  Next: NEW_LINE,  Prev: MVBITS,  Up: Intrinsic Procedures
+
+8.178 `NEAREST' -- Nearest representable number
+===============================================
+
+_Description_:
+     `NEAREST(X, S)' returns the processor-representable number nearest
+     to `X' in the direction indicated by the sign of `S'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = NEAREST(X, S)'
+
+_Arguments_:
+     X          Shall be of type `REAL'.
+     S          (Optional) shall be of type `REAL' and not
+                equal to zero.
+
+_Return value_:
+     The return value is of the same type as `X'. If `S' is positive,
+     `NEAREST' returns the processor-representable number greater than
+     `X' and nearest to it. If `S' is negative, `NEAREST' returns the
+     processor-representable number smaller than `X' and nearest to it.
+
+_Example_:
+          program test_nearest
+            real :: x, y
+            x = nearest(42.0, 1.0)
+            y = nearest(42.0, -1.0)
+            write (*,"(3(G20.15))") x, y, x - y
+          end program test_nearest
+
+
+File: gfortran.info,  Node: NEW_LINE,  Next: NINT,  Prev: NEAREST,  Up: Intrinsic Procedures
+
+8.179 `NEW_LINE' -- New line character
+======================================
+
+_Description_:
+     `NEW_LINE(C)' returns the new-line character.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = NEW_LINE(C)'
+
+_Arguments_:
+     C          The argument shall be a scalar or array of the
+                type `CHARACTER'.
+
+_Return value_:
+     Returns a CHARACTER scalar of length one with the new-line
+     character of the same kind as parameter C.
+
+_Example_:
+          program newline
+            implicit none
+            write(*,'(A)') 'This is record 1.'//NEW_LINE('A')//'This is record 2.'
+          end program newline
+
+
+File: gfortran.info,  Node: NINT,  Next: NORM2,  Prev: NEW_LINE,  Up: Intrinsic Procedures
+
+8.180 `NINT' -- Nearest whole number
+====================================
+
+_Description_:
+     `NINT(A)' rounds its argument to the nearest whole number.
+
+_Standard_:
+     Fortran 77 and later, with KIND argument Fortran 90 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = NINT(A [, KIND])'
+
+_Arguments_:
+     A          The type of the argument shall be `REAL'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     Returns A with the fractional portion of its magnitude eliminated
+     by rounding to the nearest whole number and with its sign
+     preserved, converted to an `INTEGER' of the default kind.
+
+_Example_:
+          program test_nint
+            real(4) x4
+            real(8) x8
+            x4 = 1.234E0_4
+            x8 = 4.321_8
+            print *, nint(x4), idnint(x8)
+          end program test_nint
+
+_Specific names_:
+     Name          Argument      Return Type   Standard
+     `NINT(A)'     `REAL(4) A'   `INTEGER'     Fortran 95 and
+                                               later
+     `IDNINT(A)'   `REAL(8) A'   `INTEGER'     Fortran 95 and
+                                               later
+
+_See also_:
+     *note CEILING::, *note FLOOR::
+
+
+
+File: gfortran.info,  Node: NORM2,  Next: NOT,  Prev: NINT,  Up: Intrinsic Procedures
+
+8.181 `NORM2' -- Euclidean vector norms
+=======================================
+
+_Description_:
+     Calculates the Euclidean vector norm (L_2 norm) of of ARRAY along
+     dimension DIM.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = NORM2(ARRAY[, DIM])'
+
+_Arguments_:
+     ARRAY      Shall be an array of type `REAL'
+     DIM        (Optional) shall be a scalar of type `INTEGER'
+                with a value in the range from 1 to n, where n
+                equals the rank of ARRAY.
+
+_Return value_:
+     The result is of the same type as ARRAY.
+
+     If DIM is absent, a scalar with the square root of the sum of all
+     elements in ARRAY squared  is returned. Otherwise, an array of
+     rank n-1, where n equals the rank of ARRAY, and a shape similar to
+     that of ARRAY with dimension DIM dropped is returned.
+
+_Example_:
+          PROGRAM test_sum
+            REAL :: x(5) = [ real :: 1, 2, 3, 4, 5 ]
+            print *, NORM2(x)  ! = sqrt(55.) ~ 7.416
+          END PROGRAM
+
+
+File: gfortran.info,  Node: NOT,  Next: NULL,  Prev: NORM2,  Up: Intrinsic Procedures
+
+8.182 `NOT' -- Logical negation
+===============================
+
+_Description_:
+     `NOT' returns the bitwise Boolean inverse of I.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = NOT(I)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+
+_Return value_:
+     The return type is `INTEGER', of the same kind as the argument.
+
+_See also_:
+     *note IAND::, *note IEOR::, *note IOR::, *note IBITS::, *note
+     IBSET::, *note IBCLR::
+
+
+
+File: gfortran.info,  Node: NULL,  Next: NUM_IMAGES,  Prev: NOT,  Up: Intrinsic Procedures
+
+8.183 `NULL' -- Function that returns an disassociated pointer
+==============================================================
+
+_Description_:
+     Returns a disassociated pointer.
+
+     If MOLD is present, a disassociated pointer of the same type is
+     returned, otherwise the type is determined by context.
+
+     In Fortran 95, MOLD is optional. Please note that Fortran 2003
+     includes cases where it is required.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `PTR => NULL([MOLD])'
+
+_Arguments_:
+     MOLD       (Optional) shall be a pointer of any
+                association status and of any type.
+
+_Return value_:
+     A disassociated pointer.
+
+_Example_:
+          REAL, POINTER, DIMENSION(:) :: VEC => NULL ()
+
+_See also_:
+     *note ASSOCIATED::
+
+
+File: gfortran.info,  Node: NUM_IMAGES,  Next: OR,  Prev: NULL,  Up: Intrinsic Procedures
+
+8.184 `NUM_IMAGES' -- Function that returns the number of images
+================================================================
+
+_Description_:
+     Returns the number of images.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = NUM_IMAGES()'
+
+_Arguments_: None.
+
+_Return value_:
+     Scalar default-kind integer.
+
+_Example_:
+          INTEGER :: value[*]
+          INTEGER :: i
+          value = THIS_IMAGE()
+          SYNC ALL
+          IF (THIS_IMAGE() == 1) THEN
+            DO i = 1, NUM_IMAGES()
+              WRITE(*,'(2(a,i0))') 'value[', i, '] is ', value[i]
+            END DO
+          END IF
+
+_See also_:
+     *note THIS_IMAGE::, *note IMAGE_INDEX::
+
+
+File: gfortran.info,  Node: OR,  Next: PACK,  Prev: NUM_IMAGES,  Up: Intrinsic Procedures
+
+8.185 `OR' -- Bitwise logical OR
+================================
+
+_Description_:
+     Bitwise logical `OR'.
+
+     This intrinsic routine is provided for backwards compatibility with
+     GNU Fortran 77.  For integer arguments, programmers should consider
+     the use of the *note IOR:: intrinsic defined by the Fortran
+     standard.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = OR(I, J)'
+
+_Arguments_:
+     I          The type shall be either a scalar `INTEGER'
+                type or a scalar `LOGICAL' type.
+     J          The type shall be the same as the type of J.
+
+_Return value_:
+     The return type is either a scalar `INTEGER' or a scalar
+     `LOGICAL'.  If the kind type parameters differ, then the smaller
+     kind type is implicitly converted to larger kind, and the return
+     has the larger kind.
+
+_Example_:
+          PROGRAM test_or
+            LOGICAL :: T = .TRUE., F = .FALSE.
+            INTEGER :: a, b
+            DATA a / Z'F' /, b / Z'3' /
+
+            WRITE (*,*) OR(T, T), OR(T, F), OR(F, T), OR(F, F)
+            WRITE (*,*) OR(a, b)
+          END PROGRAM
+
+_See also_:
+     Fortran 95 elemental function: *note IOR::
+
+
+File: gfortran.info,  Node: PACK,  Next: PARITY,  Prev: OR,  Up: Intrinsic Procedures
+
+8.186 `PACK' -- Pack an array into an array of rank one
+=======================================================
+
+_Description_:
+     Stores the elements of ARRAY in an array of rank one.
+
+     The beginning of the resulting array is made up of elements whose
+     MASK equals `TRUE'. Afterwards, positions are filled with elements
+     taken from VECTOR.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = PACK(ARRAY, MASK[,VECTOR]'
+
+_Arguments_:
+     ARRAY      Shall be an array of any type.
+     MASK       Shall be an array of type `LOGICAL' and of the
+                same size as ARRAY. Alternatively, it may be a
+                `LOGICAL' scalar.
+     VECTOR     (Optional) shall be an array of the same type
+                as ARRAY and of rank one. If present, the
+                number of elements in VECTOR shall be equal to
+                or greater than the number of true elements in
+                MASK. If MASK is scalar, the number of
+                elements in VECTOR shall be equal to or
+                greater than the number of elements in ARRAY.
+
+_Return value_:
+     The result is an array of rank one and the same type as that of
+     ARRAY.  If VECTOR is present, the result size is that of VECTOR,
+     the number of `TRUE' values in MASK otherwise.
+
+_Example_:
+     Gathering nonzero elements from an array:
+          PROGRAM test_pack_1
+            INTEGER :: m(6)
+            m = (/ 1, 0, 0, 0, 5, 0 /)
+            WRITE(*, FMT="(6(I0, ' '))") pack(m, m /= 0)  ! "1 5"
+          END PROGRAM
+
+     Gathering nonzero elements from an array and appending elements
+     from VECTOR:
+          PROGRAM test_pack_2
+            INTEGER :: m(4)
+            m = (/ 1, 0, 0, 2 /)
+            WRITE(*, FMT="(4(I0, ' '))") pack(m, m /= 0, (/ 0, 0, 3, 4 /))  ! "1 2 3 4"
+          END PROGRAM
+
+_See also_:
+     *note UNPACK::
+
+
+File: gfortran.info,  Node: PARITY,  Next: PERROR,  Prev: PACK,  Up: Intrinsic Procedures
+
+8.187 `PARITY' -- Reduction with exclusive OR
+=============================================
+
+_Description_:
+     Calculates the parity, i.e. the reduction using `.XOR.', of MASK
+     along dimension DIM.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = PARITY(MASK[, DIM])'
+
+_Arguments_:
+     LOGICAL    Shall be an array of type `LOGICAL'
+     DIM        (Optional) shall be a scalar of type `INTEGER'
+                with a value in the range from 1 to n, where n
+                equals the rank of MASK.
+
+_Return value_:
+     The result is of the same type as MASK.
+
+     If DIM is absent, a scalar with the parity of all elements in MASK
+     is returned, i.e. true if an odd number of elements is `.true.'
+     and false otherwise.  If DIM is present, an array of rank n-1,
+     where n equals the rank of ARRAY, and a shape similar to that of
+     MASK with dimension DIM dropped is returned.
+
+_Example_:
+          PROGRAM test_sum
+            LOGICAL :: x(2) = [ .true., .false. ]
+            print *, PARITY(x) ! prints "T" (true).
+          END PROGRAM
+
+
+File: gfortran.info,  Node: PERROR,  Next: POPCNT,  Prev: PARITY,  Up: Intrinsic Procedures
+
+8.188 `PERROR' -- Print system error message
+============================================
+
+_Description_:
+     Prints (on the C `stderr' stream) a newline-terminated error
+     message corresponding to the last system error. This is prefixed by
+     STRING, a colon and a space. See `perror(3)'.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL PERROR(STRING)'
+
+_Arguments_:
+     STRING     A scalar of type `CHARACTER' and of the
+                default kind.
+
+_See also_:
+     *note IERRNO::
+
+
+File: gfortran.info,  Node: PRECISION,  Next: PRESENT,  Prev: POPPAR,  Up: Intrinsic Procedures
+
+8.189 `PRECISION' -- Decimal precision of a real kind
+=====================================================
+
+_Description_:
+     `PRECISION(X)' returns the decimal precision in the model of the
+     type of `X'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = PRECISION(X)'
+
+_Arguments_:
+     X          Shall be of type `REAL' or `COMPLEX'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the default integer
+     kind.
+
+_See also_:
+     *note SELECTED_REAL_KIND::, *note RANGE::
+
+_Example_:
+          program prec_and_range
+            real(kind=4) :: x(2)
+            complex(kind=8) :: y
+
+            print *, precision(x), range(x)
+            print *, precision(y), range(y)
+          end program prec_and_range
+
+
+File: gfortran.info,  Node: POPCNT,  Next: POPPAR,  Prev: PERROR,  Up: Intrinsic Procedures
+
+8.190 `POPCNT' -- Number of bits set
+====================================
+
+_Description_:
+     `POPCNT(I)' returns the number of bits set ('1' bits) in the binary
+     representation of `I'.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = POPCNT(I)'
+
+_Arguments_:
+     I          Shall be of type `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the default integer
+     kind.
+
+_See also_:
+     *note POPPAR::, *note LEADZ::, *note TRAILZ::
+
+_Example_:
+          program test_population
+            print *, popcnt(127),       poppar(127)
+            print *, popcnt(huge(0_4)), poppar(huge(0_4))
+            print *, popcnt(huge(0_8)), poppar(huge(0_8))
+          end program test_population
+
+
+File: gfortran.info,  Node: POPPAR,  Next: PRECISION,  Prev: POPCNT,  Up: Intrinsic Procedures
+
+8.191 `POPPAR' -- Parity of the number of bits set
+==================================================
+
+_Description_:
+     `POPPAR(I)' returns parity of the integer `I', i.e. the parity of
+     the number of bits set ('1' bits) in the binary representation of
+     `I'. It is equal to 0 if `I' has an even number of bits set, and 1
+     for an odd number of '1' bits.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = POPPAR(I)'
+
+_Arguments_:
+     I          Shall be of type `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the default integer
+     kind.
+
+_See also_:
+     *note POPCNT::, *note LEADZ::, *note TRAILZ::
+
+_Example_:
+          program test_population
+            print *, popcnt(127),       poppar(127)
+            print *, popcnt(huge(0_4)), poppar(huge(0_4))
+            print *, popcnt(huge(0_8)), poppar(huge(0_8))
+          end program test_population
+
+
+File: gfortran.info,  Node: PRESENT,  Next: PRODUCT,  Prev: PRECISION,  Up: Intrinsic Procedures
+
+8.192 `PRESENT' -- Determine whether an optional dummy argument is specified
+============================================================================
+
+_Description_:
+     Determines whether an optional dummy argument is present.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = PRESENT(A)'
+
+_Arguments_:
+     A          May be of any type and may be a pointer,
+                scalar or array value, or a dummy procedure.
+                It shall be the name of an optional dummy
+                argument accessible within the current
+                subroutine or function.
+
+_Return value_:
+     Returns either `TRUE' if the optional argument A is present, or
+     `FALSE' otherwise.
+
+_Example_:
+          PROGRAM test_present
+            WRITE(*,*) f(), f(42)      ! "F T"
+          CONTAINS
+            LOGICAL FUNCTION f(x)
+              INTEGER, INTENT(IN), OPTIONAL :: x
+              f = PRESENT(x)
+            END FUNCTION
+          END PROGRAM
+
+
+File: gfortran.info,  Node: PRODUCT,  Next: RADIX,  Prev: PRESENT,  Up: Intrinsic Procedures
+
+8.193 `PRODUCT' -- Product of array elements
+============================================
+
+_Description_:
+     Multiplies the elements of ARRAY along dimension DIM if the
+     corresponding element in MASK is `TRUE'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = PRODUCT(ARRAY[, MASK])'
+     `RESULT = PRODUCT(ARRAY, DIM[, MASK])'
+
+_Arguments_:
+     ARRAY      Shall be an array of type `INTEGER', `REAL' or
+                `COMPLEX'.
+     DIM        (Optional) shall be a scalar of type `INTEGER'
+                with a value in the range from 1 to n, where n
+                equals the rank of ARRAY.
+     MASK       (Optional) shall be of type `LOGICAL' and
+                either be a scalar or an array of the same
+                shape as ARRAY.
+
+_Return value_:
+     The result is of the same type as ARRAY.
+
+     If DIM is absent, a scalar with the product of all elements in
+     ARRAY is returned. Otherwise, an array of rank n-1, where n equals
+     the rank of ARRAY, and a shape similar to that of ARRAY with
+     dimension DIM dropped is returned.
+
+_Example_:
+          PROGRAM test_product
+            INTEGER :: x(5) = (/ 1, 2, 3, 4 ,5 /)
+            print *, PRODUCT(x)                    ! all elements, product = 120
+            print *, PRODUCT(x, MASK=MOD(x, 2)==1) ! odd elements, product = 15
+          END PROGRAM
+
+_See also_:
+     *note SUM::
+
+
+File: gfortran.info,  Node: RADIX,  Next: RANDOM_NUMBER,  Prev: PRODUCT,  Up: Intrinsic Procedures
+
+8.194 `RADIX' -- Base of a model number
+=======================================
+
+_Description_:
+     `RADIX(X)' returns the base of the model representing the entity X.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = RADIX(X)'
+
+_Arguments_:
+     X          Shall be of type `INTEGER' or `REAL'
+
+_Return value_:
+     The return value is a scalar of type `INTEGER' and of the default
+     integer kind.
+
+_See also_:
+     *note SELECTED_REAL_KIND::
+
+_Example_:
+          program test_radix
+            print *, "The radix for the default integer kind is", radix(0)
+            print *, "The radix for the default real kind is", radix(0.0)
+          end program test_radix
+
+
+
+File: gfortran.info,  Node: RAN,  Next: REAL,  Prev: RANGE,  Up: Intrinsic Procedures
+
+8.195 `RAN' -- Real pseudo-random number
+========================================
+
+_Description_:
+     For compatibility with HP FORTRAN 77/iX, the `RAN' intrinsic is
+     provided as an alias for `RAND'.  See *note RAND:: for complete
+     documentation.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_See also_:
+     *note RAND::, *note RANDOM_NUMBER::
+
+
+File: gfortran.info,  Node: RAND,  Next: RANGE,  Prev: RANDOM_SEED,  Up: Intrinsic Procedures
+
+8.196 `RAND' -- Real pseudo-random number
+=========================================
+
+_Description_:
+     `RAND(FLAG)' returns a pseudo-random number from a uniform
+     distribution between 0 and 1. If FLAG is 0, the next number in the
+     current sequence is returned; if FLAG is 1, the generator is
+     restarted by `CALL SRAND(0)'; if FLAG has any other value, it is
+     used as a new seed with `SRAND'.
+
+     This intrinsic routine is provided for backwards compatibility with
+     GNU Fortran 77. It implements a simple modulo generator as provided
+     by `g77'. For new code, one should consider the use of *note
+     RANDOM_NUMBER:: as it implements a superior algorithm.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = RAND(I)'
+
+_Arguments_:
+     I          Shall be a scalar `INTEGER' of kind 4.
+
+_Return value_:
+     The return value is of `REAL' type and the default kind.
+
+_Example_:
+          program test_rand
+            integer,parameter :: seed = 86456
+
+            call srand(seed)
+            print *, rand(), rand(), rand(), rand()
+            print *, rand(seed), rand(), rand(), rand()
+          end program test_rand
+
+_See also_:
+     *note SRAND::, *note RANDOM_NUMBER::
+
+
+
+File: gfortran.info,  Node: RANDOM_NUMBER,  Next: RANDOM_SEED,  Prev: RADIX,  Up: Intrinsic Procedures
+
+8.197 `RANDOM_NUMBER' -- Pseudo-random number
+=============================================
+
+_Description_:
+     Returns a single pseudorandom number or an array of pseudorandom
+     numbers from the uniform distribution over the range  0 \leq x < 1.
+
+     The runtime-library implements George Marsaglia's KISS (Keep It
+     Simple Stupid) random number generator (RNG). This RNG combines:
+       1. The congruential generator x(n) = 69069 \cdot x(n-1) +
+          1327217885 with a period of 2^32,
+
+       2. A 3-shift shift-register generator with a period of 2^32 - 1,
+
+       3. Two 16-bit multiply-with-carry generators with a period of
+          597273182964842497 > 2^59.
+          The overall period exceeds 2^123.
+
+     Please note, this RNG is thread safe if used within OpenMP
+     directives, i.e., its state will be consistent while called from
+     multiple threads.  However, the KISS generator does not create
+     random numbers in parallel from multiple sources, but in sequence
+     from a single source. If an OpenMP-enabled application heavily
+     relies on random numbers, one should consider employing a
+     dedicated parallel random number generator instead.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `RANDOM_NUMBER(HARVEST)'
+
+_Arguments_:
+     HARVEST    Shall be a scalar or an array of type `REAL'.
+
+_Example_:
+          program test_random_number
+            REAL :: r(5,5)
+            CALL init_random_seed()         ! see example of RANDOM_SEED
+            CALL RANDOM_NUMBER(r)
+          end program
+
+_See also_:
+     *note RANDOM_SEED::
+
+
+File: gfortran.info,  Node: RANDOM_SEED,  Next: RAND,  Prev: RANDOM_NUMBER,  Up: Intrinsic Procedures
+
+8.198 `RANDOM_SEED' -- Initialize a pseudo-random number sequence
+=================================================================
+
+_Description_:
+     Restarts or queries the state of the pseudorandom number generator
+     used by `RANDOM_NUMBER'.
+
+     If `RANDOM_SEED' is called without arguments, it is initialized to
+     a default state. The example below shows how to initialize the
+     random seed based on the system's time.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL RANDOM_SEED([SIZE, PUT, GET])'
+
+_Arguments_:
+     SIZE       (Optional) Shall be a scalar and of type
+                default `INTEGER', with `INTENT(OUT)'. It
+                specifies the minimum size of the arrays used
+                with the PUT and GET arguments.
+     PUT        (Optional) Shall be an array of type default
+                `INTEGER' and rank one. It is `INTENT(IN)' and
+                the size of the array must be larger than or
+                equal to the number returned by the SIZE
+                argument.
+     GET        (Optional) Shall be an array of type default
+                `INTEGER' and rank one. It is `INTENT(OUT)'
+                and the size of the array must be larger than
+                or equal to the number returned by the SIZE
+                argument.
+
+_Example_:
+          SUBROUTINE init_random_seed()
+            INTEGER :: i, n, clock
+            INTEGER, DIMENSION(:), ALLOCATABLE :: seed
+
+            CALL RANDOM_SEED(size = n)
+            ALLOCATE(seed(n))
+
+            CALL SYSTEM_CLOCK(COUNT=clock)
+
+            seed = clock + 37 * (/ (i - 1, i = 1, n) /)
+            CALL RANDOM_SEED(PUT = seed)
+
+            DEALLOCATE(seed)
+          END SUBROUTINE
+
+_See also_:
+     *note RANDOM_NUMBER::
+
+
+File: gfortran.info,  Node: RANGE,  Next: RAN,  Prev: RAND,  Up: Intrinsic Procedures
+
+8.199 `RANGE' -- Decimal exponent range
+=======================================
+
+_Description_:
+     `RANGE(X)' returns the decimal exponent range in the model of the
+     type of `X'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = RANGE(X)'
+
+_Arguments_:
+     X          Shall be of type `INTEGER', `REAL' or
+                `COMPLEX'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the default integer
+     kind.
+
+_See also_:
+     *note SELECTED_REAL_KIND::, *note PRECISION::
+
+_Example_:
+     See `PRECISION' for an example.
+
+
+File: gfortran.info,  Node: REAL,  Next: RENAME,  Prev: RAN,  Up: Intrinsic Procedures
+
+8.200 `REAL' -- Convert to real type
+====================================
+
+_Description_:
+     `REAL(A [, KIND])' converts its argument A to a real type.  The
+     `REALPART' function is provided for compatibility with `g77', and
+     its use is strongly discouraged.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = REAL(A [, KIND])'
+     `RESULT = REALPART(Z)'
+
+_Arguments_:
+     A          Shall be `INTEGER', `REAL', or `COMPLEX'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     These functions return a `REAL' variable or array under the
+     following rules:
+
+    (A)
+          `REAL(A)' is converted to a default real type if A is an
+          integer or real variable.
+
+    (B)
+          `REAL(A)' is converted to a real type with the kind type
+          parameter of A if A is a complex variable.
+
+    (C)
+          `REAL(A, KIND)' is converted to a real type with kind type
+          parameter KIND if A is a complex, integer, or real variable.
+
+_Example_:
+          program test_real
+            complex :: x = (1.0, 2.0)
+            print *, real(x), real(x,8), realpart(x)
+          end program test_real
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `FLOAT(A)'    `INTEGER(4)'  `REAL(4)'     Fortran 77 and
+                                               later
+     `DFLOAT(A)'   `INTEGER(4)'  `REAL(8)'     GNU extension
+     `SNGL(A)'     `INTEGER(8)'  `REAL(4)'     Fortran 77 and
+                                               later
+
+_See also_:
+     *note DBLE::
+
+
+
+File: gfortran.info,  Node: RENAME,  Next: REPEAT,  Prev: REAL,  Up: Intrinsic Procedures
+
+8.201 `RENAME' -- Rename a file
+===============================
+
+_Description_:
+     Renames a file from file PATH1 to PATH2. A null character
+     (`CHAR(0)') can be used to mark the end of the names in PATH1 and
+     PATH2; otherwise, trailing blanks in the file names are ignored.
+     If the STATUS argument is supplied, it contains 0 on success or a
+     nonzero error code upon return; see `rename(2)'.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL RENAME(PATH1, PATH2 [, STATUS])'
+     `STATUS = RENAME(PATH1, PATH2)'
+
+_Arguments_:
+     PATH1      Shall be of default `CHARACTER' type.
+     PATH2      Shall be of default `CHARACTER' type.
+     STATUS     (Optional) Shall be of default `INTEGER' type.
+
+_See also_:
+     *note LINK::
+
+
+
+File: gfortran.info,  Node: REPEAT,  Next: RESHAPE,  Prev: RENAME,  Up: Intrinsic Procedures
+
+8.202 `REPEAT' -- Repeated string concatenation
+===============================================
+
+_Description_:
+     Concatenates NCOPIES copies of a string.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = REPEAT(STRING, NCOPIES)'
+
+_Arguments_:
+     STRING     Shall be scalar and of type `CHARACTER'.
+     NCOPIES    Shall be scalar and of type `INTEGER'.
+
+_Return value_:
+     A new scalar of type `CHARACTER' built up from NCOPIES copies of
+     STRING.
+
+_Example_:
+          program test_repeat
+            write(*,*) repeat("x", 5)   ! "xxxxx"
+          end program
+
+
+File: gfortran.info,  Node: RESHAPE,  Next: RRSPACING,  Prev: REPEAT,  Up: Intrinsic Procedures
+
+8.203 `RESHAPE' -- Function to reshape an array
+===============================================
+
+_Description_:
+     Reshapes SOURCE to correspond to SHAPE. If necessary, the new
+     array may be padded with elements from PAD or permuted as defined
+     by ORDER.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = RESHAPE(SOURCE, SHAPE[, PAD, ORDER])'
+
+_Arguments_:
+     SOURCE     Shall be an array of any type.
+     SHAPE      Shall be of type `INTEGER' and an array of
+                rank one. Its values must be positive or zero.
+     PAD        (Optional) shall be an array of the same type
+                as SOURCE.
+     ORDER      (Optional) shall be of type `INTEGER' and an
+                array of the same shape as SHAPE. Its values
+                shall be a permutation of the numbers from 1
+                to n, where n is the size of SHAPE. If ORDER
+                is absent, the natural ordering shall be
+                assumed.
+
+_Return value_:
+     The result is an array of shape SHAPE with the same type as SOURCE.
+
+_Example_:
+          PROGRAM test_reshape
+            INTEGER, DIMENSION(4) :: x
+            WRITE(*,*) SHAPE(x)                       ! prints "4"
+            WRITE(*,*) SHAPE(RESHAPE(x, (/2, 2/)))    ! prints "2 2"
+          END PROGRAM
+
+_See also_:
+     *note SHAPE::
+
+
+File: gfortran.info,  Node: RRSPACING,  Next: RSHIFT,  Prev: RESHAPE,  Up: Intrinsic Procedures
+
+8.204 `RRSPACING' -- Reciprocal of the relative spacing
+=======================================================
+
+_Description_:
+     `RRSPACING(X)' returns the  reciprocal of the relative spacing of
+     model numbers near X.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = RRSPACING(X)'
+
+_Arguments_:
+     X          Shall be of type `REAL'.
+
+_Return value_:
+     The return value is of the same type and kind as X.  The value
+     returned is equal to `ABS(FRACTION(X)) *
+     FLOAT(RADIX(X))**DIGITS(X)'.
+
+_See also_:
+     *note SPACING::
+
+
+File: gfortran.info,  Node: RSHIFT,  Next: SAME_TYPE_AS,  Prev: RRSPACING,  Up: Intrinsic Procedures
+
+8.205 `RSHIFT' -- Right shift bits
+==================================
+
+_Description_:
+     `RSHIFT' returns a value corresponding to I with all of the bits
+     shifted right by SHIFT places.  If the absolute value of SHIFT is
+     greater than `BIT_SIZE(I)', the value is undefined.  Bits shifted
+     out from the right end are lost. The fill is arithmetic: the bits
+     shifted in from the left end are equal to the leftmost bit, which
+     in two's complement representation is the sign bit.
+
+     This function has been superseded by the `SHIFTA' intrinsic, which
+     is standard in Fortran 2008 and later.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = RSHIFT(I, SHIFT)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     SHIFT      The type shall be `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the same kind as I.
+
+_See also_:
+     *note ISHFT::, *note ISHFTC::, *note LSHIFT::, *note SHIFTA::,
+     *note SHIFTR::, *note SHIFTL::
+
+
+
+File: gfortran.info,  Node: SAME_TYPE_AS,  Next: SCALE,  Prev: RSHIFT,  Up: Intrinsic Procedures
+
+8.206 `SAME_TYPE_AS' --  Query dynamic types for equality
+=========================================================
+
+_Description_:
+     Query dynamic types for equality.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = SAME_TYPE_AS(A, B)'
+
+_Arguments_:
+     A          Shall be an object of extensible declared type
+                or unlimited polymorphic.
+     B          Shall be an object of extensible declared type
+                or unlimited polymorphic.
+
+_Return value_:
+     The return value is a scalar of type default logical. It is true
+     if and only if the dynamic type of A is the same as the dynamic
+     type of B.
+
+_See also_:
+     *note EXTENDS_TYPE_OF::
+
+
+
+File: gfortran.info,  Node: SCALE,  Next: SCAN,  Prev: SAME_TYPE_AS,  Up: Intrinsic Procedures
+
+8.207 `SCALE' -- Scale a real value
+===================================
+
+_Description_:
+     `SCALE(X,I)' returns `X * RADIX(X)**I'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = SCALE(X, I)'
+
+_Arguments_:
+     X          The type of the argument shall be a `REAL'.
+     I          The type of the argument shall be a `INTEGER'.
+
+_Return value_:
+     The return value is of the same type and kind as X.  Its value is
+     `X * RADIX(X)**I'.
+
+_Example_:
+          program test_scale
+            real :: x = 178.1387e-4
+            integer :: i = 5
+            print *, scale(x,i), x*radix(x)**i
+          end program test_scale
+
+
+
+File: gfortran.info,  Node: SCAN,  Next: SECNDS,  Prev: SCALE,  Up: Intrinsic Procedures
+
+8.208 `SCAN' -- Scan a string for the presence of a set of characters
+=====================================================================
+
+_Description_:
+     Scans a STRING for any of the characters in a SET of characters.
+
+     If BACK is either absent or equals `FALSE', this function returns
+     the position of the leftmost character of STRING that is in SET.
+     If BACK equals `TRUE', the rightmost position is returned. If no
+     character of SET is found in STRING, the result is zero.
+
+_Standard_:
+     Fortran 95 and later, with KIND argument Fortran 2003 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = SCAN(STRING, SET[, BACK [, KIND]])'
+
+_Arguments_:
+     STRING     Shall be of type `CHARACTER'.
+     SET        Shall be of type `CHARACTER'.
+     BACK       (Optional) shall be of type `LOGICAL'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER' and of kind KIND. If KIND is
+     absent, the return value is of default integer kind.
+
+_Example_:
+          PROGRAM test_scan
+            WRITE(*,*) SCAN("FORTRAN", "AO")          ! 2, found 'O'
+            WRITE(*,*) SCAN("FORTRAN", "AO", .TRUE.)  ! 6, found 'A'
+            WRITE(*,*) SCAN("FORTRAN", "C++")         ! 0, found none
+          END PROGRAM
+
+_See also_:
+     *note INDEX intrinsic::, *note VERIFY::
+
+
+File: gfortran.info,  Node: SECNDS,  Next: SECOND,  Prev: SCAN,  Up: Intrinsic Procedures
+
+8.209 `SECNDS' -- Time function
+===============================
+
+_Description_:
+     `SECNDS(X)' gets the time in seconds from the real-time system
+     clock.  X is a reference time, also in seconds. If this is zero,
+     the time in seconds from midnight is returned. This function is
+     non-standard and its use is discouraged.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = SECNDS (X)'
+
+_Arguments_:
+     T          Shall be of type `REAL(4)'.
+     X          Shall be of type `REAL(4)'.
+
+_Return value_:
+     None
+
+_Example_:
+          program test_secnds
+              integer :: i
+              real(4) :: t1, t2
+              print *, secnds (0.0)   ! seconds since midnight
+              t1 = secnds (0.0)       ! reference time
+              do i = 1, 10000000      ! do something
+              end do
+              t2 = secnds (t1)        ! elapsed time
+              print *, "Something took ", t2, " seconds."
+          end program test_secnds
+
+
+File: gfortran.info,  Node: SECOND,  Next: SELECTED_CHAR_KIND,  Prev: SECNDS,  Up: Intrinsic Procedures
+
+8.210 `SECOND' -- CPU time function
+===================================
+
+_Description_:
+     Returns a `REAL(4)' value representing the elapsed CPU time in
+     seconds.  This provides the same functionality as the standard
+     `CPU_TIME' intrinsic, and is only included for backwards
+     compatibility.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL SECOND(TIME)'
+     `TIME = SECOND()'
+
+_Arguments_:
+     TIME       Shall be of type `REAL(4)'.
+
+_Return value_:
+     In either syntax, TIME is set to the process's current runtime in
+     seconds.
+
+_See also_:
+     *note CPU_TIME::
+
+
+
+File: gfortran.info,  Node: SELECTED_CHAR_KIND,  Next: SELECTED_INT_KIND,  Prev: SECOND,  Up: Intrinsic Procedures
+
+8.211 `SELECTED_CHAR_KIND' -- Choose character kind
+===================================================
+
+_Description_:
+     `SELECTED_CHAR_KIND(NAME)' returns the kind value for the character
+     set named NAME, if a character set with such a name is supported,
+     or -1 otherwise. Currently, supported character sets include
+     "ASCII" and "DEFAULT", which are equivalent, and "ISO_10646"
+     (Universal Character Set, UCS-4) which is commonly known as
+     Unicode.
+
+_Standard_:
+     Fortran 2003 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = SELECTED_CHAR_KIND(NAME)'
+
+_Arguments_:
+     NAME       Shall be a scalar and of the default character
+                type.
+
+_Example_:
+          program character_kind
+            use iso_fortran_env
+            implicit none
+            integer, parameter :: ascii = selected_char_kind ("ascii")
+            integer, parameter :: ucs4  = selected_char_kind ('ISO_10646')
+
+            character(kind=ascii, len=26) :: alphabet
+            character(kind=ucs4,  len=30) :: hello_world
+
+            alphabet = ascii_"abcdefghijklmnopqrstuvwxyz"
+            hello_world = ucs4_'Hello World and Ni Hao -- ' &
+                          // char (int (z'4F60'), ucs4)     &
+                          // char (int (z'597D'), ucs4)
+
+            write (*,*) alphabet
+
+            open (output_unit, encoding='UTF-8')
+            write (*,*) trim (hello_world)
+          end program character_kind
+
+
+File: gfortran.info,  Node: SELECTED_INT_KIND,  Next: SELECTED_REAL_KIND,  Prev: SELECTED_CHAR_KIND,  Up: Intrinsic Procedures
+
+8.212 `SELECTED_INT_KIND' -- Choose integer kind
+================================================
+
+_Description_:
+     `SELECTED_INT_KIND(R)' return the kind value of the smallest
+     integer type that can represent all values ranging from -10^R
+     (exclusive) to 10^R (exclusive). If there is no integer kind that
+     accommodates this range, `SELECTED_INT_KIND' returns -1.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = SELECTED_INT_KIND(R)'
+
+_Arguments_:
+     R          Shall be a scalar and of type `INTEGER'.
+
+_Example_:
+          program large_integers
+            integer,parameter :: k5 = selected_int_kind(5)
+            integer,parameter :: k15 = selected_int_kind(15)
+            integer(kind=k5) :: i5
+            integer(kind=k15) :: i15
+
+            print *, huge(i5), huge(i15)
+
+            ! The following inequalities are always true
+            print *, huge(i5) >= 10_k5**5-1
+            print *, huge(i15) >= 10_k15**15-1
+          end program large_integers
+
+
+File: gfortran.info,  Node: SELECTED_REAL_KIND,  Next: SET_EXPONENT,  Prev: SELECTED_INT_KIND,  Up: Intrinsic Procedures
+
+8.213 `SELECTED_REAL_KIND' -- Choose real kind
+==============================================
+
+_Description_:
+     `SELECTED_REAL_KIND(P,R)' returns the kind value of a real data
+     type with decimal precision of at least `P' digits, exponent range
+     of at least `R', and with a radix of `RADIX'.
+
+_Standard_:
+     Fortran 95 and later, with `RADIX' Fortran 2008 or later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = SELECTED_REAL_KIND([P, R, RADIX])'
+
+_Arguments_:
+     P          (Optional) shall be a scalar and of type
+                `INTEGER'.
+     R          (Optional) shall be a scalar and of type
+                `INTEGER'.
+     RADIX      (Optional) shall be a scalar and of type
+                `INTEGER'.
+     Before Fortran 2008, at least one of the arguments R or P shall be
+     present; since Fortran 2008, they are assumed to be zero if absent.
+
+_Return value_:
+     `SELECTED_REAL_KIND' returns the value of the kind type parameter
+     of a real data type with decimal precision of at least `P' digits,
+     a decimal exponent range of at least `R', and with the requested
+     `RADIX'. If the `RADIX' parameter is absent, real kinds with any
+     radix can be returned. If more than one real data type meet the
+     criteria, the kind of the data type with the smallest decimal
+     precision is returned. If no real data type matches the criteria,
+     the result is
+    -1 if the processor does not support a real data type with a
+          precision greater than or equal to `P', but the `R' and
+          `RADIX' requirements can be fulfilled
+
+    -2 if the processor does not support a real type with an exponent
+          range greater than or equal to `R', but `P' and `RADIX' are
+          fulfillable
+
+    -3 if `RADIX' but not `P' and `R' requirements
+          are fulfillable
+
+    -4 if `RADIX' and either `P' or `R' requirements
+          are fulfillable
+
+    -5 if there is no real type with the given `RADIX'
+
+_See also_:
+     *note PRECISION::, *note RANGE::, *note RADIX::
+
+_Example_:
+          program real_kinds
+            integer,parameter :: p6 = selected_real_kind(6)
+            integer,parameter :: p10r100 = selected_real_kind(10,100)
+            integer,parameter :: r400 = selected_real_kind(r=400)
+            real(kind=p6) :: x
+            real(kind=p10r100) :: y
+            real(kind=r400) :: z
+
+            print *, precision(x), range(x)
+            print *, precision(y), range(y)
+            print *, precision(z), range(z)
+          end program real_kinds
+
+
+File: gfortran.info,  Node: SET_EXPONENT,  Next: SHAPE,  Prev: SELECTED_REAL_KIND,  Up: Intrinsic Procedures
+
+8.214 `SET_EXPONENT' -- Set the exponent of the model
+=====================================================
+
+_Description_:
+     `SET_EXPONENT(X, I)' returns the real number whose fractional part
+     is that that of X and whose exponent part is I.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = SET_EXPONENT(X, I)'
+
+_Arguments_:
+     X          Shall be of type `REAL'.
+     I          Shall be of type `INTEGER'.
+
+_Return value_:
+     The return value is of the same type and kind as X.  The real
+     number whose fractional part is that that of X and whose exponent
+     part if I is returned; it is `FRACTION(X) * RADIX(X)**I'.
+
+_Example_:
+          PROGRAM test_setexp
+            REAL :: x = 178.1387e-4
+            INTEGER :: i = 17
+            PRINT *, SET_EXPONENT(x, i), FRACTION(x) * RADIX(x)**i
+          END PROGRAM
+
+
+
+File: gfortran.info,  Node: SHAPE,  Next: SHIFTA,  Prev: SET_EXPONENT,  Up: Intrinsic Procedures
+
+8.215 `SHAPE' -- Determine the shape of an array
+================================================
+
+_Description_:
+     Determines the shape of an array.
+
+_Standard_:
+     Fortran 95 and later, with KIND argument Fortran 2003 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = SHAPE(SOURCE [, KIND])'
+
+_Arguments_:
+     SOURCE     Shall be an array or scalar of any type.  If
+                SOURCE is a pointer it must be associated and
+                allocatable arrays must be allocated.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     An `INTEGER' array of rank one with as many elements as SOURCE has
+     dimensions. The elements of the resulting array correspond to the
+     extend of SOURCE along the respective dimensions. If SOURCE is a
+     scalar, the result is the rank one array of size zero. If KIND is
+     absent, the return value has the default integer kind otherwise
+     the specified kind.
+
+_Example_:
+          PROGRAM test_shape
+            INTEGER, DIMENSION(-1:1, -1:2) :: A
+            WRITE(*,*) SHAPE(A)             ! (/ 3, 4 /)
+            WRITE(*,*) SIZE(SHAPE(42))      ! (/ /)
+          END PROGRAM
+
+_See also_:
+     *note RESHAPE::, *note SIZE::
+
+
+File: gfortran.info,  Node: SHIFTA,  Next: SHIFTL,  Prev: SHAPE,  Up: Intrinsic Procedures
+
+8.216 `SHIFTA' -- Right shift with fill
+=======================================
+
+_Description_:
+     `SHIFTA' returns a value corresponding to I with all of the bits
+     shifted right by SHIFT places.  If the absolute value of SHIFT is
+     greater than `BIT_SIZE(I)', the value is undefined.  Bits shifted
+     out from the right end are lost. The fill is arithmetic: the bits
+     shifted in from the left end are equal to the leftmost bit, which
+     in two's complement representation is the sign bit.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = SHIFTA(I, SHIFT)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     SHIFT      The type shall be `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the same kind as I.
+
+_See also_:
+     *note SHIFTL::, *note SHIFTR::
+
+
+File: gfortran.info,  Node: SHIFTL,  Next: SHIFTR,  Prev: SHIFTA,  Up: Intrinsic Procedures
+
+8.217 `SHIFTL' -- Left shift
+============================
+
+_Description_:
+     `SHIFTL' returns a value corresponding to I with all of the bits
+     shifted left by SHIFT places.  If the absolute value of SHIFT is
+     greater than `BIT_SIZE(I)', the value is undefined.  Bits shifted
+     out from the left end are lost, and bits shifted in from the right
+     end are set to 0.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = SHIFTL(I, SHIFT)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     SHIFT      The type shall be `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the same kind as I.
+
+_See also_:
+     *note SHIFTA::, *note SHIFTR::
+
+
+File: gfortran.info,  Node: SHIFTR,  Next: SIGN,  Prev: SHIFTL,  Up: Intrinsic Procedures
+
+8.218 `SHIFTR' -- Right shift
+=============================
+
+_Description_:
+     `SHIFTR' returns a value corresponding to I with all of the bits
+     shifted right by SHIFT places.  If the absolute value of SHIFT is
+     greater than `BIT_SIZE(I)', the value is undefined.  Bits shifted
+     out from the right end are lost, and bits shifted in from the left
+     end are set to 0.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = SHIFTR(I, SHIFT)'
+
+_Arguments_:
+     I          The type shall be `INTEGER'.
+     SHIFT      The type shall be `INTEGER'.
+
+_Return value_:
+     The return value is of type `INTEGER' and of the same kind as I.
+
+_See also_:
+     *note SHIFTA::, *note SHIFTL::
+
+
+File: gfortran.info,  Node: SIGN,  Next: SIGNAL,  Prev: SHIFTR,  Up: Intrinsic Procedures
+
+8.219 `SIGN' -- Sign copying function
+=====================================
+
+_Description_:
+     `SIGN(A,B)' returns the value of A with the sign of B.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = SIGN(A, B)'
+
+_Arguments_:
+     A          Shall be of type `INTEGER' or `REAL'
+     B          Shall be of the same type and kind as A
+
+_Return value_:
+     The kind of the return value is that of A and B.  If B\ge 0 then
+     the result is `ABS(A)', else it is `-ABS(A)'.
+
+_Example_:
+          program test_sign
+            print *, sign(-12,1)
+            print *, sign(-12,0)
+            print *, sign(-12,-1)
+
+            print *, sign(-12.,1.)
+            print *, sign(-12.,0.)
+            print *, sign(-12.,-1.)
+          end program test_sign
+
+_Specific names_:
+     Name          Arguments     Return type   Standard
+     `SIGN(A,B)'   `REAL(4) A,   `REAL(4)'     f77, gnu
+                   B'                          
+     `ISIGN(A,B)'  `INTEGER(4)   `INTEGER(4)'  f77, gnu
+                   A, B'                       
+     `DSIGN(A,B)'  `REAL(8) A,   `REAL(8)'     f77, gnu
+                   B'                          
+
+
+File: gfortran.info,  Node: SIGNAL,  Next: SIN,  Prev: SIGN,  Up: Intrinsic Procedures
+
+8.220 `SIGNAL' -- Signal handling subroutine (or function)
+==========================================================
+
+_Description_:
+     `SIGNAL(NUMBER, HANDLER [, STATUS])' causes external subroutine
+     HANDLER to be executed with a single integer argument when signal
+     NUMBER occurs.  If HANDLER is an integer, it can be used to turn
+     off handling of signal NUMBER or revert to its default action.
+     See `signal(2)'.
+
+     If `SIGNAL' is called as a subroutine and the STATUS argument is
+     supplied, it is set to the value returned by `signal(2)'.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL SIGNAL(NUMBER, HANDLER [, STATUS])'
+     `STATUS = SIGNAL(NUMBER, HANDLER)'
+
+_Arguments_:
+     NUMBER     Shall be a scalar integer, with `INTENT(IN)'
+     HANDLER    Signal handler (`INTEGER FUNCTION' or
+                `SUBROUTINE') or dummy/global `INTEGER' scalar.
+                `INTEGER'. It is `INTENT(IN)'.
+     STATUS     (Optional) STATUS shall be a scalar integer.
+                It has `INTENT(OUT)'.
+
+_Return value_:
+     The `SIGNAL' function returns the value returned by `signal(2)'.
+
+_Example_:
+          program test_signal
+            intrinsic signal
+            external handler_print
+
+            call signal (12, handler_print)
+            call signal (10, 1)
+
+            call sleep (30)
+          end program test_signal
+
+
+File: gfortran.info,  Node: SIN,  Next: SINH,  Prev: SIGNAL,  Up: Intrinsic Procedures
+
+8.221 `SIN' -- Sine function
+============================
+
+_Description_:
+     `SIN(X)' computes the sine of X.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = SIN(X)'
+
+_Arguments_:
+     X          The type shall be `REAL' or `COMPLEX'.
+
+_Return value_:
+     The return value has same type and kind as X.
+
+_Example_:
+          program test_sin
+            real :: x = 0.0
+            x = sin(x)
+          end program test_sin
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `SIN(X)'      `REAL(4) X'   `REAL(4)'     f77, gnu
+     `DSIN(X)'     `REAL(8) X'   `REAL(8)'     f95, gnu
+     `CSIN(X)'     `COMPLEX(4)   `COMPLEX(4)'  f95, gnu
+                   X'                          
+     `ZSIN(X)'     `COMPLEX(8)   `COMPLEX(8)'  f95, gnu
+                   X'                          
+     `CDSIN(X)'    `COMPLEX(8)   `COMPLEX(8)'  f95, gnu
+                   X'                          
+
+_See also_:
+     *note ASIN::
+
+
+File: gfortran.info,  Node: SINH,  Next: SIZE,  Prev: SIN,  Up: Intrinsic Procedures
+
+8.222 `SINH' -- Hyperbolic sine function
+========================================
+
+_Description_:
+     `SINH(X)' computes the hyperbolic sine of X.
+
+_Standard_:
+     Fortran 95 and later, for a complex argument Fortran 2008 or later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = SINH(X)'
+
+_Arguments_:
+     X          The type shall be `REAL' or `COMPLEX'.
+
+_Return value_:
+     The return value has same type and kind as X.
+
+_Example_:
+          program test_sinh
+            real(8) :: x = - 1.0_8
+            x = sinh(x)
+          end program test_sinh
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `SINH(X)'     `REAL(4) X'   `REAL(4)'     Fortran 95 and
+                                               later
+     `DSINH(X)'    `REAL(8) X'   `REAL(8)'     Fortran 95 and
+                                               later
+
+_See also_:
+     *note ASINH::
+
+
+File: gfortran.info,  Node: SIZE,  Next: SIZEOF,  Prev: SINH,  Up: Intrinsic Procedures
+
+8.223 `SIZE' -- Determine the size of an array
+==============================================
+
+_Description_:
+     Determine the extent of ARRAY along a specified dimension DIM, or
+     the total number of elements in ARRAY if DIM is absent.
+
+_Standard_:
+     Fortran 95 and later, with KIND argument Fortran 2003 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = SIZE(ARRAY[, DIM [, KIND]])'
+
+_Arguments_:
+     ARRAY      Shall be an array of any type. If ARRAY is a
+                pointer it must be associated and allocatable
+                arrays must be allocated.
+     DIM        (Optional) shall be a scalar of type `INTEGER'
+                and its value shall be in the range from 1 to
+                n, where n equals the rank of ARRAY.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER' and of kind KIND. If KIND is
+     absent, the return value is of default integer kind.
+
+_Example_:
+          PROGRAM test_size
+            WRITE(*,*) SIZE((/ 1, 2 /))    ! 2
+          END PROGRAM
+
+_See also_:
+     *note SHAPE::, *note RESHAPE::
+
+
+File: gfortran.info,  Node: SIZEOF,  Next: SLEEP,  Prev: SIZE,  Up: Intrinsic Procedures
+
+8.224 `SIZEOF' -- Size in bytes of an expression
+================================================
+
+_Description_:
+     `SIZEOF(X)' calculates the number of bytes of storage the
+     expression `X' occupies.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Intrinsic function
+
+_Syntax_:
+     `N = SIZEOF(X)'
+
+_Arguments_:
+     X          The argument shall be of any type, rank or
+                shape.
+
+_Return value_:
+     The return value is of type integer and of the system-dependent
+     kind C_SIZE_T (from the ISO_C_BINDING module). Its value is the
+     number of bytes occupied by the argument.  If the argument has the
+     `POINTER' attribute, the number of bytes of the storage area
+     pointed to is returned.  If the argument is of a derived type with
+     `POINTER' or `ALLOCATABLE' components, the return value doesn't
+     account for the sizes of the data pointed to by these components.
+     If the argument is polymorphic, the size according to the declared
+     type is returned.
+
+_Example_:
+             integer :: i
+             real :: r, s(5)
+             print *, (sizeof(s)/sizeof(r) == 5)
+             end
+     The example will print `.TRUE.' unless you are using a platform
+     where default `REAL' variables are unusually padded.
+
+_See also_:
+     *note C_SIZEOF::, *note STORAGE_SIZE::
+
+
+File: gfortran.info,  Node: SLEEP,  Next: SPACING,  Prev: SIZEOF,  Up: Intrinsic Procedures
+
+8.225 `SLEEP' -- Sleep for the specified number of seconds
+==========================================================
+
+_Description_:
+     Calling this subroutine causes the process to pause for SECONDS
+     seconds.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL SLEEP(SECONDS)'
+
+_Arguments_:
+     SECONDS    The type shall be of default `INTEGER'.
+
+_Example_:
+          program test_sleep
+            call sleep(5)
+          end
+
+
+File: gfortran.info,  Node: SPACING,  Next: SPREAD,  Prev: SLEEP,  Up: Intrinsic Procedures
+
+8.226 `SPACING' -- Smallest distance between two numbers of a given type
+========================================================================
+
+_Description_:
+     Determines the distance between the argument X and the nearest
+     adjacent number of the same type.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = SPACING(X)'
+
+_Arguments_:
+     X          Shall be of type `REAL'.
+
+_Return value_:
+     The result is of the same type as the input argument X.
+
+_Example_:
+          PROGRAM test_spacing
+            INTEGER, PARAMETER :: SGL = SELECTED_REAL_KIND(p=6, r=37)
+            INTEGER, PARAMETER :: DBL = SELECTED_REAL_KIND(p=13, r=200)
+
+            WRITE(*,*) spacing(1.0_SGL)      ! "1.1920929E-07"          on i686
+            WRITE(*,*) spacing(1.0_DBL)      ! "2.220446049250313E-016" on i686
+          END PROGRAM
+
+_See also_:
+     *note RRSPACING::
+
+
+File: gfortran.info,  Node: SPREAD,  Next: SQRT,  Prev: SPACING,  Up: Intrinsic Procedures
+
+8.227 `SPREAD' -- Add a dimension to an array
+=============================================
+
+_Description_:
+     Replicates a SOURCE array NCOPIES times along a specified
+     dimension DIM.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = SPREAD(SOURCE, DIM, NCOPIES)'
+
+_Arguments_:
+     SOURCE     Shall be a scalar or an array of any type and
+                a rank less than seven.
+     DIM        Shall be a scalar of type `INTEGER' with a
+                value in the range from 1 to n+1, where n
+                equals the rank of SOURCE.
+     NCOPIES    Shall be a scalar of type `INTEGER'.
+
+_Return value_:
+     The result is an array of the same type as SOURCE and has rank n+1
+     where n equals the rank of SOURCE.
+
+_Example_:
+          PROGRAM test_spread
+            INTEGER :: a = 1, b(2) = (/ 1, 2 /)
+            WRITE(*,*) SPREAD(A, 1, 2)            ! "1 1"
+            WRITE(*,*) SPREAD(B, 1, 2)            ! "1 1 2 2"
+          END PROGRAM
+
+_See also_:
+     *note UNPACK::
+
+
+File: gfortran.info,  Node: SQRT,  Next: SRAND,  Prev: SPREAD,  Up: Intrinsic Procedures
+
+8.228 `SQRT' -- Square-root function
+====================================
+
+_Description_:
+     `SQRT(X)' computes the square root of X.
+
+_Standard_:
+     Fortran 77 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = SQRT(X)'
+
+_Arguments_:
+     X          The type shall be `REAL' or `COMPLEX'.
+
+_Return value_:
+     The return value is of type `REAL' or `COMPLEX'.  The kind type
+     parameter is the same as X.
+
+_Example_:
+          program test_sqrt
+            real(8) :: x = 2.0_8
+            complex :: z = (1.0, 2.0)
+            x = sqrt(x)
+            z = sqrt(z)
+          end program test_sqrt
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `SQRT(X)'     `REAL(4) X'   `REAL(4)'     Fortran 95 and
+                                               later
+     `DSQRT(X)'    `REAL(8) X'   `REAL(8)'     Fortran 95 and
+                                               later
+     `CSQRT(X)'    `COMPLEX(4)   `COMPLEX(4)'  Fortran 95 and
+                   X'                          later
+     `ZSQRT(X)'    `COMPLEX(8)   `COMPLEX(8)'  GNU extension
+                   X'                          
+     `CDSQRT(X)'   `COMPLEX(8)   `COMPLEX(8)'  GNU extension
+                   X'                          
+
+
+File: gfortran.info,  Node: SRAND,  Next: STAT,  Prev: SQRT,  Up: Intrinsic Procedures
+
+8.229 `SRAND' -- Reinitialize the random number generator
+=========================================================
+
+_Description_:
+     `SRAND' reinitializes the pseudo-random number generator called by
+     `RAND' and `IRAND'. The new seed used by the generator is
+     specified by the required argument SEED.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL SRAND(SEED)'
+
+_Arguments_:
+     SEED       Shall be a scalar `INTEGER(kind=4)'.
+
+_Return value_:
+     Does not return anything.
+
+_Example_:
+     See `RAND' and `IRAND' for examples.
+
+_Notes_:
+     The Fortran 2003 standard specifies the intrinsic `RANDOM_SEED' to
+     initialize the pseudo-random numbers generator and `RANDOM_NUMBER'
+     to generate pseudo-random numbers. Please note that in GNU
+     Fortran, these two sets of intrinsics (`RAND', `IRAND' and `SRAND'
+     on the one hand, `RANDOM_NUMBER' and `RANDOM_SEED' on the other
+     hand) access two independent pseudo-random number generators.
+
+_See also_:
+     *note RAND::, *note RANDOM_SEED::, *note RANDOM_NUMBER::
+
+
+
+File: gfortran.info,  Node: STAT,  Next: STORAGE_SIZE,  Prev: SRAND,  Up: Intrinsic Procedures
+
+8.230 `STAT' -- Get file status
+===============================
+
+_Description_:
+     This function returns information about a file. No permissions are
+     required on the file itself, but execute (search) permission is
+     required on all of the directories in path that lead to the file.
+
+     The elements that are obtained and stored in the array `VALUES':
+     `VALUES(1)'Device ID
+     `VALUES(2)'Inode number
+     `VALUES(3)'File mode
+     `VALUES(4)'Number of links
+     `VALUES(5)'Owner's uid
+     `VALUES(6)'Owner's gid
+     `VALUES(7)'ID of device containing directory entry for
+                file (0 if not available)
+     `VALUES(8)'File size (bytes)
+     `VALUES(9)'Last access time
+     `VALUES(10)'Last modification time
+     `VALUES(11)'Last file status change time
+     `VALUES(12)'Preferred I/O block size (-1 if not available)
+     `VALUES(13)'Number of blocks allocated (-1 if not
+                available)
+
+     Not all these elements are relevant on all systems.  If an element
+     is not relevant, it is returned as 0.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL STAT(NAME, VALUES [, STATUS])'
+     `STATUS = STAT(NAME, VALUES)'
+
+_Arguments_:
+     NAME       The type shall be `CHARACTER', of the default
+                kind and a valid path within the file system.
+     VALUES     The type shall be `INTEGER(4), DIMENSION(13)'.
+     STATUS     (Optional) status flag of type `INTEGER(4)'.
+                Returns 0 on success and a system specific
+                error code otherwise.
+
+_Example_:
+          PROGRAM test_stat
+            INTEGER, DIMENSION(13) :: buff
+            INTEGER :: status
+
+            CALL STAT("/etc/passwd", buff, status)
+
+            IF (status == 0) THEN
+              WRITE (*, FMT="('Device ID:',               T30, I19)") buff(1)
+              WRITE (*, FMT="('Inode number:',            T30, I19)") buff(2)
+              WRITE (*, FMT="('File mode (octal):',       T30, O19)") buff(3)
+              WRITE (*, FMT="('Number of links:',         T30, I19)") buff(4)
+              WRITE (*, FMT="('Owner''s uid:',            T30, I19)") buff(5)
+              WRITE (*, FMT="('Owner''s gid:',            T30, I19)") buff(6)
+              WRITE (*, FMT="('Device where located:',    T30, I19)") buff(7)
+              WRITE (*, FMT="('File size:',               T30, I19)") buff(8)
+              WRITE (*, FMT="('Last access time:',        T30, A19)") CTIME(buff(9))
+              WRITE (*, FMT="('Last modification time',   T30, A19)") CTIME(buff(10))
+              WRITE (*, FMT="('Last status change time:', T30, A19)") CTIME(buff(11))
+              WRITE (*, FMT="('Preferred block size:',    T30, I19)") buff(12)
+              WRITE (*, FMT="('No. of blocks allocated:', T30, I19)") buff(13)
+            END IF
+          END PROGRAM
+
+_See also_:
+     To stat an open file: *note FSTAT::, to stat a link: *note LSTAT::
+
+
+File: gfortran.info,  Node: STORAGE_SIZE,  Next: SUM,  Prev: STAT,  Up: Intrinsic Procedures
+
+8.231 `STORAGE_SIZE' -- Storage size in bits
+============================================
+
+_Description_:
+     Returns the storage size of argument A in bits.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = STORAGE_SIZE(A [, KIND])'
+
+_Arguments_:
+     A          Shall be a scalar or array of any type.
+     KIND       (Optional) shall be a scalar integer constant
+                expression.
+
+_Return Value_:
+     The result is a scalar integer with the kind type parameter
+     specified by KIND (or default integer type if KIND is missing).
+     The result value is the size expressed in bits for an element of
+     an array that has the dynamic type and type parameters of A.
+
+_See also_:
+     *note C_SIZEOF::, *note SIZEOF::
+
+
+File: gfortran.info,  Node: SUM,  Next: SYMLNK,  Prev: STORAGE_SIZE,  Up: Intrinsic Procedures
+
+8.232 `SUM' -- Sum of array elements
+====================================
+
+_Description_:
+     Adds the elements of ARRAY along dimension DIM if the
+     corresponding element in MASK is `TRUE'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = SUM(ARRAY[, MASK])'
+     `RESULT = SUM(ARRAY, DIM[, MASK])'
+
+_Arguments_:
+     ARRAY      Shall be an array of type `INTEGER', `REAL' or
+                `COMPLEX'.
+     DIM        (Optional) shall be a scalar of type `INTEGER'
+                with a value in the range from 1 to n, where n
+                equals the rank of ARRAY.
+     MASK       (Optional) shall be of type `LOGICAL' and
+                either be a scalar or an array of the same
+                shape as ARRAY.
+
+_Return value_:
+     The result is of the same type as ARRAY.
+
+     If DIM is absent, a scalar with the sum of all elements in ARRAY
+     is returned. Otherwise, an array of rank n-1, where n equals the
+     rank of ARRAY, and a shape similar to that of ARRAY with dimension
+     DIM dropped is returned.
+
+_Example_:
+          PROGRAM test_sum
+            INTEGER :: x(5) = (/ 1, 2, 3, 4 ,5 /)
+            print *, SUM(x)                        ! all elements, sum = 15
+            print *, SUM(x, MASK=MOD(x, 2)==1)     ! odd elements, sum = 9
+          END PROGRAM
+
+_See also_:
+     *note PRODUCT::
+
+
+File: gfortran.info,  Node: SYMLNK,  Next: SYSTEM,  Prev: SUM,  Up: Intrinsic Procedures
+
+8.233 `SYMLNK' -- Create a symbolic link
+========================================
+
+_Description_:
+     Makes a symbolic link from file PATH1 to PATH2. A null character
+     (`CHAR(0)') can be used to mark the end of the names in PATH1 and
+     PATH2; otherwise, trailing blanks in the file names are ignored.
+     If the STATUS argument is supplied, it contains 0 on success or a
+     nonzero error code upon return; see `symlink(2)'.  If the system
+     does not supply `symlink(2)', `ENOSYS' is returned.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL SYMLNK(PATH1, PATH2 [, STATUS])'
+     `STATUS = SYMLNK(PATH1, PATH2)'
+
+_Arguments_:
+     PATH1      Shall be of default `CHARACTER' type.
+     PATH2      Shall be of default `CHARACTER' type.
+     STATUS     (Optional) Shall be of default `INTEGER' type.
+
+_See also_:
+     *note LINK::, *note UNLINK::
+
+
+
+File: gfortran.info,  Node: SYSTEM,  Next: SYSTEM_CLOCK,  Prev: SYMLNK,  Up: Intrinsic Procedures
+
+8.234 `SYSTEM' -- Execute a shell command
+=========================================
+
+_Description_:
+     Passes the command COMMAND to a shell (see `system(3)'). If
+     argument STATUS is present, it contains the value returned by
+     `system(3)', which is presumably 0 if the shell command succeeded.
+     Note that which shell is used to invoke the command is
+     system-dependent and environment-dependent.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+     Note that the `system' function need not be thread-safe. It is the
+     responsibility of the user to ensure that `system' is not called
+     concurrently.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL SYSTEM(COMMAND [, STATUS])'
+     `STATUS = SYSTEM(COMMAND)'
+
+_Arguments_:
+     COMMAND    Shall be of default `CHARACTER' type.
+     STATUS     (Optional) Shall be of default `INTEGER' type.
+
+_See also_:
+     *note EXECUTE_COMMAND_LINE::, which is part of the Fortran 2008
+     standard and should considered in new code for future portability.
+
+
+File: gfortran.info,  Node: SYSTEM_CLOCK,  Next: TAN,  Prev: SYSTEM,  Up: Intrinsic Procedures
+
+8.235 `SYSTEM_CLOCK' -- Time function
+=====================================
+
+_Description_:
+     Determines the COUNT of a processor clock since an unspecified
+     time in the past modulo COUNT_MAX, COUNT_RATE determines the
+     number of clock ticks per second.  If the platform supports a high
+     resolution monotonic clock, that clock is used and can provide up
+     to nanosecond resolution.  If a high resolution monotonic clock is
+     not available, the implementation falls back to a potentially lower
+     resolution realtime clock.
+
+     COUNT_RATE and COUNT_MAX vary depending on the kind of the
+     arguments.  For KIND=8 arguments, COUNT represents nanoseconds,
+     and for KIND=4 arguments, COUNT represents milliseconds. Other
+     than the kind dependency, COUNT_RATE and COUNT_MAX are constant,
+     however the particular values are specific to `gfortran'.
+
+     If there is no clock, COUNT is set to `-HUGE(COUNT)', and
+     COUNT_RATE and COUNT_MAX are set to zero.
+
+     When running on a platform using the GNU C library (glibc), or a
+     derivative thereof, the high resolution monotonic clock is
+     available only when linking with the RT library.  This can be done
+     explicitly by adding the `-lrt' flag when linking the application,
+     but is also done implicitly when using OpenMP.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Subroutine
+
+_Syntax_:
+     `CALL SYSTEM_CLOCK([COUNT, COUNT_RATE, COUNT_MAX])'
+
+_Arguments_:
+     COUNT      (Optional) shall be a scalar of type `INTEGER'
+                with `INTENT(OUT)'.
+     COUNT_RATE (Optional) shall be a scalar of type `INTEGER'
+                with `INTENT(OUT)'.
+     COUNT_MAX  (Optional) shall be a scalar of type `INTEGER'
+                with `INTENT(OUT)'.
+
+_Example_:
+          PROGRAM test_system_clock
+            INTEGER :: count, count_rate, count_max
+            CALL SYSTEM_CLOCK(count, count_rate, count_max)
+            WRITE(*,*) count, count_rate, count_max
+          END PROGRAM
+
+_See also_:
+     *note DATE_AND_TIME::, *note CPU_TIME::
+
+
+File: gfortran.info,  Node: TAN,  Next: TANH,  Prev: SYSTEM_CLOCK,  Up: Intrinsic Procedures
+
+8.236 `TAN' -- Tangent function
+===============================
+
+_Description_:
+     `TAN(X)' computes the tangent of X.
+
+_Standard_:
+     Fortran 77 and later, for a complex argument Fortran 2008 or later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = TAN(X)'
+
+_Arguments_:
+     X          The type shall be `REAL' or `COMPLEX'.
+
+_Return value_:
+     The return value has same type and kind as X.
+
+_Example_:
+          program test_tan
+            real(8) :: x = 0.165_8
+            x = tan(x)
+          end program test_tan
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `TAN(X)'      `REAL(4) X'   `REAL(4)'     Fortran 95 and
+                                               later
+     `DTAN(X)'     `REAL(8) X'   `REAL(8)'     Fortran 95 and
+                                               later
+
+_See also_:
+     *note ATAN::
+
+
+File: gfortran.info,  Node: TANH,  Next: THIS_IMAGE,  Prev: TAN,  Up: Intrinsic Procedures
+
+8.237 `TANH' -- Hyperbolic tangent function
+===========================================
+
+_Description_:
+     `TANH(X)' computes the hyperbolic tangent of X.
+
+_Standard_:
+     Fortran 77 and later, for a complex argument Fortran 2008 or later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `X = TANH(X)'
+
+_Arguments_:
+     X          The type shall be `REAL' or `COMPLEX'.
+
+_Return value_:
+     The return value has same type and kind as X. If X is complex, the
+     imaginary part of the result is in radians. If X is `REAL', the
+     return value lies in the range  - 1 \leq tanh(x) \leq 1 .
+
+_Example_:
+          program test_tanh
+            real(8) :: x = 2.1_8
+            x = tanh(x)
+          end program test_tanh
+
+_Specific names_:
+     Name          Argument      Return type   Standard
+     `TANH(X)'     `REAL(4) X'   `REAL(4)'     Fortran 95 and
+                                               later
+     `DTANH(X)'    `REAL(8) X'   `REAL(8)'     Fortran 95 and
+                                               later
+
+_See also_:
+     *note ATANH::
+
+
+File: gfortran.info,  Node: THIS_IMAGE,  Next: TIME,  Prev: TANH,  Up: Intrinsic Procedures
+
+8.238 `THIS_IMAGE' -- Function that returns the cosubscript index of this image
+===============================================================================
+
+_Description_:
+     Returns the cosubscript for this image.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = THIS_IMAGE()'
+     `RESULT = THIS_IMAGE(COARRAY [, DIM])'
+
+_Arguments_:
+     COARRAY    Coarray of any type  (optional; if DIM
+                present, required).
+     DIM        default integer scalar (optional). If present,
+                DIM shall be between one and the corank of
+                COARRAY.
+
+_Return value_:
+     Default integer. If COARRAY is not present, it is scalar and its
+     value is the index of the invoking image. Otherwise, if DIM is not
+     present, a rank-1 array with corank elements is returned,
+     containing the cosubscripts for COARRAY specifying the invoking
+     image. If DIM is present, a scalar is returned, with the value of
+     the DIM element of `THIS_IMAGE(COARRAY)'.
+
+_Example_:
+          INTEGER :: value[*]
+          INTEGER :: i
+          value = THIS_IMAGE()
+          SYNC ALL
+          IF (THIS_IMAGE() == 1) THEN
+            DO i = 1, NUM_IMAGES()
+              WRITE(*,'(2(a,i0))') 'value[', i, '] is ', value[i]
+            END DO
+          END IF
+
+_See also_:
+     *note NUM_IMAGES::, *note IMAGE_INDEX::
+
+
+File: gfortran.info,  Node: TIME,  Next: TIME8,  Prev: THIS_IMAGE,  Up: Intrinsic Procedures
+
+8.239 `TIME' -- Time function
+=============================
+
+_Description_:
+     Returns the current time encoded as an integer (in the manner of
+     the UNIX function `time(3)'). This value is suitable for passing to
+     `CTIME', `GMTIME', and `LTIME'.
+
+     This intrinsic is not fully portable, such as to systems with
+     32-bit `INTEGER' types but supporting times wider than 32 bits.
+     Therefore, the values returned by this intrinsic might be, or
+     become, negative, or numerically less than previous values, during
+     a single run of the compiled program.
+
+     See *note TIME8::, for information on a similar intrinsic that
+     might be portable to more GNU Fortran implementations, though to
+     fewer Fortran compilers.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = TIME()'
+
+_Return value_:
+     The return value is a scalar of type `INTEGER(4)'.
+
+_See also_:
+     *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK::,
+     *note TIME8::
+
+
+
+File: gfortran.info,  Node: TIME8,  Next: TINY,  Prev: TIME,  Up: Intrinsic Procedures
+
+8.240 `TIME8' -- Time function (64-bit)
+=======================================
+
+_Description_:
+     Returns the current time encoded as an integer (in the manner of
+     the UNIX function `time(3)'). This value is suitable for passing to
+     `CTIME', `GMTIME', and `LTIME'.
+
+     _Warning:_ this intrinsic does not increase the range of the timing
+     values over that returned by `time(3)'. On a system with a 32-bit
+     `time(3)', `TIME8' will return a 32-bit value, even though it is
+     converted to a 64-bit `INTEGER(8)' value. That means overflows of
+     the 32-bit value can still occur. Therefore, the values returned
+     by this intrinsic might be or become negative or numerically less
+     than previous values during a single run of the compiled program.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = TIME8()'
+
+_Return value_:
+     The return value is a scalar of type `INTEGER(8)'.
+
+_See also_:
+     *note CTIME::, *note GMTIME::, *note LTIME::, *note MCLOCK8::,
+     *note TIME::
+
+
+
+File: gfortran.info,  Node: TINY,  Next: TRAILZ,  Prev: TIME8,  Up: Intrinsic Procedures
+
+8.241 `TINY' -- Smallest positive number of a real kind
+=======================================================
+
+_Description_:
+     `TINY(X)' returns the smallest positive (non zero) number in the
+     model of the type of `X'.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = TINY(X)'
+
+_Arguments_:
+     X          Shall be of type `REAL'.
+
+_Return value_:
+     The return value is of the same type and kind as X
+
+_Example_:
+     See `HUGE' for an example.
+
+
+File: gfortran.info,  Node: TRAILZ,  Next: TRANSFER,  Prev: TINY,  Up: Intrinsic Procedures
+
+8.242 `TRAILZ' -- Number of trailing zero bits of an integer
+============================================================
+
+_Description_:
+     `TRAILZ' returns the number of trailing zero bits of an integer.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = TRAILZ(I)'
+
+_Arguments_:
+     I          Shall be of type `INTEGER'.
+
+_Return value_:
+     The type of the return value is the default `INTEGER'.  If all the
+     bits of `I' are zero, the result value is `BIT_SIZE(I)'.
+
+_Example_:
+          PROGRAM test_trailz
+            WRITE (*,*) TRAILZ(8)  ! prints 3
+          END PROGRAM
+
+_See also_:
+     *note BIT_SIZE::, *note LEADZ::, *note POPPAR::, *note POPCNT::
+
+
+File: gfortran.info,  Node: TRANSFER,  Next: TRANSPOSE,  Prev: TRAILZ,  Up: Intrinsic Procedures
+
+8.243 `TRANSFER' -- Transfer bit patterns
+=========================================
+
+_Description_:
+     Interprets the bitwise representation of SOURCE in memory as if it
+     is the representation of a variable or array of the same type and
+     type parameters as MOLD.
+
+     This is approximately equivalent to the C concept of _casting_ one
+     type to another.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = TRANSFER(SOURCE, MOLD[, SIZE])'
+
+_Arguments_:
+     SOURCE     Shall be a scalar or an array of any type.
+     MOLD       Shall be a scalar or an array of any type.
+     SIZE       (Optional) shall be a scalar of type `INTEGER'.
+
+_Return value_:
+     The result has the same type as MOLD, with the bit level
+     representation of SOURCE.  If SIZE is present, the result is a
+     one-dimensional array of length SIZE.  If SIZE is absent but MOLD
+     is an array (of any size or shape), the result is a one-
+     dimensional array of the minimum length needed to contain the
+     entirety of the bitwise representation of SOURCE.   If SIZE is
+     absent and MOLD is a scalar, the result is a scalar.
+
+     If the bitwise representation of the result is longer than that of
+     SOURCE, then the leading bits of the result correspond to those of
+     SOURCE and any trailing bits are filled arbitrarily.
+
+     When the resulting bit representation does not correspond to a
+     valid representation of a variable of the same type as MOLD, the
+     results are undefined, and subsequent operations on the result
+     cannot be guaranteed to produce sensible behavior.  For example,
+     it is possible to create `LOGICAL' variables for which `VAR' and
+     `.NOT.VAR' both appear to be true.
+
+_Example_:
+          PROGRAM test_transfer
+            integer :: x = 2143289344
+            print *, transfer(x, 1.0)    ! prints "NaN" on i686
+          END PROGRAM
+
+
+File: gfortran.info,  Node: TRANSPOSE,  Next: TRIM,  Prev: TRANSFER,  Up: Intrinsic Procedures
+
+8.244 `TRANSPOSE' -- Transpose an array of rank two
+===================================================
+
+_Description_:
+     Transpose an array of rank two. Element (i, j) of the result has
+     the value `MATRIX(j, i)', for all i, j.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = TRANSPOSE(MATRIX)'
+
+_Arguments_:
+     MATRIX     Shall be an array of any type and have a rank
+                of two.
+
+_Return value_:
+     The result has the same type as MATRIX, and has shape `(/ m, n /)'
+     if MATRIX has shape `(/ n, m /)'.
+
+
+File: gfortran.info,  Node: TRIM,  Next: TTYNAM,  Prev: TRANSPOSE,  Up: Intrinsic Procedures
+
+8.245 `TRIM' -- Remove trailing blank characters of a string
+============================================================
+
+_Description_:
+     Removes trailing blank characters of a string.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = TRIM(STRING)'
+
+_Arguments_:
+     STRING     Shall be a scalar of type `CHARACTER'.
+
+_Return value_:
+     A scalar of type `CHARACTER' which length is that of STRING less
+     the number of trailing blanks.
+
+_Example_:
+          PROGRAM test_trim
+            CHARACTER(len=10), PARAMETER :: s = "GFORTRAN  "
+            WRITE(*,*) LEN(s), LEN(TRIM(s))  ! "10 8", with/without trailing blanks
+          END PROGRAM
+
+_See also_:
+     *note ADJUSTL::, *note ADJUSTR::
+
+
+File: gfortran.info,  Node: TTYNAM,  Next: UBOUND,  Prev: TRIM,  Up: Intrinsic Procedures
+
+8.246 `TTYNAM' -- Get the name of a terminal device.
+====================================================
+
+_Description_:
+     Get the name of a terminal device. For more information, see
+     `ttyname(3)'.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL TTYNAM(UNIT, NAME)'
+     `NAME = TTYNAM(UNIT)'
+
+_Arguments_:
+     UNIT       Shall be a scalar `INTEGER'.
+     NAME       Shall be of type `CHARACTER'.
+
+_Example_:
+          PROGRAM test_ttynam
+            INTEGER :: unit
+            DO unit = 1, 10
+              IF (isatty(unit=unit)) write(*,*) ttynam(unit)
+            END DO
+          END PROGRAM
+
+_See also_:
+     *note ISATTY::
+
+
+File: gfortran.info,  Node: UBOUND,  Next: UCOBOUND,  Prev: TTYNAM,  Up: Intrinsic Procedures
+
+8.247 `UBOUND' -- Upper dimension bounds of an array
+====================================================
+
+_Description_:
+     Returns the upper bounds of an array, or a single upper bound
+     along the DIM dimension.
+
+_Standard_:
+     Fortran 95 and later, with KIND argument Fortran 2003 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = UBOUND(ARRAY [, DIM [, KIND]])'
+
+_Arguments_:
+     ARRAY      Shall be an array, of any type.
+     DIM        (Optional) Shall be a scalar `INTEGER'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER' and of kind KIND. If KIND is
+     absent, the return value is of default integer kind.  If DIM is
+     absent, the result is an array of the upper bounds of ARRAY.  If
+     DIM is present, the result is a scalar corresponding to the upper
+     bound of the array along that dimension.  If ARRAY is an
+     expression rather than a whole array or array structure component,
+     or if it has a zero extent along the relevant dimension, the upper
+     bound is taken to be the number of elements along the relevant
+     dimension.
+
+_See also_:
+     *note LBOUND::, *note LCOBOUND::
+
+
+File: gfortran.info,  Node: UCOBOUND,  Next: UMASK,  Prev: UBOUND,  Up: Intrinsic Procedures
+
+8.248 `UCOBOUND' -- Upper codimension bounds of an array
+========================================================
+
+_Description_:
+     Returns the upper cobounds of a coarray, or a single upper cobound
+     along the DIM codimension.
+
+_Standard_:
+     Fortran 2008 and later
+
+_Class_:
+     Inquiry function
+
+_Syntax_:
+     `RESULT = UCOBOUND(COARRAY [, DIM [, KIND]])'
+
+_Arguments_:
+     ARRAY      Shall be an coarray, of any type.
+     DIM        (Optional) Shall be a scalar `INTEGER'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER' and of kind KIND. If KIND is
+     absent, the return value is of default integer kind.  If DIM is
+     absent, the result is an array of the lower cobounds of COARRAY.
+     If DIM is present, the result is a scalar corresponding to the
+     lower cobound of the array along that codimension.
+
+_See also_:
+     *note LCOBOUND::, *note LBOUND::
+
+
+File: gfortran.info,  Node: UMASK,  Next: UNLINK,  Prev: UCOBOUND,  Up: Intrinsic Procedures
+
+8.249 `UMASK' -- Set the file creation mask
+===========================================
+
+_Description_:
+     Sets the file creation mask to MASK. If called as a function, it
+     returns the old value. If called as a subroutine and argument OLD
+     if it is supplied, it is set to the old value. See `umask(2)'.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL UMASK(MASK [, OLD])'
+     `OLD = UMASK(MASK)'
+
+_Arguments_:
+     MASK       Shall be a scalar of type `INTEGER'.
+     OLD        (Optional) Shall be a scalar of type `INTEGER'.
+
+
+
+File: gfortran.info,  Node: UNLINK,  Next: UNPACK,  Prev: UMASK,  Up: Intrinsic Procedures
+
+8.250 `UNLINK' -- Remove a file from the file system
+====================================================
+
+_Description_:
+     Unlinks the file PATH. A null character (`CHAR(0)') can be used to
+     mark the end of the name in PATH; otherwise, trailing blanks in
+     the file name are ignored.  If the STATUS argument is supplied, it
+     contains 0 on success or a nonzero error code upon return; see
+     `unlink(2)'.
+
+     This intrinsic is provided in both subroutine and function forms;
+     however, only one form can be used in any given program unit.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Subroutine, function
+
+_Syntax_:
+     `CALL UNLINK(PATH [, STATUS])'
+     `STATUS = UNLINK(PATH)'
+
+_Arguments_:
+     PATH       Shall be of default `CHARACTER' type.
+     STATUS     (Optional) Shall be of default `INTEGER' type.
+
+_See also_:
+     *note LINK::, *note SYMLNK::
+
+
+File: gfortran.info,  Node: UNPACK,  Next: VERIFY,  Prev: UNLINK,  Up: Intrinsic Procedures
+
+8.251 `UNPACK' -- Unpack an array of rank one into an array
+===========================================================
+
+_Description_:
+     Store the elements of VECTOR in an array of higher rank.
+
+_Standard_:
+     Fortran 95 and later
+
+_Class_:
+     Transformational function
+
+_Syntax_:
+     `RESULT = UNPACK(VECTOR, MASK, FIELD)'
+
+_Arguments_:
+     VECTOR     Shall be an array of any type and rank one. It
+                shall have at least as many elements as MASK
+                has `TRUE' values.
+     MASK       Shall be an array of type `LOGICAL'.
+     FIELD      Shall be of the same type as VECTOR and have
+                the same shape as MASK.
+
+_Return value_:
+     The resulting array corresponds to FIELD with `TRUE' elements of
+     MASK replaced by values from VECTOR in array element order.
+
+_Example_:
+          PROGRAM test_unpack
+            integer :: vector(2)  = (/1,1/)
+            logical :: mask(4)  = (/ .TRUE., .FALSE., .FALSE., .TRUE. /)
+            integer :: field(2,2) = 0, unity(2,2)
+
+            ! result: unity matrix
+            unity = unpack(vector, reshape(mask, (/2,2/)), field)
+          END PROGRAM
+
+_See also_:
+     *note PACK::, *note SPREAD::
+
+
+File: gfortran.info,  Node: VERIFY,  Next: XOR,  Prev: UNPACK,  Up: Intrinsic Procedures
+
+8.252 `VERIFY' -- Scan a string for characters not a given set
+==============================================================
+
+_Description_:
+     Verifies that all the characters in STRING belong to the set of
+     characters in SET.
+
+     If BACK is either absent or equals `FALSE', this function returns
+     the position of the leftmost character of STRING that is not in
+     SET. If BACK equals `TRUE', the rightmost position is returned. If
+     all characters of STRING are found in SET, the result is zero.
+
+_Standard_:
+     Fortran 95 and later, with KIND argument Fortran 2003 and later
+
+_Class_:
+     Elemental function
+
+_Syntax_:
+     `RESULT = VERIFY(STRING, SET[, BACK [, KIND]])'
+
+_Arguments_:
+     STRING     Shall be of type `CHARACTER'.
+     SET        Shall be of type `CHARACTER'.
+     BACK       (Optional) shall be of type `LOGICAL'.
+     KIND       (Optional) An `INTEGER' initialization
+                expression indicating the kind parameter of
+                the result.
+
+_Return value_:
+     The return value is of type `INTEGER' and of kind KIND. If KIND is
+     absent, the return value is of default integer kind.
+
+_Example_:
+          PROGRAM test_verify
+            WRITE(*,*) VERIFY("FORTRAN", "AO")           ! 1, found 'F'
+            WRITE(*,*) VERIFY("FORTRAN", "FOO")          ! 3, found 'R'
+            WRITE(*,*) VERIFY("FORTRAN", "C++")          ! 1, found 'F'
+            WRITE(*,*) VERIFY("FORTRAN", "C++", .TRUE.)  ! 7, found 'N'
+            WRITE(*,*) VERIFY("FORTRAN", "FORTRAN")      ! 0' found none
+          END PROGRAM
+
+_See also_:
+     *note SCAN::, *note INDEX intrinsic::
+
+
+File: gfortran.info,  Node: XOR,  Prev: VERIFY,  Up: Intrinsic Procedures
+
+8.253 `XOR' -- Bitwise logical exclusive OR
+===========================================
+
+_Description_:
+     Bitwise logical exclusive or.
+
+     This intrinsic routine is provided for backwards compatibility with
+     GNU Fortran 77.  For integer arguments, programmers should consider
+     the use of the *note IEOR:: intrinsic and for logical arguments the
+     `.NEQV.' operator, which are both defined by the Fortran standard.
+
+_Standard_:
+     GNU extension
+
+_Class_:
+     Function
+
+_Syntax_:
+     `RESULT = XOR(I, J)'
+
+_Arguments_:
+     I          The type shall be either  a scalar `INTEGER'
+                type or a scalar `LOGICAL' type.
+     J          The type shall be the same as the type of I.
+
+_Return value_:
+     The return type is either a scalar `INTEGER' or a scalar
+     `LOGICAL'.  If the kind type parameters differ, then the smaller
+     kind type is implicitly converted to larger kind, and the return
+     has the larger kind.
+
+_Example_:
+          PROGRAM test_xor
+            LOGICAL :: T = .TRUE., F = .FALSE.
+            INTEGER :: a, b
+            DATA a / Z'F' /, b / Z'3' /
+
+            WRITE (*,*) XOR(T, T), XOR(T, F), XOR(F, T), XOR(F, F)
+            WRITE (*,*) XOR(a, b)
+          END PROGRAM
+
+_See also_:
+     Fortran 95 elemental function: *note IEOR::
+
+
+File: gfortran.info,  Node: Intrinsic Modules,  Next: Contributing,  Prev: Intrinsic Procedures,  Up: Top
+
+9 Intrinsic Modules
+*******************
+
+* Menu:
+
+* ISO_FORTRAN_ENV::
+* ISO_C_BINDING::
+* OpenMP Modules OMP_LIB and OMP_LIB_KINDS::
+
+
+File: gfortran.info,  Node: ISO_FORTRAN_ENV,  Next: ISO_C_BINDING,  Up: Intrinsic Modules
+
+9.1 `ISO_FORTRAN_ENV'
+=====================
+
+_Standard_:
+     Fortran 2003 and later, except when otherwise noted
+
+   The `ISO_FORTRAN_ENV' module provides the following scalar
+default-integer named constants:
+
+`ATOMIC_INT_KIND':
+     Default-kind integer constant to be used as kind parameter when
+     defining integer variables used in atomic operations. (Fortran
+     2008 or later.)
+
+`ATOMIC_LOGICAL_KIND':
+     Default-kind integer constant to be used as kind parameter when
+     defining logical variables used in atomic operations. (Fortran
+     2008 or later.)
+
+`CHARACTER_KINDS':
+     Default-kind integer constant array of rank one containing the
+     supported kind parameters of the `CHARACTER' type. (Fortran 2008
+     or later.)
+
+`CHARACTER_STORAGE_SIZE':
+     Size in bits of the character storage unit.
+
+`ERROR_UNIT':
+     Identifies the preconnected unit used for error reporting.
+
+`FILE_STORAGE_SIZE':
+     Size in bits of the file-storage unit.
+
+`INPUT_UNIT':
+     Identifies the preconnected unit identified by the asterisk (`*')
+     in `READ' statement.
+
+`INT8', `INT16', `INT32', `INT64':
+     Kind type parameters to specify an INTEGER type with a storage
+     size of 16, 32, and 64 bits. It is negative if a target platform
+     does not support the particular kind. (Fortran 2008 or later.)
+
+`INTEGER_KINDS':
+     Default-kind integer constant array of rank one containing the
+     supported kind parameters of the `INTEGER' type. (Fortran 2008 or
+     later.)
+
+`IOSTAT_END':
+     The value assigned to the variable passed to the `IOSTAT='
+     specifier of an input/output statement if an end-of-file condition
+     occurred.
+
+`IOSTAT_EOR':
+     The value assigned to the variable passed to the `IOSTAT='
+     specifier of an input/output statement if an end-of-record
+     condition occurred.
+
+`IOSTAT_INQUIRE_INTERNAL_UNIT':
+     Scalar default-integer constant, used by `INQUIRE' for the
+     `IOSTAT=' specifier to denote an that a unit number identifies an
+     internal unit. (Fortran 2008 or later.)
+
+`NUMERIC_STORAGE_SIZE':
+     The size in bits of the numeric storage unit.
+
+`LOGICAL_KINDS':
+     Default-kind integer constant array of rank one containing the
+     supported kind parameters of the `LOGICAL' type. (Fortran 2008 or
+     later.)
+
+`OUTPUT_UNIT':
+     Identifies the preconnected unit identified by the asterisk (`*')
+     in `WRITE' statement.
+
+`REAL32', `REAL64', `REAL128':
+     Kind type parameters to specify a REAL type with a storage size of
+     32, 64, and 128 bits. It is negative if a target platform does not
+     support the particular kind. (Fortran 2008 or later.)
+
+`REAL_KINDS':
+     Default-kind integer constant array of rank one containing the
+     supported kind parameters of the `REAL' type. (Fortran 2008 or
+     later.)
+
+`STAT_LOCKED':
+     Scalar default-integer constant used as STAT= return value by
+     `LOCK' to denote that the lock variable is locked by the executing
+     image. (Fortran 2008 or later.)
+
+`STAT_LOCKED_OTHER_IMAGE':
+     Scalar default-integer constant used as STAT= return value by
+     `UNLOCK' to denote that the lock variable is locked by another
+     image. (Fortran 2008 or later.)
+
+`STAT_STOPPED_IMAGE':
+     Positive, scalar default-integer constant used as STAT= return
+     value if the argument in the statement requires synchronisation
+     with an image, which has initiated the termination of the
+     execution. (Fortran 2008 or later.)
+
+`STAT_UNLOCKED':
+     Scalar default-integer constant used as STAT= return value by
+     `UNLOCK' to denote that the lock variable is unlocked. (Fortran
+     2008 or later.)
+
+   The module also provides the following intrinsic procedures: *note
+COMPILER_OPTIONS:: and *note COMPILER_VERSION::.
+
+
+File: gfortran.info,  Node: ISO_C_BINDING,  Next: OpenMP Modules OMP_LIB and OMP_LIB_KINDS,  Prev: ISO_FORTRAN_ENV,  Up: Intrinsic Modules
+
+9.2 `ISO_C_BINDING'
+===================
+
+_Standard_:
+     Fortran 2003 and later, GNU extensions
+
+   The following intrinsic procedures are provided by the module; their
+definition can be found in the section Intrinsic Procedures of this
+manual.
+
+`C_ASSOCIATED'
+
+`C_F_POINTER'
+
+`C_F_PROCPOINTER'
+
+`C_FUNLOC'
+
+`C_LOC'
+
+`C_SIZEOF'
+
+   The `ISO_C_BINDING' module provides the following named constants of
+type default integer, which can be used as KIND type parameters.
+
+   In addition to the integer named constants required by the Fortran
+2003 standard, GNU Fortran provides as an extension named constants for
+the 128-bit integer types supported by the C compiler: `C_INT128_T,
+C_INT_LEAST128_T, C_INT_FAST128_T'.
+
+Fortran     Named constant            C type                    Extension
+Type                                                            
+`INTEGER'   `C_INT'                   `int'                     
+`INTEGER'   `C_SHORT'                 `short int'               
+`INTEGER'   `C_LONG'                  `long int'                
+`INTEGER'   `C_LONG_LONG'             `long long int'           
+`INTEGER'   `C_SIGNED_CHAR'           `signed char'/`unsigned   
+                                      char'                     
+`INTEGER'   `C_SIZE_T'                `size_t'                  
+`INTEGER'   `C_INT8_T'                `int8_t'                  
+`INTEGER'   `C_INT16_T'               `int16_t'                 
+`INTEGER'   `C_INT32_T'               `int32_t'                 
+`INTEGER'   `C_INT64_T'               `int64_t'                 
+`INTEGER'   `C_INT128_T'              `int128_t'                Ext.
+`INTEGER'   `C_INT_LEAST8_T'          `int_least8_t'            
+`INTEGER'   `C_INT_LEAST16_T'         `int_least16_t'           
+`INTEGER'   `C_INT_LEAST32_T'         `int_least32_t'           
+`INTEGER'   `C_INT_LEAST64_T'         `int_least64_t'           
+`INTEGER'   `C_INT_LEAST128_T'        `int_least128_t'          Ext.
+`INTEGER'   `C_INT_FAST8_T'           `int_fast8_t'             
+`INTEGER'   `C_INT_FAST16_T'          `int_fast16_t'            
+`INTEGER'   `C_INT_FAST32_T'          `int_fast32_t'            
+`INTEGER'   `C_INT_FAST64_T'          `int_fast64_t'            
+`INTEGER'   `C_INT_FAST128_T'         `int_fast128_t'           Ext.
+`INTEGER'   `C_INTMAX_T'              `intmax_t'                
+`INTEGER'   `C_INTPTR_T'              `intptr_t'                
+`REAL'      `C_FLOAT'                 `float'                   
+`REAL'      `C_DOUBLE'                `double'                  
+`REAL'      `C_LONG_DOUBLE'           `long double'             
+`COMPLEX'   `C_FLOAT_COMPLEX'         `float _Complex'          
+`COMPLEX'   `C_DOUBLE_COMPLEX'        `double _Complex'         
+`COMPLEX'   `C_LONG_DOUBLE_COMPLEX'   `long double _Complex'    
+`LOGICAL'   `C_BOOL'                  `_Bool'                   
+`CHARACTER' `C_CHAR'                  `char'                    
+
+   Additionally, the following parameters of type
+`CHARACTER(KIND=C_CHAR)' are defined.
+
+Name           C definition                     Value
+`C_NULL_CHAR'  null character                   `'\0''
+`C_ALERT'      alert                            `'\a''
+`C_BACKSPACE'  backspace                        `'\b''
+`C_FORM_FEED'  form feed                        `'\f''
+`C_NEW_LINE'   new line                         `'\n''
+`C_CARRIAGE_RETURN'carriage return                  `'\r''
+`C_HORIZONTAL_TAB'horizontal tab                   `'\t''
+`C_VERTICAL_TAB'vertical tab                     `'\v''
+
+   Moreover, the following two named constants are defined:
+
+Name           Type
+`C_NULL_PTR'   `C_PTR'
+`C_NULL_FUNPTR'`C_FUNPTR'
+
+   Both are equivalent to the value `NULL' in C.
+
+
+File: gfortran.info,  Node: OpenMP Modules OMP_LIB and OMP_LIB_KINDS,  Prev: ISO_C_BINDING,  Up: Intrinsic Modules
+
+9.3 OpenMP Modules `OMP_LIB' and `OMP_LIB_KINDS'
+================================================
+
+_Standard_:
+     OpenMP Application Program Interface v3.0
+
+   The OpenMP Fortran runtime library routines are provided both in a
+form of two Fortran 90 modules, named `OMP_LIB' and `OMP_LIB_KINDS',
+and in a form of a Fortran `include' file named `omp_lib.h'. The
+procedures provided by `OMP_LIB' can be found in the *note
+Introduction: (libgomp)Top. manual, the named constants defined in the
+modules are listed below.
+
+   For details refer to the actual OpenMP Application Program Interface
+v3.0 (http://www.openmp.org/mp-documents/spec30.pdf).
+
+   `OMP_LIB_KINDS' provides the following scalar default-integer named
+constants:
+
+`omp_integer_kind'
+
+`omp_logical_kind'
+
+`omp_lock_kind'
+
+`omp_nest_lock_kind'
+
+`omp_sched_kind'
+
+   `OMP_LIB' provides the scalar default-integer named constant
+`openmp_version' with a value of the form YYYYMM, where `yyyy' is the
+year and MM the month of the OpenMP version; for OpenMP v3.0 the value
+is `200805'.
+
+   And the following scalar integer named constants of the kind
+`omp_sched_kind':
+
+`omp_sched_static'
+
+`omp_sched_dynamic'
+
+`omp_sched_guided'
+
+`omp_sched_auto'
+
+
+File: gfortran.info,  Node: Contributing,  Next: Copying,  Prev: Intrinsic Modules,  Up: Top
+
+Contributing
+************
+
+Free software is only possible if people contribute to efforts to
+create it.  We're always in need of more people helping out with ideas
+and comments, writing documentation and contributing code.
+
+   If you want to contribute to GNU Fortran, have a look at the long
+lists of projects you can take on.  Some of these projects are small,
+some of them are large; some are completely orthogonal to the rest of
+what is happening on GNU Fortran, but others are "mainstream" projects
+in need of enthusiastic hackers.  All of these projects are important!
+We'll eventually get around to the things here, but they are also
+things doable by someone who is willing and able.
+
+* Menu:
+
+* Contributors::
+* Projects::
+* Proposed Extensions::
+
+
+File: gfortran.info,  Node: Contributors,  Next: Projects,  Up: Contributing
+
+Contributors to GNU Fortran
+===========================
+
+Most of the parser was hand-crafted by _Andy Vaught_, who is also the
+initiator of the whole project.  Thanks Andy!  Most of the interface
+with GCC was written by _Paul Brook_.
+
+   The following individuals have contributed code and/or ideas and
+significant help to the GNU Fortran project (in alphabetical order):
+
+   - Janne Blomqvist
+
+   - Steven Bosscher
+
+   - Paul Brook
+
+   - Tobias Burnus
+
+   - Franc,ois-Xavier Coudert
+
+   - Bud Davis
+
+   - Jerry DeLisle
+
+   - Erik Edelmann
+
+   - Bernhard Fischer
+
+   - Daniel Franke
+
+   - Richard Guenther
+
+   - Richard Henderson
+
+   - Katherine Holcomb
+
+   - Jakub Jelinek
+
+   - Niels Kristian Bech Jensen
+
+   - Steven Johnson
+
+   - Steven G. Kargl
+
+   - Thomas Koenig
+
+   - Asher Langton
+
+   - H. J. Lu
+
+   - Toon Moene
+
+   - Brooks Moses
+
+   - Andrew Pinski
+
+   - Tim Prince
+
+   - Christopher D. Rickett
+
+   - Richard Sandiford
+
+   - Tobias Schlu"ter
+
+   - Roger Sayle
+
+   - Paul Thomas
+
+   - Andy Vaught
+
+   - Feng Wang
+
+   - Janus Weil
+
+   - Daniel Kraft
+
+   The following people have contributed bug reports, smaller or larger
+patches, and much needed feedback and encouragement for the GNU Fortran
+project:
+
+   - Bill Clodius
+
+   - Dominique d'Humie`res
+
+   - Kate Hedstrom
+
+   - Erik Schnetter
+
+   - Joost VandeVondele
+
+   Many other individuals have helped debug, test and improve the GNU
+Fortran compiler over the past few years, and we welcome you to do the
+same!  If you already have done so, and you would like to see your name
+listed in the list above, please contact us.
+
+
+File: gfortran.info,  Node: Projects,  Next: Proposed Extensions,  Prev: Contributors,  Up: Contributing
+
+Projects
+========
+
+_Help build the test suite_
+     Solicit more code for donation to the test suite: the more
+     extensive the testsuite, the smaller the risk of breaking things
+     in the future! We can keep code private on request.
+
+_Bug hunting/squishing_
+     Find bugs and write more test cases! Test cases are especially very
+     welcome, because it allows us to concentrate on fixing bugs
+     instead of isolating them.  Going through the bugzilla database at
+     `http://gcc.gnu.org/bugzilla/' to reduce testcases posted there and
+     add more information (for example, for which version does the
+     testcase work, for which versions does it fail?) is also very
+     helpful.
+
+
+
+File: gfortran.info,  Node: Proposed Extensions,  Prev: Projects,  Up: Contributing
+
+Proposed Extensions
+===================
+
+Here's a list of proposed extensions for the GNU Fortran compiler, in
+no particular order.  Most of these are necessary to be fully
+compatible with existing Fortran compilers, but they are not part of
+the official J3 Fortran 95 standard.
+
+Compiler extensions:
+--------------------
+
+   * User-specified alignment rules for structures.
+
+   * Automatically extend single precision constants to double.
+
+   * Compile code that conserves memory by dynamically allocating
+     common and module storage either on stack or heap.
+
+   * Compile flag to generate code for array conformance checking
+     (suggest -CC).
+
+   * User control of symbol names (underscores, etc).
+
+   * Compile setting for maximum size of stack frame size before
+     spilling parts to static or heap.
+
+   * Flag to force local variables into static space.
+
+   * Flag to force local variables onto stack.
+
+Environment Options
+-------------------
+
+   * Pluggable library modules for random numbers, linear algebra.  LA
+     should use BLAS calling conventions.
+
+   * Environment variables controlling actions on arithmetic exceptions
+     like overflow, underflow, precision loss--Generate NaN, abort,
+     default.  action.
+
+   * Set precision for fp units that support it (i387).
+
+   * Variable for setting fp rounding mode.
+
+   * Variable to fill uninitialized variables with a user-defined bit
+     pattern.
+
+   * Environment variable controlling filename that is opened for that
+     unit number.
+
+   * Environment variable to clear/trash memory being freed.
+
+   * Environment variable to control tracing of allocations and frees.
+
+   * Environment variable to display allocated memory at normal program
+     end.
+
+   * Environment variable for filename for * IO-unit.
+
+   * Environment variable for temporary file directory.
+
+   * Environment variable forcing standard output to be line buffered
+     (unix).
+
+
+
+File: gfortran.info,  Node: Copying,  Next: GNU Free Documentation License,  Prev: Contributing,  Up: Top
+
+GNU General Public License
+**************************
+
+                        Version 3, 29 June 2007
+
+     Copyright (C) 2007 Free Software Foundation, Inc. `http://fsf.org/'
+
+     Everyone is permitted to copy and distribute verbatim copies of this
+     license document, but changing it is not allowed.
+
+Preamble
+========
+
+The GNU General Public License is a free, copyleft license for software
+and other kinds of works.
+
+   The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works.  By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program-to make sure it remains free
+software for all its users.  We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors.  You can apply it to
+your programs, too.
+
+   When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+   To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights.  Therefore, you
+have certain responsibilities if you distribute copies of the software,
+or if you modify it: responsibilities to respect the freedom of others.
+
+   For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received.  You must make sure that they, too, receive
+or can get the source code.  And you must show them these terms so they
+know their rights.
+
+   Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+   For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software.  For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+   Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the
+manufacturer can do so.  This is fundamentally incompatible with the
+aim of protecting users' freedom to change the software.  The
+systematic pattern of such abuse occurs in the area of products for
+individuals to use, which is precisely where it is most unacceptable.
+Therefore, we have designed this version of the GPL to prohibit the
+practice for those products.  If such problems arise substantially in
+other domains, we stand ready to extend this provision to those domains
+in future versions of the GPL, as needed to protect the freedom of
+users.
+
+   Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary.  To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+   The precise terms and conditions for copying, distribution and
+modification follow.
+
+TERMS AND CONDITIONS
+====================
+
+  0. Definitions.
+
+     "This License" refers to version 3 of the GNU General Public
+     License.
+
+     "Copyright" also means copyright-like laws that apply to other
+     kinds of works, such as semiconductor masks.
+
+     "The Program" refers to any copyrightable work licensed under this
+     License.  Each licensee is addressed as "you".  "Licensees" and
+     "recipients" may be individuals or organizations.
+
+     To "modify" a work means to copy from or adapt all or part of the
+     work in a fashion requiring copyright permission, other than the
+     making of an exact copy.  The resulting work is called a "modified
+     version" of the earlier work or a work "based on" the earlier work.
+
+     A "covered work" means either the unmodified Program or a work
+     based on the Program.
+
+     To "propagate" a work means to do anything with it that, without
+     permission, would make you directly or secondarily liable for
+     infringement under applicable copyright law, except executing it
+     on a computer or modifying a private copy.  Propagation includes
+     copying, distribution (with or without modification), making
+     available to the public, and in some countries other activities as
+     well.
+
+     To "convey" a work means any kind of propagation that enables other
+     parties to make or receive copies.  Mere interaction with a user
+     through a computer network, with no transfer of a copy, is not
+     conveying.
+
+     An interactive user interface displays "Appropriate Legal Notices"
+     to the extent that it includes a convenient and prominently visible
+     feature that (1) displays an appropriate copyright notice, and (2)
+     tells the user that there is no warranty for the work (except to
+     the extent that warranties are provided), that licensees may
+     convey the work under this License, and how to view a copy of this
+     License.  If the interface presents a list of user commands or
+     options, such as a menu, a prominent item in the list meets this
+     criterion.
+
+  1. Source Code.
+
+     The "source code" for a work means the preferred form of the work
+     for making modifications to it.  "Object code" means any
+     non-source form of a work.
+
+     A "Standard Interface" means an interface that either is an
+     official standard defined by a recognized standards body, or, in
+     the case of interfaces specified for a particular programming
+     language, one that is widely used among developers working in that
+     language.
+
+     The "System Libraries" of an executable work include anything,
+     other than the work as a whole, that (a) is included in the normal
+     form of packaging a Major Component, but which is not part of that
+     Major Component, and (b) serves only to enable use of the work
+     with that Major Component, or to implement a Standard Interface
+     for which an implementation is available to the public in source
+     code form.  A "Major Component", in this context, means a major
+     essential component (kernel, window system, and so on) of the
+     specific operating system (if any) on which the executable work
+     runs, or a compiler used to produce the work, or an object code
+     interpreter used to run it.
+
+     The "Corresponding Source" for a work in object code form means all
+     the source code needed to generate, install, and (for an executable
+     work) run the object code and to modify the work, including
+     scripts to control those activities.  However, it does not include
+     the work's System Libraries, or general-purpose tools or generally
+     available free programs which are used unmodified in performing
+     those activities but which are not part of the work.  For example,
+     Corresponding Source includes interface definition files
+     associated with source files for the work, and the source code for
+     shared libraries and dynamically linked subprograms that the work
+     is specifically designed to require, such as by intimate data
+     communication or control flow between those subprograms and other
+     parts of the work.
+
+     The Corresponding Source need not include anything that users can
+     regenerate automatically from other parts of the Corresponding
+     Source.
+
+     The Corresponding Source for a work in source code form is that
+     same work.
+
+  2. Basic Permissions.
+
+     All rights granted under this License are granted for the term of
+     copyright on the Program, and are irrevocable provided the stated
+     conditions are met.  This License explicitly affirms your unlimited
+     permission to run the unmodified Program.  The output from running
+     a covered work is covered by this License only if the output,
+     given its content, constitutes a covered work.  This License
+     acknowledges your rights of fair use or other equivalent, as
+     provided by copyright law.
+
+     You may make, run and propagate covered works that you do not
+     convey, without conditions so long as your license otherwise
+     remains in force.  You may convey covered works to others for the
+     sole purpose of having them make modifications exclusively for
+     you, or provide you with facilities for running those works,
+     provided that you comply with the terms of this License in
+     conveying all material for which you do not control copyright.
+     Those thus making or running the covered works for you must do so
+     exclusively on your behalf, under your direction and control, on
+     terms that prohibit them from making any copies of your
+     copyrighted material outside their relationship with you.
+
+     Conveying under any other circumstances is permitted solely under
+     the conditions stated below.  Sublicensing is not allowed; section
+     10 makes it unnecessary.
+
+  3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+     No covered work shall be deemed part of an effective technological
+     measure under any applicable law fulfilling obligations under
+     article 11 of the WIPO copyright treaty adopted on 20 December
+     1996, or similar laws prohibiting or restricting circumvention of
+     such measures.
+
+     When you convey a covered work, you waive any legal power to forbid
+     circumvention of technological measures to the extent such
+     circumvention is effected by exercising rights under this License
+     with respect to the covered work, and you disclaim any intention
+     to limit operation or modification of the work as a means of
+     enforcing, against the work's users, your or third parties' legal
+     rights to forbid circumvention of technological measures.
+
+  4. Conveying Verbatim Copies.
+
+     You may convey verbatim copies of the Program's source code as you
+     receive it, in any medium, provided that you conspicuously and
+     appropriately publish on each copy an appropriate copyright notice;
+     keep intact all notices stating that this License and any
+     non-permissive terms added in accord with section 7 apply to the
+     code; keep intact all notices of the absence of any warranty; and
+     give all recipients a copy of this License along with the Program.
+
+     You may charge any price or no price for each copy that you convey,
+     and you may offer support or warranty protection for a fee.
+
+  5. Conveying Modified Source Versions.
+
+     You may convey a work based on the Program, or the modifications to
+     produce it from the Program, in the form of source code under the
+     terms of section 4, provided that you also meet all of these
+     conditions:
+
+       a. The work must carry prominent notices stating that you
+          modified it, and giving a relevant date.
+
+       b. The work must carry prominent notices stating that it is
+          released under this License and any conditions added under
+          section 7.  This requirement modifies the requirement in
+          section 4 to "keep intact all notices".
+
+       c. You must license the entire work, as a whole, under this
+          License to anyone who comes into possession of a copy.  This
+          License will therefore apply, along with any applicable
+          section 7 additional terms, to the whole of the work, and all
+          its parts, regardless of how they are packaged.  This License
+          gives no permission to license the work in any other way, but
+          it does not invalidate such permission if you have separately
+          received it.
+
+       d. If the work has interactive user interfaces, each must display
+          Appropriate Legal Notices; however, if the Program has
+          interactive interfaces that do not display Appropriate Legal
+          Notices, your work need not make them do so.
+
+     A compilation of a covered work with other separate and independent
+     works, which are not by their nature extensions of the covered
+     work, and which are not combined with it such as to form a larger
+     program, in or on a volume of a storage or distribution medium, is
+     called an "aggregate" if the compilation and its resulting
+     copyright are not used to limit the access or legal rights of the
+     compilation's users beyond what the individual works permit.
+     Inclusion of a covered work in an aggregate does not cause this
+     License to apply to the other parts of the aggregate.
+
+  6. Conveying Non-Source Forms.
+
+     You may convey a covered work in object code form under the terms
+     of sections 4 and 5, provided that you also convey the
+     machine-readable Corresponding Source under the terms of this
+     License, in one of these ways:
+
+       a. Convey the object code in, or embodied in, a physical product
+          (including a physical distribution medium), accompanied by the
+          Corresponding Source fixed on a durable physical medium
+          customarily used for software interchange.
+
+       b. Convey the object code in, or embodied in, a physical product
+          (including a physical distribution medium), accompanied by a
+          written offer, valid for at least three years and valid for
+          as long as you offer spare parts or customer support for that
+          product model, to give anyone who possesses the object code
+          either (1) a copy of the Corresponding Source for all the
+          software in the product that is covered by this License, on a
+          durable physical medium customarily used for software
+          interchange, for a price no more than your reasonable cost of
+          physically performing this conveying of source, or (2) access
+          to copy the Corresponding Source from a network server at no
+          charge.
+
+       c. Convey individual copies of the object code with a copy of
+          the written offer to provide the Corresponding Source.  This
+          alternative is allowed only occasionally and noncommercially,
+          and only if you received the object code with such an offer,
+          in accord with subsection 6b.
+
+       d. Convey the object code by offering access from a designated
+          place (gratis or for a charge), and offer equivalent access
+          to the Corresponding Source in the same way through the same
+          place at no further charge.  You need not require recipients
+          to copy the Corresponding Source along with the object code.
+          If the place to copy the object code is a network server, the
+          Corresponding Source may be on a different server (operated
+          by you or a third party) that supports equivalent copying
+          facilities, provided you maintain clear directions next to
+          the object code saying where to find the Corresponding Source.
+          Regardless of what server hosts the Corresponding Source, you
+          remain obligated to ensure that it is available for as long
+          as needed to satisfy these requirements.
+
+       e. Convey the object code using peer-to-peer transmission,
+          provided you inform other peers where the object code and
+          Corresponding Source of the work are being offered to the
+          general public at no charge under subsection 6d.
+
+
+     A separable portion of the object code, whose source code is
+     excluded from the Corresponding Source as a System Library, need
+     not be included in conveying the object code work.
+
+     A "User Product" is either (1) a "consumer product", which means
+     any tangible personal property which is normally used for personal,
+     family, or household purposes, or (2) anything designed or sold for
+     incorporation into a dwelling.  In determining whether a product
+     is a consumer product, doubtful cases shall be resolved in favor of
+     coverage.  For a particular product received by a particular user,
+     "normally used" refers to a typical or common use of that class of
+     product, regardless of the status of the particular user or of the
+     way in which the particular user actually uses, or expects or is
+     expected to use, the product.  A product is a consumer product
+     regardless of whether the product has substantial commercial,
+     industrial or non-consumer uses, unless such uses represent the
+     only significant mode of use of the product.
+
+     "Installation Information" for a User Product means any methods,
+     procedures, authorization keys, or other information required to
+     install and execute modified versions of a covered work in that
+     User Product from a modified version of its Corresponding Source.
+     The information must suffice to ensure that the continued
+     functioning of the modified object code is in no case prevented or
+     interfered with solely because modification has been made.
+
+     If you convey an object code work under this section in, or with,
+     or specifically for use in, a User Product, and the conveying
+     occurs as part of a transaction in which the right of possession
+     and use of the User Product is transferred to the recipient in
+     perpetuity or for a fixed term (regardless of how the transaction
+     is characterized), the Corresponding Source conveyed under this
+     section must be accompanied by the Installation Information.  But
+     this requirement does not apply if neither you nor any third party
+     retains the ability to install modified object code on the User
+     Product (for example, the work has been installed in ROM).
+
+     The requirement to provide Installation Information does not
+     include a requirement to continue to provide support service,
+     warranty, or updates for a work that has been modified or
+     installed by the recipient, or for the User Product in which it
+     has been modified or installed.  Access to a network may be denied
+     when the modification itself materially and adversely affects the
+     operation of the network or violates the rules and protocols for
+     communication across the network.
+
+     Corresponding Source conveyed, and Installation Information
+     provided, in accord with this section must be in a format that is
+     publicly documented (and with an implementation available to the
+     public in source code form), and must require no special password
+     or key for unpacking, reading or copying.
+
+  7. Additional Terms.
+
+     "Additional permissions" are terms that supplement the terms of
+     this License by making exceptions from one or more of its
+     conditions.  Additional permissions that are applicable to the
+     entire Program shall be treated as though they were included in
+     this License, to the extent that they are valid under applicable
+     law.  If additional permissions apply only to part of the Program,
+     that part may be used separately under those permissions, but the
+     entire Program remains governed by this License without regard to
+     the additional permissions.
+
+     When you convey a copy of a covered work, you may at your option
+     remove any additional permissions from that copy, or from any part
+     of it.  (Additional permissions may be written to require their own
+     removal in certain cases when you modify the work.)  You may place
+     additional permissions on material, added by you to a covered work,
+     for which you have or can give appropriate copyright permission.
+
+     Notwithstanding any other provision of this License, for material
+     you add to a covered work, you may (if authorized by the copyright
+     holders of that material) supplement the terms of this License
+     with terms:
+
+       a. Disclaiming warranty or limiting liability differently from
+          the terms of sections 15 and 16 of this License; or
+
+       b. Requiring preservation of specified reasonable legal notices
+          or author attributions in that material or in the Appropriate
+          Legal Notices displayed by works containing it; or
+
+       c. Prohibiting misrepresentation of the origin of that material,
+          or requiring that modified versions of such material be
+          marked in reasonable ways as different from the original
+          version; or
+
+       d. Limiting the use for publicity purposes of names of licensors
+          or authors of the material; or
+
+       e. Declining to grant rights under trademark law for use of some
+          trade names, trademarks, or service marks; or
+
+       f. Requiring indemnification of licensors and authors of that
+          material by anyone who conveys the material (or modified
+          versions of it) with contractual assumptions of liability to
+          the recipient, for any liability that these contractual
+          assumptions directly impose on those licensors and authors.
+
+     All other non-permissive additional terms are considered "further
+     restrictions" within the meaning of section 10.  If the Program as
+     you received it, or any part of it, contains a notice stating that
+     it is governed by this License along with a term that is a further
+     restriction, you may remove that term.  If a license document
+     contains a further restriction but permits relicensing or
+     conveying under this License, you may add to a covered work
+     material governed by the terms of that license document, provided
+     that the further restriction does not survive such relicensing or
+     conveying.
+
+     If you add terms to a covered work in accord with this section, you
+     must place, in the relevant source files, a statement of the
+     additional terms that apply to those files, or a notice indicating
+     where to find the applicable terms.
+
+     Additional terms, permissive or non-permissive, may be stated in
+     the form of a separately written license, or stated as exceptions;
+     the above requirements apply either way.
+
+  8. Termination.
+
+     You may not propagate or modify a covered work except as expressly
+     provided under this License.  Any attempt otherwise to propagate or
+     modify it is void, and will automatically terminate your rights
+     under this License (including any patent licenses granted under
+     the third paragraph of section 11).
+
+     However, if you cease all violation of this License, then your
+     license from a particular copyright holder is reinstated (a)
+     provisionally, unless and until the copyright holder explicitly
+     and finally terminates your license, and (b) permanently, if the
+     copyright holder fails to notify you of the violation by some
+     reasonable means prior to 60 days after the cessation.
+
+     Moreover, your license from a particular copyright holder is
+     reinstated permanently if the copyright holder notifies you of the
+     violation by some reasonable means, this is the first time you have
+     received notice of violation of this License (for any work) from
+     that copyright holder, and you cure the violation prior to 30 days
+     after your receipt of the notice.
+
+     Termination of your rights under this section does not terminate
+     the licenses of parties who have received copies or rights from
+     you under this License.  If your rights have been terminated and
+     not permanently reinstated, you do not qualify to receive new
+     licenses for the same material under section 10.
+
+  9. Acceptance Not Required for Having Copies.
+
+     You are not required to accept this License in order to receive or
+     run a copy of the Program.  Ancillary propagation of a covered work
+     occurring solely as a consequence of using peer-to-peer
+     transmission to receive a copy likewise does not require
+     acceptance.  However, nothing other than this License grants you
+     permission to propagate or modify any covered work.  These actions
+     infringe copyright if you do not accept this License.  Therefore,
+     by modifying or propagating a covered work, you indicate your
+     acceptance of this License to do so.
+
+ 10. Automatic Licensing of Downstream Recipients.
+
+     Each time you convey a covered work, the recipient automatically
+     receives a license from the original licensors, to run, modify and
+     propagate that work, subject to this License.  You are not
+     responsible for enforcing compliance by third parties with this
+     License.
+
+     An "entity transaction" is a transaction transferring control of an
+     organization, or substantially all assets of one, or subdividing an
+     organization, or merging organizations.  If propagation of a
+     covered work results from an entity transaction, each party to that
+     transaction who receives a copy of the work also receives whatever
+     licenses to the work the party's predecessor in interest had or
+     could give under the previous paragraph, plus a right to
+     possession of the Corresponding Source of the work from the
+     predecessor in interest, if the predecessor has it or can get it
+     with reasonable efforts.
+
+     You may not impose any further restrictions on the exercise of the
+     rights granted or affirmed under this License.  For example, you
+     may not impose a license fee, royalty, or other charge for
+     exercise of rights granted under this License, and you may not
+     initiate litigation (including a cross-claim or counterclaim in a
+     lawsuit) alleging that any patent claim is infringed by making,
+     using, selling, offering for sale, or importing the Program or any
+     portion of it.
+
+ 11. Patents.
+
+     A "contributor" is a copyright holder who authorizes use under this
+     License of the Program or a work on which the Program is based.
+     The work thus licensed is called the contributor's "contributor
+     version".
+
+     A contributor's "essential patent claims" are all patent claims
+     owned or controlled by the contributor, whether already acquired or
+     hereafter acquired, that would be infringed by some manner,
+     permitted by this License, of making, using, or selling its
+     contributor version, but do not include claims that would be
+     infringed only as a consequence of further modification of the
+     contributor version.  For purposes of this definition, "control"
+     includes the right to grant patent sublicenses in a manner
+     consistent with the requirements of this License.
+
+     Each contributor grants you a non-exclusive, worldwide,
+     royalty-free patent license under the contributor's essential
+     patent claims, to make, use, sell, offer for sale, import and
+     otherwise run, modify and propagate the contents of its
+     contributor version.
+
+     In the following three paragraphs, a "patent license" is any
+     express agreement or commitment, however denominated, not to
+     enforce a patent (such as an express permission to practice a
+     patent or covenant not to sue for patent infringement).  To
+     "grant" such a patent license to a party means to make such an
+     agreement or commitment not to enforce a patent against the party.
+
+     If you convey a covered work, knowingly relying on a patent
+     license, and the Corresponding Source of the work is not available
+     for anyone to copy, free of charge and under the terms of this
+     License, through a publicly available network server or other
+     readily accessible means, then you must either (1) cause the
+     Corresponding Source to be so available, or (2) arrange to deprive
+     yourself of the benefit of the patent license for this particular
+     work, or (3) arrange, in a manner consistent with the requirements
+     of this License, to extend the patent license to downstream
+     recipients.  "Knowingly relying" means you have actual knowledge
+     that, but for the patent license, your conveying the covered work
+     in a country, or your recipient's use of the covered work in a
+     country, would infringe one or more identifiable patents in that
+     country that you have reason to believe are valid.
+
+     If, pursuant to or in connection with a single transaction or
+     arrangement, you convey, or propagate by procuring conveyance of, a
+     covered work, and grant a patent license to some of the parties
+     receiving the covered work authorizing them to use, propagate,
+     modify or convey a specific copy of the covered work, then the
+     patent license you grant is automatically extended to all
+     recipients of the covered work and works based on it.
+
+     A patent license is "discriminatory" if it does not include within
+     the scope of its coverage, prohibits the exercise of, or is
+     conditioned on the non-exercise of one or more of the rights that
+     are specifically granted under this License.  You may not convey a
+     covered work if you are a party to an arrangement with a third
+     party that is in the business of distributing software, under
+     which you make payment to the third party based on the extent of
+     your activity of conveying the work, and under which the third
+     party grants, to any of the parties who would receive the covered
+     work from you, a discriminatory patent license (a) in connection
+     with copies of the covered work conveyed by you (or copies made
+     from those copies), or (b) primarily for and in connection with
+     specific products or compilations that contain the covered work,
+     unless you entered into that arrangement, or that patent license
+     was granted, prior to 28 March 2007.
+
+     Nothing in this License shall be construed as excluding or limiting
+     any implied license or other defenses to infringement that may
+     otherwise be available to you under applicable patent law.
+
+ 12. No Surrender of Others' Freedom.
+
+     If conditions are imposed on you (whether by court order,
+     agreement or otherwise) that contradict the conditions of this
+     License, they do not excuse you from the conditions of this
+     License.  If you cannot convey a covered work so as to satisfy
+     simultaneously your obligations under this License and any other
+     pertinent obligations, then as a consequence you may not convey it
+     at all.  For example, if you agree to terms that obligate you to
+     collect a royalty for further conveying from those to whom you
+     convey the Program, the only way you could satisfy both those
+     terms and this License would be to refrain entirely from conveying
+     the Program.
+
+ 13. Use with the GNU Affero General Public License.
+
+     Notwithstanding any other provision of this License, you have
+     permission to link or combine any covered work with a work licensed
+     under version 3 of the GNU Affero General Public License into a
+     single combined work, and to convey the resulting work.  The terms
+     of this License will continue to apply to the part which is the
+     covered work, but the special requirements of the GNU Affero
+     General Public License, section 13, concerning interaction through
+     a network will apply to the combination as such.
+
+ 14. Revised Versions of this License.
+
+     The Free Software Foundation may publish revised and/or new
+     versions of the GNU General Public License from time to time.
+     Such new versions will be similar in spirit to the present
+     version, but may differ in detail to address new problems or
+     concerns.
+
+     Each version is given a distinguishing version number.  If the
+     Program specifies that a certain numbered version of the GNU
+     General Public License "or any later version" applies to it, you
+     have the option of following the terms and conditions either of
+     that numbered version or of any later version published by the
+     Free Software Foundation.  If the Program does not specify a
+     version number of the GNU General Public License, you may choose
+     any version ever published by the Free Software Foundation.
+
+     If the Program specifies that a proxy can decide which future
+     versions of the GNU General Public License can be used, that
+     proxy's public statement of acceptance of a version permanently
+     authorizes you to choose that version for the Program.
+
+     Later license versions may give you additional or different
+     permissions.  However, no additional obligations are imposed on any
+     author or copyright holder as a result of your choosing to follow a
+     later version.
+
+ 15. Disclaimer of Warranty.
+
+     THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+     APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE
+     COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS"
+     WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
+     INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+     MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE
+     RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.
+     SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
+     NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. Limitation of Liability.
+
+     IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+     WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES
+     AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU
+     FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
+     CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
+     THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA
+     BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+     PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+     PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF
+     THE POSSIBILITY OF SUCH DAMAGES.
+
+ 17. Interpretation of Sections 15 and 16.
+
+     If the disclaimer of warranty and limitation of liability provided
+     above cannot be given local legal effect according to their terms,
+     reviewing courts shall apply local law that most closely
+     approximates an absolute waiver of all civil liability in
+     connection with the Program, unless a warranty or assumption of
+     liability accompanies a copy of the Program in return for a fee.
+
+
+END OF TERMS AND CONDITIONS
+===========================
+
+How to Apply These Terms to Your New Programs
+=============================================
+
+If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these
+terms.
+
+   To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+     ONE LINE TO GIVE THE PROGRAM'S NAME AND A BRIEF IDEA OF WHAT IT DOES.
+     Copyright (C) YEAR NAME OF AUTHOR
+
+     This program is free software: you can redistribute it and/or modify
+     it under the terms of the GNU General Public License as published by
+     the Free Software Foundation, either version 3 of the License, or (at
+     your option) any later version.
+
+     This program is distributed in the hope that it will be useful, but
+     WITHOUT ANY WARRANTY; without even the implied warranty of
+     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+     General Public License for more details.
+
+     You should have received a copy of the GNU General Public License
+     along with this program.  If not, see `http://www.gnu.org/licenses/'.
+
+   Also add information on how to contact you by electronic and paper
+mail.
+
+   If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+     PROGRAM Copyright (C) YEAR NAME OF AUTHOR
+     This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+     This is free software, and you are welcome to redistribute it
+     under certain conditions; type `show c' for details.
+
+   The hypothetical commands `show w' and `show c' should show the
+appropriate parts of the General Public License.  Of course, your
+program's commands might be different; for a GUI interface, you would
+use an "about box".
+
+   You should also get your employer (if you work as a programmer) or
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary.  For more information on this, and how to apply and follow
+the GNU GPL, see `http://www.gnu.org/licenses/'.
+
+   The GNU General Public License does not permit incorporating your
+program into proprietary programs.  If your program is a subroutine
+library, you may consider it more useful to permit linking proprietary
+applications with the library.  If this is what you want to do, use the
+GNU Lesser General Public License instead of this License.  But first,
+please read `http://www.gnu.org/philosophy/why-not-lgpl.html'.
+
+
+File: gfortran.info,  Node: GNU Free Documentation License,  Next: Funding,  Prev: Copying,  Up: Top
+
+GNU Free Documentation License
+******************************
+
+                     Version 1.3, 3 November 2008
+
+     Copyright (C) 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
+     `http://fsf.org/'
+
+     Everyone is permitted to copy and distribute verbatim copies
+     of this license document, but changing it is not allowed.
+
+  0. PREAMBLE
+
+     The purpose of this License is to make a manual, textbook, or other
+     functional and useful document "free" in the sense of freedom: to
+     assure everyone the effective freedom to copy and redistribute it,
+     with or without modifying it, either commercially or
+     noncommercially.  Secondarily, this License preserves for the
+     author and publisher a way to get credit for their work, while not
+     being considered responsible for modifications made by others.
+
+     This License is a kind of "copyleft", which means that derivative
+     works of the document must themselves be free in the same sense.
+     It complements the GNU General Public License, which is a copyleft
+     license designed for free software.
+
+     We have designed this License in order to use it for manuals for
+     free software, because free software needs free documentation: a
+     free program should come with manuals providing the same freedoms
+     that the software does.  But this License is not limited to
+     software manuals; it can be used for any textual work, regardless
+     of subject matter or whether it is published as a printed book.
+     We recommend this License principally for works whose purpose is
+     instruction or reference.
+
+  1. APPLICABILITY AND DEFINITIONS
+
+     This License applies to any manual or other work, in any medium,
+     that contains a notice placed by the copyright holder saying it
+     can be distributed under the terms of this License.  Such a notice
+     grants a world-wide, royalty-free license, unlimited in duration,
+     to use that work under the conditions stated herein.  The
+     "Document", below, refers to any such manual or work.  Any member
+     of the public is a licensee, and is addressed as "you".  You
+     accept the license if you copy, modify or distribute the work in a
+     way requiring permission under copyright law.
+
+     A "Modified Version" of the Document means any work containing the
+     Document or a portion of it, either copied verbatim, or with
+     modifications and/or translated into another language.
+
+     A "Secondary Section" is a named appendix or a front-matter section
+     of the Document that deals exclusively with the relationship of the
+     publishers or authors of the Document to the Document's overall
+     subject (or to related matters) and contains nothing that could
+     fall directly within that overall subject.  (Thus, if the Document
+     is in part a textbook of mathematics, a Secondary Section may not
+     explain any mathematics.)  The relationship could be a matter of
+     historical connection with the subject or with related matters, or
+     of legal, commercial, philosophical, ethical or political position
+     regarding them.
+
+     The "Invariant Sections" are certain Secondary Sections whose
+     titles are designated, as being those of Invariant Sections, in
+     the notice that says that the Document is released under this
+     License.  If a section does not fit the above definition of
+     Secondary then it is not allowed to be designated as Invariant.
+     The Document may contain zero Invariant Sections.  If the Document
+     does not identify any Invariant Sections then there are none.
+
+     The "Cover Texts" are certain short passages of text that are
+     listed, as Front-Cover Texts or Back-Cover Texts, in the notice
+     that says that the Document is released under this License.  A
+     Front-Cover Text may be at most 5 words, and a Back-Cover Text may
+     be at most 25 words.
+
+     A "Transparent" copy of the Document means a machine-readable copy,
+     represented in a format whose specification is available to the
+     general public, that is suitable for revising the document
+     straightforwardly with generic text editors or (for images
+     composed of pixels) generic paint programs or (for drawings) some
+     widely available drawing editor, and that is suitable for input to
+     text formatters or for automatic translation to a variety of
+     formats suitable for input to text formatters.  A copy made in an
+     otherwise Transparent file format whose markup, or absence of
+     markup, has been arranged to thwart or discourage subsequent
+     modification by readers is not Transparent.  An image format is
+     not Transparent if used for any substantial amount of text.  A
+     copy that is not "Transparent" is called "Opaque".
+
+     Examples of suitable formats for Transparent copies include plain
+     ASCII without markup, Texinfo input format, LaTeX input format,
+     SGML or XML using a publicly available DTD, and
+     standard-conforming simple HTML, PostScript or PDF designed for
+     human modification.  Examples of transparent image formats include
+     PNG, XCF and JPG.  Opaque formats include proprietary formats that
+     can be read and edited only by proprietary word processors, SGML or
+     XML for which the DTD and/or processing tools are not generally
+     available, and the machine-generated HTML, PostScript or PDF
+     produced by some word processors for output purposes only.
+
+     The "Title Page" means, for a printed book, the title page itself,
+     plus such following pages as are needed to hold, legibly, the
+     material this License requires to appear in the title page.  For
+     works in formats which do not have any title page as such, "Title
+     Page" means the text near the most prominent appearance of the
+     work's title, preceding the beginning of the body of the text.
+
+     The "publisher" means any person or entity that distributes copies
+     of the Document to the public.
+
+     A section "Entitled XYZ" means a named subunit of the Document
+     whose title either is precisely XYZ or contains XYZ in parentheses
+     following text that translates XYZ in another language.  (Here XYZ
+     stands for a specific section name mentioned below, such as
+     "Acknowledgements", "Dedications", "Endorsements", or "History".)
+     To "Preserve the Title" of such a section when you modify the
+     Document means that it remains a section "Entitled XYZ" according
+     to this definition.
+
+     The Document may include Warranty Disclaimers next to the notice
+     which states that this License applies to the Document.  These
+     Warranty Disclaimers are considered to be included by reference in
+     this License, but only as regards disclaiming warranties: any other
+     implication that these Warranty Disclaimers may have is void and
+     has no effect on the meaning of this License.
+
+  2. VERBATIM COPYING
+
+     You may copy and distribute the Document in any medium, either
+     commercially or noncommercially, provided that this License, the
+     copyright notices, and the license notice saying this License
+     applies to the Document are reproduced in all copies, and that you
+     add no other conditions whatsoever to those of this License.  You
+     may not use technical measures to obstruct or control the reading
+     or further copying of the copies you make or distribute.  However,
+     you may accept compensation in exchange for copies.  If you
+     distribute a large enough number of copies you must also follow
+     the conditions in section 3.
+
+     You may also lend copies, under the same conditions stated above,
+     and you may publicly display copies.
+
+  3. COPYING IN QUANTITY
+
+     If you publish printed copies (or copies in media that commonly
+     have printed covers) of the Document, numbering more than 100, and
+     the Document's license notice requires Cover Texts, you must
+     enclose the copies in covers that carry, clearly and legibly, all
+     these Cover Texts: Front-Cover Texts on the front cover, and
+     Back-Cover Texts on the back cover.  Both covers must also clearly
+     and legibly identify you as the publisher of these copies.  The
+     front cover must present the full title with all words of the
+     title equally prominent and visible.  You may add other material
+     on the covers in addition.  Copying with changes limited to the
+     covers, as long as they preserve the title of the Document and
+     satisfy these conditions, can be treated as verbatim copying in
+     other respects.
+
+     If the required texts for either cover are too voluminous to fit
+     legibly, you should put the first ones listed (as many as fit
+     reasonably) on the actual cover, and continue the rest onto
+     adjacent pages.
+
+     If you publish or distribute Opaque copies of the Document
+     numbering more than 100, you must either include a
+     machine-readable Transparent copy along with each Opaque copy, or
+     state in or with each Opaque copy a computer-network location from
+     which the general network-using public has access to download
+     using public-standard network protocols a complete Transparent
+     copy of the Document, free of added material.  If you use the
+     latter option, you must take reasonably prudent steps, when you
+     begin distribution of Opaque copies in quantity, to ensure that
+     this Transparent copy will remain thus accessible at the stated
+     location until at least one year after the last time you
+     distribute an Opaque copy (directly or through your agents or
+     retailers) of that edition to the public.
+
+     It is requested, but not required, that you contact the authors of
+     the Document well before redistributing any large number of
+     copies, to give them a chance to provide you with an updated
+     version of the Document.
+
+  4. MODIFICATIONS
+
+     You may copy and distribute a Modified Version of the Document
+     under the conditions of sections 2 and 3 above, provided that you
+     release the Modified Version under precisely this License, with
+     the Modified Version filling the role of the Document, thus
+     licensing distribution and modification of the Modified Version to
+     whoever possesses a copy of it.  In addition, you must do these
+     things in the Modified Version:
+
+       A. Use in the Title Page (and on the covers, if any) a title
+          distinct from that of the Document, and from those of
+          previous versions (which should, if there were any, be listed
+          in the History section of the Document).  You may use the
+          same title as a previous version if the original publisher of
+          that version gives permission.
+
+       B. List on the Title Page, as authors, one or more persons or
+          entities responsible for authorship of the modifications in
+          the Modified Version, together with at least five of the
+          principal authors of the Document (all of its principal
+          authors, if it has fewer than five), unless they release you
+          from this requirement.
+
+       C. State on the Title page the name of the publisher of the
+          Modified Version, as the publisher.
+
+       D. Preserve all the copyright notices of the Document.
+
+       E. Add an appropriate copyright notice for your modifications
+          adjacent to the other copyright notices.
+
+       F. Include, immediately after the copyright notices, a license
+          notice giving the public permission to use the Modified
+          Version under the terms of this License, in the form shown in
+          the Addendum below.
+
+       G. Preserve in that license notice the full lists of Invariant
+          Sections and required Cover Texts given in the Document's
+          license notice.
+
+       H. Include an unaltered copy of this License.
+
+       I. Preserve the section Entitled "History", Preserve its Title,
+          and add to it an item stating at least the title, year, new
+          authors, and publisher of the Modified Version as given on
+          the Title Page.  If there is no section Entitled "History" in
+          the Document, create one stating the title, year, authors,
+          and publisher of the Document as given on its Title Page,
+          then add an item describing the Modified Version as stated in
+          the previous sentence.
+
+       J. Preserve the network location, if any, given in the Document
+          for public access to a Transparent copy of the Document, and
+          likewise the network locations given in the Document for
+          previous versions it was based on.  These may be placed in
+          the "History" section.  You may omit a network location for a
+          work that was published at least four years before the
+          Document itself, or if the original publisher of the version
+          it refers to gives permission.
+
+       K. For any section Entitled "Acknowledgements" or "Dedications",
+          Preserve the Title of the section, and preserve in the
+          section all the substance and tone of each of the contributor
+          acknowledgements and/or dedications given therein.
+
+       L. Preserve all the Invariant Sections of the Document,
+          unaltered in their text and in their titles.  Section numbers
+          or the equivalent are not considered part of the section
+          titles.
+
+       M. Delete any section Entitled "Endorsements".  Such a section
+          may not be included in the Modified Version.
+
+       N. Do not retitle any existing section to be Entitled
+          "Endorsements" or to conflict in title with any Invariant
+          Section.
+
+       O. Preserve any Warranty Disclaimers.
+
+     If the Modified Version includes new front-matter sections or
+     appendices that qualify as Secondary Sections and contain no
+     material copied from the Document, you may at your option
+     designate some or all of these sections as invariant.  To do this,
+     add their titles to the list of Invariant Sections in the Modified
+     Version's license notice.  These titles must be distinct from any
+     other section titles.
+
+     You may add a section Entitled "Endorsements", provided it contains
+     nothing but endorsements of your Modified Version by various
+     parties--for example, statements of peer review or that the text
+     has been approved by an organization as the authoritative
+     definition of a standard.
+
+     You may add a passage of up to five words as a Front-Cover Text,
+     and a passage of up to 25 words as a Back-Cover Text, to the end
+     of the list of Cover Texts in the Modified Version.  Only one
+     passage of Front-Cover Text and one of Back-Cover Text may be
+     added by (or through arrangements made by) any one entity.  If the
+     Document already includes a cover text for the same cover,
+     previously added by you or by arrangement made by the same entity
+     you are acting on behalf of, you may not add another; but you may
+     replace the old one, on explicit permission from the previous
+     publisher that added the old one.
+
+     The author(s) and publisher(s) of the Document do not by this
+     License give permission to use their names for publicity for or to
+     assert or imply endorsement of any Modified Version.
+
+  5. COMBINING DOCUMENTS
+
+     You may combine the Document with other documents released under
+     this License, under the terms defined in section 4 above for
+     modified versions, provided that you include in the combination
+     all of the Invariant Sections of all of the original documents,
+     unmodified, and list them all as Invariant Sections of your
+     combined work in its license notice, and that you preserve all
+     their Warranty Disclaimers.
+
+     The combined work need only contain one copy of this License, and
+     multiple identical Invariant Sections may be replaced with a single
+     copy.  If there are multiple Invariant Sections with the same name
+     but different contents, make the title of each such section unique
+     by adding at the end of it, in parentheses, the name of the
+     original author or publisher of that section if known, or else a
+     unique number.  Make the same adjustment to the section titles in
+     the list of Invariant Sections in the license notice of the
+     combined work.
+
+     In the combination, you must combine any sections Entitled
+     "History" in the various original documents, forming one section
+     Entitled "History"; likewise combine any sections Entitled
+     "Acknowledgements", and any sections Entitled "Dedications".  You
+     must delete all sections Entitled "Endorsements."
+
+  6. COLLECTIONS OF DOCUMENTS
+
+     You may make a collection consisting of the Document and other
+     documents released under this License, and replace the individual
+     copies of this License in the various documents with a single copy
+     that is included in the collection, provided that you follow the
+     rules of this License for verbatim copying of each of the
+     documents in all other respects.
+
+     You may extract a single document from such a collection, and
+     distribute it individually under this License, provided you insert
+     a copy of this License into the extracted document, and follow
+     this License in all other respects regarding verbatim copying of
+     that document.
+
+  7. AGGREGATION WITH INDEPENDENT WORKS
+
+     A compilation of the Document or its derivatives with other
+     separate and independent documents or works, in or on a volume of
+     a storage or distribution medium, is called an "aggregate" if the
+     copyright resulting from the compilation is not used to limit the
+     legal rights of the compilation's users beyond what the individual
+     works permit.  When the Document is included in an aggregate, this
+     License does not apply to the other works in the aggregate which
+     are not themselves derivative works of the Document.
+
+     If the Cover Text requirement of section 3 is applicable to these
+     copies of the Document, then if the Document is less than one half
+     of the entire aggregate, the Document's Cover Texts may be placed
+     on covers that bracket the Document within the aggregate, or the
+     electronic equivalent of covers if the Document is in electronic
+     form.  Otherwise they must appear on printed covers that bracket
+     the whole aggregate.
+
+  8. TRANSLATION
+
+     Translation is considered a kind of modification, so you may
+     distribute translations of the Document under the terms of section
+     4.  Replacing Invariant Sections with translations requires special
+     permission from their copyright holders, but you may include
+     translations of some or all Invariant Sections in addition to the
+     original versions of these Invariant Sections.  You may include a
+     translation of this License, and all the license notices in the
+     Document, and any Warranty Disclaimers, provided that you also
+     include the original English version of this License and the
+     original versions of those notices and disclaimers.  In case of a
+     disagreement between the translation and the original version of
+     this License or a notice or disclaimer, the original version will
+     prevail.
+
+     If a section in the Document is Entitled "Acknowledgements",
+     "Dedications", or "History", the requirement (section 4) to
+     Preserve its Title (section 1) will typically require changing the
+     actual title.
+
+  9. TERMINATION
+
+     You may not copy, modify, sublicense, or distribute the Document
+     except as expressly provided under this License.  Any attempt
+     otherwise to copy, modify, sublicense, or distribute it is void,
+     and will automatically terminate your rights under this License.
+
+     However, if you cease all violation of this License, then your
+     license from a particular copyright holder is reinstated (a)
+     provisionally, unless and until the copyright holder explicitly
+     and finally terminates your license, and (b) permanently, if the
+     copyright holder fails to notify you of the violation by some
+     reasonable means prior to 60 days after the cessation.
+
+     Moreover, your license from a particular copyright holder is
+     reinstated permanently if the copyright holder notifies you of the
+     violation by some reasonable means, this is the first time you have
+     received notice of violation of this License (for any work) from
+     that copyright holder, and you cure the violation prior to 30 days
+     after your receipt of the notice.
+
+     Termination of your rights under this section does not terminate
+     the licenses of parties who have received copies or rights from
+     you under this License.  If your rights have been terminated and
+     not permanently reinstated, receipt of a copy of some or all of
+     the same material does not give you any rights to use it.
+
+ 10. FUTURE REVISIONS OF THIS LICENSE
+
+     The Free Software Foundation may publish new, revised versions of
+     the GNU Free Documentation License from time to time.  Such new
+     versions will be similar in spirit to the present version, but may
+     differ in detail to address new problems or concerns.  See
+     `http://www.gnu.org/copyleft/'.
+
+     Each version of the License is given a distinguishing version
+     number.  If the Document specifies that a particular numbered
+     version of this License "or any later version" applies to it, you
+     have the option of following the terms and conditions either of
+     that specified version or of any later version that has been
+     published (not as a draft) by the Free Software Foundation.  If
+     the Document does not specify a version number of this License,
+     you may choose any version ever published (not as a draft) by the
+     Free Software Foundation.  If the Document specifies that a proxy
+     can decide which future versions of this License can be used, that
+     proxy's public statement of acceptance of a version permanently
+     authorizes you to choose that version for the Document.
+
+ 11. RELICENSING
+
+     "Massive Multiauthor Collaboration Site" (or "MMC Site") means any
+     World Wide Web server that publishes copyrightable works and also
+     provides prominent facilities for anybody to edit those works.  A
+     public wiki that anybody can edit is an example of such a server.
+     A "Massive Multiauthor Collaboration" (or "MMC") contained in the
+     site means any set of copyrightable works thus published on the MMC
+     site.
+
+     "CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0
+     license published by Creative Commons Corporation, a not-for-profit
+     corporation with a principal place of business in San Francisco,
+     California, as well as future copyleft versions of that license
+     published by that same organization.
+
+     "Incorporate" means to publish or republish a Document, in whole or
+     in part, as part of another Document.
+
+     An MMC is "eligible for relicensing" if it is licensed under this
+     License, and if all works that were first published under this
+     License somewhere other than this MMC, and subsequently
+     incorporated in whole or in part into the MMC, (1) had no cover
+     texts or invariant sections, and (2) were thus incorporated prior
+     to November 1, 2008.
+
+     The operator of an MMC Site may republish an MMC contained in the
+     site under CC-BY-SA on the same site at any time before August 1,
+     2009, provided the MMC is eligible for relicensing.
+
+
+ADDENDUM: How to use this License for your documents
+====================================================
+
+To use this License in a document you have written, include a copy of
+the License in the document and put the following copyright and license
+notices just after the title page:
+
+       Copyright (C)  YEAR  YOUR NAME.
+       Permission is granted to copy, distribute and/or modify this document
+       under the terms of the GNU Free Documentation License, Version 1.3
+       or any later version published by the Free Software Foundation;
+       with no Invariant Sections, no Front-Cover Texts, and no Back-Cover
+       Texts.  A copy of the license is included in the section entitled ``GNU
+       Free Documentation License''.
+
+   If you have Invariant Sections, Front-Cover Texts and Back-Cover
+Texts, replace the "with...Texts." line with this:
+
+         with the Invariant Sections being LIST THEIR TITLES, with
+         the Front-Cover Texts being LIST, and with the Back-Cover Texts
+         being LIST.
+
+   If you have Invariant Sections without Cover Texts, or some other
+combination of the three, merge those two alternatives to suit the
+situation.
+
+   If your document contains nontrivial examples of program code, we
+recommend releasing these examples in parallel under your choice of
+free software license, such as the GNU General Public License, to
+permit their use in free software.
+
+
+File: gfortran.info,  Node: Funding,  Next: Option Index,  Prev: GNU Free Documentation License,  Up: Top
+
+Funding Free Software
+*********************
+
+If you want to have more free software a few years from now, it makes
+sense for you to help encourage people to contribute funds for its
+development.  The most effective approach known is to encourage
+commercial redistributors to donate.
+
+   Users of free software systems can boost the pace of development by
+encouraging for-a-fee distributors to donate part of their selling price
+to free software developers--the Free Software Foundation, and others.
+
+   The way to convince distributors to do this is to demand it and
+expect it from them.  So when you compare distributors, judge them
+partly by how much they give to free software development.  Show
+distributors they must compete to be the one who gives the most.
+
+   To make this approach work, you must insist on numbers that you can
+compare, such as, "We will donate ten dollars to the Frobnitz project
+for each disk sold."  Don't be satisfied with a vague promise, such as
+"A portion of the profits are donated," since it doesn't give a basis
+for comparison.
+
+   Even a precise fraction "of the profits from this disk" is not very
+meaningful, since creative accounting and unrelated business decisions
+can greatly alter what fraction of the sales price counts as profit.
+If the price you pay is $50, ten percent of the profit is probably less
+than a dollar; it might be a few cents, or nothing at all.
+
+   Some redistributors do development work themselves.  This is useful
+too; but to keep everyone honest, you need to inquire how much they do,
+and what kind.  Some kinds of development make much more long-term
+difference than others.  For example, maintaining a separate version of
+a program contributes very little; maintaining the standard version of a
+program for the whole community contributes much.  Easy new ports
+contribute little, since someone else would surely do them; difficult
+ports such as adding a new CPU to the GNU Compiler Collection
+contribute more; major new features or packages contribute the most.
+
+   By establishing the idea that supporting further development is "the
+proper thing to do" when distributing free software for a fee, we can
+assure a steady flow of resources into making more free software.
+
+     Copyright (C) 1994 Free Software Foundation, Inc.
+     Verbatim copying and redistribution of this section is permitted
+     without royalty; alteration is not permitted.
+
+
+File: gfortran.info,  Node: Option Index,  Next: Keyword Index,  Prev: Funding,  Up: Top
+
+Option Index
+************
+
+`gfortran''s command line options are indexed here without any initial
+`-' or `--'.  Where an option has both positive and negative forms
+(such as -foption and -fno-option), relevant entries in the manual are
+indexed under the most appropriate form; it may sometimes be useful to
+look up both forms.
+
+
+* Menu:
+
+* A-PREDICATE=ANSWER:                    Preprocessing Options.
+                                                              (line 120)
+* APREDICATE=ANSWER:                     Preprocessing Options.
+                                                              (line 114)
+* backslash:                             Fortran Dialect Options.
+                                                              (line  60)
+* C:                                     Preprocessing Options.
+                                                              (line 123)
+* CC:                                    Preprocessing Options.
+                                                              (line 138)
+* cpp:                                   Preprocessing Options.
+                                                              (line  12)
+* dD:                                    Preprocessing Options.
+                                                              (line  35)
+* dI:                                    Preprocessing Options.
+                                                              (line  51)
+* dM:                                    Preprocessing Options.
+                                                              (line  26)
+* dN:                                    Preprocessing Options.
+                                                              (line  41)
+* DNAME:                                 Preprocessing Options.
+                                                              (line 153)
+* DNAME=DEFINITION:                      Preprocessing Options.
+                                                              (line 156)
+* dU:                                    Preprocessing Options.
+                                                              (line  44)
+* falign-commons:                        Code Gen Options.    (line 318)
+* fall-intrinsics:                       Fortran Dialect Options.
+                                                              (line  17)
+* fbacktrace:                            Debugging Options.   (line  41)
+* fblas-matmul-limit:                    Code Gen Options.    (line 274)
+* fbounds-check:                         Code Gen Options.    (line 206)
+* fcheck:                                Code Gen Options.    (line 157)
+* fcheck-array-temporaries:              Code Gen Options.    (line 209)
+* fcoarray:                              Code Gen Options.    (line 147)
+* fconvert=CONVERSION:                   Runtime Options.     (line  10)
+* fcray-pointer:                         Fortran Dialect Options.
+                                                              (line 106)
+* fd-lines-as-code:                      Fortran Dialect Options.
+                                                              (line  27)
+* fd-lines-as-comments:                  Fortran Dialect Options.
+                                                              (line  27)
+* fdefault-double-8:                     Fortran Dialect Options.
+                                                              (line  34)
+* fdefault-integer-8:                    Fortran Dialect Options.
+                                                              (line  42)
+* fdefault-real-8:                       Fortran Dialect Options.
+                                                              (line  47)
+* fdollar-ok:                            Fortran Dialect Options.
+                                                              (line  54)
+* fdump-core:                            Debugging Options.   (line  48)
+* fdump-fortran-optimized:               Debugging Options.   (line  15)
+* fdump-fortran-original:                Debugging Options.   (line  10)
+* fdump-parse-tree:                      Debugging Options.   (line  18)
+* fexternal-blas:                        Code Gen Options.    (line 266)
+* ff2c:                                  Code Gen Options.    (line  25)
+* ffixed-line-length-N:                  Fortran Dialect Options.
+                                                              (line  77)
+* ffpe-trap=LIST:                        Debugging Options.   (line  24)
+* ffree-form:                            Fortran Dialect Options.
+                                                              (line  11)
+* ffree-line-length-N:                   Fortran Dialect Options.
+                                                              (line  90)
+* fimplicit-none:                        Fortran Dialect Options.
+                                                              (line 101)
+* finit-character:                       Code Gen Options.    (line 294)
+* finit-integer:                         Code Gen Options.    (line 294)
+* finit-local-zero:                      Code Gen Options.    (line 294)
+* finit-logical:                         Code Gen Options.    (line 294)
+* finit-real:                            Code Gen Options.    (line 294)
+* fintrinsic-modules-path DIR:           Directory Options.   (line  36)
+* fmax-array-constructor:                Code Gen Options.    (line 212)
+* fmax-errors=N:                         Error and Warning Options.
+                                                              (line  27)
+* fmax-identifier-length=N:              Fortran Dialect Options.
+                                                              (line  97)
+* fmax-stack-var-size:                   Code Gen Options.    (line 230)
+* fmax-subrecord-length=LENGTH:          Runtime Options.     (line  37)
+* fmodule-private:                       Fortran Dialect Options.
+                                                              (line  72)
+* fno-automatic:                         Code Gen Options.    (line  15)
+* fno-fixed-form:                        Fortran Dialect Options.
+                                                              (line  11)
+* fno-protect-parens:                    Code Gen Options.    (line 330)
+* fno-range-check:                       Runtime Options.     (line  21)
+* fno-underscoring:                      Code Gen Options.    (line  54)
+* fno-whole-file:                        Code Gen Options.    (line 113)
+* fopenmp:                               Fortran Dialect Options.
+                                                              (line 110)
+* fpack-derived:                         Code Gen Options.    (line 244)
+* fpp:                                   Preprocessing Options.
+                                                              (line  12)
+* frange-check:                          Fortran Dialect Options.
+                                                              (line 118)
+* frealloc-lhs:                          Code Gen Options.    (line 338)
+* frecord-marker=LENGTH:                 Runtime Options.     (line  29)
+* frecursive:                            Code Gen Options.    (line 285)
+* frepack-arrays:                        Code Gen Options.    (line 250)
+* fsecond-underscore:                    Code Gen Options.    (line 130)
+* fshort-enums <1>:                      Fortran 2003 status. (line  83)
+* fshort-enums:                          Code Gen Options.    (line 260)
+* fsign-zero:                            Runtime Options.     (line  42)
+* fsyntax-only:                          Error and Warning Options.
+                                                              (line  33)
+* fworking-directory:                    Preprocessing Options.
+                                                              (line  55)
+* H:                                     Preprocessing Options.
+                                                              (line 176)
+* IDIR:                                  Directory Options.   (line  14)
+* idirafter DIR:                         Preprocessing Options.
+                                                              (line  70)
+* imultilib DIR:                         Preprocessing Options.
+                                                              (line  77)
+* iprefix PREFIX:                        Preprocessing Options.
+                                                              (line  81)
+* iquote DIR:                            Preprocessing Options.
+                                                              (line  90)
+* isysroot DIR:                          Preprocessing Options.
+                                                              (line  86)
+* isystem DIR:                           Preprocessing Options.
+                                                              (line  97)
+* JDIR:                                  Directory Options.   (line  29)
+* MDIR:                                  Directory Options.   (line  29)
+* nostdinc:                              Preprocessing Options.
+                                                              (line 105)
+* P:                                     Preprocessing Options.
+                                                              (line 181)
+* pedantic:                              Error and Warning Options.
+                                                              (line  38)
+* pedantic-errors:                       Error and Warning Options.
+                                                              (line  57)
+* static-libgfortran:                    Link Options.        (line  11)
+* std=STD option:                        Fortran Dialect Options.
+                                                              (line 130)
+* UNAME:                                 Preprocessing Options.
+                                                              (line 187)
+* undef:                                 Preprocessing Options.
+                                                              (line 110)
+* Waliasing:                             Error and Warning Options.
+                                                              (line  69)
+* Walign-commons:                        Error and Warning Options.
+                                                              (line 184)
+* Wall:                                  Error and Warning Options.
+                                                              (line  61)
+* Wampersand:                            Error and Warning Options.
+                                                              (line  86)
+* Warray-temporaries:                    Error and Warning Options.
+                                                              (line  94)
+* Wcharacter-truncation:                 Error and Warning Options.
+                                                              (line  99)
+* Wconversion:                           Error and Warning Options.
+                                                              (line 105)
+* Wconversion-extra:                     Error and Warning Options.
+                                                              (line 109)
+* Werror:                                Error and Warning Options.
+                                                              (line 190)
+* Wimplicit-interface:                   Error and Warning Options.
+                                                              (line 112)
+* Wimplicit-procedure:                   Error and Warning Options.
+                                                              (line 118)
+* Wintrinsic-shadow:                     Error and Warning Options.
+                                                              (line 167)
+* Wintrinsics-std:                       Error and Warning Options.
+                                                              (line 122)
+* Wline-truncation:                      Error and Warning Options.
+                                                              (line 102)
+* Wreal-q-constant:                      Error and Warning Options.
+                                                              (line 129)
+* Wsurprising:                           Error and Warning Options.
+                                                              (line 133)
+* Wtabs:                                 Error and Warning Options.
+                                                              (line 155)
+* Wunderflow:                            Error and Warning Options.
+                                                              (line 163)
+* Wunused-dummy-argument:                Error and Warning Options.
+                                                              (line 173)
+* Wunused-parameter:                     Error and Warning Options.
+                                                              (line 177)
+
+
+File: gfortran.info,  Node: Keyword Index,  Prev: Option Index,  Up: Top
+
+Keyword Index
+*************
+
+
+* Menu:
+
+* $:                                     Fortran Dialect Options.
+                                                              (line  54)
+* %LOC:                                  Argument list functions.
+                                                              (line   6)
+* %REF:                                  Argument list functions.
+                                                              (line   6)
+* %VAL:                                  Argument list functions.
+                                                              (line   6)
+* &:                                     Error and Warning Options.
+                                                              (line  86)
+* [...]:                                 Fortran 2003 status. (line  68)
+* _gfortran_set_args:                    _gfortran_set_args.  (line   6)
+* _gfortran_set_convert:                 _gfortran_set_convert.
+                                                              (line   6)
+* _gfortran_set_fpe:                     _gfortran_set_fpe.   (line   6)
+* _gfortran_set_max_subrecord_length:    _gfortran_set_max_subrecord_length.
+                                                              (line   6)
+* _gfortran_set_options:                 _gfortran_set_options.
+                                                              (line   6)
+* _gfortran_set_record_marker:           _gfortran_set_record_marker.
+                                                              (line   6)
+* ABORT:                                 ABORT.               (line   6)
+* ABS:                                   ABS.                 (line   6)
+* absolute value:                        ABS.                 (line   6)
+* ACCESS:                                ACCESS.              (line   6)
+* ACCESS='STREAM' I/O:                   Fortran 2003 status. (line  95)
+* ACHAR:                                 ACHAR.               (line   6)
+* ACOS:                                  ACOS.                (line   6)
+* ACOSH:                                 ACOSH.               (line   6)
+* adjust string <1>:                     ADJUSTR.             (line   6)
+* adjust string:                         ADJUSTL.             (line   6)
+* ADJUSTL:                               ADJUSTL.             (line   6)
+* ADJUSTR:                               ADJUSTR.             (line   6)
+* AIMAG:                                 AIMAG.               (line   6)
+* AINT:                                  AINT.                (line   6)
+* ALARM:                                 ALARM.               (line   6)
+* ALGAMA:                                LOG_GAMMA.           (line   6)
+* aliasing:                              Error and Warning Options.
+                                                              (line  69)
+* alignment of COMMON blocks <1>:        Code Gen Options.    (line 318)
+* alignment of COMMON blocks:            Error and Warning Options.
+                                                              (line 184)
+* ALL:                                   ALL.                 (line   6)
+* all warnings:                          Error and Warning Options.
+                                                              (line  61)
+* ALLOCATABLE components of derived types: Fortran 2003 status.
+                                                              (line  93)
+* ALLOCATABLE dummy arguments:           Fortran 2003 status. (line  89)
+* ALLOCATABLE function results:          Fortran 2003 status. (line  91)
+* ALLOCATED:                             ALLOCATED.           (line   6)
+* allocation, moving:                    MOVE_ALLOC.          (line   6)
+* allocation, status:                    ALLOCATED.           (line   6)
+* ALOG:                                  LOG.                 (line   6)
+* ALOG10:                                LOG10.               (line   6)
+* AMAX0:                                 MAX.                 (line   6)
+* AMAX1:                                 MAX.                 (line   6)
+* AMIN0:                                 MIN.                 (line   6)
+* AMIN1:                                 MIN.                 (line   6)
+* AMOD:                                  MOD.                 (line   6)
+* AND:                                   AND.                 (line   6)
+* ANINT:                                 ANINT.               (line   6)
+* ANY:                                   ANY.                 (line   6)
+* area hyperbolic cosine:                ACOSH.               (line   6)
+* area hyperbolic sine:                  ASINH.               (line   6)
+* area hyperbolic tangent:               ATANH.               (line   6)
+* argument list functions:               Argument list functions.
+                                                              (line   6)
+* arguments, to program <1>:             IARGC.               (line   6)
+* arguments, to program <2>:             GET_COMMAND_ARGUMENT.
+                                                              (line   6)
+* arguments, to program <3>:             GET_COMMAND.         (line   6)
+* arguments, to program <4>:             GETARG.              (line   6)
+* arguments, to program:                 COMMAND_ARGUMENT_COUNT.
+                                                              (line   6)
+* array, add elements:                   SUM.                 (line   6)
+* array, AND:                            IALL.                (line   6)
+* array, apply condition <1>:            ANY.                 (line   6)
+* array, apply condition:                ALL.                 (line   6)
+* array, bounds checking:                Code Gen Options.    (line 157)
+* array, change dimensions:              RESHAPE.             (line   6)
+* array, combine arrays:                 MERGE.               (line   6)
+* array, condition testing <1>:          ANY.                 (line   6)
+* array, condition testing:              ALL.                 (line   6)
+* array, conditionally add elements:     SUM.                 (line   6)
+* array, conditionally count elements:   COUNT.               (line   6)
+* array, conditionally multiply elements: PRODUCT.            (line   6)
+* array, constructors:                   Fortran 2003 status. (line  68)
+* array, count elements:                 SIZE.                (line   6)
+* array, duplicate dimensions:           SPREAD.              (line   6)
+* array, duplicate elements:             SPREAD.              (line   6)
+* array, element counting:               COUNT.               (line   6)
+* array, gather elements:                PACK.                (line   6)
+* array, increase dimension <1>:         UNPACK.              (line   6)
+* array, increase dimension:             SPREAD.              (line   6)
+* array, indices of type real:           Real array indices.  (line   6)
+* array, location of maximum element:    MAXLOC.              (line   6)
+* array, location of minimum element:    MINLOC.              (line   6)
+* array, lower bound:                    LBOUND.              (line   6)
+* array, maximum value:                  MAXVAL.              (line   6)
+* array, merge arrays:                   MERGE.               (line   6)
+* array, minimum value:                  MINVAL.              (line   6)
+* array, multiply elements:              PRODUCT.             (line   6)
+* array, number of elements <1>:         SIZE.                (line   6)
+* array, number of elements:             COUNT.               (line   6)
+* array, OR:                             IANY.                (line   6)
+* array, packing:                        PACK.                (line   6)
+* array, parity:                         IPARITY.             (line   6)
+* array, permutation:                    CSHIFT.              (line   6)
+* array, product:                        PRODUCT.             (line   6)
+* array, reduce dimension:               PACK.                (line   6)
+* array, rotate:                         CSHIFT.              (line   6)
+* array, scatter elements:               UNPACK.              (line   6)
+* array, shape:                          SHAPE.               (line   6)
+* array, shift:                          EOSHIFT.             (line   6)
+* array, shift circularly:               CSHIFT.              (line   6)
+* array, size:                           SIZE.                (line   6)
+* array, sum:                            SUM.                 (line   6)
+* array, transmogrify:                   RESHAPE.             (line   6)
+* array, transpose:                      TRANSPOSE.           (line   6)
+* array, unpacking:                      UNPACK.              (line   6)
+* array, upper bound:                    UBOUND.              (line   6)
+* array, XOR:                            IPARITY.             (line   6)
+* ASCII collating sequence <1>:          IACHAR.              (line   6)
+* ASCII collating sequence:              ACHAR.               (line   6)
+* ASIN:                                  ASIN.                (line   6)
+* ASINH:                                 ASINH.               (line   6)
+* ASSOCIATED:                            ASSOCIATED.          (line   6)
+* association status:                    ASSOCIATED.          (line   6)
+* association status, C pointer:         C_ASSOCIATED.        (line   6)
+* ATAN:                                  ATAN.                (line   6)
+* ATAN2:                                 ATAN2.               (line   6)
+* ATANH:                                 ATANH.               (line   6)
+* Authors:                               Contributors.        (line   6)
+* backslash:                             Fortran Dialect Options.
+                                                              (line  60)
+* backtrace:                             Debugging Options.   (line  41)
+* base 10 logarithm function:            LOG10.               (line   6)
+* BESJ0:                                 BESSEL_J0.           (line   6)
+* BESJ1:                                 BESSEL_J1.           (line   6)
+* BESJN:                                 BESSEL_JN.           (line   6)
+* Bessel function, first kind <1>:       BESSEL_JN.           (line   6)
+* Bessel function, first kind <2>:       BESSEL_J1.           (line   6)
+* Bessel function, first kind:           BESSEL_J0.           (line   6)
+* Bessel function, second kind <1>:      BESSEL_YN.           (line   6)
+* Bessel function, second kind <2>:      BESSEL_Y1.           (line   6)
+* Bessel function, second kind:          BESSEL_Y0.           (line   6)
+* BESSEL_J0:                             BESSEL_J0.           (line   6)
+* BESSEL_J1:                             BESSEL_J1.           (line   6)
+* BESSEL_JN:                             BESSEL_JN.           (line   6)
+* BESSEL_Y0:                             BESSEL_Y0.           (line   6)
+* BESSEL_Y1:                             BESSEL_Y1.           (line   6)
+* BESSEL_YN:                             BESSEL_YN.           (line   6)
+* BESY0:                                 BESSEL_Y0.           (line   6)
+* BESY1:                                 BESSEL_Y1.           (line   6)
+* BESYN:                                 BESSEL_YN.           (line   6)
+* BGE:                                   BGE.                 (line   6)
+* BGT:                                   BGT.                 (line   6)
+* binary representation <1>:             POPPAR.              (line   6)
+* binary representation:                 POPCNT.              (line   6)
+* BIT_SIZE:                              BIT_SIZE.            (line   6)
+* bits set:                              POPCNT.              (line   6)
+* bits, AND of array elements:           IALL.                (line   6)
+* bits, clear:                           IBCLR.               (line   6)
+* bits, extract:                         IBITS.               (line   6)
+* bits, get:                             IBITS.               (line   6)
+* bits, merge:                           MERGE_BITS.          (line   6)
+* bits, move <1>:                        TRANSFER.            (line   6)
+* bits, move:                            MVBITS.              (line   6)
+* bits, negate:                          NOT.                 (line   6)
+* bits, number of:                       BIT_SIZE.            (line   6)
+* bits, OR of array elements:            IANY.                (line   6)
+* bits, set:                             IBSET.               (line   6)
+* bits, shift:                           ISHFT.               (line   6)
+* bits, shift circular:                  ISHFTC.              (line   6)
+* bits, shift left <1>:                  SHIFTL.              (line   6)
+* bits, shift left:                      LSHIFT.              (line   6)
+* bits, shift right <1>:                 SHIFTR.              (line   6)
+* bits, shift right <2>:                 SHIFTA.              (line   6)
+* bits, shift right:                     RSHIFT.              (line   6)
+* bits, testing:                         BTEST.               (line   6)
+* bits, unset:                           IBCLR.               (line   6)
+* bits, XOR of array elements:           IPARITY.             (line   6)
+* bitwise comparison <1>:                BLT.                 (line   6)
+* bitwise comparison <2>:                BLE.                 (line   6)
+* bitwise comparison <3>:                BGT.                 (line   6)
+* bitwise comparison:                    BGE.                 (line   6)
+* bitwise logical and <1>:               IAND.                (line   6)
+* bitwise logical and:                   AND.                 (line   6)
+* bitwise logical exclusive or <1>:      XOR.                 (line   6)
+* bitwise logical exclusive or:          IEOR.                (line   6)
+* bitwise logical not:                   NOT.                 (line   6)
+* bitwise logical or <1>:                OR.                  (line   6)
+* bitwise logical or:                    IOR.                 (line   6)
+* BLE:                                   BLE.                 (line   6)
+* BLT:                                   BLT.                 (line   6)
+* bounds checking:                       Code Gen Options.    (line 157)
+* BOZ literal constants:                 BOZ literal constants.
+                                                              (line   6)
+* BTEST:                                 BTEST.               (line   6)
+* C_ASSOCIATED:                          C_ASSOCIATED.        (line   6)
+* C_F_POINTER:                           C_F_POINTER.         (line   6)
+* C_F_PROCPOINTER:                       C_F_PROCPOINTER.     (line   6)
+* C_FUNLOC:                              C_FUNLOC.            (line   6)
+* C_LOC:                                 C_LOC.               (line   6)
+* C_SIZEOF:                              C_SIZEOF.            (line   6)
+* CABS:                                  ABS.                 (line   6)
+* calling convention:                    Code Gen Options.    (line  25)
+* CCOS:                                  COS.                 (line   6)
+* CDABS:                                 ABS.                 (line   6)
+* CDCOS:                                 COS.                 (line   6)
+* CDEXP:                                 EXP.                 (line   6)
+* CDLOG:                                 LOG.                 (line   6)
+* CDSIN:                                 SIN.                 (line   6)
+* CDSQRT:                                SQRT.                (line   6)
+* ceiling:                               CEILING.             (line   6)
+* CEILING:                               CEILING.             (line   6)
+* ceiling:                               ANINT.               (line   6)
+* CEXP:                                  EXP.                 (line   6)
+* CHAR:                                  CHAR.                (line   6)
+* character kind:                        SELECTED_CHAR_KIND.  (line   6)
+* character set:                         Fortran Dialect Options.
+                                                              (line  54)
+* CHDIR:                                 CHDIR.               (line   6)
+* checking array temporaries:            Code Gen Options.    (line 157)
+* checking subscripts:                   Code Gen Options.    (line 157)
+* CHMOD:                                 CHMOD.               (line   6)
+* clock ticks <1>:                       SYSTEM_CLOCK.        (line   6)
+* clock ticks <2>:                       MCLOCK8.             (line   6)
+* clock ticks:                           MCLOCK.              (line   6)
+* CLOG:                                  LOG.                 (line   6)
+* CMPLX:                                 CMPLX.               (line   6)
+* coarray, IMAGE_INDEX:                  IMAGE_INDEX.         (line   6)
+* coarray, lower bound:                  LCOBOUND.            (line   6)
+* coarray, NUM_IMAGES:                   NUM_IMAGES.          (line   6)
+* coarray, THIS_IMAGE:                   THIS_IMAGE.          (line   6)
+* coarray, upper bound:                  UCOBOUND.            (line   6)
+* coarrays:                              Code Gen Options.    (line 147)
+* code generation, conventions:          Code Gen Options.    (line   6)
+* collating sequence, ASCII <1>:         IACHAR.              (line   6)
+* collating sequence, ASCII:             ACHAR.               (line   6)
+* command line:                          EXECUTE_COMMAND_LINE.
+                                                              (line   6)
+* command options:                       Invoking GNU Fortran.
+                                                              (line   6)
+* command-line arguments <1>:            IARGC.               (line   6)
+* command-line arguments <2>:            GET_COMMAND_ARGUMENT.
+                                                              (line   6)
+* command-line arguments <3>:            GET_COMMAND.         (line   6)
+* command-line arguments <4>:            GETARG.              (line   6)
+* command-line arguments:                COMMAND_ARGUMENT_COUNT.
+                                                              (line   6)
+* command-line arguments, number of <1>: IARGC.               (line   6)
+* command-line arguments, number of:     COMMAND_ARGUMENT_COUNT.
+                                                              (line   6)
+* COMMAND_ARGUMENT_COUNT:                COMMAND_ARGUMENT_COUNT.
+                                                              (line   6)
+* compiler flags inquiry function:       COMPILER_OPTIONS.    (line   6)
+* compiler, name and version:            COMPILER_VERSION.    (line   6)
+* COMPILER_OPTIONS:                      COMPILER_OPTIONS.    (line   6)
+* COMPILER_VERSION:                      COMPILER_VERSION.    (line   6)
+* COMPLEX:                               COMPLEX.             (line   6)
+* complex conjugate:                     CONJG.               (line   6)
+* Complex function:                      Alternate complex function syntax.
+                                                              (line   6)
+* complex numbers, conversion to <1>:    DCMPLX.              (line   6)
+* complex numbers, conversion to <2>:    COMPLEX.             (line   6)
+* complex numbers, conversion to:        CMPLX.               (line   6)
+* complex numbers, imaginary part:       AIMAG.               (line   6)
+* complex numbers, real part <1>:        REAL.                (line   6)
+* complex numbers, real part:            DREAL.               (line   6)
+* Conditional compilation:               Preprocessing and conditional compilation.
+                                                              (line   6)
+* CONJG:                                 CONJG.               (line   6)
+* Contributing:                          Contributing.        (line   6)
+* Contributors:                          Contributors.        (line   6)
+* conversion:                            Error and Warning Options.
+                                                              (line 105)
+* conversion, to character:              CHAR.                (line   6)
+* conversion, to complex <1>:            DCMPLX.              (line   6)
+* conversion, to complex <2>:            COMPLEX.             (line   6)
+* conversion, to complex:                CMPLX.               (line   6)
+* conversion, to integer <1>:            LONG.                (line   6)
+* conversion, to integer <2>:            INT8.                (line   6)
+* conversion, to integer <3>:            INT2.                (line   6)
+* conversion, to integer <4>:            INT.                 (line   6)
+* conversion, to integer <5>:            ICHAR.               (line   6)
+* conversion, to integer <6>:            IACHAR.              (line   6)
+* conversion, to integer:                Implicitly convert LOGICAL and INTEGER values.
+                                                              (line   6)
+* conversion, to logical <1>:            LOGICAL.             (line   6)
+* conversion, to logical:                Implicitly convert LOGICAL and INTEGER values.
+                                                              (line   6)
+* conversion, to real <1>:               REAL.                (line   6)
+* conversion, to real:                   DBLE.                (line   6)
+* conversion, to string:                 CTIME.               (line   6)
+* CONVERT specifier:                     CONVERT specifier.   (line   6)
+* core, dump <1>:                        ABORT.               (line   6)
+* core, dump:                            Debugging Options.   (line  48)
+* COS:                                   COS.                 (line   6)
+* COSH:                                  COSH.                (line   6)
+* cosine:                                COS.                 (line   6)
+* cosine, hyperbolic:                    COSH.                (line   6)
+* cosine, hyperbolic, inverse:           ACOSH.               (line   6)
+* cosine, inverse:                       ACOS.                (line   6)
+* COUNT:                                 COUNT.               (line   6)
+* CPP <1>:                               Preprocessing Options.
+                                                              (line   6)
+* CPP:                                   Preprocessing and conditional compilation.
+                                                              (line   6)
+* CPU_TIME:                              CPU_TIME.            (line   6)
+* Credits:                               Contributors.        (line   6)
+* CSHIFT:                                CSHIFT.              (line   6)
+* CSIN:                                  SIN.                 (line   6)
+* CSQRT:                                 SQRT.                (line   6)
+* CTIME:                                 CTIME.               (line   6)
+* current date <1>:                      IDATE.               (line   6)
+* current date <2>:                      FDATE.               (line   6)
+* current date:                          DATE_AND_TIME.       (line   6)
+* current time <1>:                      TIME8.               (line   6)
+* current time <2>:                      TIME.                (line   6)
+* current time <3>:                      ITIME.               (line   6)
+* current time <4>:                      FDATE.               (line   6)
+* current time:                          DATE_AND_TIME.       (line   6)
+* DABS:                                  ABS.                 (line   6)
+* DACOS:                                 ACOS.                (line   6)
+* DACOSH:                                ACOSH.               (line   6)
+* DASIN:                                 ASIN.                (line   6)
+* DASINH:                                ASINH.               (line   6)
+* DATAN:                                 ATAN.                (line   6)
+* DATAN2:                                ATAN2.               (line   6)
+* DATANH:                                ATANH.               (line   6)
+* date, current <1>:                     IDATE.               (line   6)
+* date, current <2>:                     FDATE.               (line   6)
+* date, current:                         DATE_AND_TIME.       (line   6)
+* DATE_AND_TIME:                         DATE_AND_TIME.       (line   6)
+* DBESJ0:                                BESSEL_J0.           (line   6)
+* DBESJ1:                                BESSEL_J1.           (line   6)
+* DBESJN:                                BESSEL_JN.           (line   6)
+* DBESY0:                                BESSEL_Y0.           (line   6)
+* DBESY1:                                BESSEL_Y1.           (line   6)
+* DBESYN:                                BESSEL_YN.           (line   6)
+* DBLE:                                  DBLE.                (line   6)
+* DCMPLX:                                DCMPLX.              (line   6)
+* DCONJG:                                CONJG.               (line   6)
+* DCOS:                                  COS.                 (line   6)
+* DCOSH:                                 COSH.                (line   6)
+* DDIM:                                  DIM.                 (line   6)
+* debugging information options:         Debugging Options.   (line   6)
+* debugging, preprocessor:               Preprocessing Options.
+                                                              (line  26)
+* DECODE:                                ENCODE and DECODE statements.
+                                                              (line   6)
+* delayed execution <1>:                 SLEEP.               (line   6)
+* delayed execution:                     ALARM.               (line   6)
+* DEXP:                                  EXP.                 (line   6)
+* DFLOAT:                                REAL.                (line   6)
+* DGAMMA:                                GAMMA.               (line   6)
+* dialect options:                       Fortran Dialect Options.
+                                                              (line   6)
+* DIGITS:                                DIGITS.              (line   6)
+* DIM:                                   DIM.                 (line   6)
+* DIMAG:                                 AIMAG.               (line   6)
+* DINT:                                  AINT.                (line   6)
+* directive, INCLUDE:                    Directory Options.   (line   6)
+* directory, options:                    Directory Options.   (line   6)
+* directory, search paths for inclusion: Directory Options.   (line  14)
+* division, modulo:                      MODULO.              (line   6)
+* division, remainder:                   MOD.                 (line   6)
+* DLGAMA:                                LOG_GAMMA.           (line   6)
+* DLOG:                                  LOG.                 (line   6)
+* DLOG10:                                LOG10.               (line   6)
+* DMAX1:                                 MAX.                 (line   6)
+* DMIN1:                                 MIN.                 (line   6)
+* DMOD:                                  MOD.                 (line   6)
+* DNINT:                                 ANINT.               (line   6)
+* dot product:                           DOT_PRODUCT.         (line   6)
+* DOT_PRODUCT:                           DOT_PRODUCT.         (line   6)
+* DPROD:                                 DPROD.               (line   6)
+* DREAL:                                 DREAL.               (line   6)
+* DSHIFTL:                               DSHIFTL.             (line   6)
+* DSHIFTR:                               DSHIFTR.             (line   6)
+* DSIGN:                                 SIGN.                (line   6)
+* DSIN:                                  SIN.                 (line   6)
+* DSINH:                                 SINH.                (line   6)
+* DSQRT:                                 SQRT.                (line   6)
+* DTAN:                                  TAN.                 (line   6)
+* DTANH:                                 TANH.                (line   6)
+* DTIME:                                 DTIME.               (line   6)
+* dummy argument, unused:                Error and Warning Options.
+                                                              (line 173)
+* elapsed time <1>:                      SECOND.              (line   6)
+* elapsed time <2>:                      SECNDS.              (line   6)
+* elapsed time:                          DTIME.               (line   6)
+* ENCODE:                                ENCODE and DECODE statements.
+                                                              (line   6)
+* ENUM statement:                        Fortran 2003 status. (line  83)
+* ENUMERATOR statement:                  Fortran 2003 status. (line  83)
+* environment variable <1>:              GET_ENVIRONMENT_VARIABLE.
+                                                              (line   6)
+* environment variable <2>:              GETENV.              (line   6)
+* environment variable <3>:              Runtime.             (line   6)
+* environment variable:                  Environment Variables.
+                                                              (line   6)
+* EOSHIFT:                               EOSHIFT.             (line   6)
+* EPSILON:                               EPSILON.             (line   6)
+* ERF:                                   ERF.                 (line   6)
+* ERFC:                                  ERFC.                (line   6)
+* ERFC_SCALED:                           ERFC_SCALED.         (line   6)
+* error function:                        ERF.                 (line   6)
+* error function, complementary:         ERFC.                (line   6)
+* error function, complementary, exponentially-scaled: ERFC_SCALED.
+                                                              (line   6)
+* errors, limiting:                      Error and Warning Options.
+                                                              (line  27)
+* escape characters:                     Fortran Dialect Options.
+                                                              (line  60)
+* ETIME:                                 ETIME.               (line   6)
+* Euclidean distance:                    HYPOT.               (line   6)
+* Euclidean vector norm:                 NORM2.               (line   6)
+* EXECUTE_COMMAND_LINE:                  EXECUTE_COMMAND_LINE.
+                                                              (line   6)
+* EXIT:                                  EXIT.                (line   6)
+* EXP:                                   EXP.                 (line   6)
+* EXPONENT:                              EXPONENT.            (line   6)
+* exponential function:                  EXP.                 (line   6)
+* exponential function, inverse <1>:     LOG10.               (line   6)
+* exponential function, inverse:         LOG.                 (line   6)
+* expression size <1>:                   SIZEOF.              (line   6)
+* expression size:                       C_SIZEOF.            (line   6)
+* EXTENDS_TYPE_OF:                       EXTENDS_TYPE_OF.     (line   6)
+* extensions:                            Extensions.          (line   6)
+* extensions, implemented:               Extensions implemented in GNU Fortran.
+                                                              (line   6)
+* extensions, not implemented:           Extensions not implemented in GNU Fortran.
+                                                              (line   6)
+* f2c calling convention:                Code Gen Options.    (line  25)
+* Factorial function:                    GAMMA.               (line   6)
+* FDATE:                                 FDATE.               (line   6)
+* FDL, GNU Free Documentation License:   GNU Free Documentation License.
+                                                              (line   6)
+* FGET:                                  FGET.                (line   6)
+* FGETC:                                 FGETC.               (line   6)
+* file format, fixed:                    Fortran Dialect Options.
+                                                              (line  11)
+* file format, free:                     Fortran Dialect Options.
+                                                              (line  11)
+* file operation, file number:           FNUM.                (line   6)
+* file operation, flush:                 FLUSH.               (line   6)
+* file operation, position <1>:          FTELL.               (line   6)
+* file operation, position:              FSEEK.               (line   6)
+* file operation, read character <1>:    FGETC.               (line   6)
+* file operation, read character:        FGET.                (line   6)
+* file operation, seek:                  FSEEK.               (line   6)
+* file operation, write character <1>:   FPUTC.               (line   6)
+* file operation, write character:       FPUT.                (line   6)
+* file system, access mode:              ACCESS.              (line   6)
+* file system, change access mode:       CHMOD.               (line   6)
+* file system, create link <1>:          SYMLNK.              (line   6)
+* file system, create link:              LINK.                (line   6)
+* file system, file creation mask:       UMASK.               (line   6)
+* file system, file status <1>:          STAT.                (line   6)
+* file system, file status <2>:          LSTAT.               (line   6)
+* file system, file status:              FSTAT.               (line   6)
+* file system, hard link:                LINK.                (line   6)
+* file system, remove file:              UNLINK.              (line   6)
+* file system, rename file:              RENAME.              (line   6)
+* file system, soft link:                SYMLNK.              (line   6)
+* flags inquiry function:                COMPILER_OPTIONS.    (line   6)
+* FLOAT:                                 REAL.                (line   6)
+* floating point, exponent:              EXPONENT.            (line   6)
+* floating point, fraction:              FRACTION.            (line   6)
+* floating point, nearest different:     NEAREST.             (line   6)
+* floating point, relative spacing <1>:  SPACING.             (line   6)
+* floating point, relative spacing:      RRSPACING.           (line   6)
+* floating point, scale:                 SCALE.               (line   6)
+* floating point, set exponent:          SET_EXPONENT.        (line   6)
+* floor:                                 FLOOR.               (line   6)
+* FLOOR:                                 FLOOR.               (line   6)
+* floor:                                 AINT.                (line   6)
+* FLUSH:                                 FLUSH.               (line   6)
+* FLUSH statement:                       Fortran 2003 status. (line  79)
+* FNUM:                                  FNUM.                (line   6)
+* FORMAT:                                Variable FORMAT expressions.
+                                                              (line   6)
+* Fortran 77:                            GNU Fortran and G77. (line   6)
+* FPP:                                   Preprocessing and conditional compilation.
+                                                              (line   6)
+* FPUT:                                  FPUT.                (line   6)
+* FPUTC:                                 FPUTC.               (line   6)
+* FRACTION:                              FRACTION.            (line   6)
+* FREE:                                  FREE.                (line   6)
+* FSEEK:                                 FSEEK.               (line   6)
+* FSTAT:                                 FSTAT.               (line   6)
+* FTELL:                                 FTELL.               (line   6)
+* g77:                                   GNU Fortran and G77. (line   6)
+* g77 calling convention:                Code Gen Options.    (line  25)
+* GAMMA:                                 GAMMA.               (line   6)
+* Gamma function:                        GAMMA.               (line   6)
+* Gamma function, logarithm of:          LOG_GAMMA.           (line   6)
+* GCC:                                   GNU Fortran and GCC. (line   6)
+* GERROR:                                GERROR.              (line   6)
+* GET_COMMAND:                           GET_COMMAND.         (line   6)
+* GET_COMMAND_ARGUMENT:                  GET_COMMAND_ARGUMENT.
+                                                              (line   6)
+* GET_ENVIRONMENT_VARIABLE:              GET_ENVIRONMENT_VARIABLE.
+                                                              (line   6)
+* GETARG:                                GETARG.              (line   6)
+* GETCWD:                                GETCWD.              (line   6)
+* GETENV:                                GETENV.              (line   6)
+* GETGID:                                GETGID.              (line   6)
+* GETLOG:                                GETLOG.              (line   6)
+* GETPID:                                GETPID.              (line   6)
+* GETUID:                                GETUID.              (line   6)
+* GMTIME:                                GMTIME.              (line   6)
+* GNU Compiler Collection:               GNU Fortran and GCC. (line   6)
+* GNU Fortran command options:           Invoking GNU Fortran.
+                                                              (line   6)
+* Hollerith constants:                   Hollerith constants support.
+                                                              (line   6)
+* HOSTNM:                                HOSTNM.              (line   6)
+* HUGE:                                  HUGE.                (line   6)
+* hyperbolic cosine:                     COSH.                (line   6)
+* hyperbolic function, cosine:           COSH.                (line   6)
+* hyperbolic function, cosine, inverse:  ACOSH.               (line   6)
+* hyperbolic function, sine:             SINH.                (line   6)
+* hyperbolic function, sine, inverse:    ASINH.               (line   6)
+* hyperbolic function, tangent:          TANH.                (line   6)
+* hyperbolic function, tangent, inverse: ATANH.               (line   6)
+* hyperbolic sine:                       SINH.                (line   6)
+* hyperbolic tangent:                    TANH.                (line   6)
+* HYPOT:                                 HYPOT.               (line   6)
+* I/O item lists:                        I/O item lists.      (line   6)
+* IABS:                                  ABS.                 (line   6)
+* IACHAR:                                IACHAR.              (line   6)
+* IALL:                                  IALL.                (line   6)
+* IAND:                                  IAND.                (line   6)
+* IANY:                                  IANY.                (line   6)
+* IARGC:                                 IARGC.               (line   6)
+* IBCLR:                                 IBCLR.               (line   6)
+* IBITS:                                 IBITS.               (line   6)
+* IBSET:                                 IBSET.               (line   6)
+* ICHAR:                                 ICHAR.               (line   6)
+* IDATE:                                 IDATE.               (line   6)
+* IDIM:                                  DIM.                 (line   6)
+* IDINT:                                 INT.                 (line   6)
+* IDNINT:                                NINT.                (line   6)
+* IEEE, ISNAN:                           ISNAN.               (line   6)
+* IEOR:                                  IEOR.                (line   6)
+* IERRNO:                                IERRNO.              (line   6)
+* IFIX:                                  INT.                 (line   6)
+* IMAG:                                  AIMAG.               (line   6)
+* IMAGE_INDEX:                           IMAGE_INDEX.         (line   6)
+* images, cosubscript to image index conversion: IMAGE_INDEX. (line   6)
+* images, index of this image:           THIS_IMAGE.          (line   6)
+* images, number of:                     NUM_IMAGES.          (line   6)
+* IMAGPART:                              AIMAG.               (line   6)
+* IMPORT statement:                      Fortran 2003 status. (line 110)
+* INCLUDE directive:                     Directory Options.   (line   6)
+* inclusion, directory search paths for: Directory Options.   (line  14)
+* INDEX:                                 INDEX intrinsic.     (line   6)
+* INT:                                   INT.                 (line   6)
+* INT2:                                  INT2.                (line   6)
+* INT8:                                  INT8.                (line   6)
+* integer kind:                          SELECTED_INT_KIND.   (line   6)
+* Interoperability:                      Mixed-Language Programming.
+                                                              (line   6)
+* intrinsic:                             Error and Warning Options.
+                                                              (line 167)
+* intrinsic Modules:                     Intrinsic Modules.   (line   6)
+* intrinsic procedures:                  Intrinsic Procedures.
+                                                              (line   6)
+* Introduction:                          Top.                 (line   6)
+* inverse hyperbolic cosine:             ACOSH.               (line   6)
+* inverse hyperbolic sine:               ASINH.               (line   6)
+* inverse hyperbolic tangent:            ATANH.               (line   6)
+* IOMSG= specifier:                      Fortran 2003 status. (line  81)
+* IOR:                                   IOR.                 (line   6)
+* IOSTAT, end of file:                   IS_IOSTAT_END.       (line   6)
+* IOSTAT, end of record:                 IS_IOSTAT_EOR.       (line   6)
+* IPARITY:                               IPARITY.             (line   6)
+* IRAND:                                 IRAND.               (line   6)
+* IS_IOSTAT_END:                         IS_IOSTAT_END.       (line   6)
+* IS_IOSTAT_EOR:                         IS_IOSTAT_EOR.       (line   6)
+* ISATTY:                                ISATTY.              (line   6)
+* ISHFT:                                 ISHFT.               (line   6)
+* ISHFTC:                                ISHFTC.              (line   6)
+* ISIGN:                                 SIGN.                (line   6)
+* ISNAN:                                 ISNAN.               (line   6)
+* ISO_FORTRAN_ENV statement:             Fortran 2003 status. (line 118)
+* ITIME:                                 ITIME.               (line   6)
+* KILL:                                  KILL.                (line   6)
+* kind:                                  KIND.                (line   6)
+* KIND:                                  KIND.                (line   6)
+* kind:                                  KIND Type Parameters.
+                                                              (line   6)
+* kind, character:                       SELECTED_CHAR_KIND.  (line   6)
+* kind, integer:                         SELECTED_INT_KIND.   (line   6)
+* kind, old-style:                       Old-style kind specifications.
+                                                              (line   6)
+* kind, real:                            SELECTED_REAL_KIND.  (line   6)
+* L2 vector norm:                        NORM2.               (line   6)
+* language, dialect options:             Fortran Dialect Options.
+                                                              (line   6)
+* LBOUND:                                LBOUND.              (line   6)
+* LCOBOUND:                              LCOBOUND.            (line   6)
+* LEADZ:                                 LEADZ.               (line   6)
+* left shift, combined:                  DSHIFTL.             (line   6)
+* LEN:                                   LEN.                 (line   6)
+* LEN_TRIM:                              LEN_TRIM.            (line   6)
+* lexical comparison of strings <1>:     LLT.                 (line   6)
+* lexical comparison of strings <2>:     LLE.                 (line   6)
+* lexical comparison of strings <3>:     LGT.                 (line   6)
+* lexical comparison of strings:         LGE.                 (line   6)
+* LGAMMA:                                LOG_GAMMA.           (line   6)
+* LGE:                                   LGE.                 (line   6)
+* LGT:                                   LGT.                 (line   6)
+* libf2c calling convention:             Code Gen Options.    (line  25)
+* libgfortran initialization, set_args:  _gfortran_set_args.  (line   6)
+* libgfortran initialization, set_convert: _gfortran_set_convert.
+                                                              (line   6)
+* libgfortran initialization, set_fpe:   _gfortran_set_fpe.   (line   6)
+* libgfortran initialization, set_max_subrecord_length: _gfortran_set_max_subrecord_length.
+                                                              (line   6)
+* libgfortran initialization, set_options: _gfortran_set_options.
+                                                              (line   6)
+* libgfortran initialization, set_record_marker: _gfortran_set_record_marker.
+                                                              (line   6)
+* limits, largest number:                HUGE.                (line   6)
+* limits, smallest number:               TINY.                (line   6)
+* LINK:                                  LINK.                (line   6)
+* linking, static:                       Link Options.        (line   6)
+* LLE:                                   LLE.                 (line   6)
+* LLT:                                   LLT.                 (line   6)
+* LNBLNK:                                LNBLNK.              (line   6)
+* LOC:                                   LOC.                 (line   6)
+* location of a variable in memory:      LOC.                 (line   6)
+* LOG:                                   LOG.                 (line   6)
+* LOG10:                                 LOG10.               (line   6)
+* LOG_GAMMA:                             LOG_GAMMA.           (line   6)
+* logarithm function:                    LOG.                 (line   6)
+* logarithm function with base 10:       LOG10.               (line   6)
+* logarithm function, inverse:           EXP.                 (line   6)
+* LOGICAL:                               LOGICAL.             (line   6)
+* logical and, bitwise <1>:              IAND.                (line   6)
+* logical and, bitwise:                  AND.                 (line   6)
+* logical exclusive or, bitwise <1>:     XOR.                 (line   6)
+* logical exclusive or, bitwise:         IEOR.                (line   6)
+* logical not, bitwise:                  NOT.                 (line   6)
+* logical or, bitwise <1>:               OR.                  (line   6)
+* logical or, bitwise:                   IOR.                 (line   6)
+* logical, variable representation:      Internal representation of LOGICAL variables.
+                                                              (line   6)
+* login name:                            GETLOG.              (line   6)
+* LONG:                                  LONG.                (line   6)
+* LSHIFT:                                LSHIFT.              (line   6)
+* LSTAT:                                 LSTAT.               (line   6)
+* LTIME:                                 LTIME.               (line   6)
+* MALLOC:                                MALLOC.              (line   6)
+* mask, left justified:                  MASKL.               (line   6)
+* mask, right justified:                 MASKR.               (line   6)
+* MASKL:                                 MASKL.               (line   6)
+* MASKR:                                 MASKR.               (line   6)
+* MATMUL:                                MATMUL.              (line   6)
+* matrix multiplication:                 MATMUL.              (line   6)
+* matrix, transpose:                     TRANSPOSE.           (line   6)
+* MAX:                                   MAX.                 (line   6)
+* MAX0:                                  MAX.                 (line   6)
+* MAX1:                                  MAX.                 (line   6)
+* MAXEXPONENT:                           MAXEXPONENT.         (line   6)
+* maximum value <1>:                     MAXVAL.              (line   6)
+* maximum value:                         MAX.                 (line   6)
+* MAXLOC:                                MAXLOC.              (line   6)
+* MAXVAL:                                MAXVAL.              (line   6)
+* MCLOCK:                                MCLOCK.              (line   6)
+* MCLOCK8:                               MCLOCK8.             (line   6)
+* memory checking:                       Code Gen Options.    (line 157)
+* MERGE:                                 MERGE.               (line   6)
+* MERGE_BITS:                            MERGE_BITS.          (line   6)
+* messages, error:                       Error and Warning Options.
+                                                              (line   6)
+* messages, warning:                     Error and Warning Options.
+                                                              (line   6)
+* MIN:                                   MIN.                 (line   6)
+* MIN0:                                  MIN.                 (line   6)
+* MIN1:                                  MIN.                 (line   6)
+* MINEXPONENT:                           MINEXPONENT.         (line   6)
+* minimum value <1>:                     MINVAL.              (line   6)
+* minimum value:                         MIN.                 (line   6)
+* MINLOC:                                MINLOC.              (line   6)
+* MINVAL:                                MINVAL.              (line   6)
+* Mixed-language programming:            Mixed-Language Programming.
+                                                              (line   6)
+* MOD:                                   MOD.                 (line   6)
+* model representation, base:            RADIX.               (line   6)
+* model representation, epsilon:         EPSILON.             (line   6)
+* model representation, largest number:  HUGE.                (line   6)
+* model representation, maximum exponent: MAXEXPONENT.        (line   6)
+* model representation, minimum exponent: MINEXPONENT.        (line   6)
+* model representation, precision:       PRECISION.           (line   6)
+* model representation, radix:           RADIX.               (line   6)
+* model representation, range:           RANGE.               (line   6)
+* model representation, significant digits: DIGITS.           (line   6)
+* model representation, smallest number: TINY.                (line   6)
+* module entities:                       Fortran Dialect Options.
+                                                              (line  72)
+* module search path:                    Directory Options.   (line  14)
+* modulo:                                MODULO.              (line   6)
+* MODULO:                                MODULO.              (line   6)
+* MOVE_ALLOC:                            MOVE_ALLOC.          (line   6)
+* moving allocation:                     MOVE_ALLOC.          (line   6)
+* multiply array elements:               PRODUCT.             (line   6)
+* MVBITS:                                MVBITS.              (line   6)
+* Namelist:                              Extensions to namelist.
+                                                              (line   6)
+* natural logarithm function:            LOG.                 (line   6)
+* NEAREST:                               NEAREST.             (line   6)
+* NEW_LINE:                              NEW_LINE.            (line   6)
+* newline:                               NEW_LINE.            (line   6)
+* NINT:                                  NINT.                (line   6)
+* norm, Euclidean:                       NORM2.               (line   6)
+* NORM2:                                 NORM2.               (line   6)
+* NOT:                                   NOT.                 (line   6)
+* NULL:                                  NULL.                (line   6)
+* NUM_IMAGES:                            NUM_IMAGES.          (line   6)
+* OpenMP <1>:                            OpenMP.              (line   6)
+* OpenMP:                                Fortran Dialect Options.
+                                                              (line 110)
+* operators, unary:                      Unary operators.     (line   6)
+* options inquiry function:              COMPILER_OPTIONS.    (line   6)
+* options, code generation:              Code Gen Options.    (line   6)
+* options, debugging:                    Debugging Options.   (line   6)
+* options, dialect:                      Fortran Dialect Options.
+                                                              (line   6)
+* options, directory search:             Directory Options.   (line   6)
+* options, errors:                       Error and Warning Options.
+                                                              (line   6)
+* options, fortran dialect:              Fortran Dialect Options.
+                                                              (line  11)
+* options, gfortran command:             Invoking GNU Fortran.
+                                                              (line   6)
+* options, linking:                      Link Options.        (line   6)
+* options, negative forms:               Invoking GNU Fortran.
+                                                              (line  13)
+* options, preprocessor:                 Preprocessing Options.
+                                                              (line   6)
+* options, run-time:                     Code Gen Options.    (line   6)
+* options, runtime:                      Runtime Options.     (line   6)
+* options, warnings:                     Error and Warning Options.
+                                                              (line   6)
+* OR:                                    OR.                  (line   6)
+* output, newline:                       NEW_LINE.            (line   6)
+* PACK:                                  PACK.                (line   6)
+* parity:                                POPPAR.              (line   6)
+* Parity:                                PARITY.              (line   6)
+* PARITY:                                PARITY.              (line   6)
+* paths, search:                         Directory Options.   (line  14)
+* PERROR:                                PERROR.              (line   6)
+* pointer checking:                      Code Gen Options.    (line 157)
+* pointer, C address of pointers:        C_F_PROCPOINTER.     (line   6)
+* pointer, C address of procedures:      C_FUNLOC.            (line   6)
+* pointer, C association status:         C_ASSOCIATED.        (line   6)
+* pointer, convert C to Fortran:         C_F_POINTER.         (line   6)
+* pointer, cray <1>:                     MALLOC.              (line   6)
+* pointer, cray:                         FREE.                (line   6)
+* pointer, Cray:                         Cray pointers.       (line   6)
+* pointer, disassociated:                NULL.                (line   6)
+* pointer, status <1>:                   NULL.                (line   6)
+* pointer, status:                       ASSOCIATED.          (line   6)
+* POPCNT:                                POPCNT.              (line   6)
+* POPPAR:                                POPPAR.              (line   6)
+* positive difference:                   DIM.                 (line   6)
+* PRECISION:                             PRECISION.           (line   6)
+* Preprocessing:                         Preprocessing and conditional compilation.
+                                                              (line   6)
+* preprocessing, assertion:              Preprocessing Options.
+                                                              (line 114)
+* preprocessing, define macros:          Preprocessing Options.
+                                                              (line 153)
+* preprocessing, include path:           Preprocessing Options.
+                                                              (line  70)
+* preprocessing, keep comments:          Preprocessing Options.
+                                                              (line 123)
+* preprocessing, no linemarkers:         Preprocessing Options.
+                                                              (line 181)
+* preprocessing, undefine macros:        Preprocessing Options.
+                                                              (line 187)
+* preprocessor:                          Preprocessing Options.
+                                                              (line   6)
+* preprocessor, debugging:               Preprocessing Options.
+                                                              (line  26)
+* preprocessor, disable:                 Preprocessing Options.
+                                                              (line  12)
+* preprocessor, enable:                  Preprocessing Options.
+                                                              (line  12)
+* preprocessor, include file handling:   Preprocessing and conditional compilation.
+                                                              (line   6)
+* preprocessor, working directory:       Preprocessing Options.
+                                                              (line  55)
+* PRESENT:                               PRESENT.             (line   6)
+* private:                               Fortran Dialect Options.
+                                                              (line  72)
+* procedure pointer, convert C to Fortran: C_LOC.             (line   6)
+* process ID:                            GETPID.              (line   6)
+* PRODUCT:                               PRODUCT.             (line   6)
+* product, double-precision:             DPROD.               (line   6)
+* product, matrix:                       MATMUL.              (line   6)
+* product, vector:                       DOT_PRODUCT.         (line   6)
+* program termination:                   EXIT.                (line   6)
+* program termination, with core dump:   ABORT.               (line   6)
+* PROTECTED statement:                   Fortran 2003 status. (line 104)
+* Q exponent-letter:                     Q exponent-letter.   (line   6)
+* RADIX:                                 RADIX.               (line   6)
+* radix, real:                           SELECTED_REAL_KIND.  (line   6)
+* RAN:                                   RAN.                 (line   6)
+* RAND:                                  RAND.                (line   6)
+* random number generation <1>:          RANDOM_NUMBER.       (line   6)
+* random number generation <2>:          RAND.                (line   6)
+* random number generation <3>:          RAN.                 (line   6)
+* random number generation:              IRAND.               (line   6)
+* random number generation, seeding <1>: SRAND.               (line   6)
+* random number generation, seeding:     RANDOM_SEED.         (line   6)
+* RANDOM_NUMBER:                         RANDOM_NUMBER.       (line   6)
+* RANDOM_SEED:                           RANDOM_SEED.         (line   6)
+* RANGE:                                 RANGE.               (line   6)
+* range checking:                        Code Gen Options.    (line 157)
+* re-association of parenthesized expressions: Code Gen Options.
+                                                              (line 330)
+* read character, stream mode <1>:       FGETC.               (line   6)
+* read character, stream mode:           FGET.                (line   6)
+* REAL:                                  REAL.                (line   6)
+* real kind:                             SELECTED_REAL_KIND.  (line   6)
+* real number, exponent:                 EXPONENT.            (line   6)
+* real number, fraction:                 FRACTION.            (line   6)
+* real number, nearest different:        NEAREST.             (line   6)
+* real number, relative spacing <1>:     SPACING.             (line   6)
+* real number, relative spacing:         RRSPACING.           (line   6)
+* real number, scale:                    SCALE.               (line   6)
+* real number, set exponent:             SET_EXPONENT.        (line   6)
+* Reallocate the LHS in assignments:     Code Gen Options.    (line 338)
+* REALPART:                              REAL.                (line   6)
+* RECORD:                                STRUCTURE and RECORD.
+                                                              (line   6)
+* Reduction, XOR:                        PARITY.              (line   6)
+* remainder:                             MOD.                 (line   6)
+* RENAME:                                RENAME.              (line   6)
+* repacking arrays:                      Code Gen Options.    (line 250)
+* REPEAT:                                REPEAT.              (line   6)
+* RESHAPE:                               RESHAPE.             (line   6)
+* right shift, combined:                 DSHIFTR.             (line   6)
+* root:                                  SQRT.                (line   6)
+* rounding, ceiling <1>:                 CEILING.             (line   6)
+* rounding, ceiling:                     ANINT.               (line   6)
+* rounding, floor <1>:                   FLOOR.               (line   6)
+* rounding, floor:                       AINT.                (line   6)
+* rounding, nearest whole number:        NINT.                (line   6)
+* RRSPACING:                             RRSPACING.           (line   6)
+* RSHIFT:                                RSHIFT.              (line   6)
+* run-time checking:                     Code Gen Options.    (line 157)
+* SAME_TYPE_AS:                          SAME_TYPE_AS.        (line   6)
+* SAVE statement:                        Code Gen Options.    (line  15)
+* SCALE:                                 SCALE.               (line   6)
+* SCAN:                                  SCAN.                (line   6)
+* search path:                           Directory Options.   (line   6)
+* search paths, for included files:      Directory Options.   (line  14)
+* SECNDS:                                SECNDS.              (line   6)
+* SECOND:                                SECOND.              (line   6)
+* seeding a random number generator <1>: SRAND.               (line   6)
+* seeding a random number generator:     RANDOM_SEED.         (line   6)
+* SELECTED_CHAR_KIND:                    SELECTED_CHAR_KIND.  (line   6)
+* SELECTED_INT_KIND:                     SELECTED_INT_KIND.   (line   6)
+* SELECTED_REAL_KIND:                    SELECTED_REAL_KIND.  (line   6)
+* SET_EXPONENT:                          SET_EXPONENT.        (line   6)
+* SHAPE:                                 SHAPE.               (line   6)
+* shift, left <1>:                       SHIFTL.              (line   6)
+* shift, left:                           DSHIFTL.             (line   6)
+* shift, right <1>:                      SHIFTR.              (line   6)
+* shift, right:                          DSHIFTR.             (line   6)
+* shift, right with fill:                SHIFTA.              (line   6)
+* SHIFTA:                                SHIFTA.              (line   6)
+* SHIFTL:                                SHIFTL.              (line   6)
+* SHIFTR:                                SHIFTR.              (line   6)
+* SHORT:                                 INT2.                (line   6)
+* SIGN:                                  SIGN.                (line   6)
+* sign copying:                          SIGN.                (line   6)
+* SIGNAL:                                SIGNAL.              (line   6)
+* SIN:                                   SIN.                 (line   6)
+* sine:                                  SIN.                 (line   6)
+* sine, hyperbolic:                      SINH.                (line   6)
+* sine, hyperbolic, inverse:             ASINH.               (line   6)
+* sine, inverse:                         ASIN.                (line   6)
+* SINH:                                  SINH.                (line   6)
+* SIZE:                                  SIZE.                (line   6)
+* size of a variable, in bits:           BIT_SIZE.            (line   6)
+* size of an expression <1>:             SIZEOF.              (line   6)
+* size of an expression:                 C_SIZEOF.            (line   6)
+* SIZEOF:                                SIZEOF.              (line   6)
+* SLEEP:                                 SLEEP.               (line   6)
+* SNGL:                                  REAL.                (line   6)
+* SPACING:                               SPACING.             (line   6)
+* SPREAD:                                SPREAD.              (line   6)
+* SQRT:                                  SQRT.                (line   6)
+* square-root:                           SQRT.                (line   6)
+* SRAND:                                 SRAND.               (line   6)
+* Standards:                             Standards.           (line   6)
+* STAT:                                  STAT.                (line   6)
+* statement, ENUM:                       Fortran 2003 status. (line  83)
+* statement, ENUMERATOR:                 Fortran 2003 status. (line  83)
+* statement, FLUSH:                      Fortran 2003 status. (line  79)
+* statement, IMPORT:                     Fortran 2003 status. (line 110)
+* statement, ISO_FORTRAN_ENV:            Fortran 2003 status. (line 118)
+* statement, PROTECTED:                  Fortran 2003 status. (line 104)
+* statement, SAVE:                       Code Gen Options.    (line  15)
+* statement, USE, INTRINSIC:             Fortran 2003 status. (line 118)
+* statement, VALUE:                      Fortran 2003 status. (line 106)
+* statement, VOLATILE:                   Fortran 2003 status. (line 108)
+* storage size:                          STORAGE_SIZE.        (line   6)
+* STORAGE_SIZE:                          STORAGE_SIZE.        (line   6)
+* STREAM I/O:                            Fortran 2003 status. (line  95)
+* stream mode, read character <1>:       FGETC.               (line   6)
+* stream mode, read character:           FGET.                (line   6)
+* stream mode, write character <1>:      FPUTC.               (line   6)
+* stream mode, write character:          FPUT.                (line   6)
+* string, adjust left:                   ADJUSTL.             (line   6)
+* string, adjust right:                  ADJUSTR.             (line   6)
+* string, comparison <1>:                LLT.                 (line   6)
+* string, comparison <2>:                LLE.                 (line   6)
+* string, comparison <3>:                LGT.                 (line   6)
+* string, comparison:                    LGE.                 (line   6)
+* string, concatenate:                   REPEAT.              (line   6)
+* string, find missing set:              VERIFY.              (line   6)
+* string, find non-blank character:      LNBLNK.              (line   6)
+* string, find subset:                   SCAN.                (line   6)
+* string, find substring:                INDEX intrinsic.     (line   6)
+* string, length:                        LEN.                 (line   6)
+* string, length, without trailing whitespace: LEN_TRIM.      (line   6)
+* string, remove trailing whitespace:    TRIM.                (line   6)
+* string, repeat:                        REPEAT.              (line   6)
+* strings, varying length:               Varying Length Character Strings.
+                                                              (line   6)
+* STRUCTURE:                             STRUCTURE and RECORD.
+                                                              (line   6)
+* structure packing:                     Code Gen Options.    (line 244)
+* subscript checking:                    Code Gen Options.    (line 157)
+* substring position:                    INDEX intrinsic.     (line   6)
+* SUM:                                   SUM.                 (line   6)
+* sum array elements:                    SUM.                 (line   6)
+* suppressing warnings:                  Error and Warning Options.
+                                                              (line   6)
+* symbol names:                          Fortran Dialect Options.
+                                                              (line  54)
+* symbol names, transforming:            Code Gen Options.    (line  54)
+* symbol names, underscores:             Code Gen Options.    (line  54)
+* SYMLNK:                                SYMLNK.              (line   6)
+* syntax checking:                       Error and Warning Options.
+                                                              (line  33)
+* SYSTEM:                                SYSTEM.              (line   6)
+* system, error handling <1>:            PERROR.              (line   6)
+* system, error handling <2>:            IERRNO.              (line   6)
+* system, error handling:                GERROR.              (line   6)
+* system, group ID:                      GETGID.              (line   6)
+* system, host name:                     HOSTNM.              (line   6)
+* system, login name:                    GETLOG.              (line   6)
+* system, process ID:                    GETPID.              (line   6)
+* system, signal handling:               SIGNAL.              (line   6)
+* system, system call <1>:               SYSTEM.              (line   6)
+* system, system call:                   EXECUTE_COMMAND_LINE.
+                                                              (line   6)
+* system, terminal <1>:                  TTYNAM.              (line   6)
+* system, terminal:                      ISATTY.              (line   6)
+* system, user ID:                       GETUID.              (line   6)
+* system, working directory <1>:         GETCWD.              (line   6)
+* system, working directory:             CHDIR.               (line   6)
+* SYSTEM_CLOCK:                          SYSTEM_CLOCK.        (line   6)
+* tabulators:                            Error and Warning Options.
+                                                              (line 155)
+* TAN:                                   TAN.                 (line   6)
+* tangent:                               TAN.                 (line   6)
+* tangent, hyperbolic:                   TANH.                (line   6)
+* tangent, hyperbolic, inverse:          ATANH.               (line   6)
+* tangent, inverse <1>:                  ATAN2.               (line   6)
+* tangent, inverse:                      ATAN.                (line   6)
+* TANH:                                  TANH.                (line   6)
+* terminate program:                     EXIT.                (line   6)
+* terminate program, with core dump:     ABORT.               (line   6)
+* THIS_IMAGE:                            THIS_IMAGE.          (line   6)
+* thread-safety, threads:                Thread-safety of the runtime library.
+                                                              (line   6)
+* TIME:                                  TIME.                (line   6)
+* time, clock ticks <1>:                 SYSTEM_CLOCK.        (line   6)
+* time, clock ticks <2>:                 MCLOCK8.             (line   6)
+* time, clock ticks:                     MCLOCK.              (line   6)
+* time, conversion to GMT info:          GMTIME.              (line   6)
+* time, conversion to local time info:   LTIME.               (line   6)
+* time, conversion to string:            CTIME.               (line   6)
+* time, current <1>:                     TIME8.               (line   6)
+* time, current <2>:                     TIME.                (line   6)
+* time, current <3>:                     ITIME.               (line   6)
+* time, current <4>:                     FDATE.               (line   6)
+* time, current:                         DATE_AND_TIME.       (line   6)
+* time, elapsed <1>:                     SECOND.              (line   6)
+* time, elapsed <2>:                     SECNDS.              (line   6)
+* time, elapsed <3>:                     ETIME.               (line   6)
+* time, elapsed <4>:                     DTIME.               (line   6)
+* time, elapsed:                         CPU_TIME.            (line   6)
+* TIME8:                                 TIME8.               (line   6)
+* TINY:                                  TINY.                (line   6)
+* TR 15581:                              Fortran 2003 status. (line  88)
+* trace:                                 Debugging Options.   (line  41)
+* TRAILZ:                                TRAILZ.              (line   6)
+* TRANSFER:                              TRANSFER.            (line   6)
+* transforming symbol names:             Code Gen Options.    (line  54)
+* transpose:                             TRANSPOSE.           (line   6)
+* TRANSPOSE:                             TRANSPOSE.           (line   6)
+* trigonometric function, cosine:        COS.                 (line   6)
+* trigonometric function, cosine, inverse: ACOS.              (line   6)
+* trigonometric function, sine:          SIN.                 (line   6)
+* trigonometric function, sine, inverse: ASIN.                (line   6)
+* trigonometric function, tangent:       TAN.                 (line   6)
+* trigonometric function, tangent, inverse <1>: ATAN2.        (line   6)
+* trigonometric function, tangent, inverse: ATAN.             (line   6)
+* TRIM:                                  TRIM.                (line   6)
+* TTYNAM:                                TTYNAM.              (line   6)
+* type cast:                             TRANSFER.            (line   6)
+* UBOUND:                                UBOUND.              (line   6)
+* UCOBOUND:                              UCOBOUND.            (line   6)
+* UMASK:                                 UMASK.               (line   6)
+* underflow:                             Error and Warning Options.
+                                                              (line 163)
+* underscore:                            Code Gen Options.    (line  54)
+* UNLINK:                                UNLINK.              (line   6)
+* UNPACK:                                UNPACK.              (line   6)
+* unused dummy argument:                 Error and Warning Options.
+                                                              (line 173)
+* unused parameter:                      Error and Warning Options.
+                                                              (line 177)
+* USE, INTRINSIC statement:              Fortran 2003 status. (line 118)
+* user id:                               GETUID.              (line   6)
+* VALUE statement:                       Fortran 2003 status. (line 106)
+* Varying length character strings:      Varying Length Character Strings.
+                                                              (line   6)
+* Varying length strings:                Varying Length Character Strings.
+                                                              (line   6)
+* vector product:                        DOT_PRODUCT.         (line   6)
+* VERIFY:                                VERIFY.              (line   6)
+* version of the compiler:               COMPILER_VERSION.    (line   6)
+* VOLATILE statement:                    Fortran 2003 status. (line 108)
+* warnings, aliasing:                    Error and Warning Options.
+                                                              (line  69)
+* warnings, alignment of COMMON blocks:  Error and Warning Options.
+                                                              (line 184)
+* warnings, all:                         Error and Warning Options.
+                                                              (line  61)
+* warnings, ampersand:                   Error and Warning Options.
+                                                              (line  86)
+* warnings, array temporaries:           Error and Warning Options.
+                                                              (line  94)
+* warnings, character truncation:        Error and Warning Options.
+                                                              (line  99)
+* warnings, conversion:                  Error and Warning Options.
+                                                              (line 105)
+* warnings, implicit interface:          Error and Warning Options.
+                                                              (line 112)
+* warnings, implicit procedure:          Error and Warning Options.
+                                                              (line 118)
+* warnings, intrinsic:                   Error and Warning Options.
+                                                              (line 167)
+* warnings, intrinsics of other standards: Error and Warning Options.
+                                                              (line 122)
+* warnings, line truncation:             Error and Warning Options.
+                                                              (line 102)
+* warnings, non-standard intrinsics:     Error and Warning Options.
+                                                              (line 122)
+* warnings, q exponent-letter:           Error and Warning Options.
+                                                              (line 129)
+* warnings, suppressing:                 Error and Warning Options.
+                                                              (line   6)
+* warnings, suspicious code:             Error and Warning Options.
+                                                              (line 133)
+* warnings, tabs:                        Error and Warning Options.
+                                                              (line 155)
+* warnings, to errors:                   Error and Warning Options.
+                                                              (line 190)
+* warnings, underflow:                   Error and Warning Options.
+                                                              (line 163)
+* warnings, unused dummy argument:       Error and Warning Options.
+                                                              (line 173)
+* warnings, unused parameter:            Error and Warning Options.
+                                                              (line 177)
+* write character, stream mode <1>:      FPUTC.               (line   6)
+* write character, stream mode:          FPUT.                (line   6)
+* XOR:                                   XOR.                 (line   6)
+* XOR reduction:                         PARITY.              (line   6)
+* ZABS:                                  ABS.                 (line   6)
+* ZCOS:                                  COS.                 (line   6)
+* zero bits <1>:                         TRAILZ.              (line   6)
+* zero bits:                             LEADZ.               (line   6)
+* ZEXP:                                  EXP.                 (line   6)
+* ZLOG:                                  LOG.                 (line   6)
+* ZSIN:                                  SIN.                 (line   6)
+* ZSQRT:                                 SQRT.                (line   6)
+
+
+
+Tag Table:
+Node: Top2133
+Node: Introduction3511
+Node: About GNU Fortran4258
+Node: GNU Fortran and GCC8246
+Node: Preprocessing and conditional compilation10360
+Node: GNU Fortran and G7712004
+Node: Project Status12577
+Node: Standards15024
+Node: Varying Length Character Strings15962
+Node: Invoking GNU Fortran16498
+Node: Option Summary18221
+Node: Fortran Dialect Options21923
+Node: Preprocessing Options28959
+Node: Error and Warning Options37189
+Node: Debugging Options45282
+Node: Directory Options47898
+Node: Link Options49333
+Node: Runtime Options49957
+Node: Code Gen Options52207
+Node: Environment Variables67557
+Node: Runtime68162
+Node: GFORTRAN_STDIN_UNIT69390
+Node: GFORTRAN_STDOUT_UNIT69757
+Node: GFORTRAN_STDERR_UNIT70158
+Node: GFORTRAN_USE_STDERR70556
+Node: GFORTRAN_TMPDIR71002
+Node: GFORTRAN_UNBUFFERED_ALL71453
+Node: GFORTRAN_UNBUFFERED_PRECONNECTED71977
+Node: GFORTRAN_SHOW_LOCUS72619
+Node: GFORTRAN_OPTIONAL_PLUS73114
+Node: GFORTRAN_DEFAULT_RECL73590
+Node: GFORTRAN_LIST_SEPARATOR74081
+Node: GFORTRAN_CONVERT_UNIT74690
+Node: GFORTRAN_ERROR_DUMPCORE77552
+Node: GFORTRAN_ERROR_BACKTRACE78101
+Node: Fortran 2003 and 2008 status78653
+Node: Fortran 2003 status78893
+Node: Fortran 2008 status83540
+Node: Compiler Characteristics88194
+Node: KIND Type Parameters88710
+Node: Internal representation of LOGICAL variables89960
+Node: Thread-safety of the runtime library91317
+Node: Extensions92704
+Node: Extensions implemented in GNU Fortran93305
+Node: Old-style kind specifications94663
+Node: Old-style variable initialization95770
+Node: Extensions to namelist97082
+Node: X format descriptor without count field99079
+Node: Commas in FORMAT specifications99606
+Node: Missing period in FORMAT specifications100123
+Node: I/O item lists100685
+Node: `Q' exponent-letter101074
+Node: BOZ literal constants101680
+Node: Real array indices104255
+Node: Unary operators104552
+Node: Implicitly convert LOGICAL and INTEGER values104966
+Node: Hollerith constants support105926
+Node: Cray pointers107698
+Node: CONVERT specifier113145
+Node: OpenMP115143
+Node: Argument list functions117394
+Node: Extensions not implemented in GNU Fortran119000
+Node: STRUCTURE and RECORD119922
+Node: ENCODE and DECODE statements121979
+Node: Variable FORMAT expressions123338
+Node: Alternate complex function syntax124443
+Node: Mixed-Language Programming124963
+Node: Interoperability with C125507
+Node: Intrinsic Types126845
+Node: Derived Types and struct127360
+Node: Interoperable Global Variables128716
+Node: Interoperable Subroutines and Functions129992
+Node: Working with Pointers133605
+Node: Further Interoperability of Fortran with C137922
+Node: GNU Fortran Compiler Directives138904
+Node: Non-Fortran Main Program141105
+Node: _gfortran_set_args143247
+Node: _gfortran_set_options144182
+Node: _gfortran_set_convert147088
+Node: _gfortran_set_record_marker147952
+Node: _gfortran_set_fpe148777
+Node: _gfortran_set_max_subrecord_length149991
+Node: Intrinsic Procedures150947
+Node: Introduction to Intrinsics166178
+Node: ABORT168530
+Node: ABS169287
+Node: ACCESS170904
+Node: ACHAR172825
+Node: ACOS174026
+Node: ACOSH175263
+Node: ADJUSTL176251
+Node: ADJUSTR177192
+Node: AIMAG178139
+Node: AINT179520
+Node: ALARM181107
+Node: ALL182741
+Node: ALLOCATED184659
+Node: AND185796
+Node: ANINT187093
+Node: ANY188571
+Node: ASIN190501
+Node: ASINH191727
+Node: ASSOCIATED192725
+Node: ATAN195730
+Node: ATAN2197149
+Node: ATANH198784
+Node: BESSEL_J0199780
+Node: BESSEL_J1200824
+Node: BESSEL_JN201876
+Node: BESSEL_Y0203758
+Node: BESSEL_Y1204758
+Node: BESSEL_YN205758
+Node: BGE207590
+Node: BGT208279
+Node: BIT_SIZE208926
+Node: BLE209747
+Node: BLT210426
+Node: BTEST211061
+Node: C_ASSOCIATED211944
+Node: C_FUNLOC213153
+Node: C_F_PROCPOINTER214522
+Node: C_F_POINTER216023
+Node: C_LOC217441
+Node: C_SIZEOF218718
+Node: CEILING220127
+Node: CHAR221132
+Node: CHDIR222336
+Node: CHMOD223504
+Node: CMPLX225299
+Node: COMMAND_ARGUMENT_COUNT226763
+Node: COMPILER_OPTIONS227677
+Node: COMPILER_VERSION228690
+Node: COMPLEX229658
+Node: CONJG230812
+Node: COS231892
+Node: COSH233338
+Node: COUNT234503
+Node: CPU_TIME236519
+Node: CSHIFT237873
+Node: CTIME239529
+Node: DATE_AND_TIME241182
+Node: DBLE243643
+Node: DCMPLX244436
+Node: DIGITS245630
+Node: DIM246596
+Node: DOT_PRODUCT247854
+Node: DPROD249510
+Node: DREAL250427
+Node: DSHIFTL251093
+Node: DSHIFTR251886
+Node: DTIME252680
+Node: EOSHIFT255483
+Node: EPSILON257556
+Node: ERF258282
+Node: ERFC259056
+Node: ERFC_SCALED259860
+Node: ETIME260552
+Node: EXECUTE_COMMAND_LINE262793
+Node: EXIT265373
+Node: EXP266247
+Node: EXPONENT267520
+Node: EXTENDS_TYPE_OF268280
+Node: FDATE269133
+Node: FGET270615
+Node: FGETC272433
+Node: FLOOR274232
+Node: FLUSH275216
+Node: FNUM277091
+Node: FPUT277813
+Node: FPUTC279438
+Node: FRACTION281209
+Node: FREE282110
+Node: FSEEK282945
+Node: FSTAT285239
+Node: FTELL286319
+Node: GAMMA287297
+Node: GERROR288338
+Node: GETARG289057
+Node: GET_COMMAND290821
+Node: GET_COMMAND_ARGUMENT292185
+Node: GETCWD294219
+Node: GETENV295191
+Node: GET_ENVIRONMENT_VARIABLE296614
+Node: GETGID298767
+Node: GETLOG299304
+Node: GETPID300164
+Node: GETUID300894
+Node: GMTIME301410
+Node: HOSTNM302899
+Node: HUGE303817
+Node: HYPOT304538
+Node: IACHAR305358
+Node: IALL306538
+Node: IAND308015
+Node: IANY308999
+Node: IARGC310485
+Node: IBCLR311506
+Node: IBITS312167
+Node: IBSET313082
+Node: ICHAR313738
+Node: IDATE315910
+Node: IEOR316937
+Node: IERRNO317813
+Node: IMAGE_INDEX318362
+Node: INDEX intrinsic319386
+Node: INT320927
+Node: INT2322629
+Node: INT8323394
+Node: IOR324106
+Node: IPARITY324958
+Node: IRAND326482
+Node: IS_IOSTAT_END327838
+Node: IS_IOSTAT_EOR328935
+Node: ISATTY330062
+Node: ISHFT330845
+Node: ISHFTC331825
+Node: ISNAN333041
+Node: ITIME333789
+Node: KILL334814
+Node: KIND335718
+Node: LBOUND336563
+Node: LCOBOUND337896
+Node: LEADZ339026
+Node: LEN339886
+Node: LEN_TRIM341167
+Node: LGE342149
+Node: LGT343651
+Node: LINK345118
+Node: LLE346153
+Node: LLT347647
+Node: LNBLNK349107
+Node: LOC349883
+Node: LOG350614
+Node: LOG10352017
+Node: LOG_GAMMA352991
+Node: LOGICAL354080
+Node: LONG354888
+Node: LSHIFT355644
+Node: LSTAT356729
+Node: LTIME357923
+Node: MALLOC359334
+Node: MASKL360793
+Node: MASKR361556
+Node: MATMUL362322
+Node: MAX363411
+Node: MAXEXPONENT364910
+Node: MAXLOC365726
+Node: MAXVAL367745
+Node: MCLOCK369378
+Node: MCLOCK8370381
+Node: MERGE371593
+Node: MERGE_BITS372342
+Node: MIN373203
+Node: MINEXPONENT374704
+Node: MINLOC375334
+Node: MINVAL377353
+Node: MOD379005
+Node: MODULO380612
+Node: MOVE_ALLOC381826
+Node: MVBITS382855
+Node: NEAREST383914
+Node: NEW_LINE385037
+Node: NINT385808
+Node: NORM2387211
+Node: NOT388349
+Node: NULL388933
+Node: NUM_IMAGES389838
+Node: OR390654
+Node: PACK391938
+Node: PARITY393930
+Node: PERROR395145
+Node: PRECISION395766
+Node: POPCNT396652
+Node: POPPAR397523
+Node: PRESENT398574
+Node: PRODUCT399680
+Node: RADIX401205
+Node: RAN402027
+Node: RAND402483
+Node: RANDOM_NUMBER403815
+Node: RANDOM_SEED405533
+Node: RANGE407418
+Node: REAL408106
+Node: RENAME409880
+Node: REPEAT410899
+Node: RESHAPE411625
+Node: RRSPACING413094
+Node: RSHIFT413787
+Node: SAME_TYPE_AS414925
+Node: SCALE415755
+Node: SCAN416535
+Node: SECNDS418085
+Node: SECOND419173
+Node: SELECTED_CHAR_KIND420049
+Node: SELECTED_INT_KIND421640
+Node: SELECTED_REAL_KIND422815
+Node: SET_EXPONENT425481
+Node: SHAPE426477
+Node: SHIFTA427892
+Node: SHIFTL428853
+Node: SHIFTR429688
+Node: SIGN430524
+Node: SIGNAL431808
+Node: SIN433305
+Node: SINH434403
+Node: SIZE435399
+Node: SIZEOF436707
+Node: SLEEP438118
+Node: SPACING438678
+Node: SPREAD439691
+Node: SQRT440836
+Node: SRAND442190
+Node: STAT443358
+Node: STORAGE_SIZE446525
+Node: SUM447405
+Node: SYMLNK448888
+Node: SYSTEM450020
+Node: SYSTEM_CLOCK451271
+Node: TAN453429
+Node: TANH454401
+Node: THIS_IMAGE455558
+Node: TIME457050
+Node: TIME8458154
+Node: TINY459283
+Node: TRAILZ459883
+Node: TRANSFER460700
+Node: TRANSPOSE462734
+Node: TRIM463421
+Node: TTYNAM464278
+Node: UBOUND465193
+Node: UCOBOUND466583
+Node: UMASK467715
+Node: UNLINK468393
+Node: UNPACK469370
+Node: VERIFY470658
+Node: XOR472379
+Node: Intrinsic Modules473751
+Node: ISO_FORTRAN_ENV473994
+Node: ISO_C_BINDING477834
+Node: OpenMP Modules OMP_LIB and OMP_LIB_KINDS481696
+Node: Contributing483022
+Node: Contributors483874
+Node: Projects485541
+Node: Proposed Extensions486345
+Node: Copying488356
+Node: GNU Free Documentation License525920
+Node: Funding551063
+Node: Option Index553588
+Node: Keyword Index566546
+
+End Tag Table
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
new file mode 100644
index 000000000..88676cd2a
--- /dev/null
+++ b/gcc/fortran/gfortran.texi
@@ -0,0 +1,3052 @@
+\input texinfo  @c -*-texinfo-*-
+@c %**start of header
+@setfilename gfortran.info
+@set copyrights-gfortran 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+
+@include gcc-common.texi
+
+@settitle The GNU Fortran Compiler
+
+@c Create a separate index for command line options
+@defcodeindex op
+@c Merge the standard indexes into a single one.
+@syncodeindex fn cp
+@syncodeindex vr cp
+@syncodeindex ky cp
+@syncodeindex pg cp
+@syncodeindex tp cp
+
+@c TODO: The following "Part" definitions are included here temporarily
+@c until they are incorporated into the official Texinfo distribution.
+@c They borrow heavily from Texinfo's \unnchapentry definitions.
+
+@tex
+\gdef\part#1#2{%
+  \pchapsepmacro
+  \gdef\thischapter{}
+  \begingroup
+    \vglue\titlepagetopglue
+    \titlefonts \rm
+    \leftline{Part #1:@* #2}
+    \vskip4pt \hrule height 4pt width \hsize \vskip4pt
+  \endgroup
+  \writetocentry{part}{#2}{#1}
+}
+\gdef\blankpart{%
+  \writetocentry{blankpart}{}{}
+}
+% Part TOC-entry definition for summary contents.
+\gdef\dosmallpartentry#1#2#3#4{%
+  \vskip .5\baselineskip plus.2\baselineskip
+  \begingroup
+    \let\rm=\bf \rm
+    \tocentry{Part #2: #1}{\doshortpageno\bgroup#4\egroup}
+  \endgroup
+}
+\gdef\dosmallblankpartentry#1#2#3#4{%
+  \vskip .5\baselineskip plus.2\baselineskip
+}
+% Part TOC-entry definition for regular contents.  This has to be
+% equated to an existing entry to not cause problems when the PDF
+% outline is created.
+\gdef\dopartentry#1#2#3#4{%
+  \unnchapentry{Part #2: #1}{}{#3}{#4}
+}
+\gdef\doblankpartentry#1#2#3#4{}
+@end tex
+
+@c %**end of header
+
+@c Use with @@smallbook.
+
+@c %** start of document
+
+@c Cause even numbered pages to be printed on the left hand side of
+@c the page and odd numbered pages to be printed on the right hand
+@c side of the page.  Using this, you can print on both sides of a
+@c sheet of paper and have the text on the same part of the sheet.
+
+@c The text on right hand pages is pushed towards the right hand
+@c margin and the text on left hand pages is pushed toward the left
+@c hand margin.
+@c (To provide the reverse effect, set bindingoffset to -0.75in.)
+
+@c @tex
+@c \global\bindingoffset=0.75in
+@c \global\normaloffset =0.75in
+@c @end tex
+
+@copying
+Copyright @copyright{} @value{copyrights-gfortran} Free Software Foundation, Inc.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with the
+Invariant Sections being ``Funding Free Software'', the Front-Cover
+Texts being (a) (see below), and with the Back-Cover Texts being (b)
+(see below).  A copy of the license is included in the section entitled
+``GNU Free Documentation License''.
+
+(a) The FSF's Front-Cover Text is:
+
+     A GNU Manual
+
+(b) The FSF's Back-Cover Text is:
+
+     You have freedom to copy and modify this GNU Manual, like GNU
+     software.  Copies published by the Free Software Foundation raise
+     funds for GNU development.
+@end copying
+
+@ifinfo
+@dircategory Software development
+@direntry
+* gfortran: (gfortran).                  The GNU Fortran Compiler.
+@end direntry
+This file documents the use and the internals of
+the GNU Fortran compiler, (@command{gfortran}).
+
+Published by the Free Software Foundation
+51 Franklin Street, Fifth Floor
+Boston, MA 02110-1301 USA
+
+@insertcopying
+@end ifinfo
+
+
+@setchapternewpage odd
+@titlepage
+@title Using GNU Fortran
+@versionsubtitle
+@author The @t{gfortran} team
+@page
+@vskip 0pt plus 1filll
+Published by the Free Software Foundation@*
+51 Franklin Street, Fifth Floor@*
+Boston, MA 02110-1301, USA@*
+@c Last printed ??ber, 19??.@*
+@c Printed copies are available for $? each.@*
+@c ISBN ???
+@sp 1
+@insertcopying
+@end titlepage
+
+@c TODO: The following "Part" definitions are included here temporarily
+@c until they are incorporated into the official Texinfo distribution.
+
+@tex
+\global\let\partentry=\dosmallpartentry
+\global\let\blankpartentry=\dosmallblankpartentry
+@end tex
+@summarycontents
+
+@tex
+\global\let\partentry=\dopartentry
+\global\let\blankpartentry=\doblankpartentry
+@end tex
+@contents
+
+@page
+
+@c ---------------------------------------------------------------------
+@c TexInfo table of contents.
+@c ---------------------------------------------------------------------
+
+@ifnottex
+@node Top
+@top Introduction
+@cindex Introduction
+
+This manual documents the use of @command{gfortran}, 
+the GNU Fortran compiler.  You can find in this manual how to invoke
+@command{gfortran}, as well as its features and incompatibilities.
+
+@ifset DEVELOPMENT
+@emph{Warning:} This document, and the compiler it describes, are still
+under development.  While efforts are made to keep it up-to-date, it might
+not accurately reflect the status of the most recent GNU Fortran compiler.
+@end ifset
+
+@comment
+@comment  When you add a new menu item, please keep the right hand
+@comment  aligned to the same column.  Do not use tabs.  This provides
+@comment  better formatting.
+@comment
+@menu
+* Introduction::
+
+Part I: Invoking GNU Fortran
+* Invoking GNU Fortran:: Command options supported by @command{gfortran}.
+* Runtime::              Influencing runtime behavior with environment variables.
+
+Part II: Language Reference
+* Fortran 2003 and 2008 status::  Fortran 2003 and 2008 features supported by GNU Fortran.
+* Compiler Characteristics::      User-visible implementation details.
+* Mixed-Language Programming::    Interoperability with C
+* Extensions::           Language extensions implemented by GNU Fortran.
+* Intrinsic Procedures:: Intrinsic procedures supported by GNU Fortran.
+* Intrinsic Modules::    Intrinsic modules supported by GNU Fortran.
+
+* Contributing::         How you can help.
+* Copying::              GNU General Public License says
+                         how you can copy and share GNU Fortran.
+* GNU Free Documentation License::
+                         How you can copy and share this manual.
+* Funding::              How to help assure continued work for free software.
+* Option Index::         Index of command line options
+* Keyword Index::        Index of concepts
+@end menu
+@end ifnottex
+
+@c ---------------------------------------------------------------------
+@c Introduction
+@c ---------------------------------------------------------------------
+
+@node Introduction
+@chapter Introduction
+
+@c The following duplicates the text on the TexInfo table of contents.
+@iftex
+This manual documents the use of @command{gfortran}, the GNU Fortran
+compiler.  You can find in this manual how to invoke @command{gfortran},
+as well as its features and incompatibilities.
+
+@ifset DEVELOPMENT
+@emph{Warning:} This document, and the compiler it describes, are still
+under development.  While efforts are made to keep it up-to-date, it
+might not accurately reflect the status of the most recent GNU Fortran
+compiler.
+@end ifset
+@end iftex
+
+The GNU Fortran compiler front end was
+designed initially as a free replacement for,
+or alternative to, the unix @command{f95} command;
+@command{gfortran} is the command you'll use to invoke the compiler.
+
+@menu
+* About GNU Fortran::    What you should know about the GNU Fortran compiler.
+* GNU Fortran and GCC::  You can compile Fortran, C, or other programs.
+* Preprocessing and conditional compilation:: The Fortran preprocessor
+* GNU Fortran and G77::  Why we chose to start from scratch.
+* Project Status::       Status of GNU Fortran, roadmap, proposed extensions.
+* Standards::            Standards supported by GNU Fortran.
+@end menu
+
+
+@c ---------------------------------------------------------------------
+@c About GNU Fortran
+@c ---------------------------------------------------------------------
+
+@node About GNU Fortran
+@section About GNU Fortran
+
+The GNU Fortran compiler supports the Fortran 77, 90 and 95 standards
+completely, parts of the Fortran 2003 and Fortran 2008 standards, and
+several vendor extensions.  The development goal is to provide the
+following features:
+
+@itemize @bullet
+@item
+Read a user's program,
+stored in a file and containing instructions written
+in Fortran 77, Fortran 90, Fortran 95, Fortran 2003 or Fortran 2008.
+This file contains @dfn{source code}.
+
+@item
+Translate the user's program into instructions a computer
+can carry out more quickly than it takes to translate the
+instructions in the first
+place.  The result after compilation of a program is
+@dfn{machine code},
+code designed to be efficiently translated and processed
+by a machine such as your computer.
+Humans usually aren't as good writing machine code
+as they are at writing Fortran (or C++, Ada, or Java),
+because it is easy to make tiny mistakes writing machine code.
+
+@item
+Provide the user with information about the reasons why
+the compiler is unable to create a binary from the source code.
+Usually this will be the case if the source code is flawed.
+The Fortran 90 standard requires that the compiler can point out
+mistakes to the user.
+An incorrect usage of the language causes an @dfn{error message}.
+
+The compiler will also attempt to diagnose cases where the
+user's program contains a correct usage of the language,
+but instructs the computer to do something questionable.
+This kind of diagnostics message is called a @dfn{warning message}.
+
+@item
+Provide optional information about the translation passes
+from the source code to machine code.
+This can help a user of the compiler to find the cause of
+certain bugs which may not be obvious in the source code,
+but may be more easily found at a lower level compiler output.
+It also helps developers to find bugs in the compiler itself.
+
+@item
+Provide information in the generated machine code that can
+make it easier to find bugs in the program (using a debugging tool,
+called a @dfn{debugger}, such as the GNU Debugger @command{gdb}). 
+
+@item
+Locate and gather machine code already generated to
+perform actions requested by statements in the user's program.
+This machine code is organized into @dfn{modules} and is located
+and @dfn{linked} to the user program. 
+@end itemize
+
+The GNU Fortran compiler consists of several components:
+
+@itemize @bullet
+@item
+A version of the @command{gcc} command
+(which also might be installed as the system's @command{cc} command)
+that also understands and accepts Fortran source code.
+The @command{gcc} command is the @dfn{driver} program for
+all the languages in the GNU Compiler Collection (GCC);
+With @command{gcc},
+you can compile the source code of any language for
+which a front end is available in GCC.
+
+@item
+The @command{gfortran} command itself,
+which also might be installed as the
+system's @command{f95} command.
+@command{gfortran} is just another driver program,
+but specifically for the Fortran compiler only.
+The difference with @command{gcc} is that @command{gfortran}
+will automatically link the correct libraries to your program.
+
+@item
+A collection of run-time libraries.
+These libraries contain the machine code needed to support
+capabilities of the Fortran language that are not directly
+provided by the machine code generated by the
+@command{gfortran} compilation phase,
+such as intrinsic functions and subroutines,
+and routines for interaction with files and the operating system.
+@c and mechanisms to spawn,
+@c unleash and pause threads in parallelized code.
+
+@item
+The Fortran compiler itself, (@command{f951}).
+This is the GNU Fortran parser and code generator,
+linked to and interfaced with the GCC backend library.
+@command{f951} ``translates'' the source code to
+assembler code.  You would typically not use this
+program directly;
+instead, the @command{gcc} or @command{gfortran} driver
+programs will call it for you.
+@end itemize
+
+
+@c ---------------------------------------------------------------------
+@c GNU Fortran and GCC
+@c ---------------------------------------------------------------------
+
+@node GNU Fortran and GCC
+@section GNU Fortran and GCC
+@cindex GNU Compiler Collection
+@cindex GCC
+
+GNU Fortran is a part of GCC, the @dfn{GNU Compiler Collection}.  GCC
+consists of a collection of front ends for various languages, which
+translate the source code into a language-independent form called
+@dfn{GENERIC}.  This is then processed by a common middle end which
+provides optimization, and then passed to one of a collection of back
+ends which generate code for different computer architectures and
+operating systems.
+
+Functionally, this is implemented with a driver program (@command{gcc})
+which provides the command-line interface for the compiler.  It calls
+the relevant compiler front-end program (e.g., @command{f951} for
+Fortran) for each file in the source code, and then calls the assembler
+and linker as appropriate to produce the compiled output.  In a copy of
+GCC which has been compiled with Fortran language support enabled,
+@command{gcc} will recognize files with @file{.f}, @file{.for}, @file{.ftn},
+@file{.f90}, @file{.f95}, @file{.f03} and @file{.f08} extensions as
+Fortran source code, and compile it accordingly.  A @command{gfortran}
+driver program is also provided, which is identical to @command{gcc}
+except that it automatically links the Fortran runtime libraries into the
+compiled program.
+
+Source files with @file{.f}, @file{.for}, @file{.fpp}, @file{.ftn}, @file{.F},
+@file{.FOR}, @file{.FPP}, and @file{.FTN} extensions are treated as fixed form.
+Source files with @file{.f90}, @file{.f95}, @file{.f03}, @file{.f08},
+@file{.F90}, @file{.F95}, @file{.F03} and @file{.F08} extensions are
+treated as free form.  The capitalized versions of either form are run
+through preprocessing.  Source files with the lower case @file{.fpp}
+extension are also run through preprocessing.
+
+This manual specifically documents the Fortran front end, which handles
+the programming language's syntax and semantics.  The aspects of GCC
+which relate to the optimization passes and the back-end code generation
+are documented in the GCC manual; see 
+@ref{Top,,Introduction,gcc,Using the GNU Compiler Collection (GCC)}.
+The two manuals together provide a complete reference for the GNU
+Fortran compiler.
+
+
+@c ---------------------------------------------------------------------
+@c Preprocessing and conditional compilation
+@c ---------------------------------------------------------------------
+
+@node Preprocessing and conditional compilation
+@section Preprocessing and conditional compilation
+@cindex CPP
+@cindex FPP
+@cindex Conditional compilation
+@cindex Preprocessing
+@cindex preprocessor, include file handling
+
+Many Fortran compilers including GNU Fortran allow passing the source code
+through a C preprocessor (CPP; sometimes also called the Fortran preprocessor,
+FPP) to allow for conditional compilation.  In the case of GNU Fortran,
+this is the GNU C Preprocessor in the traditional mode.  On systems with
+case-preserving file names, the preprocessor is automatically invoked if the
+filename extension is @file{.F}, @file{.FOR}, @file{.FTN}, @file{.fpp},
+@file{.FPP}, @file{.F90}, @file{.F95}, @file{.F03} or @file{.F08}.  To manually
+invoke the preprocessor on any file, use @option{-cpp}, to disable
+preprocessing on files where the preprocessor is run automatically, use
+@option{-nocpp}.
+
+If a preprocessed file includes another file with the Fortran @code{INCLUDE}
+statement, the included file is not preprocessed.  To preprocess included
+files, use the equivalent preprocessor statement @code{#include}.
+
+If GNU Fortran invokes the preprocessor, @code{__GFORTRAN__}
+is defined and @code{__GNUC__}, @code{__GNUC_MINOR__} and
+@code{__GNUC_PATCHLEVEL__} can be used to determine the version of the
+compiler.  See @ref{Top,,Overview,cpp,The C Preprocessor} for details.
+
+While CPP is the de-facto standard for preprocessing Fortran code,
+Part 3 of the Fortran 95 standard (ISO/IEC 1539-3:1998) defines
+Conditional Compilation, which is not widely used and not directly
+supported by the GNU Fortran compiler.  You can use the program coco
+to preprocess such files (@uref{http://www.daniellnagle.com/coco.html}).
+
+
+@c ---------------------------------------------------------------------
+@c GNU Fortran and G77
+@c ---------------------------------------------------------------------
+
+@node GNU Fortran and G77
+@section GNU Fortran and G77
+@cindex Fortran 77
+@cindex @command{g77}
+
+The GNU Fortran compiler is the successor to @command{g77}, the Fortran 
+77 front end included in GCC prior to version 4.  It is an entirely new 
+program that has been designed to provide Fortran 95 support and 
+extensibility for future Fortran language standards, as well as providing 
+backwards compatibility for Fortran 77 and nearly all of the GNU language 
+extensions supported by @command{g77}.
+
+
+@c ---------------------------------------------------------------------
+@c Project Status
+@c ---------------------------------------------------------------------
+
+@node Project Status
+@section Project Status
+
+@quotation
+As soon as @command{gfortran} can parse all of the statements correctly,
+it will be in the ``larva'' state.
+When we generate code, the ``puppa'' state.
+When @command{gfortran} is done,
+we'll see if it will be a beautiful butterfly,
+or just a big bug....
+
+--Andy Vaught, April 2000
+@end quotation
+
+The start of the GNU Fortran 95 project was announced on
+the GCC homepage in March 18, 2000
+(even though Andy had already been working on it for a while,
+of course).
+
+The GNU Fortran compiler is able to compile nearly all
+standard-compliant Fortran 95, Fortran 90, and Fortran 77 programs,
+including a number of standard and non-standard extensions, and can be
+used on real-world programs.  In particular, the supported extensions
+include OpenMP, Cray-style pointers, and several Fortran 2003 and Fortran
+2008 features, including TR 15581.  However, it is still under
+development and has a few remaining rough edges.
+
+At present, the GNU Fortran compiler passes the
+@uref{http://www.fortran-2000.com/ArnaudRecipes/fcvs21_f95.html, 
+NIST Fortran 77 Test Suite}, and produces acceptable results on the
+@uref{http://www.netlib.org/lapack/faq.html#1.21, LAPACK Test Suite}.
+It also provides respectable performance on 
+the @uref{http://www.polyhedron.com/pb05.html, Polyhedron Fortran
+compiler benchmarks} and the
+@uref{http://www.llnl.gov/asci_benchmarks/asci/limited/lfk/README.html,
+Livermore Fortran Kernels test}.  It has been used to compile a number of
+large real-world programs, including
+@uref{http://mysite.verizon.net/serveall/moene.pdf, the HIRLAM
+weather-forecasting code} and
+@uref{http://www.theochem.uwa.edu.au/tonto/, the Tonto quantum 
+chemistry package}; see @url{http://gcc.gnu.org/@/wiki/@/GfortranApps} for an
+extended list.
+
+Among other things, the GNU Fortran compiler is intended as a replacement
+for G77.  At this point, nearly all programs that could be compiled with
+G77 can be compiled with GNU Fortran, although there are a few minor known
+regressions.
+
+The primary work remaining to be done on GNU Fortran falls into three
+categories: bug fixing (primarily regarding the treatment of invalid code
+and providing useful error messages), improving the compiler optimizations
+and the performance of compiled code, and extending the compiler to support
+future standards---in particular, Fortran 2003 and Fortran 2008.
+
+
+@c ---------------------------------------------------------------------
+@c Standards
+@c ---------------------------------------------------------------------
+
+@node Standards
+@section Standards
+@cindex Standards
+
+@menu
+* Varying Length Character Strings::
+@end menu
+
+The GNU Fortran compiler implements
+ISO/IEC 1539:1997 (Fortran 95).  As such, it can also compile essentially all
+standard-compliant Fortran 90 and Fortran 77 programs.   It also supports
+the ISO/IEC TR-15581 enhancements to allocatable arrays.
+
+In the future, the GNU Fortran compiler will also support ISO/IEC
+1539-1:2004 (Fortran 2003), ISO/IEC 1539-1:2010 (Fortran 2008) and
+future Fortran standards.  Partial support of the Fortran 2003 and
+Fortran 2008 standard is already provided; the current status of the
+support is reported in the @ref{Fortran 2003 status} and
+@ref{Fortran 2008 status} sections of the documentation.
+
+Additionally, the GNU Fortran compilers supports the OpenMP specification
+(version 3.0, @url{http://openmp.org/@/wp/@/openmp-specifications/}).
+
+@node Varying Length Character Strings
+@subsection Varying Length Character Strings
+@cindex Varying length character strings
+@cindex Varying length strings
+@cindex strings, varying length
+
+The Fortran 95 standard specifies in Part 2 (ISO/IEC 1539-2:2000)
+varying length character strings.  While GNU Fortran currently does not
+support such strings directly, there exist two Fortran implementations
+for them, which work with GNU Fortran.  They can be found at
+@uref{http://www.fortran.com/@/iso_varying_string.f95} and at
+@uref{ftp://ftp.nag.co.uk/@/sc22wg5/@/ISO_VARYING_STRING/}.
+
+
+
+@c =====================================================================
+@c PART I: INVOCATION REFERENCE
+@c =====================================================================
+
+@tex
+\part{I}{Invoking GNU Fortran}
+@end tex
+
+@c ---------------------------------------------------------------------
+@c Compiler Options
+@c ---------------------------------------------------------------------
+
+@include invoke.texi
+
+
+@c ---------------------------------------------------------------------
+@c Runtime
+@c ---------------------------------------------------------------------
+
+@node Runtime
+@chapter Runtime:  Influencing runtime behavior with environment variables
+@cindex environment variable
+
+The behavior of the @command{gfortran} can be influenced by
+environment variables.
+
+Malformed environment variables are silently ignored.
+
+@menu
+* GFORTRAN_STDIN_UNIT:: Unit number for standard input
+* GFORTRAN_STDOUT_UNIT:: Unit number for standard output
+* GFORTRAN_STDERR_UNIT:: Unit number for standard error
+* GFORTRAN_USE_STDERR:: Send library output to standard error
+* GFORTRAN_TMPDIR:: Directory for scratch files
+* GFORTRAN_UNBUFFERED_ALL:: Don't buffer I/O for all units.
+* GFORTRAN_UNBUFFERED_PRECONNECTED:: Don't buffer I/O for preconnected units.
+* GFORTRAN_SHOW_LOCUS::  Show location for runtime errors
+* GFORTRAN_OPTIONAL_PLUS:: Print leading + where permitted
+* GFORTRAN_DEFAULT_RECL:: Default record length for new files
+* GFORTRAN_LIST_SEPARATOR::  Separator for list output
+* GFORTRAN_CONVERT_UNIT::  Set endianness for unformatted I/O
+* GFORTRAN_ERROR_DUMPCORE:: Dump core on run-time errors
+* GFORTRAN_ERROR_BACKTRACE:: Show backtrace on run-time errors
+@end menu
+
+@node GFORTRAN_STDIN_UNIT
+@section @env{GFORTRAN_STDIN_UNIT}---Unit number for standard input
+
+This environment variable can be used to select the unit number
+preconnected to standard input.  This must be a positive integer.
+The default value is 5.
+
+@node GFORTRAN_STDOUT_UNIT
+@section @env{GFORTRAN_STDOUT_UNIT}---Unit number for standard output
+
+This environment variable can be used to select the unit number
+preconnected to standard output.  This must be a positive integer.
+The default value is 6.
+
+@node GFORTRAN_STDERR_UNIT
+@section @env{GFORTRAN_STDERR_UNIT}---Unit number for standard error
+
+This environment variable can be used to select the unit number
+preconnected to standard error.  This must be a positive integer.
+The default value is 0.
+
+@node GFORTRAN_USE_STDERR
+@section @env{GFORTRAN_USE_STDERR}---Send library output to standard error
+
+This environment variable controls where library output is sent.
+If the first letter is @samp{y}, @samp{Y} or @samp{1}, standard
+error is used.  If the first letter is @samp{n}, @samp{N} or
+@samp{0}, standard output is used.
+
+@node GFORTRAN_TMPDIR
+@section @env{GFORTRAN_TMPDIR}---Directory for scratch files
+
+This environment variable controls where scratch files are
+created.  If this environment variable is missing,
+GNU Fortran searches for the environment variable @env{TMP}, then @env{TEMP}.
+If these are missing, the default is @file{/tmp}.
+
+@node GFORTRAN_UNBUFFERED_ALL
+@section @env{GFORTRAN_UNBUFFERED_ALL}---Don't buffer I/O on all units
+
+This environment variable controls whether all I/O is unbuffered.  If
+the first letter is @samp{y}, @samp{Y} or @samp{1}, all I/O is
+unbuffered.  This will slow down small sequential reads and writes.  If
+the first letter is @samp{n}, @samp{N} or @samp{0}, I/O is buffered.
+This is the default.
+
+@node GFORTRAN_UNBUFFERED_PRECONNECTED
+@section @env{GFORTRAN_UNBUFFERED_PRECONNECTED}---Don't buffer I/O on preconnected units
+
+The environment variable named @env{GFORTRAN_UNBUFFERED_PRECONNECTED} controls
+whether I/O on a preconnected unit (i.e.@: STDOUT or STDERR) is unbuffered.  If 
+the first letter is @samp{y}, @samp{Y} or @samp{1}, I/O is unbuffered.  This
+will slow down small sequential reads and writes.  If the first letter
+is @samp{n}, @samp{N} or @samp{0}, I/O is buffered.  This is the default.
+
+@node GFORTRAN_SHOW_LOCUS
+@section @env{GFORTRAN_SHOW_LOCUS}---Show location for runtime errors
+
+If the first letter is @samp{y}, @samp{Y} or @samp{1}, filename and
+line numbers for runtime errors are printed.  If the first letter is
+@samp{n}, @samp{N} or @samp{0}, don't print filename and line numbers
+for runtime errors.  The default is to print the location.
+
+@node GFORTRAN_OPTIONAL_PLUS
+@section @env{GFORTRAN_OPTIONAL_PLUS}---Print leading + where permitted
+
+If the first letter is @samp{y}, @samp{Y} or @samp{1},
+a plus sign is printed
+where permitted by the Fortran standard.  If the first letter
+is @samp{n}, @samp{N} or @samp{0}, a plus sign is not printed
+in most cases.  Default is not to print plus signs.
+
+@node GFORTRAN_DEFAULT_RECL
+@section @env{GFORTRAN_DEFAULT_RECL}---Default record length for new files
+
+This environment variable specifies the default record length, in
+bytes, for files which are opened without a @code{RECL} tag in the
+@code{OPEN} statement.  This must be a positive integer.  The
+default value is 1073741824 bytes (1 GB).
+
+@node GFORTRAN_LIST_SEPARATOR
+@section @env{GFORTRAN_LIST_SEPARATOR}---Separator for list output
+
+This environment variable specifies the separator when writing
+list-directed output.  It may contain any number of spaces and
+at most one comma.  If you specify this on the command line,
+be sure to quote spaces, as in
+@smallexample
+$ GFORTRAN_LIST_SEPARATOR='  ,  ' ./a.out
+@end smallexample
+when @command{a.out} is the compiled Fortran program that you want to run.
+Default is a single space.
+
+@node GFORTRAN_CONVERT_UNIT
+@section @env{GFORTRAN_CONVERT_UNIT}---Set endianness for unformatted I/O
+
+By setting the @env{GFORTRAN_CONVERT_UNIT} variable, it is possible
+to change the representation of data for unformatted files.
+The syntax for the @env{GFORTRAN_CONVERT_UNIT} variable is:
+@smallexample
+GFORTRAN_CONVERT_UNIT: mode | mode ';' exception | exception ;
+mode: 'native' | 'swap' | 'big_endian' | 'little_endian' ;
+exception: mode ':' unit_list | unit_list ;
+unit_list: unit_spec | unit_list unit_spec ;
+unit_spec: INTEGER | INTEGER '-' INTEGER ;
+@end smallexample
+The variable consists of an optional default mode, followed by
+a list of optional exceptions, which are separated by semicolons
+from the preceding default and each other.  Each exception consists
+of a format and a comma-separated list of units.  Valid values for
+the modes are the same as for the @code{CONVERT} specifier:
+
+@itemize @w{}
+@item @code{NATIVE} Use the native format.  This is the default.
+@item @code{SWAP} Swap between little- and big-endian.
+@item @code{LITTLE_ENDIAN} Use the little-endian format
+for unformatted files.
+@item @code{BIG_ENDIAN} Use the big-endian format for unformatted files.
+@end itemize
+A missing mode for an exception is taken to mean @code{BIG_ENDIAN}.
+Examples of values for @env{GFORTRAN_CONVERT_UNIT} are:
+@itemize @w{}
+@item @code{'big_endian'}  Do all unformatted I/O in big_endian mode.
+@item @code{'little_endian;native:10-20,25'}  Do all unformatted I/O 
+in little_endian mode, except for units 10 to 20 and 25, which are in
+native format.
+@item @code{'10-20'}  Units 10 to 20 are big-endian, the rest is native.
+@end itemize
+
+Setting the environment variables should be done on the command
+line or via the @command{export}
+command for @command{sh}-compatible shells and via @command{setenv}
+for @command{csh}-compatible shells.
+
+Example for @command{sh}:
+@smallexample
+$ gfortran foo.f90
+$ GFORTRAN_CONVERT_UNIT='big_endian;native:10-20' ./a.out
+@end smallexample
+
+Example code for @command{csh}:
+@smallexample
+% gfortran foo.f90
+% setenv GFORTRAN_CONVERT_UNIT 'big_endian;native:10-20'
+% ./a.out
+@end smallexample
+
+Using anything but the native representation for unformatted data
+carries a significant speed overhead.  If speed in this area matters
+to you, it is best if you use this only for data that needs to be
+portable.
+
+@xref{CONVERT specifier}, for an alternative way to specify the
+data representation for unformatted files.  @xref{Runtime Options}, for
+setting a default data representation for the whole program.  The
+@code{CONVERT} specifier overrides the @option{-fconvert} compile options.
+
+@emph{Note that the values specified via the GFORTRAN_CONVERT_UNIT
+environment variable will override the CONVERT specifier in the
+open statement}.  This is to give control over data formats to
+users who do not have the source code of their program available.
+
+@node GFORTRAN_ERROR_DUMPCORE
+@section @env{GFORTRAN_ERROR_DUMPCORE}---Dump core on run-time errors
+
+If the @env{GFORTRAN_ERROR_DUMPCORE} variable is set to
+@samp{y}, @samp{Y} or @samp{1} (only the first letter is relevant)
+then library run-time errors cause core dumps.  To disable the core
+dumps, set the variable to @samp{n}, @samp{N}, @samp{0}.  Default
+is not to core dump unless the @option{-fdump-core} compile option
+was used.
+
+@node GFORTRAN_ERROR_BACKTRACE
+@section @env{GFORTRAN_ERROR_BACKTRACE}---Show backtrace on run-time errors
+
+If the @env{GFORTRAN_ERROR_BACKTRACE} variable is set to
+@samp{y}, @samp{Y} or @samp{1} (only the first letter is relevant)
+then a backtrace is printed when a run-time error occurs.
+To disable the backtracing, set the variable to
+@samp{n}, @samp{N}, @samp{0}.  Default is not to print a backtrace
+unless the @option{-fbacktrace} compile option
+was used.
+
+@c =====================================================================
+@c PART II: LANGUAGE REFERENCE
+@c =====================================================================
+
+@tex
+\part{II}{Language Reference}
+@end tex
+
+@c ---------------------------------------------------------------------
+@c Fortran 2003 and 2008 Status
+@c ---------------------------------------------------------------------
+
+@node Fortran 2003 and 2008 status
+@chapter Fortran 2003 and 2008 Status
+
+@menu
+* Fortran 2003 status::
+* Fortran 2008 status::
+@end menu
+
+@node Fortran 2003 status
+@section Fortran 2003 status
+
+GNU Fortran supports several Fortran 2003 features; an incomplete
+list can be found below.  See also the
+@uref{http://gcc.gnu.org/wiki/Fortran2003, wiki page} about Fortran 2003.
+
+@itemize
+@item Procedure pointers including procedure-pointer components with
+@code{PASS} attribute.
+
+@item Procedures which are bound to a derived type (type-bound procedures)
+including @code{PASS}, @code{PROCEDURE} and @code{GENERIC}, and
+operators bound to a type.
+
+@item Abstract interfaces and and type extension with the possibility to
+override type-bound procedures or to have deferred binding.
+
+@item Polymorphic entities (``@code{CLASS}'') for derived types -- including
+@code{SAME_TYPE_AS}, @code{EXTENDS_TYPE_OF} and @code{SELECT TYPE}.
+Note that the support for array-valued polymorphic entities is incomplete
+and unlimited polymophism is currently not supported.
+
+@item The @code{ASSOCIATE} construct.
+
+@item Interoperability with C including enumerations, 
+
+@item In structure constructors the components with default values may be
+omitted.
+
+@item Extensions to the @code{ALLOCATE} statement, allowing for a
+type-specification with type parameter and for allocation and initialization
+from a @code{SOURCE=} expression; @code{ALLOCATE} and @code{DEALLOCATE}
+optionally return an error message string via @code{ERRMSG=}.
+
+@item Reallocation on assignment: If an intrinsic assignment is
+used, an allocatable variable on the left-hand side is automatically allocated
+(if unallocated) or reallocated (if the shape is different). Currently, scalar
+deferred character length left-hand sides are correctly handled but arrays
+are not yet fully implemented.
+
+@item Transferring of allocations via @code{MOVE_ALLOC}.
+
+@item The @code{PRIVATE} and @code{PUBLIC} attributes may be given individually
+to derived-type components.
+
+@item In pointer assignments, the lower bound may be specified and
+the remapping of elements is supported.
+
+@item For pointers an @code{INTENT} may be specified which affect the
+association status not the value of the pointer target.
+
+@item Intrinsics @code{command_argument_count}, @code{get_command},
+@code{get_command_argument}, and @code{get_environment_variable}.
+
+@item Support for unicode characters (ISO 10646) and UTF-8, including
+the @code{SELECTED_CHAR_KIND} and @code{NEW_LINE} intrinsic functions.
+
+@item Support for binary, octal and hexadecimal (BOZ) constants in the
+intrinsic functions @code{INT}, @code{REAL}, @code{CMPLX} and @code{DBLE}.
+
+@item Support for namelist variables with allocatable and pointer
+attribute and nonconstant length type parameter.
+
+@item
+@cindex array, constructors
+@cindex @code{[...]}
+Array constructors using square brackets.  That is, @code{[...]} rather
+than @code{(/.../)}.  Type-specification for array constructors like
+@code{(/ some-type :: ... /)}.
+
+@item Extensions to the specification and initialization expressions,
+including the support for intrinsics with real and complex arguments.
+
+@item Support for the asynchronous input/output syntax; however, the
+data transfer is currently always synchronously performed. 
+
+@item
+@cindex @code{FLUSH} statement
+@cindex statement, @code{FLUSH}
+@code{FLUSH} statement.
+
+@item
+@cindex @code{IOMSG=} specifier
+@code{IOMSG=} specifier for I/O statements.
+
+@item
+@cindex @code{ENUM} statement
+@cindex @code{ENUMERATOR} statement
+@cindex statement, @code{ENUM}
+@cindex statement, @code{ENUMERATOR}
+@opindex @code{fshort-enums}
+Support for the declaration of enumeration constants via the
+@code{ENUM} and @code{ENUMERATOR} statements.  Interoperability with
+@command{gcc} is guaranteed also for the case where the
+@command{-fshort-enums} command line option is given.
+
+@item
+@cindex TR 15581
+TR 15581:
+@itemize
+@item
+@cindex @code{ALLOCATABLE} dummy arguments
+@code{ALLOCATABLE} dummy arguments.
+@item
+@cindex @code{ALLOCATABLE} function results
+@code{ALLOCATABLE} function results
+@item
+@cindex @code{ALLOCATABLE} components of derived types
+@code{ALLOCATABLE} components of derived types
+@end itemize
+
+@item
+@cindex @code{STREAM} I/O
+@cindex @code{ACCESS='STREAM'} I/O
+The @code{OPEN} statement supports the @code{ACCESS='STREAM'} specifier,
+allowing I/O without any record structure.
+
+@item
+Namelist input/output for internal files.
+
+@item Further I/O extensions: Rounding during formatted output, using of
+a decimal comma instead of a decimal point, setting whether a plus sign
+should appear for positive numbers.
+
+@item
+@cindex @code{PROTECTED} statement
+@cindex statement, @code{PROTECTED}
+The @code{PROTECTED} statement and attribute.
+
+@item
+@cindex @code{VALUE} statement
+@cindex statement, @code{VALUE}
+The @code{VALUE} statement and attribute.
+
+@item
+@cindex @code{VOLATILE} statement
+@cindex statement, @code{VOLATILE}
+The @code{VOLATILE} statement and attribute.
+
+@item
+@cindex @code{IMPORT} statement
+@cindex statement, @code{IMPORT}
+The @code{IMPORT} statement, allowing to import
+host-associated derived types.
+
+@item The intrinsic modules @code{ISO_FORTRAN_ENVIRONMENT} is supported,
+which contains parameters of the I/O units, storage sizes. Additionally,
+procedures for C interoperability are available in the @code{ISO_C_BINDING}
+module.
+
+@item
+@cindex @code{USE, INTRINSIC} statement
+@cindex statement, @code{USE, INTRINSIC}
+@cindex @code{ISO_FORTRAN_ENV} statement
+@cindex statement, @code{ISO_FORTRAN_ENV}
+@code{USE} statement with @code{INTRINSIC} and @code{NON_INTRINSIC}
+attribute; supported intrinsic modules: @code{ISO_FORTRAN_ENV},
+@code{ISO_C_BINDING}, @code{OMP_LIB} and @code{OMP_LIB_KINDS}.
+
+@item
+Renaming of operators in the @code{USE} statement.
+
+@end itemize
+
+
+@node Fortran 2008 status
+@section Fortran 2008 status
+
+The latest version of the Fortran standard is ISO/IEC 1539-1:2010, informally
+known as Fortran 2008.  The official version is available from International
+Organization for Standardization (ISO) or its national member organizations.
+The the final draft (FDIS) can be downloaded free of charge from
+@url{http://www.nag.co.uk/@/sc22wg5/@/links.html}.  Fortran is developed by the
+Working Group 5 of Sub-Committee 22 of the Joint Technical Committee 1 of the
+International Organization for Standardization and the International
+Electrotechnical Commission (IEC).  This group is known as
+@uref{http://www.nag.co.uk/sc22wg5/, WG5}.
+
+The GNU Fortran supports several of the new features of Fortran 2008; the
+@uref{http://gcc.gnu.org/wiki/Fortran2008Status, wiki} has some information
+about the current Fortran 2008 implementation status.  In particular, the
+following is implemented.
+
+@itemize
+@item The @option{-std=f2008} option and support for the file extensions 
+@file{.f08} and @file{.F08}.
+
+@item The @code{OPEN} statement now supports the @code{NEWUNIT=} option,
+which returns a unique file unit, thus preventing inadvertent use of the
+same unit in different parts of the program.
+
+@item The @code{g0} format descriptor and unlimited format items.
+
+@item The mathematical intrinsics @code{ASINH}, @code{ACOSH}, @code{ATANH},
+@code{ERF}, @code{ERFC}, @code{GAMMA}, @code{LOG_GAMMA}, @code{BESSEL_J0},
+@code{BESSEL_J1}, @code{BESSEL_JN}, @code{BESSEL_Y0}, @code{BESSEL_Y1},
+@code{BESSEL_YN}, @code{HYPOT}, @code{NORM2}, and @code{ERFC_SCALED}.
+
+@item Using complex arguments with @code{TAN}, @code{SINH}, @code{COSH},
+@code{TANH}, @code{ASIN}, @code{ACOS}, and @code{ATAN} is now possible;
+@code{ATAN}(@var{Y},@var{X}) is now an alias for @code{ATAN2}(@var{Y},@var{X}).
+
+@item Support of the @code{PARITY} intrinsic functions.
+
+@item The following bit intrinsics: @code{LEADZ} and @code{TRAILZ} for
+counting the number of leading and trailing zero bits, @code{POPCNT} and
+@code{POPPAR} for counting the number of one bits and returning the parity;
+@code{BGE}, @code{BGT}, @code{BLE}, and @code{BLT} for bitwise comparisons;
+@code{DSHIFTL} and @code{DSHIFTR} for combined left and right shifts,
+@code{MASKL} and @code{MASKR} for simple left and right justified masks,
+@code{MERGE_BITS} for a bitwise merge using a mask, @code{SHIFTA},
+@code{SHIFTL} and @code{SHIFTR} for shift operations, and the
+transformational bit intrinsics @code{IALL}, @code{IANY} and @code{IPARITY}.
+
+@item Support of the @code{EXECUTE_COMMAND_LINE} intrinsic subroutine.
+
+@item Support for the @code{STORAGE_SIZE} intrinsic inquiry function.
+
+@item The @code{INT@{8,16,32@}} and @code{REAL@{32,64,128@}} kind type
+parameters and the array-valued named constants @code{INTEGER_KINDS},
+@code{LOGICAL_KINDS}, @code{REAL_KINDS} and @code{CHARACTER_KINDS} of
+the intrinsic module @code{ISO_FORTRAN_ENV}.
+
+@item The module procedures @code{C_SIZEOF} of the intrinsic module
+@code{ISO_C_BINDINGS} and @code{COMPILER_VERSION} and @code{COMPILER_OPTIONS}
+of @code{ISO_FORTRAN_ENV}.
+
+@item Experimental coarray support (for one image only), use the
+@option{-fcoarray=single} flag to enable it.
+
+@item The @code{BLOCK} construct is supported.
+
+@item The @code{STOP} and the new @code{ERROR STOP} statements now
+support all constant expressions.
+
+@item Support for the @code{CONTIGUOUS} attribute.
+
+@item Support for @code{ALLOCATE} with @code{MOLD}.
+
+@item Support for the @code{IMPURE} attribute for procedures, which
+allows for @code{ELEMENTAL} procedures without the restrictions of
+@code{PURE}.
+
+@item Null pointers (including @code{NULL()}) and not-allocated variables
+can be used as actual argument to optional non-pointer, non-allocatable
+dummy arguments, denoting an absent argument.
+
+@item Non-pointer variables with @code{TARGET} attribute can be used as
+actual argument to @code{POINTER} dummies with @code{INTENT(IN)}.
+
+@item Pointers including procedure pointers and those in a derived
+type (pointer components) can now be initialized by a target instead
+of only by @code{NULL}.
+
+@item The @code{EXIT} statement (with construct-name) can be now be
+used to leave not only the @code{DO} but also the @code{ASSOCIATE},
+@code{BLOCK}, @code{IF}, @code{SELECT CASE} and @code{SELECT TYPE}
+constructs.
+
+@item Internal procedures can now be used as actual argument.
+
+@item Minor features: obsolesce diagnostics for @code{ENTRY} with
+@option{-std=f2008}; a line may start with a semicolon; for internal
+and module procedures @code{END} can be used instead of
+@code{END SUBROUTINE} and @code{END FUNCTION}; @code{SELECTED_REAL_KIND}
+now also takes a @code{RADIX} argument; intrinsic types are supported
+for @code{TYPE}(@var{intrinsic-type-spec}); multiple type-bound procedures
+can be declared in a single @code{PROCEDURE} statement; implied-shape
+arrays are supported for named constants (@code{PARAMETER}).
+@end itemize
+
+
+
+@c ---------------------------------------------------------------------
+@c Compiler Characteristics
+@c ---------------------------------------------------------------------
+
+@node Compiler Characteristics
+@chapter Compiler Characteristics
+
+This chapter describes certain characteristics of the GNU Fortran
+compiler, that are not specified by the Fortran standard, but which
+might in some way or another become visible to the programmer.
+
+@menu
+* KIND Type Parameters::
+* Internal representation of LOGICAL variables::
+* Thread-safety of the runtime library::
+@end menu
+
+
+@node KIND Type Parameters
+@section KIND Type Parameters
+@cindex kind
+
+The @code{KIND} type parameters supported by GNU Fortran for the primitive
+data types are:
+
+@table @code
+
+@item INTEGER
+1, 2, 4, 8*, 16*, default: 4 (1)
+
+@item LOGICAL
+1, 2, 4, 8*, 16*, default: 4 (1)
+
+@item REAL
+4, 8, 10*, 16*, default: 4 (2)
+
+@item COMPLEX
+4, 8, 10*, 16*, default: 4 (2)
+
+@item CHARACTER
+1, 4, default: 1
+
+@end table
+
+@noindent
+* = not available on all systems @*
+(1) Unless -fdefault-integer-8 is used @*
+(2) Unless -fdefault-real-8 is used
+
+@noindent
+The @code{KIND} value matches the storage size in bytes, except for
+@code{COMPLEX} where the storage size is twice as much (or both real and
+imaginary part are a real value of the given size).  It is recommended to use
+the @code{SELECTED_CHAR_KIND}, @code{SELECTED_INT_KIND} and
+@code{SELECTED_REAL_KIND} intrinsics or the @code{INT8}, @code{INT16},
+@code{INT32}, @code{INT64}, @code{REAL32}, @code{REAL64}, and @code{REAL128}
+parameters of the @code{ISO_FORTRAN_ENV} module instead of the concrete values.
+The available kind parameters can be found in the constant arrays
+@code{CHARACTER_KINDS}, @code{INTEGER_KINDS}, @code{LOGICAL_KINDS} and
+@code{REAL_KINDS} in the @code{ISO_FORTRAN_ENV} module
+(see @ref{ISO_FORTRAN_ENV}).
+
+
+@node Internal representation of LOGICAL variables
+@section Internal representation of LOGICAL variables
+@cindex logical, variable representation
+
+The Fortran standard does not specify how variables of @code{LOGICAL}
+type are represented, beyond requiring that @code{LOGICAL} variables
+of default kind have the same storage size as default @code{INTEGER}
+and @code{REAL} variables.  The GNU Fortran internal representation is
+as follows.
+
+A @code{LOGICAL(KIND=N)} variable is represented as an
+@code{INTEGER(KIND=N)} variable, however, with only two permissible
+values: @code{1} for @code{.TRUE.} and @code{0} for
+@code{.FALSE.}.  Any other integer value results in undefined behavior.
+
+Note that for mixed-language programming using the
+@code{ISO_C_BINDING} feature, there is a @code{C_BOOL} kind that can
+be used to create @code{LOGICAL(KIND=C_BOOL)} variables which are
+interoperable with the C99 _Bool type.  The C99 _Bool type has an
+internal representation described in the C99 standard, which is
+identical to the above description, i.e. with 1 for true and 0 for
+false being the only permissible values.  Thus the internal
+representation of @code{LOGICAL} variables in GNU Fortran is identical
+to C99 _Bool, except for a possible difference in storage size
+depending on the kind.
+
+
+@node Thread-safety of the runtime library
+@section Thread-safety of the runtime library
+@cindex thread-safety, threads
+
+GNU Fortran can be used in programs with multiple threads, e.g.@: by
+using OpenMP, by calling OS thread handling functions via the
+@code{ISO_C_BINDING} facility, or by GNU Fortran compiled library code
+being called from a multi-threaded program.
+
+The GNU Fortran runtime library, (@code{libgfortran}), supports being
+called concurrently from multiple threads with the following
+exceptions. 
+
+During library initialization, the C @code{getenv} function is used,
+which need not be thread-safe.  Similarly, the @code{getenv}
+function is used to implement the @code{GET_ENVIRONMENT_VARIABLE} and
+@code{GETENV} intrinsics.  It is the responsibility of the user to
+ensure that the environment is not being updated concurrently when any
+of these actions are taking place.
+
+The @code{EXECUTE_COMMAND_LINE} and @code{SYSTEM} intrinsics are
+implemented with the @code{system} function, which need not be
+thread-safe.  It is the responsibility of the user to ensure that
+@code{system} is not called concurrently.
+
+Finally, for platforms not supporting thread-safe POSIX functions,
+further functionality might not be thread-safe.  For details, please
+consult the documentation for your operating system.
+
+@c ---------------------------------------------------------------------
+@c Extensions
+@c ---------------------------------------------------------------------
+
+@c Maybe this chapter should be merged with the 'Standards' section,
+@c whenever that is written :-)
+
+@node Extensions
+@chapter Extensions
+@cindex extensions
+
+The two sections below detail the extensions to standard Fortran that are
+implemented in GNU Fortran, as well as some of the popular or
+historically important extensions that are not (or not yet) implemented.
+For the latter case, we explain the alternatives available to GNU Fortran
+users, including replacement by standard-conforming code or GNU
+extensions.
+
+@menu
+* Extensions implemented in GNU Fortran::
+* Extensions not implemented in GNU Fortran::
+@end menu
+
+
+@node Extensions implemented in GNU Fortran
+@section Extensions implemented in GNU Fortran
+@cindex extensions, implemented
+
+GNU Fortran implements a number of extensions over standard
+Fortran.  This chapter contains information on their syntax and
+meaning.  There are currently two categories of GNU Fortran
+extensions, those that provide functionality beyond that provided
+by any standard, and those that are supported by GNU Fortran
+purely for backward compatibility with legacy compilers.  By default,
+@option{-std=gnu} allows the compiler to accept both types of
+extensions, but to warn about the use of the latter.  Specifying
+either @option{-std=f95}, @option{-std=f2003} or @option{-std=f2008}
+disables both types of extensions, and @option{-std=legacy} allows both
+without warning.
+
+@menu
+* Old-style kind specifications::
+* Old-style variable initialization::
+* Extensions to namelist::
+* X format descriptor without count field::
+* Commas in FORMAT specifications::
+* Missing period in FORMAT specifications::
+* I/O item lists::
+* BOZ literal constants::
+* @code{Q} exponent-letter::
+* Real array indices::
+* Unary operators::
+* Implicitly convert LOGICAL and INTEGER values::
+* Hollerith constants support::
+* Cray pointers::
+* CONVERT specifier::
+* OpenMP::
+* Argument list functions::
+@end menu
+
+@node Old-style kind specifications
+@subsection Old-style kind specifications
+@cindex kind, old-style
+
+GNU Fortran allows old-style kind specifications in declarations.  These
+look like:
+@smallexample
+      TYPESPEC*size x,y,z
+@end smallexample
+@noindent
+where @code{TYPESPEC} is a basic type (@code{INTEGER}, @code{REAL},
+etc.), and where @code{size} is a byte count corresponding to the
+storage size of a valid kind for that type.  (For @code{COMPLEX}
+variables, @code{size} is the total size of the real and imaginary
+parts.)  The statement then declares @code{x}, @code{y} and @code{z} to
+be of type @code{TYPESPEC} with the appropriate kind.  This is
+equivalent to the standard-conforming declaration
+@smallexample
+      TYPESPEC(k) x,y,z
+@end smallexample
+@noindent
+where @code{k} is the kind parameter suitable for the intended precision.  As
+kind parameters are implementation-dependent, use the @code{KIND},
+@code{SELECTED_INT_KIND} and @code{SELECTED_REAL_KIND} intrinsics to retrieve
+the correct value, for instance @code{REAL*8 x} can be replaced by:
+@smallexample
+INTEGER, PARAMETER :: dbl = KIND(1.0d0)
+REAL(KIND=dbl) :: x
+@end smallexample
+
+@node Old-style variable initialization
+@subsection Old-style variable initialization
+
+GNU Fortran allows old-style initialization of variables of the
+form:
+@smallexample
+      INTEGER i/1/,j/2/
+      REAL x(2,2) /3*0.,1./
+@end smallexample
+The syntax for the initializers is as for the @code{DATA} statement, but
+unlike in a @code{DATA} statement, an initializer only applies to the
+variable immediately preceding the initialization.  In other words,
+something like @code{INTEGER I,J/2,3/} is not valid.  This style of
+initialization is only allowed in declarations without double colons
+(@code{::}); the double colons were introduced in Fortran 90, which also
+introduced a standard syntax for initializing variables in type
+declarations.
+
+Examples of standard-conforming code equivalent to the above example
+are:
+@smallexample
+! Fortran 90
+      INTEGER :: i = 1, j = 2
+      REAL :: x(2,2) = RESHAPE((/0.,0.,0.,1./),SHAPE(x))
+! Fortran 77
+      INTEGER i, j
+      REAL x(2,2)
+      DATA i/1/, j/2/, x/3*0.,1./
+@end smallexample
+
+Note that variables which are explicitly initialized in declarations
+or in @code{DATA} statements automatically acquire the @code{SAVE}
+attribute.
+
+@node Extensions to namelist
+@subsection Extensions to namelist
+@cindex Namelist
+
+GNU Fortran fully supports the Fortran 95 standard for namelist I/O
+including array qualifiers, substrings and fully qualified derived types.
+The output from a namelist write is compatible with namelist read.  The
+output has all names in upper case and indentation to column 1 after the
+namelist name.  Two extensions are permitted:
+
+Old-style use of @samp{$} instead of @samp{&}
+@smallexample
+$MYNML
+ X(:)%Y(2) = 1.0 2.0 3.0
+ CH(1:4) = "abcd"
+$END
+@end smallexample
+
+It should be noted that the default terminator is @samp{/} rather than
+@samp{&END}.
+
+Querying of the namelist when inputting from stdin.  After at least
+one space, entering @samp{?} sends to stdout the namelist name and the names of
+the variables in the namelist:
+@smallexample
+ ?
+
+&mynml
+ x
+ x%y
+ ch
+&end
+@end smallexample
+
+Entering @samp{=?} outputs the namelist to stdout, as if
+@code{WRITE(*,NML = mynml)} had been called:
+@smallexample
+=?
+
+&MYNML
+ X(1)%Y=  0.000000    ,  1.000000    ,  0.000000    ,
+ X(2)%Y=  0.000000    ,  2.000000    ,  0.000000    ,
+ X(3)%Y=  0.000000    ,  3.000000    ,  0.000000    ,
+ CH=abcd,  /
+@end smallexample
+
+To aid this dialog, when input is from stdin, errors send their
+messages to stderr and execution continues, even if @code{IOSTAT} is set.
+
+@code{PRINT} namelist is permitted.  This causes an error if
+@option{-std=f95} is used.
+@smallexample
+PROGRAM test_print
+  REAL, dimension (4)  ::  x = (/1.0, 2.0, 3.0, 4.0/)
+  NAMELIST /mynml/ x
+  PRINT mynml
+END PROGRAM test_print
+@end smallexample
+
+Expanded namelist reads are permitted.  This causes an error if 
+@option{-std=f95} is used.  In the following example, the first element
+of the array will be given the value 0.00 and the two succeeding
+elements will be given the values 1.00 and 2.00.
+@smallexample
+&MYNML
+  X(1,1) = 0.00 , 1.00 , 2.00
+/
+@end smallexample
+
+@node X format descriptor without count field
+@subsection @code{X} format descriptor without count field
+
+To support legacy codes, GNU Fortran permits the count field of the
+@code{X} edit descriptor in @code{FORMAT} statements to be omitted.
+When omitted, the count is implicitly assumed to be one.
+
+@smallexample
+       PRINT 10, 2, 3
+10     FORMAT (I1, X, I1)
+@end smallexample
+
+@node Commas in FORMAT specifications
+@subsection Commas in @code{FORMAT} specifications
+
+To support legacy codes, GNU Fortran allows the comma separator
+to be omitted immediately before and after character string edit
+descriptors in @code{FORMAT} statements.
+
+@smallexample
+       PRINT 10, 2, 3
+10     FORMAT ('FOO='I1' BAR='I2)
+@end smallexample
+
+
+@node Missing period in FORMAT specifications
+@subsection Missing period in @code{FORMAT} specifications
+
+To support legacy codes, GNU Fortran allows missing periods in format
+specifications if and only if @option{-std=legacy} is given on the
+command line.  This is considered non-conforming code and is
+discouraged.
+
+@smallexample
+       REAL :: value
+       READ(*,10) value
+10     FORMAT ('F4')
+@end smallexample
+
+@node I/O item lists
+@subsection I/O item lists
+@cindex I/O item lists
+
+To support legacy codes, GNU Fortran allows the input item list
+of the @code{READ} statement, and the output item lists of the
+@code{WRITE} and @code{PRINT} statements, to start with a comma.
+
+@node @code{Q} exponent-letter
+@subsection @code{Q} exponent-letter
+@cindex @code{Q} exponent-letter
+
+GNU Fortran accepts real literal constants with an exponent-letter
+of @code{Q}, for example, @code{1.23Q45}.  The constant is interpreted
+as a @code{REAL(16)} entity on targets that suppports this type.  If
+the target does not support @code{REAL(16)} but has a @code{REAL(10)}
+type, then the real-literal-constant will be interpreted as a
+@code{REAL(10)} entity.  In the absence of @code{REAL(16)} and
+@code{REAL(10)}, an error will occur.
+
+@node BOZ literal constants
+@subsection BOZ literal constants
+@cindex BOZ literal constants
+
+Besides decimal constants, Fortran also supports binary (@code{b}),
+octal (@code{o}) and hexadecimal (@code{z}) integer constants.  The
+syntax is: @samp{prefix quote digits quote}, were the prefix is
+either @code{b}, @code{o} or @code{z}, quote is either @code{'} or
+@code{"} and the digits are for binary @code{0} or @code{1}, for
+octal between @code{0} and @code{7}, and for hexadecimal between
+@code{0} and @code{F}.  (Example: @code{b'01011101'}.)
+
+Up to Fortran 95, BOZ literals were only allowed to initialize
+integer variables in DATA statements.  Since Fortran 2003 BOZ literals
+are also allowed as argument of @code{REAL}, @code{DBLE}, @code{INT}
+and @code{CMPLX}; the result is the same as if the integer BOZ
+literal had been converted by @code{TRANSFER} to, respectively,
+@code{real}, @code{double precision}, @code{integer} or @code{complex}.
+As GNU Fortran extension the intrinsic procedures @code{FLOAT},
+@code{DFLOAT}, @code{COMPLEX} and @code{DCMPLX} are treated alike.
+
+As an extension, GNU Fortran allows hexadecimal BOZ literal constants to
+be specified using the @code{X} prefix, in addition to the standard
+@code{Z} prefix.  The BOZ literal can also be specified by adding a
+suffix to the string, for example, @code{Z'ABC'} and @code{'ABC'Z} are
+equivalent.
+
+Furthermore, GNU Fortran allows using BOZ literal constants outside
+DATA statements and the four intrinsic functions allowed by Fortran 2003.
+In DATA statements, in direct assignments, where the right-hand side
+only contains a BOZ literal constant, and for old-style initializers of
+the form @code{integer i /o'0173'/}, the constant is transferred
+as if @code{TRANSFER} had been used; for @code{COMPLEX} numbers, only
+the real part is initialized unless @code{CMPLX} is used.  In all other
+cases, the BOZ literal constant is converted to an @code{INTEGER} value with
+the largest decimal representation.  This value is then converted
+numerically to the type and kind of the variable in question.
+(For instance, @code{real :: r = b'0000001' + 1} initializes @code{r}
+with @code{2.0}.) As different compilers implement the extension
+differently, one should be careful when doing bitwise initialization
+of non-integer variables.
+
+Note that initializing an @code{INTEGER} variable with a statement such
+as @code{DATA i/Z'FFFFFFFF'/} will give an integer overflow error rather
+than the desired result of @math{-1} when @code{i} is a 32-bit integer
+on a system that supports 64-bit integers.  The @samp{-fno-range-check}
+option can be used as a workaround for legacy code that initializes
+integers in this manner.
+
+@node Real array indices
+@subsection Real array indices
+@cindex array, indices of type real
+
+As an extension, GNU Fortran allows the use of @code{REAL} expressions
+or variables as array indices.
+
+@node Unary operators
+@subsection Unary operators
+@cindex operators, unary
+
+As an extension, GNU Fortran allows unary plus and unary minus operators
+to appear as the second operand of binary arithmetic operators without
+the need for parenthesis.
+
+@smallexample
+       X = Y * -Z
+@end smallexample
+
+@node Implicitly convert LOGICAL and INTEGER values
+@subsection Implicitly convert @code{LOGICAL} and @code{INTEGER} values
+@cindex conversion, to integer
+@cindex conversion, to logical
+
+As an extension for backwards compatibility with other compilers, GNU
+Fortran allows the implicit conversion of @code{LOGICAL} values to
+@code{INTEGER} values and vice versa.  When converting from a
+@code{LOGICAL} to an @code{INTEGER}, @code{.FALSE.} is interpreted as
+zero, and @code{.TRUE.} is interpreted as one.  When converting from
+@code{INTEGER} to @code{LOGICAL}, the value zero is interpreted as
+@code{.FALSE.} and any nonzero value is interpreted as @code{.TRUE.}.
+
+@smallexample
+        LOGICAL :: l
+        l = 1
+@end smallexample
+@smallexample
+        INTEGER :: i
+        i = .TRUE.
+@end smallexample
+
+However, there is no implicit conversion of @code{INTEGER} values in
+@code{if}-statements, nor of @code{LOGICAL} or @code{INTEGER} values
+in I/O operations.
+
+@node Hollerith constants support
+@subsection Hollerith constants support
+@cindex Hollerith constants
+
+GNU Fortran supports Hollerith constants in assignments, function
+arguments, and @code{DATA} and @code{ASSIGN} statements.  A Hollerith
+constant is written as a string of characters preceded by an integer
+constant indicating the character count, and the letter @code{H} or
+@code{h}, and stored in bytewise fashion in a numeric (@code{INTEGER},
+@code{REAL}, or @code{complex}) or @code{LOGICAL} variable.  The
+constant will be padded or truncated to fit the size of the variable in
+which it is stored.
+
+Examples of valid uses of Hollerith constants:
+@smallexample
+      complex*16 x(2)
+      data x /16Habcdefghijklmnop, 16Hqrstuvwxyz012345/
+      x(1) = 16HABCDEFGHIJKLMNOP
+      call foo (4h abc)
+@end smallexample
+
+Invalid Hollerith constants examples:
+@smallexample
+      integer*4 a
+      a = 8H12345678 ! Valid, but the Hollerith constant will be truncated.
+      a = 0H         ! At least one character is needed.
+@end smallexample
+
+In general, Hollerith constants were used to provide a rudimentary
+facility for handling character strings in early Fortran compilers,
+prior to the introduction of @code{CHARACTER} variables in Fortran 77;
+in those cases, the standard-compliant equivalent is to convert the
+program to use proper character strings.  On occasion, there may be a
+case where the intent is specifically to initialize a numeric variable
+with a given byte sequence.  In these cases, the same result can be
+obtained by using the @code{TRANSFER} statement, as in this example.
+@smallexample
+      INTEGER(KIND=4) :: a
+      a = TRANSFER ("abcd", a)     ! equivalent to: a = 4Habcd
+@end smallexample
+
+
+@node Cray pointers
+@subsection Cray pointers
+@cindex pointer, Cray
+
+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 @code{*} 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 @code{ipt} to the address of
+@code{target(1)}, as it would in C pointer arithmetic.  Adding @code{1}
+to @code{ipt} just adds one byte to the address stored in @code{ipt}.
+
+Any expression involving the pointee will be translated to use the
+value stored in the pointer as the base address.
+
+To get the address of elements, this extension provides an intrinsic
+function @code{LOC()}.  The @code{LOC()} function is equivalent to the
+@code{&} operator in C, 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 the @code{MALLOC} intrinsic
+(see @ref{MALLOC}).
+
+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 @code{ipt} remains unchanged, @code{iarr} is now an alias for
+@code{target}.  The optimizer, however, will not detect this aliasing, so
+it is unsafe to use @code{iarr} and @code{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 are 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 GNU Fortran; 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
+@code{ALLOCATABLE}, @code{INTENT}, @code{OPTIONAL}, @code{DUMMY},
+@code{TARGET}, @code{INTRINSIC}, or @code{POINTER} attributes.  Pointers
+may not have the @code{DIMENSION}, @code{POINTER}, @code{TARGET},
+@code{ALLOCATABLE}, @code{EXTERNAL}, or @code{INTRINSIC} attributes, nor
+may they be function results.  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 Cray pointer may also point to a function or a subroutine.  For
+example, the following excerpt is valid:
+@smallexample
+  implicit none
+  external sub
+  pointer (subptr,subpte)
+  external subpte
+  subptr = loc(sub)
+  call subpte()
+  [...]
+  subroutine sub
+  [...]
+  end subroutine sub
+@end smallexample
+
+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.
+
+@node CONVERT specifier
+@subsection @code{CONVERT} specifier
+@cindex @code{CONVERT} specifier
+
+GNU Fortran allows the conversion of unformatted data between little-
+and big-endian representation to facilitate moving of data
+between different systems.  The conversion can be indicated with
+the @code{CONVERT} specifier on the @code{OPEN} statement.
+@xref{GFORTRAN_CONVERT_UNIT}, for an alternative way of specifying
+the data format via an environment variable.
+
+Valid values for @code{CONVERT} are:
+@itemize @w{}
+@item @code{CONVERT='NATIVE'} Use the native format.  This is the default.
+@item @code{CONVERT='SWAP'} Swap between little- and big-endian.
+@item @code{CONVERT='LITTLE_ENDIAN'} Use the little-endian representation
+for unformatted files.
+@item @code{CONVERT='BIG_ENDIAN'} Use the big-endian representation for
+unformatted files.
+@end itemize
+
+Using the option could look like this:
+@smallexample
+  open(file='big.dat',form='unformatted',access='sequential', &
+       convert='big_endian')
+@end smallexample
+
+The value of the conversion can be queried by using
+@code{INQUIRE(CONVERT=ch)}.  The values returned are
+@code{'BIG_ENDIAN'} and @code{'LITTLE_ENDIAN'}.
+
+@code{CONVERT} works between big- and little-endian for
+@code{INTEGER} values of all supported kinds and for @code{REAL}
+on IEEE systems of kinds 4 and 8.  Conversion between different
+``extended double'' types on different architectures such as
+m68k and x86_64, which GNU Fortran
+supports as @code{REAL(KIND=10)} and @code{REAL(KIND=16)}, will
+probably not work.
+
+@emph{Note that the values specified via the GFORTRAN_CONVERT_UNIT
+environment variable will override the CONVERT specifier in the
+open statement}.  This is to give control over data formats to
+users who do not have the source code of their program available.
+
+Using anything but the native representation for unformatted data
+carries a significant speed overhead.  If speed in this area matters
+to you, it is best if you use this only for data that needs to be
+portable.
+
+@node OpenMP
+@subsection OpenMP
+@cindex OpenMP
+
+OpenMP (Open Multi-Processing) is an application programming
+interface (API) that supports multi-platform shared memory 
+multiprocessing programming in C/C++ and Fortran on many 
+architectures, including Unix and Microsoft Windows platforms.
+It consists of a set of compiler directives, library routines,
+and environment variables that influence run-time behavior.
+
+GNU Fortran strives to be compatible to the 
+@uref{http://www.openmp.org/mp-documents/spec30.pdf,
+OpenMP Application Program Interface v3.0}.
+
+To enable the processing of the OpenMP directive @code{!$omp} in
+free-form source code; the @code{c$omp}, @code{*$omp} and @code{!$omp}
+directives in fixed form; the @code{!$} conditional compilation sentinels
+in free form; and the @code{c$}, @code{*$} and @code{!$} sentinels
+in fixed form, @command{gfortran} needs to be invoked with the
+@option{-fopenmp}.  This also arranges for automatic linking of the
+GNU OpenMP runtime library @ref{Top,,libgomp,libgomp,GNU OpenMP
+runtime library}.
+
+The OpenMP Fortran runtime library routines are provided both in a
+form of a Fortran 90 module named @code{omp_lib} and in a form of
+a Fortran @code{include} file named @file{omp_lib.h}.
+
+An example of a parallelized loop taken from Appendix A.1 of
+the OpenMP Application Program Interface v2.5:
+@smallexample
+SUBROUTINE A1(N, A, B)
+  INTEGER I, N
+  REAL B(N), A(N)
+!$OMP PARALLEL DO !I is private by default
+  DO I=2,N
+    B(I) = (A(I) + A(I-1)) / 2.0
+  ENDDO
+!$OMP END PARALLEL DO
+END SUBROUTINE A1
+@end smallexample
+
+Please note:
+@itemize
+@item
+@option{-fopenmp} implies @option{-frecursive}, i.e., all local arrays
+will be allocated on the stack.  When porting existing code to OpenMP,
+this may lead to surprising results, especially to segmentation faults
+if the stacksize is limited.
+
+@item
+On glibc-based systems, OpenMP enabled applications cannot be statically
+linked due to limitations of the underlying pthreads-implementation.  It
+might be possible to get a working solution if 
+@command{-Wl,--whole-archive -lpthread -Wl,--no-whole-archive} is added
+to the command line.  However, this is not supported by @command{gcc} and
+thus not recommended.
+@end itemize
+
+@node Argument list functions
+@subsection Argument list functions @code{%VAL}, @code{%REF} and @code{%LOC}
+@cindex argument list functions
+@cindex @code{%VAL}
+@cindex @code{%REF}
+@cindex @code{%LOC}
+
+GNU Fortran supports argument list functions @code{%VAL}, @code{%REF} 
+and @code{%LOC} statements, for backward compatibility with g77. 
+It is recommended that these should be used only for code that is 
+accessing facilities outside of GNU Fortran, such as operating system 
+or windowing facilities.  It is best to constrain such uses to isolated 
+portions of a program--portions that deal specifically and exclusively 
+with low-level, system-dependent facilities.  Such portions might well 
+provide a portable interface for use by the program as a whole, but are 
+themselves not portable, and should be thoroughly tested each time they 
+are rebuilt using a new compiler or version of a compiler.
+
+@code{%VAL} passes a scalar argument by value, @code{%REF} passes it by 
+reference and @code{%LOC} passes its memory location.  Since gfortran 
+already passes scalar arguments by reference, @code{%REF} is in effect 
+a do-nothing.  @code{%LOC} has the same effect as a Fortran pointer.
+
+An example of passing an argument by value to a C subroutine foo.:
+@smallexample
+C
+C prototype      void foo_ (float x);
+C
+      external foo
+      real*4 x
+      x = 3.14159
+      call foo (%VAL (x))
+      end
+@end smallexample
+
+For details refer to the g77 manual
+@uref{http://gcc.gnu.org/@/onlinedocs/@/gcc-3.4.6/@/g77/@/index.html#Top}.
+
+Also, @code{c_by_val.f} and its partner @code{c_by_val.c} of the
+GNU Fortran testsuite are worth a look.
+
+
+@node Extensions not implemented in GNU Fortran
+@section Extensions not implemented in GNU Fortran
+@cindex extensions, not implemented
+
+The long history of the Fortran language, its wide use and broad
+userbase, the large number of different compiler vendors and the lack of
+some features crucial to users in the first standards have lead to the
+existence of a number of important extensions to the language.  While
+some of the most useful or popular extensions are supported by the GNU
+Fortran compiler, not all existing extensions are supported.  This section
+aims at listing these extensions and offering advice on how best make
+code that uses them running with the GNU Fortran compiler.
+
+@c More can be found here:
+@c   -- http://gcc.gnu.org/onlinedocs/gcc-3.4.6/g77/Missing-Features.html
+@c   -- the list of Fortran and libgfortran bugs closed as WONTFIX:
+@c      http://tinyurl.com/2u4h5y
+
+@menu
+* STRUCTURE and RECORD::
+@c * UNION and MAP::
+* ENCODE and DECODE statements::
+* Variable FORMAT expressions::
+@c * Q edit descriptor::
+@c * AUTOMATIC statement::
+@c * TYPE and ACCEPT I/O Statements::
+@c * .XOR. operator::
+@c * CARRIAGECONTROL, DEFAULTFILE, DISPOSE and RECORDTYPE I/O specifiers::
+@c * Omitted arguments in procedure call::
+* Alternate complex function syntax::
+@end menu
+
+
+@node STRUCTURE and RECORD
+@subsection @code{STRUCTURE} and @code{RECORD}
+@cindex @code{STRUCTURE}
+@cindex @code{RECORD}
+
+Structures are user-defined aggregate data types; this functionality was
+standardized in Fortran 90 with an different syntax, under the name of
+``derived types''.  Here is an example of code using the non portable
+structure syntax:
+
+@example
+! Declaring a structure named ``item'' and containing three fields:
+! an integer ID, an description string and a floating-point price.
+STRUCTURE /item/
+  INTEGER id
+  CHARACTER(LEN=200) description
+  REAL price
+END STRUCTURE
+
+! Define two variables, an single record of type ``item''
+! named ``pear'', and an array of items named ``store_catalog''
+RECORD /item/ pear, store_catalog(100)
+
+! We can directly access the fields of both variables
+pear.id = 92316
+pear.description = "juicy D'Anjou pear"
+pear.price = 0.15
+store_catalog(7).id = 7831
+store_catalog(7).description = "milk bottle"
+store_catalog(7).price = 1.2
+
+! We can also manipulate the whole structure
+store_catalog(12) = pear
+print *, store_catalog(12)
+@end example
+
+@noindent
+This code can easily be rewritten in the Fortran 90 syntax as following:
+
+@example
+! ``STRUCTURE /name/ ... END STRUCTURE'' becomes
+! ``TYPE name ... END TYPE''
+TYPE item
+  INTEGER id
+  CHARACTER(LEN=200) description
+  REAL price
+END TYPE
+
+! ``RECORD /name/ variable'' becomes ``TYPE(name) variable''
+TYPE(item) pear, store_catalog(100)
+
+! Instead of using a dot (.) to access fields of a record, the
+! standard syntax uses a percent sign (%)
+pear%id = 92316
+pear%description = "juicy D'Anjou pear"
+pear%price = 0.15
+store_catalog(7)%id = 7831
+store_catalog(7)%description = "milk bottle"
+store_catalog(7)%price = 1.2
+
+! Assignments of a whole variable don't change
+store_catalog(12) = pear
+print *, store_catalog(12)
+@end example
+
+
+@c @node UNION and MAP
+@c @subsection @code{UNION} and @code{MAP}
+@c @cindex @code{UNION}
+@c @cindex @code{MAP}
+@c
+@c For help writing this one, see
+@c http://www.eng.umd.edu/~nsw/ench250/fortran1.htm#UNION and
+@c http://www.tacc.utexas.edu/services/userguides/pgi/pgiws_ug/pgi32u06.htm
+
+
+@node ENCODE and DECODE statements
+@subsection @code{ENCODE} and @code{DECODE} statements
+@cindex @code{ENCODE}
+@cindex @code{DECODE}
+
+GNU Fortran doesn't support the @code{ENCODE} and @code{DECODE}
+statements.  These statements are best replaced by @code{READ} and
+@code{WRITE} statements involving internal files (@code{CHARACTER}
+variables and arrays), which have been part of the Fortran standard since
+Fortran 77.  For example, replace a code fragment like
+
+@smallexample
+      INTEGER*1 LINE(80)
+      REAL A, B, C
+c     ... Code that sets LINE
+      DECODE (80, 9000, LINE) A, B, C
+ 9000 FORMAT (1X, 3(F10.5))
+@end smallexample
+
+@noindent
+with the following:
+
+@smallexample
+      CHARACTER(LEN=80) LINE
+      REAL A, B, C
+c     ... Code that sets LINE
+      READ (UNIT=LINE, FMT=9000) A, B, C
+ 9000 FORMAT (1X, 3(F10.5))
+@end smallexample
+
+Similarly, replace a code fragment like
+
+@smallexample
+      INTEGER*1 LINE(80)
+      REAL A, B, C
+c     ... Code that sets A, B and C
+      ENCODE (80, 9000, LINE) A, B, C
+ 9000 FORMAT (1X, 'OUTPUT IS ', 3(F10.5))
+@end smallexample
+
+@noindent
+with the following:
+
+@smallexample
+      CHARACTER(LEN=80) LINE
+      REAL A, B, C
+c     ... Code that sets A, B and C
+      WRITE (UNIT=LINE, FMT=9000) A, B, C
+ 9000 FORMAT (1X, 'OUTPUT IS ', 3(F10.5))
+@end smallexample
+
+
+@node Variable FORMAT expressions
+@subsection Variable @code{FORMAT} expressions
+@cindex @code{FORMAT}
+
+A variable @code{FORMAT} expression is format statement which includes
+angle brackets enclosing a Fortran expression: @code{FORMAT(I<N>)}.  GNU
+Fortran does not support this legacy extension.  The effect of variable
+format expressions can be reproduced by using the more powerful (and
+standard) combination of internal output and string formats.  For example,
+replace a code fragment like this:
+
+@smallexample
+      WRITE(6,20) INT1
+ 20   FORMAT(I<N+1>)
+@end smallexample
+
+@noindent
+with the following:
+
+@smallexample
+c     Variable declaration
+      CHARACTER(LEN=20) FMT
+c     
+c     Other code here...
+c
+      WRITE(FMT,'("(I", I0, ")")') N+1
+      WRITE(6,FMT) INT1
+@end smallexample
+
+@noindent
+or with:
+
+@smallexample
+c     Variable declaration
+      CHARACTER(LEN=20) FMT
+c     
+c     Other code here...
+c
+      WRITE(FMT,*) N+1
+      WRITE(6,"(I" // ADJUSTL(FMT) // ")") INT1
+@end smallexample
+
+
+@node Alternate complex function syntax
+@subsection Alternate complex function syntax
+@cindex Complex function
+
+Some Fortran compilers, including @command{g77}, let the user declare
+complex functions with the syntax @code{COMPLEX FUNCTION name*16()}, as
+well as @code{COMPLEX*16 FUNCTION name()}.  Both are non-standard, legacy
+extensions.  @command{gfortran} accepts the latter form, which is more
+common, but not the former.
+
+
+
+@c ---------------------------------------------------------------------
+@c Mixed-Language Programming
+@c ---------------------------------------------------------------------
+
+@node Mixed-Language Programming
+@chapter Mixed-Language Programming
+@cindex Interoperability
+@cindex Mixed-language programming
+
+@menu
+* Interoperability with C::
+* GNU Fortran Compiler Directives::
+* Non-Fortran Main Program::
+@end menu
+
+This chapter is about mixed-language interoperability, but also applies
+if one links Fortran code compiled by different compilers.  In most cases,
+use of the C Binding features of the Fortran 2003 standard is sufficient,
+and their use is highly recommended.
+
+
+@node Interoperability with C
+@section Interoperability with C
+
+@menu
+* Intrinsic Types::
+* Derived Types and struct::
+* Interoperable Global Variables::
+* Interoperable Subroutines and Functions::
+* Working with Pointers::
+* Further Interoperability of Fortran with C::
+@end menu
+
+Since Fortran 2003 (ISO/IEC 1539-1:2004(E)) there is a
+standardized way to generate procedure and derived-type
+declarations and global variables which are interoperable with C
+(ISO/IEC 9899:1999).  The @code{bind(C)} attribute has been added
+to inform the compiler that a symbol shall be interoperable with C;
+also, some constraints are added.  Note, however, that not
+all C features have a Fortran equivalent or vice versa.  For instance,
+neither C's unsigned integers nor C's functions with variable number
+of arguments have an equivalent in Fortran.
+
+Note that array dimensions are reversely ordered in C and that arrays in
+C always start with index 0 while in Fortran they start by default with
+1.  Thus, an array declaration @code{A(n,m)} in Fortran matches
+@code{A[m][n]} in C and accessing the element @code{A(i,j)} matches
+@code{A[j-1][i-1]}.  The element following @code{A(i,j)} (C: @code{A[j-1][i-1]};
+assuming @math{i < n}) in memory is @code{A(i+1,j)} (C: @code{A[j-1][i]}).
+
+@node Intrinsic Types
+@subsection Intrinsic Types
+
+In order to ensure that exactly the same variable type and kind is used
+in C and Fortran, the named constants shall be used which are defined in the
+@code{ISO_C_BINDING} intrinsic module.  That module contains named constants
+for kind parameters and character named constants for the escape sequences
+in C.  For a list of the constants, see @ref{ISO_C_BINDING}.
+
+@node Derived Types and struct
+@subsection Derived Types and struct
+
+For compatibility of derived types with @code{struct}, one needs to use
+the @code{BIND(C)} attribute in the type declaration.  For instance, the
+following type declaration
+
+@smallexample
+ USE ISO_C_BINDING
+ TYPE, BIND(C) :: myType
+   INTEGER(C_INT) :: i1, i2
+   INTEGER(C_SIGNED_CHAR) :: i3
+   REAL(C_DOUBLE) :: d1
+   COMPLEX(C_FLOAT_COMPLEX) :: c1
+   CHARACTER(KIND=C_CHAR) :: str(5)
+ END TYPE
+@end smallexample
+
+matches the following @code{struct} declaration in C
+
+@smallexample
+ struct @{
+   int i1, i2;
+   /* Note: "char" might be signed or unsigned.  */
+   signed char i3;
+   double d1;
+   float _Complex c1;
+   char str[5];
+ @} myType;
+@end smallexample
+
+Derived types with the C binding attribute shall not have the @code{sequence}
+attribute, type parameters, the @code{extends} attribute, nor type-bound
+procedures.  Every component must be of interoperable type and kind and may not
+have the @code{pointer} or @code{allocatable} attribute.  The names of the
+variables are irrelevant for interoperability.
+
+As there exist no direct Fortran equivalents, neither unions nor structs
+with bit field or variable-length array members are interoperable.
+
+@node Interoperable Global Variables
+@subsection Interoperable Global Variables
+
+Variables can be made accessible from C using the C binding attribute,
+optionally together with specifying a binding name.  Those variables
+have to be declared in the declaration part of a @code{MODULE},
+be of interoperable type, and have neither the @code{pointer} nor
+the @code{allocatable} attribute.
+
+@smallexample
+  MODULE m
+    USE myType_module
+    USE ISO_C_BINDING
+    integer(C_INT), bind(C, name="_MyProject_flags") :: global_flag
+    type(myType), bind(C) :: tp
+  END MODULE
+@end smallexample
+
+Here, @code{_MyProject_flags} is the case-sensitive name of the variable
+as seen from C programs while @code{global_flag} is the case-insensitive
+name as seen from Fortran.  If no binding name is specified, as for
+@var{tp}, the C binding name is the (lowercase) Fortran binding name.
+If a binding name is specified, only a single variable may be after the
+double colon.  Note of warning: You cannot use a global variable to
+access @var{errno} of the C library as the C standard allows it to be
+a macro.  Use the @code{IERRNO} intrinsic (GNU extension) instead.
+
+@node Interoperable Subroutines and Functions
+@subsection Interoperable Subroutines and Functions
+
+Subroutines and functions have to have the @code{BIND(C)} attribute to
+be compatible with C.  The dummy argument declaration is relatively
+straightforward.  However, one needs to be careful because C uses
+call-by-value by default while Fortran behaves usually similar to
+call-by-reference.  Furthermore, strings and pointers are handled
+differently.  Note that only explicit size and assumed-size arrays are
+supported but not assumed-shape or allocatable arrays.
+
+To pass a variable by value, use the @code{VALUE} attribute.
+Thus the following C prototype
+
+@smallexample
+@code{int func(int i, int *j)}
+@end smallexample
+
+matches the Fortran declaration
+
+@smallexample
+  integer(c_int) function func(i,j)
+    use iso_c_binding, only: c_int
+    integer(c_int), VALUE :: i
+    integer(c_int) :: j
+@end smallexample
+
+Note that pointer arguments also frequently need the @code{VALUE} attribute,
+see @ref{Working with Pointers}.
+
+Strings are handled quite differently in C and Fortran.  In C a string
+is a @code{NUL}-terminated array of characters while in Fortran each string
+has a length associated with it and is thus not terminated (by e.g.
+@code{NUL}).  For example, if one wants to use the following C function,
+
+@smallexample
+  #include <stdio.h>
+  void print_C(char *string) /* equivalent: char string[]  */
+  @{
+     printf("%s\n", string);
+  @}
+@end smallexample
+
+to print ``Hello World'' from Fortran, one can call it using
+
+@smallexample
+  use iso_c_binding, only: C_CHAR, C_NULL_CHAR
+  interface
+    subroutine print_c(string) bind(C, name="print_C")
+      use iso_c_binding, only: c_char
+      character(kind=c_char) :: string(*)
+    end subroutine print_c
+  end interface
+  call print_c(C_CHAR_"Hello World"//C_NULL_CHAR)
+@end smallexample
+
+As the example shows, one needs to ensure that the
+string is @code{NUL} terminated.  Additionally, the dummy argument
+@var{string} of @code{print_C} is a length-one assumed-size
+array; using @code{character(len=*)} is not allowed.  The example
+above uses @code{c_char_"Hello World"} to ensure the string
+literal has the right type; typically the default character
+kind and @code{c_char} are the same and thus @code{"Hello World"}
+is equivalent.  However, the standard does not guarantee this.
+
+The use of strings is now further illustrated using the C library
+function @code{strncpy}, whose prototype is
+
+@smallexample
+  char *strncpy(char *restrict s1, const char *restrict s2, size_t n);
+@end smallexample
+
+The function @code{strncpy} copies at most @var{n} characters from
+string @var{s2} to @var{s1} and returns @var{s1}.  In the following
+example, we ignore the return value:
+
+@smallexample
+  use iso_c_binding
+  implicit none
+  character(len=30) :: str,str2
+  interface
+    ! Ignore the return value of strncpy -> subroutine
+    ! "restrict" is always assumed if we do not pass a pointer
+    subroutine strncpy(dest, src, n) bind(C)
+      import
+      character(kind=c_char),  intent(out) :: dest(*)
+      character(kind=c_char),  intent(in)  :: src(*)
+      integer(c_size_t), value, intent(in) :: n
+    end subroutine strncpy
+  end interface
+  str = repeat('X',30) ! Initialize whole string with 'X'
+  call strncpy(str, c_char_"Hello World"//C_NULL_CHAR, &
+               len(c_char_"Hello World",kind=c_size_t))
+  print '(a)', str ! prints: "Hello WorldXXXXXXXXXXXXXXXXXXX"
+  end
+@end smallexample
+
+The intrinsic procedures are described in @ref{Intrinsic Procedures}.
+
+@node Working with Pointers
+@subsection Working with Pointers
+
+C pointers are represented in Fortran via the special opaque derived type
+@code{type(c_ptr)} (with private components).  Thus one needs to
+use intrinsic conversion procedures to convert from or to C pointers.
+For example,
+
+@smallexample
+  use iso_c_binding
+  type(c_ptr) :: cptr1, cptr2
+  integer, target :: array(7), scalar
+  integer, pointer :: pa(:), ps
+  cptr1 = c_loc(array(1)) ! The programmer needs to ensure that the
+                          ! array is contiguous if required by the C
+                          ! procedure
+  cptr2 = c_loc(scalar)
+  call c_f_pointer(cptr2, ps)
+  call c_f_pointer(cptr2, pa, shape=[7])
+@end smallexample
+
+When converting C to Fortran arrays, the one-dimensional @code{SHAPE} argument
+has to be passed.
+
+If a pointer is a dummy-argument of an interoperable procedure, it usually
+has to be declared using the @code{VALUE} attribute.  @code{void*}
+matches @code{TYPE(C_PTR), VALUE}, while @code{TYPE(C_PTR)} alone
+matches @code{void**}.
+
+Procedure pointers are handled analogously to pointers; the C type is
+@code{TYPE(C_FUNPTR)} and the intrinsic conversion procedures are
+@code{C_F_PROCPOINTER} and @code{C_FUNLOC}.
+
+Let's consider two examples of actually passing a procedure pointer from
+C to Fortran and vice versa.  Note that these examples are also very
+similar to passing ordinary pointers between both languages.
+First, consider this code in C:
+
+@smallexample
+/* Procedure implemented in Fortran.  */
+void get_values (void (*)(double));
+
+/* Call-back routine we want called from Fortran.  */
+void
+print_it (double x)
+@{
+  printf ("Number is %f.\n", x);
+@}
+
+/* Call Fortran routine and pass call-back to it.  */
+void
+foobar ()
+@{
+  get_values (&print_it);
+@}
+@end smallexample
+
+A matching implementation for @code{get_values} in Fortran, that correctly
+receives the procedure pointer from C and is able to call it, is given
+in the following @code{MODULE}:
+
+@smallexample
+MODULE m
+  IMPLICIT NONE
+
+  ! Define interface of call-back routine.
+  ABSTRACT INTERFACE
+    SUBROUTINE callback (x)
+      USE, INTRINSIC :: ISO_C_BINDING
+      REAL(KIND=C_DOUBLE), INTENT(IN), VALUE :: x
+    END SUBROUTINE callback
+  END INTERFACE
+
+CONTAINS
+
+  ! Define C-bound procedure.
+  SUBROUTINE get_values (cproc) BIND(C)
+    USE, INTRINSIC :: ISO_C_BINDING
+    TYPE(C_FUNPTR), INTENT(IN), VALUE :: cproc
+
+    PROCEDURE(callback), POINTER :: proc
+
+    ! Convert C to Fortran procedure pointer.
+    CALL C_F_PROCPOINTER (cproc, proc)
+
+    ! Call it.
+    CALL proc (1.0_C_DOUBLE)
+    CALL proc (-42.0_C_DOUBLE)
+    CALL proc (18.12_C_DOUBLE)
+  END SUBROUTINE get_values
+
+END MODULE m
+@end smallexample
+
+Next, we want to call a C routine that expects a procedure pointer argument
+and pass it a Fortran procedure (which clearly must be interoperable!).
+Again, the C function may be:
+
+@smallexample
+int
+call_it (int (*func)(int), int arg)
+@{
+  return func (arg);
+@}
+@end smallexample
+
+It can be used as in the following Fortran code:
+
+@smallexample
+MODULE m
+  USE, INTRINSIC :: ISO_C_BINDING
+  IMPLICIT NONE
+
+  ! Define interface of C function.
+  INTERFACE
+    INTEGER(KIND=C_INT) FUNCTION call_it (func, arg) BIND(C)
+      USE, INTRINSIC :: ISO_C_BINDING
+      TYPE(C_FUNPTR), INTENT(IN), VALUE :: func
+      INTEGER(KIND=C_INT), INTENT(IN), VALUE :: arg
+    END FUNCTION call_it
+  END INTERFACE
+
+CONTAINS
+
+  ! Define procedure passed to C function.
+  ! It must be interoperable!
+  INTEGER(KIND=C_INT) FUNCTION double_it (arg) BIND(C)
+    INTEGER(KIND=C_INT), INTENT(IN), VALUE :: arg
+    double_it = arg + arg
+  END FUNCTION double_it
+
+  ! Call C function.
+  SUBROUTINE foobar ()
+    TYPE(C_FUNPTR) :: cproc
+    INTEGER(KIND=C_INT) :: i
+
+    ! Get C procedure pointer.
+    cproc = C_FUNLOC (double_it)
+
+    ! Use it.
+    DO i = 1_C_INT, 10_C_INT
+      PRINT *, call_it (cproc, i)
+    END DO
+  END SUBROUTINE foobar
+
+END MODULE m
+@end smallexample
+
+@node Further Interoperability of Fortran with C
+@subsection Further Interoperability of Fortran with C
+
+Assumed-shape and allocatable arrays are passed using an array descriptor
+(dope vector).  The internal structure of the array descriptor used
+by GNU Fortran is not yet documented and will change.  There will also be
+a Technical Report (TR 29113) which standardizes an interoperable
+array descriptor.  Until then, you can use the Chasm Language
+Interoperability Tools, @url{http://chasm-interop.sourceforge.net/},
+which provide an interface to GNU Fortran's array descriptor.
+
+The technical report 29113 will presumably also include support for
+C-interoperable @code{OPTIONAL} and for assumed-rank and assumed-type
+dummy arguments.  However, the TR has neither been approved nor implemented
+in GNU Fortran; therefore, these features are not yet available.
+
+
+
+@node GNU Fortran Compiler Directives
+@section GNU Fortran Compiler Directives
+
+The Fortran standard standard describes how a conforming program shall
+behave; however, the exact implementation is not standardized.  In order
+to allow the user to choose specific implementation details, compiler
+directives can be used to set attributes of variables and procedures
+which are not part of the standard.  Whether a given attribute is
+supported and its exact effects depend on both the operating system and
+on the processor; see
+@ref{Top,,C Extensions,gcc,Using the GNU Compiler Collection (GCC)}
+for details.
+
+For procedures and procedure pointers, the following attributes can
+be used to change the calling convention:
+
+@itemize
+@item @code{CDECL} -- standard C calling convention
+@item @code{STDCALL} -- convention where the called procedure pops the stack
+@item @code{FASTCALL} -- part of the arguments are passed via registers
+instead using the stack
+@end itemize
+
+Besides changing the calling convention, the attributes also influence
+the decoration of the symbol name, e.g., by a leading underscore or by
+a trailing at-sign followed by the number of bytes on the stack.  When
+assigning a procedure to a procedure pointer, both should use the same
+calling convention.
+
+On some systems, procedures and global variables (module variables and
+@code{COMMON} blocks) need special handling to be accessible when they
+are in a shared library.  The following attributes are available:
+
+@itemize
+@item @code{DLLEXPORT} -- provide a global pointer to a pointer in the DLL
+@item @code{DLLIMPORT} -- reference the function or variable using a global pointer 
+@end itemize
+
+The attributes are specified using the syntax
+
+@code{!GCC$ ATTRIBUTES} @var{attribute-list} @code{::} @var{variable-list}
+
+where in free-form source code only whitespace is allowed before @code{!GCC$}
+and in fixed-form source code @code{!GCC$}, @code{cGCC$} or @code{*GCC$} shall
+start in the first column.
+
+For procedures, the compiler directives shall be placed into the body
+of the procedure; for variables and procedure pointers, they shall be in
+the same declaration part as the variable or procedure pointer.
+
+
+
+@node Non-Fortran Main Program
+@section Non-Fortran Main Program
+
+@menu
+* _gfortran_set_args:: Save command-line arguments
+* _gfortran_set_options:: Set library option flags
+* _gfortran_set_convert:: Set endian conversion
+* _gfortran_set_record_marker:: Set length of record markers
+* _gfortran_set_max_subrecord_length:: Set subrecord length
+* _gfortran_set_fpe:: Set when a Floating Point Exception should be raised
+@end menu
+
+Even if you are doing mixed-language programming, it is very
+likely that you do not need to know or use the information in this
+section.  Since it is about the internal structure of GNU Fortran,
+it may also change in GCC minor releases.
+
+When you compile a @code{PROGRAM} with GNU Fortran, a function
+with the name @code{main} (in the symbol table of the object file)
+is generated, which initializes the libgfortran library and then
+calls the actual program which uses the name @code{MAIN__}, for
+historic reasons.  If you link GNU Fortran compiled procedures
+to, e.g., a C or C++ program or to a Fortran program compiled by
+a different compiler, the libgfortran library is not initialized
+and thus a few intrinsic procedures do not work properly, e.g.
+those for obtaining the command-line arguments.
+
+Therefore, if your @code{PROGRAM} is not compiled with
+GNU Fortran and the GNU Fortran compiled procedures require
+intrinsics relying on the library initialization, you need to
+initialize the library yourself.  Using the default options,
+gfortran calls @code{_gfortran_set_args} and
+@code{_gfortran_set_options}.  The initialization of the former
+is needed if the called procedures access the command line
+(and for backtracing); the latter sets some flags based on the
+standard chosen or to enable backtracing.  In typical programs,
+it is not necessary to call any initialization function.
+
+If your @code{PROGRAM} is compiled with GNU Fortran, you shall
+not call any of the following functions.  The libgfortran
+initialization functions are shown in C syntax but using C
+bindings they are also accessible from Fortran.
+
+
+@node _gfortran_set_args
+@subsection @code{_gfortran_set_args} --- Save command-line arguments
+@fnindex _gfortran_set_args
+@cindex libgfortran initialization, set_args
+
+@table @asis
+@item @emph{Description}:
+@code{_gfortran_set_args} saves the command-line arguments; this
+initialization is required if any of the command-line intrinsics
+is called.  Additionally, it shall be called if backtracing is
+enabled (see @code{_gfortran_set_options}).
+
+@item @emph{Syntax}:
+@code{void _gfortran_set_args (int argc, char *argv[])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{argc} @tab number of command line argument strings
+@item @var{argv} @tab the command-line argument strings; argv[0]
+is the pathname of the executable itself.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+int main (int argc, char *argv[])
+@{
+  /* Initialize libgfortran.  */
+  _gfortran_set_args (argc, argv);
+  return 0;
+@}
+@end smallexample
+@end table
+
+
+@node _gfortran_set_options
+@subsection @code{_gfortran_set_options} --- Set library option flags
+@fnindex _gfortran_set_options
+@cindex libgfortran initialization, set_options
+
+@table @asis
+@item @emph{Description}:
+@code{_gfortran_set_options} sets several flags related to the Fortran
+standard to be used, whether backtracing or core dumps should be enabled
+and whether range checks should be performed.  The syntax allows for
+upward compatibility since the number of passed flags is specified; for
+non-passed flags, the default value is used.  See also
+@pxref{Code Gen Options}.  Please note that not all flags are actually
+used.
+
+@item @emph{Syntax}:
+@code{void _gfortran_set_options (int num, int options[])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{num} @tab number of options passed
+@item @var{argv} @tab The list of flag values
+@end multitable
+
+@item @emph{option flag list}:
+@multitable @columnfractions .15 .70
+@item @var{option}[0] @tab Allowed standard; can give run-time errors
+if e.g. an input-output edit descriptor is invalid in a given standard.
+Possible values are (bitwise or-ed) @code{GFC_STD_F77} (1),
+@code{GFC_STD_F95_OBS} (2), @code{GFC_STD_F95_DEL} (4), @code{GFC_STD_F95}
+(8), @code{GFC_STD_F2003} (16), @code{GFC_STD_GNU} (32),
+@code{GFC_STD_LEGACY} (64), @code{GFC_STD_F2008} (128), and
+@code{GFC_STD_F2008_OBS} (256).  Default: @code{GFC_STD_F95_OBS
+| GFC_STD_F95_DEL | GFC_STD_F95 | GFC_STD_F2003 | GFC_STD_F2008
+| GFC_STD_F2008_OBS | GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY}.
+@item @var{option}[1] @tab Standard-warning flag; prints a warning to
+standard error.  Default: @code{GFC_STD_F95_DEL | GFC_STD_LEGACY}.
+@item @var{option}[2] @tab If non zero, enable pedantic checking.
+Default: off.
+@item @var{option}[3] @tab If non zero, enable core dumps on run-time
+errors.  Default: off.
+@item @var{option}[4] @tab If non zero, enable backtracing on run-time
+errors.  Default: off.
+Note: Installs a signal handler and requires command-line
+initialization using @code{_gfortran_set_args}.
+@item @var{option}[5] @tab If non zero, supports signed zeros.
+Default: enabled.
+@item @var{option}[6] @tab Enables run-time checking.  Possible values
+are (bitwise or-ed): GFC_RTCHECK_BOUNDS (1), GFC_RTCHECK_ARRAY_TEMPS (2),
+GFC_RTCHECK_RECURSION (4), GFC_RTCHECK_DO (16), GFC_RTCHECK_POINTER (32).
+Default: disabled.
+@item @var{option}[7] @tab If non zero, range checking is enabled.
+Default: enabled.  See -frange-check (@pxref{Code Gen Options}).
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+  /* Use gfortran 4.5 default options.  */
+  static int options[] = @{68, 255, 0, 0, 0, 1, 0, 1@};
+  _gfortran_set_options (8, &options);
+@end smallexample
+@end table
+
+
+@node _gfortran_set_convert
+@subsection @code{_gfortran_set_convert} --- Set endian conversion
+@fnindex _gfortran_set_convert
+@cindex libgfortran initialization, set_convert
+
+@table @asis
+@item @emph{Description}:
+@code{_gfortran_set_convert} set the representation of data for
+unformatted files.
+
+@item @emph{Syntax}:
+@code{void _gfortran_set_convert (int conv)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{conv} @tab Endian conversion, possible values:
+GFC_CONVERT_NATIVE (0, default), GFC_CONVERT_SWAP (1),
+GFC_CONVERT_BIG (2), GFC_CONVERT_LITTLE (3).
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+int main (int argc, char *argv[])
+@{
+  /* Initialize libgfortran.  */
+  _gfortran_set_args (argc, argv);
+  _gfortran_set_convert (1);
+  return 0;
+@}
+@end smallexample
+@end table
+
+
+@node _gfortran_set_record_marker
+@subsection @code{_gfortran_set_record_marker} --- Set length of record markers
+@fnindex _gfortran_set_record_marker
+@cindex libgfortran initialization, set_record_marker
+
+@table @asis
+@item @emph{Description}:
+@code{_gfortran_set_record_marker} sets the length of record markers
+for unformatted files.
+
+@item @emph{Syntax}:
+@code{void _gfortran_set_record_marker (int val)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{val} @tab Length of the record marker; valid values
+are 4 and 8.  Default is 4.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+int main (int argc, char *argv[])
+@{
+  /* Initialize libgfortran.  */
+  _gfortran_set_args (argc, argv);
+  _gfortran_set_record_marker (8);
+  return 0;
+@}
+@end smallexample
+@end table
+
+
+@node _gfortran_set_fpe
+@subsection @code{_gfortran_set_fpe} --- Set when a Floating Point Exception should be raised
+@fnindex _gfortran_set_fpe
+@cindex libgfortran initialization, set_fpe
+
+@table @asis
+@item @emph{Description}:
+@code{_gfortran_set_fpe} sets the IEEE exceptions for which a
+Floating Point Exception (FPE) should be raised.  On most systems,
+this will result in a SIGFPE signal being sent and the program
+being interrupted.
+
+@item @emph{Syntax}:
+@code{void _gfortran_set_fpe (int val)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{option}[0] @tab IEEE exceptions.  Possible values are
+(bitwise or-ed) zero (0, default) no trapping,
+@code{GFC_FPE_INVALID} (1), @code{GFC_FPE_DENORMAL} (2),
+@code{GFC_FPE_ZERO} (4), @code{GFC_FPE_OVERFLOW} (8),
+@code{GFC_FPE_UNDERFLOW} (16), and @code{GFC_FPE_PRECISION} (32).
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+int main (int argc, char *argv[])
+@{
+  /* Initialize libgfortran.  */
+  _gfortran_set_args (argc, argv);
+  /* FPE for invalid operations such as SQRT(-1.0).  */
+  _gfortran_set_fpe (1);
+  return 0;
+@}
+@end smallexample
+@end table
+
+
+@node _gfortran_set_max_subrecord_length
+@subsection @code{_gfortran_set_max_subrecord_length} --- Set subrecord length
+@fnindex _gfortran_set_max_subrecord_length
+@cindex libgfortran initialization, set_max_subrecord_length
+
+@table @asis
+@item @emph{Description}:
+@code{_gfortran_set_max_subrecord_length} set the maximum length
+for a subrecord.  This option only makes sense for testing and
+debugging of unformatted I/O.
+
+@item @emph{Syntax}:
+@code{void _gfortran_set_max_subrecord_length (int val)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{val} @tab the maximum length for a subrecord;
+the maximum permitted value is 2147483639, which is also
+the default.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+int main (int argc, char *argv[])
+@{
+  /* Initialize libgfortran.  */
+  _gfortran_set_args (argc, argv);
+  _gfortran_set_max_subrecord_length (8);
+  return 0;
+@}
+@end smallexample
+@end table
+
+
+
+@c Intrinsic Procedures
+@c ---------------------------------------------------------------------
+
+@include intrinsic.texi
+
+
+@tex
+\blankpart
+@end tex
+
+@c ---------------------------------------------------------------------
+@c Contributing
+@c ---------------------------------------------------------------------
+
+@node Contributing
+@unnumbered Contributing
+@cindex Contributing
+
+Free software is only possible if people contribute to efforts
+to create it.
+We're always in need of more people helping out with ideas
+and comments, writing documentation and contributing code.
+
+If you want to contribute to GNU Fortran,
+have a look at the long lists of projects you can take on.
+Some of these projects are small,
+some of them are large;
+some are completely orthogonal to the rest of what is
+happening on GNU Fortran,
+but others are ``mainstream'' projects in need of enthusiastic hackers.
+All of these projects are important!
+We'll eventually get around to the things here,
+but they are also things doable by someone who is willing and able.
+
+@menu
+* Contributors::
+* Projects::
+* Proposed Extensions::
+@end menu
+
+
+@node Contributors
+@section Contributors to GNU Fortran
+@cindex Contributors
+@cindex Credits
+@cindex Authors
+
+Most of the parser was hand-crafted by @emph{Andy Vaught}, who is
+also the initiator of the whole project.  Thanks Andy!
+Most of the interface with GCC was written by @emph{Paul Brook}.
+
+The following individuals have contributed code and/or
+ideas and significant help to the GNU Fortran project
+(in alphabetical order):
+
+@itemize @minus
+@item Janne Blomqvist
+@item Steven Bosscher
+@item Paul Brook
+@item Tobias Burnus
+@item Fran@,{c}ois-Xavier Coudert
+@item Bud Davis
+@item Jerry DeLisle
+@item Erik Edelmann
+@item Bernhard Fischer
+@item Daniel Franke
+@item Richard Guenther
+@item Richard Henderson
+@item Katherine Holcomb
+@item Jakub Jelinek
+@item Niels Kristian Bech Jensen
+@item Steven Johnson
+@item Steven G. Kargl
+@item Thomas Koenig
+@item Asher Langton
+@item H. J. Lu
+@item Toon Moene
+@item Brooks Moses
+@item Andrew Pinski
+@item Tim Prince
+@item Christopher D. Rickett
+@item Richard Sandiford
+@item Tobias Schl@"uter
+@item Roger Sayle
+@item Paul Thomas
+@item Andy Vaught
+@item Feng Wang
+@item Janus Weil
+@item Daniel Kraft
+@end itemize
+
+The following people have contributed bug reports,
+smaller or larger patches,
+and much needed feedback and encouragement for the
+GNU Fortran project: 
+
+@itemize @minus
+@item Bill Clodius
+@item Dominique d'Humi@`eres
+@item Kate Hedstrom
+@item Erik Schnetter
+@item Joost VandeVondele
+@end itemize
+
+Many other individuals have helped debug,
+test and improve the GNU Fortran compiler over the past few years,
+and we welcome you to do the same!
+If you already have done so,
+and you would like to see your name listed in the
+list above, please contact us.
+
+
+@node Projects
+@section Projects
+
+@table @emph
+
+@item Help build the test suite
+Solicit more code for donation to the test suite: the more extensive the
+testsuite, the smaller the risk of breaking things in the future! We can
+keep code private on request.
+
+@item Bug hunting/squishing
+Find bugs and write more test cases! Test cases are especially very
+welcome, because it allows us to concentrate on fixing bugs instead of
+isolating them.  Going through the bugzilla database at
+@url{http://gcc.gnu.org/@/bugzilla/} to reduce testcases posted there and
+add more information (for example, for which version does the testcase
+work, for which versions does it fail?) is also very helpful.
+
+@end table
+
+
+@node Proposed Extensions
+@section Proposed Extensions
+
+Here's a list of proposed extensions for the GNU Fortran compiler, in no particular
+order.  Most of these are necessary to be fully compatible with
+existing Fortran compilers, but they are not part of the official
+J3 Fortran 95 standard.
+
+@subsection Compiler extensions: 
+@itemize @bullet
+@item
+User-specified alignment rules for structures.
+
+@item
+Automatically extend single precision constants to double.
+
+@item
+Compile code that conserves memory by dynamically allocating common and
+module storage either on stack or heap.
+
+@item
+Compile flag to generate code for array conformance checking (suggest -CC).
+
+@item
+User control of symbol names (underscores, etc).
+
+@item
+Compile setting for maximum size of stack frame size before spilling
+parts to static or heap.
+
+@item
+Flag to force local variables into static space.
+
+@item
+Flag to force local variables onto stack.
+@end itemize
+
+
+@subsection Environment Options
+@itemize @bullet
+@item
+Pluggable library modules for random numbers, linear algebra.
+LA should use BLAS calling conventions.
+
+@item
+Environment variables controlling actions on arithmetic exceptions like
+overflow, underflow, precision loss---Generate NaN, abort, default.
+action.
+
+@item
+Set precision for fp units that support it (i387).
+
+@item
+Variable for setting fp rounding mode.
+
+@item
+Variable to fill uninitialized variables with a user-defined bit
+pattern.
+
+@item
+Environment variable controlling filename that is opened for that unit
+number.
+
+@item
+Environment variable to clear/trash memory being freed.
+
+@item
+Environment variable to control tracing of allocations and frees.
+
+@item
+Environment variable to display allocated memory at normal program end.
+
+@item
+Environment variable for filename for * IO-unit.
+
+@item
+Environment variable for temporary file directory.
+
+@item
+Environment variable forcing standard output to be line buffered (unix).
+
+@end itemize
+
+
+@c ---------------------------------------------------------------------
+@c GNU General Public License
+@c ---------------------------------------------------------------------
+
+@include gpl_v3.texi
+
+
+
+@c ---------------------------------------------------------------------
+@c GNU Free Documentation License
+@c ---------------------------------------------------------------------
+
+@include fdl.texi
+
+
+
+@c ---------------------------------------------------------------------
+@c Funding Free Software
+@c ---------------------------------------------------------------------
+
+@include funding.texi
+
+@c ---------------------------------------------------------------------
+@c Indices
+@c ---------------------------------------------------------------------
+
+@node Option Index
+@unnumbered Option Index
+@command{gfortran}'s command line options are indexed here without any
+initial @samp{-} or @samp{--}.  Where an option has both positive and
+negative forms (such as -foption and -fno-option), relevant entries in
+the manual are indexed under the most appropriate form; it may sometimes
+be useful to look up both forms.
+@printindex op
+
+@node Keyword Index
+@unnumbered Keyword Index
+@printindex cp
+
+@bye
diff --git a/gcc/fortran/gfortranspec.c b/gcc/fortran/gfortranspec.c
new file mode 100644
index 000000000..36c7b4429
--- /dev/null
+++ b/gcc/fortran/gfortranspec.c
@@ -0,0 +1,487 @@
+/* Specific flags and argument handling of the Fortran front-end.
+   Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+   2007, 2008, 2009, 2010, 2011
+   Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GNU CC is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU CC is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* This file is copied more or less verbatim from g77.  */
+/* This file contains a filter for the main `gcc' driver, which is
+   replicated for the `gfortran' driver by adding this filter.  The purpose
+   of this filter is to be basically identical to gcc (in that
+   it faithfully passes all of the original arguments to gcc) but,
+   unless explicitly overridden by the user in certain ways, ensure
+   that the needs of the language supported by this wrapper are met.
+
+   For GNU Fortran 95(gfortran), we do the following to the argument list
+   before passing it to `gcc':
+
+   1.  Make sure `-lgfortran -lm' is at the end of the list.
+
+   2.  Make sure each time `-lgfortran' or `-lm' is seen, it forms
+       part of the series `-lgfortran -lm'.
+
+   #1 and #2 are not done if `-nostdlib' or any option that disables
+   the linking phase is present, or if `-xfoo' is in effect.  Note that
+   a lack of source files or -l options disables linking.
+
+   This program was originally made out of gcc/cp/g++spec.c, but the
+   way it builds the new argument list was rewritten so it is much
+   easier to maintain, improve the way it decides to add or not add
+   extra arguments, etc.  And several improvements were made in the
+   handling of arguments, primarily to make it more consistent with
+   `gcc' itself.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "gcc.h"
+#include "opts.h"
+
+#include "tm.h"
+#include "intl.h"
+
+#ifndef MATH_LIBRARY
+#define MATH_LIBRARY "m"
+#endif
+
+#ifndef FORTRAN_LIBRARY
+#define FORTRAN_LIBRARY "gfortran"
+#endif
+
+/* Name of the spec file.  */
+#define SPEC_FILE "libgfortran.spec"
+
+/* The original argument list and related info is copied here.  */
+static unsigned int g77_xargc;
+static const struct cl_decoded_option *g77_x_decoded_options;
+static void append_arg (const struct cl_decoded_option *);
+
+/* The new argument list will be built here.  */
+static unsigned int g77_newargc;
+static struct cl_decoded_option *g77_new_decoded_options;
+
+/* The path to the spec file.  */
+static char *spec_file = NULL;
+
+/* This will be NULL if we encounter a situation where we should not
+   link in the fortran libraries.  */
+static const char *library = NULL;
+
+
+/* Return full path name of spec file if it is in DIR, or NULL if
+   not.  */
+static char *
+find_spec_file (const char *dir)
+{
+  const char dirsep_string[] = { DIR_SEPARATOR, '\0' };
+  char *spec;
+  struct stat sb;
+
+  spec = XNEWVEC (char, strlen (dir) + sizeof (SPEC_FILE) + 4);
+  strcpy (spec, dir);
+  strcat (spec, dirsep_string);
+  strcat (spec, SPEC_FILE);
+  if (!stat (spec, &sb))
+    return spec;
+  free (spec);
+  return NULL;
+}
+
+
+/* Return whether strings S1 and S2 are both NULL or both the same
+   string.  */
+
+static bool
+strings_same (const char *s1, const char *s2)
+{
+  return s1 == s2 || (s1 != NULL && s2 != NULL && strcmp (s1, s2) == 0);
+}
+
+/* Return whether decoded option structures OPT1 and OPT2 are the
+   same.  */
+
+static bool
+options_same (const struct cl_decoded_option *opt1,
+	      const struct cl_decoded_option *opt2)
+{
+  return (opt1->opt_index == opt2->opt_index
+	  && strings_same (opt1->arg, opt2->arg)
+	  && strings_same (opt1->orig_option_with_args_text,
+			   opt2->orig_option_with_args_text)
+	  && strings_same (opt1->canonical_option[0],
+			   opt2->canonical_option[0])
+	  && strings_same (opt1->canonical_option[1],
+			   opt2->canonical_option[1])
+	  && strings_same (opt1->canonical_option[2],
+			   opt2->canonical_option[2])
+	  && strings_same (opt1->canonical_option[3],
+			   opt2->canonical_option[3])
+	  && (opt1->canonical_option_num_elements
+	      == opt2->canonical_option_num_elements)
+	  && opt1->value == opt2->value
+	  && opt1->errors == opt2->errors);
+}
+
+/* Append another argument to the list being built.  As long as it is
+   identical to the corresponding arg in the original list, just increment
+   the new arg count.  Otherwise allocate a new list, etc.  */
+
+static void
+append_arg (const struct cl_decoded_option *arg)
+{
+  static unsigned int newargsize;
+
+  if (g77_new_decoded_options == g77_x_decoded_options
+      && g77_newargc < g77_xargc
+      && options_same (arg, &g77_x_decoded_options[g77_newargc]))
+    {
+      ++g77_newargc;
+      return;			/* Nothing new here.  */
+    }
+
+  if (g77_new_decoded_options == g77_x_decoded_options)
+    {				/* Make new arglist.  */
+      unsigned int i;
+
+      newargsize = (g77_xargc << 2) + 20;	/* This should handle all.  */
+      g77_new_decoded_options = XNEWVEC (struct cl_decoded_option, newargsize);
+
+      /* Copy what has been done so far.  */
+      for (i = 0; i < g77_newargc; ++i)
+	g77_new_decoded_options[i] = g77_x_decoded_options[i];
+    }
+
+  if (g77_newargc == newargsize)
+    fatal_error ("overflowed output arg list for %qs",
+		 arg->orig_option_with_args_text);
+
+  g77_new_decoded_options[g77_newargc++] = *arg;
+}
+
+/* Append an option described by OPT_INDEX, ARG and VALUE to the list
+   being built.  */
+static void
+append_option (size_t opt_index, const char *arg, int value)
+{
+  struct cl_decoded_option decoded;
+
+  generate_option (opt_index, arg, value, CL_DRIVER, &decoded);
+  append_arg (&decoded);
+}
+
+/* Append a libgfortran argument to the list being built.  If
+   FORCE_STATIC, ensure the library is linked statically.  */
+
+static void
+add_arg_libgfortran (bool force_static ATTRIBUTE_UNUSED)
+{
+#ifdef HAVE_LD_STATIC_DYNAMIC
+  if (force_static)
+    append_option (OPT_Wl_, LD_STATIC_OPTION, 1);
+#endif
+  append_option (OPT_l, FORTRAN_LIBRARY, 1);
+#ifdef HAVE_LD_STATIC_DYNAMIC
+  if (force_static)
+    append_option (OPT_Wl_, LD_DYNAMIC_OPTION, 1);
+#endif
+}
+
+void
+lang_specific_driver (struct cl_decoded_option **in_decoded_options,
+		      unsigned int *in_decoded_options_count,
+		      int *in_added_libraries ATTRIBUTE_UNUSED)
+{
+  unsigned int argc = *in_decoded_options_count;
+  struct cl_decoded_option *decoded_options = *in_decoded_options;
+  unsigned int i;
+  int verbose = 0;
+
+  /* 0 => -xnone in effect.
+     1 => -xfoo in effect.  */
+  int saw_speclang = 0;
+
+  /* 0 => initial/reset state
+     1 => last arg was -l<library>
+     2 => last two args were -l<library> -lm.  */
+  int saw_library = 0;
+
+  /* By default, we throw on the math library if we have one.  */
+  int need_math = (MATH_LIBRARY[0] != '\0');
+
+  /* Whether we should link a static libgfortran. */
+  int static_lib = 0; 
+
+  /* Whether we need to link statically.  */
+  int static_linking = 0;
+
+  /* The number of input and output files in the incoming arg list.  */
+  int n_infiles = 0;
+  int n_outfiles = 0;
+
+  library = FORTRAN_LIBRARY;
+
+#if 0
+  fprintf (stderr, "Incoming:");
+  for (i = 0; i < argc; i++)
+    fprintf (stderr, " %s", decoded_options[i].orig_option_with_args_text);
+  fprintf (stderr, "\n");
+#endif
+
+  g77_xargc = argc;
+  g77_x_decoded_options = decoded_options;
+  g77_newargc = 0;
+  g77_new_decoded_options = decoded_options;
+
+  /* First pass through arglist.
+
+     If -nostdlib or a "turn-off-linking" option is anywhere in the
+     command line, don't do any library-option processing (except
+     relating to -x).  */
+
+  for (i = 1; i < argc; ++i)
+    {
+      if (decoded_options[i].errors & CL_ERR_MISSING_ARG)
+	continue;
+
+      switch (decoded_options[i].opt_index)
+	{
+	case OPT_SPECIAL_input_file:
+	  ++n_infiles;
+	  continue;
+
+	case OPT_nostdlib:
+	case OPT_nodefaultlibs:
+	case OPT_c:
+	case OPT_S:
+	case OPT_fsyntax_only:
+	case OPT_E:
+	  /* These options disable linking entirely or linking of the
+	     standard libraries.  */
+	  library = 0;
+	  break;
+
+	case OPT_static_libgfortran:
+#ifdef HAVE_LD_STATIC_DYNAMIC
+	  static_lib = 1;
+#endif
+	  break;
+
+	case OPT_static:
+#ifdef HAVE_LD_STATIC_DYNAMIC
+	  static_linking = 1;
+#endif
+	  break;
+
+	case OPT_l:
+	  ++n_infiles;
+	  break;
+
+	case OPT_o:
+	  ++n_outfiles;
+	  break;
+
+	case OPT_v:
+	  verbose = 1;
+	  break;
+
+	case OPT__version:
+	  printf ("GNU Fortran %s%s\n", pkgversion_string, version_string);
+	  printf ("Copyright %s 2011 Free Software Foundation, Inc.\n\n",
+		  _("(C)"));
+	  printf (_("GNU Fortran comes with NO WARRANTY, to the extent permitted by law.\n\
+You may redistribute copies of GNU Fortran\n\
+under the terms of the GNU General Public License.\n\
+For more information about these matters, see the file named COPYING\n\n"));
+	  exit (0);
+	  break;
+
+	case OPT__help:
+	  /* Let gcc.c handle this, as it has a really
+	     cool facility for handling --help and --verbose --help.  */
+	  return;
+
+	case OPT_L:
+	  if (!spec_file)
+	    spec_file = find_spec_file (decoded_options[i].arg);
+	  break;
+
+
+	default:
+	  break;
+	}
+    }
+
+  if ((n_outfiles != 0) && (n_infiles == 0))
+    fatal_error ("no input files; unwilling to write output files");
+
+  /* If there are no input files, no need for the library.  */
+  if (n_infiles == 0)
+    library = 0;
+
+  /* Second pass through arglist, transforming arguments as appropriate.  */
+
+  append_arg (&decoded_options[0]); /* Start with command name, of course.  */
+
+  for (i = 1; i < argc; ++i)
+    {
+      if (decoded_options[i].errors & CL_ERR_MISSING_ARG)
+	{
+	  append_arg (&decoded_options[i]);
+	  continue;
+	}
+
+      if (decoded_options[i].opt_index == OPT_SPECIAL_input_file
+	  && decoded_options[i].arg[0] == '\0')
+	{
+	  /* Interesting.  Just append as is.  */
+	  append_arg (&decoded_options[i]);
+	  continue;
+	}
+
+      if (decoded_options[i].opt_index != OPT_l
+	  && (decoded_options[i].opt_index != OPT_SPECIAL_input_file
+	      || strcmp (decoded_options[i].arg, "-") == 0))
+	{
+	  /* Not a filename or library.  */
+
+	  if (saw_library == 1 && need_math)	/* -l<library>.  */
+	    append_option (OPT_l, MATH_LIBRARY, 1);
+
+	  saw_library = 0;
+
+	  if (decoded_options[i].opt_index == OPT_SPECIAL_input_file)
+	    {
+	      append_arg (&decoded_options[i]);	/* "-" == Standard input.  */
+	      continue;
+	    }
+
+	  if (decoded_options[i].opt_index == OPT_x)
+	    {
+	      /* Track input language.  */
+	      const char *lang = decoded_options[i].arg;
+
+	      saw_speclang = (strcmp (lang, "none") != 0);
+	    }
+
+	  append_arg (&decoded_options[i]);
+
+	  continue;
+	}
+
+      /* A filename/library, not an option.  */
+
+      if (saw_speclang)
+	saw_library = 0;	/* -xfoo currently active.  */
+      else
+	{			/* -lfoo or filename.  */
+	  if (decoded_options[i].opt_index == OPT_l
+	      && strcmp (decoded_options[i].arg, MATH_LIBRARY) == 0)
+	    {
+	      if (saw_library == 1)
+		saw_library = 2;	/* -l<library> -lm.  */
+	      else
+		add_arg_libgfortran (static_lib && !static_linking);
+	    }
+	  else if (decoded_options[i].opt_index == OPT_l
+	      && strcmp (decoded_options[i].arg, FORTRAN_LIBRARY) == 0)
+	    {
+	      saw_library = 1;	/* -l<library>.  */
+	      add_arg_libgfortran (static_lib && !static_linking);
+	      continue;
+	    }
+	  else
+	    {			/* Other library, or filename.  */
+	      if (saw_library == 1 && need_math)
+		append_option (OPT_l, MATH_LIBRARY, 1);
+	      saw_library = 0;
+	    }
+	}
+      append_arg (&decoded_options[i]);
+    }
+
+  /* Append `-lgfortran -lm' as necessary.  */
+
+  if (library)
+    {				/* Doing a link and no -nostdlib.  */
+      if (saw_speclang)
+	append_option (OPT_x, "none", 1);
+
+      switch (saw_library)
+	{
+	case 0:
+	  add_arg_libgfortran (static_lib && !static_linking);
+	  /* Fall through.  */
+
+	case 1:
+	  if (need_math)
+	    append_option (OPT_l, MATH_LIBRARY, 1);
+	default:
+	  break;
+	}
+    }
+
+#ifdef ENABLE_SHARED_LIBGCC
+  if (library)
+    {
+      unsigned int i;
+
+      for (i = 1; i < g77_newargc; i++)
+	if (g77_new_decoded_options[i].opt_index == OPT_static_libgcc
+	    || g77_new_decoded_options[i].opt_index == OPT_static)
+	  break;
+
+      if (i == g77_newargc)
+	append_option (OPT_shared_libgcc, NULL, 1);
+    }
+
+#endif
+
+  /* Read the specs file corresponding to libgfortran.
+     If we didn't find the spec file on the -L path, we load it
+     via lang_specific_pre_link.  */
+  if (spec_file)
+    append_option (OPT_specs_, spec_file, 1);
+
+  if (verbose && g77_new_decoded_options != g77_x_decoded_options)
+    {
+      fprintf (stderr, _("Driving:"));
+      for (i = 0; i < g77_newargc; i++)
+	fprintf (stderr, " %s",
+		 g77_new_decoded_options[i].orig_option_with_args_text);
+      fprintf (stderr, "\n");
+    }
+
+  *in_decoded_options_count = g77_newargc;
+  *in_decoded_options = g77_new_decoded_options;
+}
+
+
+/* Called before linking.  Returns 0 on success and -1 on failure.  */
+int
+lang_specific_pre_link (void)
+{
+  if (spec_file)
+    free (spec_file);
+  else if (library)
+    do_spec ("%:include(libgfortran.spec)");
+
+  return 0;
+}
+
+/* Number of extra output files that lang_specific_pre_link may generate.  */
+int lang_specific_extra_outfiles = 0;	/* Not used for F77.  */
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
new file mode 100644
index 000000000..cc7eef75d
--- /dev/null
+++ b/gcc/fortran/interface.c
@@ -0,0 +1,3448 @@
+/* Deal with interfaces.
+   Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009,
+   2010
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+/* Deal with interfaces.  An explicit interface is represented as a
+   singly linked list of formal argument structures attached to the
+   relevant symbols.  For an implicit interface, the arguments don't
+   point to symbols.  Explicit interfaces point to namespaces that
+   contain the symbols within that interface.
+
+   Implicit interfaces are linked together in a singly linked list
+   along the next_if member of symbol nodes.  Since a particular
+   symbol can only have a single explicit interface, the symbol cannot
+   be part of multiple lists and a single next-member suffices.
+
+   This is not the case for general classes, though.  An operator
+   definition is independent of just about all other uses and has it's
+   own head pointer.
+
+   Nameless interfaces:
+     Nameless interfaces create symbols with explicit interfaces within
+     the current namespace.  They are otherwise unlinked.
+
+   Generic interfaces:
+     The generic name points to a linked list of symbols.  Each symbol
+     has an explicit interface.  Each explicit interface has its own
+     namespace containing the arguments.  Module procedures are symbols in
+     which the interface is added later when the module procedure is parsed.
+
+   User operators:
+     User-defined operators are stored in a their own set of symtrees
+     separate from regular symbols.  The symtrees point to gfc_user_op
+     structures which in turn head up a list of relevant interfaces.
+
+   Extended intrinsics and assignment:
+     The head of these interface lists are stored in the containing namespace.
+
+   Implicit interfaces:
+     An implicit interface is represented as a singly linked list of
+     formal argument list structures that don't point to any symbol
+     nodes -- they just contain types.
+
+
+   When a subprogram is defined, the program unit's name points to an
+   interface as usual, but the link to the namespace is NULL and the
+   formal argument list points to symbols within the same namespace as
+   the program unit name.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+#include "match.h"
+
+/* The current_interface structure holds information about the
+   interface currently being parsed.  This structure is saved and
+   restored during recursive interfaces.  */
+
+gfc_interface_info current_interface;
+
+
+/* Free a singly linked list of gfc_interface structures.  */
+
+void
+gfc_free_interface (gfc_interface *intr)
+{
+  gfc_interface *next;
+
+  for (; intr; intr = next)
+    {
+      next = intr->next;
+      gfc_free (intr);
+    }
+}
+
+
+/* Change the operators unary plus and minus into binary plus and
+   minus respectively, leaving the rest unchanged.  */
+
+static gfc_intrinsic_op
+fold_unary_intrinsic (gfc_intrinsic_op op)
+{
+  switch (op)
+    {
+    case INTRINSIC_UPLUS:
+      op = INTRINSIC_PLUS;
+      break;
+    case INTRINSIC_UMINUS:
+      op = INTRINSIC_MINUS;
+      break;
+    default:
+      break;
+    }
+
+  return op;
+}
+
+
+/* Match a generic specification.  Depending on which type of
+   interface is found, the 'name' or 'op' pointers may be set.
+   This subroutine doesn't return MATCH_NO.  */
+
+match
+gfc_match_generic_spec (interface_type *type,
+			char *name,
+			gfc_intrinsic_op *op)
+{
+  char buffer[GFC_MAX_SYMBOL_LEN + 1];
+  match m;
+  gfc_intrinsic_op i;
+
+  if (gfc_match (" assignment ( = )") == MATCH_YES)
+    {
+      *type = INTERFACE_INTRINSIC_OP;
+      *op = INTRINSIC_ASSIGN;
+      return MATCH_YES;
+    }
+
+  if (gfc_match (" operator ( %o )", &i) == MATCH_YES)
+    {				/* Operator i/f */
+      *type = INTERFACE_INTRINSIC_OP;
+      *op = fold_unary_intrinsic (i);
+      return MATCH_YES;
+    }
+
+  *op = INTRINSIC_NONE;
+  if (gfc_match (" operator ( ") == MATCH_YES)
+    {
+      m = gfc_match_defined_op_name (buffer, 1);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m != MATCH_YES)
+	return MATCH_ERROR;
+
+      m = gfc_match_char (')');
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m != MATCH_YES)
+	return MATCH_ERROR;
+
+      strcpy (name, buffer);
+      *type = INTERFACE_USER_OP;
+      return MATCH_YES;
+    }
+
+  if (gfc_match_name (buffer) == MATCH_YES)
+    {
+      strcpy (name, buffer);
+      *type = INTERFACE_GENERIC;
+      return MATCH_YES;
+    }
+
+  *type = INTERFACE_NAMELESS;
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in generic specification at %C");
+  return MATCH_ERROR;
+}
+
+
+/* Match one of the five F95 forms of an interface statement.  The
+   matcher for the abstract interface follows.  */
+
+match
+gfc_match_interface (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  interface_type type;
+  gfc_symbol *sym;
+  gfc_intrinsic_op op;
+  match m;
+
+  m = gfc_match_space ();
+
+  if (gfc_match_generic_spec (&type, name, &op) == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  /* If we're not looking at the end of the statement now, or if this
+     is not a nameless interface but we did not see a space, punt.  */
+  if (gfc_match_eos () != MATCH_YES
+      || (type != INTERFACE_NAMELESS && m != MATCH_YES))
+    {
+      gfc_error ("Syntax error: Trailing garbage in INTERFACE statement "
+		 "at %C");
+      return MATCH_ERROR;
+    }
+
+  current_interface.type = type;
+
+  switch (type)
+    {
+    case INTERFACE_GENERIC:
+      if (gfc_get_symbol (name, NULL, &sym))
+	return MATCH_ERROR;
+
+      if (!sym->attr.generic 
+	  && gfc_add_generic (&sym->attr, sym->name, NULL) == FAILURE)
+	return MATCH_ERROR;
+
+      if (sym->attr.dummy)
+	{
+	  gfc_error ("Dummy procedure '%s' at %C cannot have a "
+		     "generic interface", sym->name);
+	  return MATCH_ERROR;
+	}
+
+      current_interface.sym = gfc_new_block = sym;
+      break;
+
+    case INTERFACE_USER_OP:
+      current_interface.uop = gfc_get_uop (name);
+      break;
+
+    case INTERFACE_INTRINSIC_OP:
+      current_interface.op = op;
+      break;
+
+    case INTERFACE_NAMELESS:
+    case INTERFACE_ABSTRACT:
+      break;
+    }
+
+  return MATCH_YES;
+}
+
+
+
+/* Match a F2003 abstract interface.  */
+
+match
+gfc_match_abstract_interface (void)
+{
+  match m;
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ABSTRACT INTERFACE at %C")
+		      == FAILURE)
+    return MATCH_ERROR;
+
+  m = gfc_match_eos ();
+
+  if (m != MATCH_YES)
+    {
+      gfc_error ("Syntax error in ABSTRACT INTERFACE statement at %C");
+      return MATCH_ERROR;
+    }
+
+  current_interface.type = INTERFACE_ABSTRACT;
+
+  return m;
+}
+
+
+/* Match the different sort of generic-specs that can be present after
+   the END INTERFACE itself.  */
+
+match
+gfc_match_end_interface (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  interface_type type;
+  gfc_intrinsic_op op;
+  match m;
+
+  m = gfc_match_space ();
+
+  if (gfc_match_generic_spec (&type, name, &op) == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  /* If we're not looking at the end of the statement now, or if this
+     is not a nameless interface but we did not see a space, punt.  */
+  if (gfc_match_eos () != MATCH_YES
+      || (type != INTERFACE_NAMELESS && m != MATCH_YES))
+    {
+      gfc_error ("Syntax error: Trailing garbage in END INTERFACE "
+		 "statement at %C");
+      return MATCH_ERROR;
+    }
+
+  m = MATCH_YES;
+
+  switch (current_interface.type)
+    {
+    case INTERFACE_NAMELESS:
+    case INTERFACE_ABSTRACT:
+      if (type != INTERFACE_NAMELESS)
+	{
+	  gfc_error ("Expected a nameless interface at %C");
+	  m = MATCH_ERROR;
+	}
+
+      break;
+
+    case INTERFACE_INTRINSIC_OP:
+      if (type != current_interface.type || op != current_interface.op)
+	{
+
+	  if (current_interface.op == INTRINSIC_ASSIGN)
+	    {
+	      m = MATCH_ERROR;
+	      gfc_error ("Expected 'END INTERFACE ASSIGNMENT (=)' at %C");
+	    }
+	  else
+	    {
+	      const char *s1, *s2;
+	      s1 = gfc_op2string (current_interface.op);
+	      s2 = gfc_op2string (op);
+
+	      /* The following if-statements are used to enforce C1202
+		 from F2003.  */
+	      if ((strcmp(s1, "==") == 0 && strcmp(s2, ".eq.") == 0)
+		  || (strcmp(s1, ".eq.") == 0 && strcmp(s2, "==") == 0))
+		break;
+	      if ((strcmp(s1, "/=") == 0 && strcmp(s2, ".ne.") == 0)
+		  || (strcmp(s1, ".ne.") == 0 && strcmp(s2, "/=") == 0))
+		break;
+	      if ((strcmp(s1, "<=") == 0 && strcmp(s2, ".le.") == 0)
+		  || (strcmp(s1, ".le.") == 0 && strcmp(s2, "<=") == 0))
+		break;
+	      if ((strcmp(s1, "<") == 0 && strcmp(s2, ".lt.") == 0)
+		  || (strcmp(s1, ".lt.") == 0 && strcmp(s2, "<") == 0))
+		break;
+	      if ((strcmp(s1, ">=") == 0 && strcmp(s2, ".ge.") == 0)
+		  || (strcmp(s1, ".ge.") == 0 && strcmp(s2, ">=") == 0))
+		break;
+	      if ((strcmp(s1, ">") == 0 && strcmp(s2, ".gt.") == 0)
+		  || (strcmp(s1, ".gt.") == 0 && strcmp(s2, ">") == 0))
+		break;
+
+	      m = MATCH_ERROR;
+	      gfc_error ("Expecting 'END INTERFACE OPERATOR (%s)' at %C, "
+			 "but got %s", s1, s2);
+	    }
+		
+	}
+
+      break;
+
+    case INTERFACE_USER_OP:
+      /* Comparing the symbol node names is OK because only use-associated
+	 symbols can be renamed.  */
+      if (type != current_interface.type
+	  || strcmp (current_interface.uop->name, name) != 0)
+	{
+	  gfc_error ("Expecting 'END INTERFACE OPERATOR (.%s.)' at %C",
+		     current_interface.uop->name);
+	  m = MATCH_ERROR;
+	}
+
+      break;
+
+    case INTERFACE_GENERIC:
+      if (type != current_interface.type
+	  || strcmp (current_interface.sym->name, name) != 0)
+	{
+	  gfc_error ("Expecting 'END INTERFACE %s' at %C",
+		     current_interface.sym->name);
+	  m = MATCH_ERROR;
+	}
+
+      break;
+    }
+
+  return m;
+}
+
+
+/* Compare two derived types using the criteria in 4.4.2 of the standard,
+   recursing through gfc_compare_types for the components.  */
+
+int
+gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2)
+{
+  gfc_component *dt1, *dt2;
+
+  if (derived1 == derived2)
+    return 1;
+
+  /* Special case for comparing derived types across namespaces.  If the
+     true names and module names are the same and the module name is
+     nonnull, then they are equal.  */
+  if (derived1 != NULL && derived2 != NULL
+      && strcmp (derived1->name, derived2->name) == 0
+      && derived1->module != NULL && derived2->module != NULL
+      && strcmp (derived1->module, derived2->module) == 0)
+    return 1;
+
+  /* Compare type via the rules of the standard.  Both types must have
+     the SEQUENCE attribute to be equal.  */
+
+  if (strcmp (derived1->name, derived2->name))
+    return 0;
+
+  if (derived1->component_access == ACCESS_PRIVATE
+      || derived2->component_access == ACCESS_PRIVATE)
+    return 0;
+
+  if (derived1->attr.sequence == 0 || derived2->attr.sequence == 0)
+    return 0;
+
+  dt1 = derived1->components;
+  dt2 = derived2->components;
+
+  /* Since subtypes of SEQUENCE types must be SEQUENCE types as well, a
+     simple test can speed things up.  Otherwise, lots of things have to
+     match.  */
+  for (;;)
+    {
+      if (strcmp (dt1->name, dt2->name) != 0)
+	return 0;
+
+      if (dt1->attr.access != dt2->attr.access)
+	return 0;
+
+      if (dt1->attr.pointer != dt2->attr.pointer)
+	return 0;
+
+      if (dt1->attr.dimension != dt2->attr.dimension)
+	return 0;
+
+     if (dt1->attr.allocatable != dt2->attr.allocatable)
+	return 0;
+
+      if (dt1->attr.dimension && gfc_compare_array_spec (dt1->as, dt2->as) == 0)
+	return 0;
+
+      /* Make sure that link lists do not put this function into an 
+	 endless recursive loop!  */
+      if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
+	    && !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
+	    && gfc_compare_types (&dt1->ts, &dt2->ts) == 0)
+	return 0;
+
+      else if ((dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
+		&& !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived))
+	return 0;
+
+      else if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived)
+		&& (dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.u.derived))
+	return 0;
+
+      dt1 = dt1->next;
+      dt2 = dt2->next;
+
+      if (dt1 == NULL && dt2 == NULL)
+	break;
+      if (dt1 == NULL || dt2 == NULL)
+	return 0;
+    }
+
+  return 1;
+}
+
+
+/* Compare two typespecs, recursively if necessary.  */
+
+int
+gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2)
+{
+  /* See if one of the typespecs is a BT_VOID, which is what is being used
+     to allow the funcs like c_f_pointer to accept any pointer type.
+     TODO: Possibly should narrow this to just the one typespec coming in
+     that is for the formal arg, but oh well.  */
+  if (ts1->type == BT_VOID || ts2->type == BT_VOID)
+    return 1;
+   
+  if (ts1->type != ts2->type
+      && ((ts1->type != BT_DERIVED && ts1->type != BT_CLASS)
+	  || (ts2->type != BT_DERIVED && ts2->type != BT_CLASS)))
+    return 0;
+  if (ts1->type != BT_DERIVED && ts1->type != BT_CLASS)
+    return (ts1->kind == ts2->kind);
+
+  /* Compare derived types.  */
+  if (gfc_type_compatible (ts1, ts2))
+    return 1;
+
+  return gfc_compare_derived_types (ts1->u.derived ,ts2->u.derived);
+}
+
+
+/* Given two symbols that are formal arguments, compare their ranks
+   and types.  Returns nonzero if they have the same rank and type,
+   zero otherwise.  */
+
+static int
+compare_type_rank (gfc_symbol *s1, gfc_symbol *s2)
+{
+  int r1, r2;
+
+  r1 = (s1->as != NULL) ? s1->as->rank : 0;
+  r2 = (s2->as != NULL) ? s2->as->rank : 0;
+
+  if (r1 != r2)
+    return 0;			/* Ranks differ.  */
+
+  return gfc_compare_types (&s1->ts, &s2->ts);
+}
+
+
+/* Given two symbols that are formal arguments, compare their types
+   and rank and their formal interfaces if they are both dummy
+   procedures.  Returns nonzero if the same, zero if different.  */
+
+static int
+compare_type_rank_if (gfc_symbol *s1, gfc_symbol *s2)
+{
+  if (s1 == NULL || s2 == NULL)
+    return s1 == s2 ? 1 : 0;
+
+  if (s1 == s2)
+    return 1;
+
+  if (s1->attr.flavor != FL_PROCEDURE && s2->attr.flavor != FL_PROCEDURE)
+    return compare_type_rank (s1, s2);
+
+  if (s1->attr.flavor != FL_PROCEDURE || s2->attr.flavor != FL_PROCEDURE)
+    return 0;
+
+  /* At this point, both symbols are procedures.  It can happen that
+     external procedures are compared, where one is identified by usage
+     to be a function or subroutine but the other is not.  Check TKR
+     nonetheless for these cases.  */
+  if (s1->attr.function == 0 && s1->attr.subroutine == 0)
+    return s1->attr.external == 1 ? compare_type_rank (s1, s2) : 0;
+
+  if (s2->attr.function == 0 && s2->attr.subroutine == 0)
+    return s2->attr.external == 1 ? compare_type_rank (s1, s2) : 0;
+
+  /* Now the type of procedure has been identified.  */
+  if (s1->attr.function != s2->attr.function
+      || s1->attr.subroutine != s2->attr.subroutine)
+    return 0;
+
+  if (s1->attr.function && compare_type_rank (s1, s2) == 0)
+    return 0;
+
+  /* Originally, gfortran recursed here to check the interfaces of passed
+     procedures.  This is explicitly not required by the standard.  */
+  return 1;
+}
+
+
+/* Given a formal argument list and a keyword name, search the list
+   for that keyword.  Returns the correct symbol node if found, NULL
+   if not found.  */
+
+static gfc_symbol *
+find_keyword_arg (const char *name, gfc_formal_arglist *f)
+{
+  for (; f; f = f->next)
+    if (strcmp (f->sym->name, name) == 0)
+      return f->sym;
+
+  return NULL;
+}
+
+
+/******** Interface checking subroutines **********/
+
+
+/* Given an operator interface and the operator, make sure that all
+   interfaces for that operator are legal.  */
+
+bool
+gfc_check_operator_interface (gfc_symbol *sym, gfc_intrinsic_op op,
+			      locus opwhere)
+{
+  gfc_formal_arglist *formal;
+  sym_intent i1, i2;
+  bt t1, t2;
+  int args, r1, r2, k1, k2;
+
+  gcc_assert (sym);
+
+  args = 0;
+  t1 = t2 = BT_UNKNOWN;
+  i1 = i2 = INTENT_UNKNOWN;
+  r1 = r2 = -1;
+  k1 = k2 = -1;
+
+  for (formal = sym->formal; formal; formal = formal->next)
+    {
+      gfc_symbol *fsym = formal->sym;
+      if (fsym == NULL)
+	{
+	  gfc_error ("Alternate return cannot appear in operator "
+		     "interface at %L", &sym->declared_at);
+	  return false;
+	}
+      if (args == 0)
+	{
+	  t1 = fsym->ts.type;
+	  i1 = fsym->attr.intent;
+	  r1 = (fsym->as != NULL) ? fsym->as->rank : 0;
+	  k1 = fsym->ts.kind;
+	}
+      if (args == 1)
+	{
+	  t2 = fsym->ts.type;
+	  i2 = fsym->attr.intent;
+	  r2 = (fsym->as != NULL) ? fsym->as->rank : 0;
+	  k2 = fsym->ts.kind;
+	}
+      args++;
+    }
+
+  /* Only +, - and .not. can be unary operators.
+     .not. cannot be a binary operator.  */
+  if (args == 0 || args > 2 || (args == 1 && op != INTRINSIC_PLUS
+				&& op != INTRINSIC_MINUS
+				&& op != INTRINSIC_NOT)
+      || (args == 2 && op == INTRINSIC_NOT))
+    {
+      gfc_error ("Operator interface at %L has the wrong number of arguments",
+		 &sym->declared_at);
+      return false;
+    }
+
+  /* Check that intrinsics are mapped to functions, except
+     INTRINSIC_ASSIGN which should map to a subroutine.  */
+  if (op == INTRINSIC_ASSIGN)
+    {
+      if (!sym->attr.subroutine)
+	{
+	  gfc_error ("Assignment operator interface at %L must be "
+		     "a SUBROUTINE", &sym->declared_at);
+	  return false;
+	}
+      if (args != 2)
+	{
+	  gfc_error ("Assignment operator interface at %L must have "
+		     "two arguments", &sym->declared_at);
+	  return false;
+	}
+
+      /* Allowed are (per F2003, 12.3.2.1.2 Defined assignments):
+	 - First argument an array with different rank than second,
+	 - First argument is a scalar and second an array,
+	 - Types and kinds do not conform, or
+	 - First argument is of derived type.  */
+      if (sym->formal->sym->ts.type != BT_DERIVED
+	  && sym->formal->sym->ts.type != BT_CLASS
+	  && (r2 == 0 || r1 == r2)
+	  && (sym->formal->sym->ts.type == sym->formal->next->sym->ts.type
+	      || (gfc_numeric_ts (&sym->formal->sym->ts)
+		  && gfc_numeric_ts (&sym->formal->next->sym->ts))))
+	{
+	  gfc_error ("Assignment operator interface at %L must not redefine "
+		     "an INTRINSIC type assignment", &sym->declared_at);
+	  return false;
+	}
+    }
+  else
+    {
+      if (!sym->attr.function)
+	{
+	  gfc_error ("Intrinsic operator interface at %L must be a FUNCTION",
+		     &sym->declared_at);
+	  return false;
+	}
+    }
+
+  /* Check intents on operator interfaces.  */
+  if (op == INTRINSIC_ASSIGN)
+    {
+      if (i1 != INTENT_OUT && i1 != INTENT_INOUT)
+	{
+	  gfc_error ("First argument of defined assignment at %L must be "
+		     "INTENT(OUT) or INTENT(INOUT)", &sym->declared_at);
+	  return false;
+	}
+
+      if (i2 != INTENT_IN)
+	{
+	  gfc_error ("Second argument of defined assignment at %L must be "
+		     "INTENT(IN)", &sym->declared_at);
+	  return false;
+	}
+    }
+  else
+    {
+      if (i1 != INTENT_IN)
+	{
+	  gfc_error ("First argument of operator interface at %L must be "
+		     "INTENT(IN)", &sym->declared_at);
+	  return false;
+	}
+
+      if (args == 2 && i2 != INTENT_IN)
+	{
+	  gfc_error ("Second argument of operator interface at %L must be "
+		     "INTENT(IN)", &sym->declared_at);
+	  return false;
+	}
+    }
+
+  /* From now on, all we have to do is check that the operator definition
+     doesn't conflict with an intrinsic operator. The rules for this
+     game are defined in 7.1.2 and 7.1.3 of both F95 and F2003 standards,
+     as well as 12.3.2.1.1 of Fortran 2003:
+
+     "If the operator is an intrinsic-operator (R310), the number of
+     function arguments shall be consistent with the intrinsic uses of
+     that operator, and the types, kind type parameters, or ranks of the
+     dummy arguments shall differ from those required for the intrinsic
+     operation (7.1.2)."  */
+
+#define IS_NUMERIC_TYPE(t) \
+  ((t) == BT_INTEGER || (t) == BT_REAL || (t) == BT_COMPLEX)
+
+  /* Unary ops are easy, do them first.  */
+  if (op == INTRINSIC_NOT)
+    {
+      if (t1 == BT_LOGICAL)
+	goto bad_repl;
+      else
+	return true;
+    }
+
+  if (args == 1 && (op == INTRINSIC_PLUS || op == INTRINSIC_MINUS))
+    {
+      if (IS_NUMERIC_TYPE (t1))
+	goto bad_repl;
+      else
+	return true;
+    }
+
+  /* Character intrinsic operators have same character kind, thus
+     operator definitions with operands of different character kinds
+     are always safe.  */
+  if (t1 == BT_CHARACTER && t2 == BT_CHARACTER && k1 != k2)
+    return true;
+
+  /* Intrinsic operators always perform on arguments of same rank,
+     so different ranks is also always safe.  (rank == 0) is an exception
+     to that, because all intrinsic operators are elemental.  */
+  if (r1 != r2 && r1 != 0 && r2 != 0)
+    return true;
+
+  switch (op)
+  {
+    case INTRINSIC_EQ:
+    case INTRINSIC_EQ_OS:
+    case INTRINSIC_NE:
+    case INTRINSIC_NE_OS:
+      if (t1 == BT_CHARACTER && t2 == BT_CHARACTER)
+	goto bad_repl;
+      /* Fall through.  */
+
+    case INTRINSIC_PLUS:
+    case INTRINSIC_MINUS:
+    case INTRINSIC_TIMES:
+    case INTRINSIC_DIVIDE:
+    case INTRINSIC_POWER:
+      if (IS_NUMERIC_TYPE (t1) && IS_NUMERIC_TYPE (t2))
+	goto bad_repl;
+      break;
+
+    case INTRINSIC_GT:
+    case INTRINSIC_GT_OS:
+    case INTRINSIC_GE:
+    case INTRINSIC_GE_OS:
+    case INTRINSIC_LT:
+    case INTRINSIC_LT_OS:
+    case INTRINSIC_LE:
+    case INTRINSIC_LE_OS:
+      if (t1 == BT_CHARACTER && t2 == BT_CHARACTER)
+	goto bad_repl;
+      if ((t1 == BT_INTEGER || t1 == BT_REAL)
+	  && (t2 == BT_INTEGER || t2 == BT_REAL))
+	goto bad_repl;
+      break;
+
+    case INTRINSIC_CONCAT:
+      if (t1 == BT_CHARACTER && t2 == BT_CHARACTER)
+	goto bad_repl;
+      break;
+
+    case INTRINSIC_AND:
+    case INTRINSIC_OR:
+    case INTRINSIC_EQV:
+    case INTRINSIC_NEQV:
+      if (t1 == BT_LOGICAL && t2 == BT_LOGICAL)
+	goto bad_repl;
+      break;
+
+    default:
+      break;
+  }
+
+  return true;
+
+#undef IS_NUMERIC_TYPE
+
+bad_repl:
+  gfc_error ("Operator interface at %L conflicts with intrinsic interface",
+	     &opwhere);
+  return false;
+}
+
+
+/* Given a pair of formal argument lists, we see if the two lists can
+   be distinguished by counting the number of nonoptional arguments of
+   a given type/rank in f1 and seeing if there are less then that
+   number of those arguments in f2 (including optional arguments).
+   Since this test is asymmetric, it has to be called twice to make it
+   symmetric.  Returns nonzero if the argument lists are incompatible
+   by this test.  This subroutine implements rule 1 of section
+   14.1.2.3 in the Fortran 95 standard.  */
+
+static int
+count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2)
+{
+  int rc, ac1, ac2, i, j, k, n1;
+  gfc_formal_arglist *f;
+
+  typedef struct
+  {
+    int flag;
+    gfc_symbol *sym;
+  }
+  arginfo;
+
+  arginfo *arg;
+
+  n1 = 0;
+
+  for (f = f1; f; f = f->next)
+    n1++;
+
+  /* Build an array of integers that gives the same integer to
+     arguments of the same type/rank.  */
+  arg = XCNEWVEC (arginfo, n1);
+
+  f = f1;
+  for (i = 0; i < n1; i++, f = f->next)
+    {
+      arg[i].flag = -1;
+      arg[i].sym = f->sym;
+    }
+
+  k = 0;
+
+  for (i = 0; i < n1; i++)
+    {
+      if (arg[i].flag != -1)
+	continue;
+
+      if (arg[i].sym && arg[i].sym->attr.optional)
+	continue;		/* Skip optional arguments.  */
+
+      arg[i].flag = k;
+
+      /* Find other nonoptional arguments of the same type/rank.  */
+      for (j = i + 1; j < n1; j++)
+	if ((arg[j].sym == NULL || !arg[j].sym->attr.optional)
+	    && (compare_type_rank_if (arg[i].sym, arg[j].sym)
+	        || compare_type_rank_if (arg[j].sym, arg[i].sym)))
+	  arg[j].flag = k;
+
+      k++;
+    }
+
+  /* Now loop over each distinct type found in f1.  */
+  k = 0;
+  rc = 0;
+
+  for (i = 0; i < n1; i++)
+    {
+      if (arg[i].flag != k)
+	continue;
+
+      ac1 = 1;
+      for (j = i + 1; j < n1; j++)
+	if (arg[j].flag == k)
+	  ac1++;
+
+      /* Count the number of arguments in f2 with that type, including
+	 those that are optional.  */
+      ac2 = 0;
+
+      for (f = f2; f; f = f->next)
+	if (compare_type_rank_if (arg[i].sym, f->sym)
+	    || compare_type_rank_if (f->sym, arg[i].sym))
+	  ac2++;
+
+      if (ac1 > ac2)
+	{
+	  rc = 1;
+	  break;
+	}
+
+      k++;
+    }
+
+  gfc_free (arg);
+
+  return rc;
+}
+
+
+/* Perform the correspondence test in rule 2 of section 14.1.2.3.
+   Returns zero if no argument is found that satisfies rule 2, nonzero
+   otherwise.
+
+   This test is also not symmetric in f1 and f2 and must be called
+   twice.  This test finds problems caused by sorting the actual
+   argument list with keywords.  For example:
+
+   INTERFACE FOO
+       SUBROUTINE F1(A, B)
+	   INTEGER :: A ; REAL :: B
+       END SUBROUTINE F1
+
+       SUBROUTINE F2(B, A)
+	   INTEGER :: A ; REAL :: B
+       END SUBROUTINE F1
+   END INTERFACE FOO
+
+   At this point, 'CALL FOO(A=1, B=1.0)' is ambiguous.  */
+
+static int
+generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2)
+{
+  gfc_formal_arglist *f2_save, *g;
+  gfc_symbol *sym;
+
+  f2_save = f2;
+
+  while (f1)
+    {
+      if (f1->sym->attr.optional)
+	goto next;
+
+      if (f2 != NULL && (compare_type_rank (f1->sym, f2->sym)
+			 || compare_type_rank (f2->sym, f1->sym)))
+	goto next;
+
+      /* Now search for a disambiguating keyword argument starting at
+	 the current non-match.  */
+      for (g = f1; g; g = g->next)
+	{
+	  if (g->sym->attr.optional)
+	    continue;
+
+	  sym = find_keyword_arg (g->sym->name, f2_save);
+	  if (sym == NULL || !compare_type_rank (g->sym, sym))
+	    return 1;
+	}
+
+    next:
+      f1 = f1->next;
+      if (f2 != NULL)
+	f2 = f2->next;
+    }
+
+  return 0;
+}
+
+
+/* 'Compare' two formal interfaces associated with a pair of symbols.
+   We return nonzero if there exists an actual argument list that
+   would be ambiguous between the two interfaces, zero otherwise.
+   'intent_flag' specifies whether INTENT and OPTIONAL of the arguments are
+   required to match, which is not the case for ambiguity checks.*/
+
+int
+gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2,
+			int generic_flag, int intent_flag,
+			char *errmsg, int err_len)
+{
+  gfc_formal_arglist *f1, *f2;
+
+  gcc_assert (name2 != NULL);
+
+  if (s1->attr.function && (s2->attr.subroutine
+      || (!s2->attr.function && s2->ts.type == BT_UNKNOWN
+	  && gfc_get_default_type (name2, s2->ns)->type == BT_UNKNOWN)))
+    {
+      if (errmsg != NULL)
+	snprintf (errmsg, err_len, "'%s' is not a function", name2);
+      return 0;
+    }
+
+  if (s1->attr.subroutine && s2->attr.function)
+    {
+      if (errmsg != NULL)
+	snprintf (errmsg, err_len, "'%s' is not a subroutine", name2);
+      return 0;
+    }
+
+  /* If the arguments are functions, check type and kind
+     (only for dummy procedures and procedure pointer assignments).  */
+  if (!generic_flag && intent_flag && s1->attr.function && s2->attr.function)
+    {
+      if (s1->ts.type == BT_UNKNOWN)
+	return 1;
+      if ((s1->ts.type != s2->ts.type) || (s1->ts.kind != s2->ts.kind))
+	{
+	  if (errmsg != NULL)
+	    snprintf (errmsg, err_len, "Type/kind mismatch in return value "
+		      "of '%s'", name2);
+	  return 0;
+	}
+    }
+
+  if (s1->attr.if_source == IFSRC_UNKNOWN
+      || s2->attr.if_source == IFSRC_UNKNOWN)
+    return 1;
+
+  f1 = s1->formal;
+  f2 = s2->formal;
+
+  if (f1 == NULL && f2 == NULL)
+    return 1;			/* Special case: No arguments.  */
+
+  if (generic_flag)
+    {
+      if (count_types_test (f1, f2) || count_types_test (f2, f1))
+	return 0;
+      if (generic_correspondence (f1, f2) || generic_correspondence (f2, f1))
+	return 0;
+    }
+  else
+    /* Perform the abbreviated correspondence test for operators (the
+       arguments cannot be optional and are always ordered correctly).
+       This is also done when comparing interfaces for dummy procedures and in
+       procedure pointer assignments.  */
+
+    for (;;)
+      {
+	/* Check existence.  */
+	if (f1 == NULL && f2 == NULL)
+	  break;
+	if (f1 == NULL || f2 == NULL)
+	  {
+	    if (errmsg != NULL)
+	      snprintf (errmsg, err_len, "'%s' has the wrong number of "
+			"arguments", name2);
+	    return 0;
+	  }
+
+	/* Check type and rank.  */
+	if (!compare_type_rank (f2->sym, f1->sym))
+	  {
+	    if (errmsg != NULL)
+	      snprintf (errmsg, err_len, "Type/rank mismatch in argument '%s'",
+			f1->sym->name);
+	    return 0;
+	  }
+
+	/* Check INTENT.  */
+	if (intent_flag && (f1->sym->attr.intent != f2->sym->attr.intent))
+	  {
+	    snprintf (errmsg, err_len, "INTENT mismatch in argument '%s'",
+		      f1->sym->name);
+	    return 0;
+	  }
+
+	/* Check OPTIONAL.  */
+	if (intent_flag && (f1->sym->attr.optional != f2->sym->attr.optional))
+	  {
+	    snprintf (errmsg, err_len, "OPTIONAL mismatch in argument '%s'",
+		      f1->sym->name);
+	    return 0;
+	  }
+
+	f1 = f1->next;
+	f2 = f2->next;
+      }
+
+  return 1;
+}
+
+
+/* Given a pointer to an interface pointer, remove duplicate
+   interfaces and make sure that all symbols are either functions
+   or subroutines, and all of the same kind.  Returns nonzero if
+   something goes wrong.  */
+
+static int
+check_interface0 (gfc_interface *p, const char *interface_name)
+{
+  gfc_interface *psave, *q, *qlast;
+
+  psave = p;
+  for (; p; p = p->next)
+    {
+      /* Make sure all symbols in the interface have been defined as
+	 functions or subroutines.  */
+      if ((!p->sym->attr.function && !p->sym->attr.subroutine)
+	  || !p->sym->attr.if_source)
+	{
+	  if (p->sym->attr.external)
+	    gfc_error ("Procedure '%s' in %s at %L has no explicit interface",
+		       p->sym->name, interface_name, &p->sym->declared_at);
+	  else
+	    gfc_error ("Procedure '%s' in %s at %L is neither function nor "
+		       "subroutine", p->sym->name, interface_name,
+		      &p->sym->declared_at);
+	  return 1;
+	}
+
+      /* Verify that procedures are either all SUBROUTINEs or all FUNCTIONs.  */
+      if ((psave->sym->attr.function && !p->sym->attr.function)
+	  || (psave->sym->attr.subroutine && !p->sym->attr.subroutine))
+	{
+	  gfc_error ("In %s at %L procedures must be either all SUBROUTINEs"
+		     " or all FUNCTIONs", interface_name, &p->sym->declared_at);
+	  return 1;
+	}
+
+      if (p->sym->attr.proc == PROC_INTERNAL
+	  && gfc_notify_std (GFC_STD_GNU, "Extension: Internal procedure '%s' "
+			     "in %s at %L", p->sym->name, interface_name,
+			     &p->sym->declared_at) == FAILURE)
+	return 1;
+    }
+  p = psave;
+
+  /* Remove duplicate interfaces in this interface list.  */
+  for (; p; p = p->next)
+    {
+      qlast = p;
+
+      for (q = p->next; q;)
+	{
+	  if (p->sym != q->sym)
+	    {
+	      qlast = q;
+	      q = q->next;
+	    }
+	  else
+	    {
+	      /* Duplicate interface.  */
+	      qlast->next = q->next;
+	      gfc_free (q);
+	      q = qlast->next;
+	    }
+	}
+    }
+
+  return 0;
+}
+
+
+/* Check lists of interfaces to make sure that no two interfaces are
+   ambiguous.  Duplicate interfaces (from the same symbol) are OK here.  */
+
+static int
+check_interface1 (gfc_interface *p, gfc_interface *q0,
+		  int generic_flag, const char *interface_name,
+		  bool referenced)
+{
+  gfc_interface *q;
+  for (; p; p = p->next)
+    for (q = q0; q; q = q->next)
+      {
+	if (p->sym == q->sym)
+	  continue;		/* Duplicates OK here.  */
+
+	if (p->sym->name == q->sym->name && p->sym->module == q->sym->module)
+	  continue;
+
+	if (gfc_compare_interfaces (p->sym, q->sym, q->sym->name, generic_flag,
+				    0, NULL, 0))
+	  {
+	    if (referenced)
+	      gfc_error ("Ambiguous interfaces '%s' and '%s' in %s at %L",
+			 p->sym->name, q->sym->name, interface_name,
+			 &p->where);
+	    else if (!p->sym->attr.use_assoc && q->sym->attr.use_assoc)
+	      gfc_warning ("Ambiguous interfaces '%s' and '%s' in %s at %L",
+			   p->sym->name, q->sym->name, interface_name,
+			   &p->where);
+	    else
+	      gfc_warning ("Although not referenced, '%s' has ambiguous "
+			   "interfaces at %L", interface_name, &p->where);
+	    return 1;
+	  }
+      }
+  return 0;
+}
+
+
+/* Check the generic and operator interfaces of symbols to make sure
+   that none of the interfaces conflict.  The check has to be done
+   after all of the symbols are actually loaded.  */
+
+static void
+check_sym_interfaces (gfc_symbol *sym)
+{
+  char interface_name[100];
+  gfc_interface *p;
+
+  if (sym->ns != gfc_current_ns)
+    return;
+
+  if (sym->generic != NULL)
+    {
+      sprintf (interface_name, "generic interface '%s'", sym->name);
+      if (check_interface0 (sym->generic, interface_name))
+	return;
+
+      for (p = sym->generic; p; p = p->next)
+	{
+	  if (p->sym->attr.mod_proc
+	      && (p->sym->attr.if_source != IFSRC_DECL
+		  || p->sym->attr.procedure))
+	    {
+	      gfc_error ("'%s' at %L is not a module procedure",
+			 p->sym->name, &p->where);
+	      return;
+	    }
+	}
+
+      /* Originally, this test was applied to host interfaces too;
+	 this is incorrect since host associated symbols, from any
+	 source, cannot be ambiguous with local symbols.  */
+      check_interface1 (sym->generic, sym->generic, 1, interface_name,
+			sym->attr.referenced || !sym->attr.use_assoc);
+    }
+}
+
+
+static void
+check_uop_interfaces (gfc_user_op *uop)
+{
+  char interface_name[100];
+  gfc_user_op *uop2;
+  gfc_namespace *ns;
+
+  sprintf (interface_name, "operator interface '%s'", uop->name);
+  if (check_interface0 (uop->op, interface_name))
+    return;
+
+  for (ns = gfc_current_ns; ns; ns = ns->parent)
+    {
+      uop2 = gfc_find_uop (uop->name, ns);
+      if (uop2 == NULL)
+	continue;
+
+      check_interface1 (uop->op, uop2->op, 0,
+			interface_name, true);
+    }
+}
+
+/* Given an intrinsic op, return an equivalent op if one exists,
+   or INTRINSIC_NONE otherwise.  */
+
+gfc_intrinsic_op
+gfc_equivalent_op (gfc_intrinsic_op op)
+{
+  switch(op)
+    {
+    case INTRINSIC_EQ:
+      return INTRINSIC_EQ_OS;
+
+    case INTRINSIC_EQ_OS:
+      return INTRINSIC_EQ;
+
+    case INTRINSIC_NE:
+      return INTRINSIC_NE_OS;
+
+    case INTRINSIC_NE_OS:
+      return INTRINSIC_NE;
+
+    case INTRINSIC_GT:
+      return INTRINSIC_GT_OS;
+
+    case INTRINSIC_GT_OS:
+      return INTRINSIC_GT;
+
+    case INTRINSIC_GE:
+      return INTRINSIC_GE_OS;
+
+    case INTRINSIC_GE_OS:
+      return INTRINSIC_GE;
+
+    case INTRINSIC_LT:
+      return INTRINSIC_LT_OS;
+
+    case INTRINSIC_LT_OS:
+      return INTRINSIC_LT;
+
+    case INTRINSIC_LE:
+      return INTRINSIC_LE_OS;
+
+    case INTRINSIC_LE_OS:
+      return INTRINSIC_LE;
+
+    default:
+      return INTRINSIC_NONE;
+    }
+}
+
+/* For the namespace, check generic, user operator and intrinsic
+   operator interfaces for consistency and to remove duplicate
+   interfaces.  We traverse the whole namespace, counting on the fact
+   that most symbols will not have generic or operator interfaces.  */
+
+void
+gfc_check_interfaces (gfc_namespace *ns)
+{
+  gfc_namespace *old_ns, *ns2;
+  char interface_name[100];
+  int i;
+
+  old_ns = gfc_current_ns;
+  gfc_current_ns = ns;
+
+  gfc_traverse_ns (ns, check_sym_interfaces);
+
+  gfc_traverse_user_op (ns, check_uop_interfaces);
+
+  for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++)
+    {
+      if (i == INTRINSIC_USER)
+	continue;
+
+      if (i == INTRINSIC_ASSIGN)
+	strcpy (interface_name, "intrinsic assignment operator");
+      else
+	sprintf (interface_name, "intrinsic '%s' operator",
+		 gfc_op2string ((gfc_intrinsic_op) i));
+
+      if (check_interface0 (ns->op[i], interface_name))
+	continue;
+
+      if (ns->op[i])
+	gfc_check_operator_interface (ns->op[i]->sym, (gfc_intrinsic_op) i,
+				      ns->op[i]->where);
+
+      for (ns2 = ns; ns2; ns2 = ns2->parent)
+	{
+	  gfc_intrinsic_op other_op;
+	  
+	  if (check_interface1 (ns->op[i], ns2->op[i], 0,
+				interface_name, true))
+	    goto done;
+
+	  /* i should be gfc_intrinsic_op, but has to be int with this cast
+	     here for stupid C++ compatibility rules.  */
+	  other_op = gfc_equivalent_op ((gfc_intrinsic_op) i);
+	  if (other_op != INTRINSIC_NONE
+	    &&  check_interface1 (ns->op[i], ns2->op[other_op],
+				  0, interface_name, true))
+	    goto done;
+	}
+    }
+
+done:
+  gfc_current_ns = old_ns;
+}
+
+
+static int
+symbol_rank (gfc_symbol *sym)
+{
+  return (sym->as == NULL) ? 0 : sym->as->rank;
+}
+
+
+/* Given a symbol of a formal argument list and an expression, if the
+   formal argument is allocatable, check that the actual argument is
+   allocatable. Returns nonzero if compatible, zero if not compatible.  */
+
+static int
+compare_allocatable (gfc_symbol *formal, gfc_expr *actual)
+{
+  symbol_attribute attr;
+
+  if (formal->attr.allocatable
+      || (formal->ts.type == BT_CLASS && CLASS_DATA (formal)->attr.allocatable))
+    {
+      attr = gfc_expr_attr (actual);
+      if (!attr.allocatable)
+	return 0;
+    }
+
+  return 1;
+}
+
+
+/* Given a symbol of a formal argument list and an expression, if the
+   formal argument is a pointer, see if the actual argument is a
+   pointer. Returns nonzero if compatible, zero if not compatible.  */
+
+static int
+compare_pointer (gfc_symbol *formal, gfc_expr *actual)
+{
+  symbol_attribute attr;
+
+  if (formal->attr.pointer)
+    {
+      attr = gfc_expr_attr (actual);
+
+      /* Fortran 2008 allows non-pointer actual arguments.  */
+      if (!attr.pointer && attr.target && formal->attr.intent == INTENT_IN)
+	return 2;
+
+      if (!attr.pointer)
+	return 0;
+    }
+
+  return 1;
+}
+
+
+/* Emit clear error messages for rank mismatch.  */
+
+static void
+argument_rank_mismatch (const char *name, locus *where,
+			int rank1, int rank2)
+{
+  if (rank1 == 0)
+    {
+      gfc_error ("Rank mismatch in argument '%s' at %L "
+		 "(scalar and rank-%d)", name, where, rank2);
+    }
+  else if (rank2 == 0)
+    {
+      gfc_error ("Rank mismatch in argument '%s' at %L "
+		 "(rank-%d and scalar)", name, where, rank1);
+    }
+  else
+    {    
+      gfc_error ("Rank mismatch in argument '%s' at %L "
+		 "(rank-%d and rank-%d)", name, where, rank1, rank2);
+    }
+}
+
+
+/* Given a symbol of a formal argument list and an expression, see if
+   the two are compatible as arguments.  Returns nonzero if
+   compatible, zero if not compatible.  */
+
+static int
+compare_parameter (gfc_symbol *formal, gfc_expr *actual,
+		   int ranks_must_agree, int is_elemental, locus *where)
+{
+  gfc_ref *ref;
+  bool rank_check, is_pointer;
+
+  /* If the formal arg has type BT_VOID, it's to one of the iso_c_binding
+     procs c_f_pointer or c_f_procpointer, and we need to accept most
+     pointers the user could give us.  This should allow that.  */
+  if (formal->ts.type == BT_VOID)
+    return 1;
+
+  if (formal->ts.type == BT_DERIVED
+      && formal->ts.u.derived && formal->ts.u.derived->ts.is_iso_c
+      && actual->ts.type == BT_DERIVED
+      && actual->ts.u.derived && actual->ts.u.derived->ts.is_iso_c)
+    return 1;
+
+  if (formal->ts.type == BT_CLASS && actual->ts.type == BT_DERIVED)
+    /* Make sure the vtab symbol is present when
+       the module variables are generated.  */
+    gfc_find_derived_vtab (actual->ts.u.derived);
+
+  if (actual->ts.type == BT_PROCEDURE)
+    {
+      char err[200];
+      gfc_symbol *act_sym = actual->symtree->n.sym;
+
+      if (formal->attr.flavor != FL_PROCEDURE)
+	{
+	  if (where)
+	    gfc_error ("Invalid procedure argument at %L", &actual->where);
+	  return 0;
+	}
+
+      if (!gfc_compare_interfaces (formal, act_sym, act_sym->name, 0, 1, err,
+				   sizeof(err)))
+	{
+	  if (where)
+	    gfc_error ("Interface mismatch in dummy procedure '%s' at %L: %s",
+		       formal->name, &actual->where, err);
+	  return 0;
+	}
+
+      if (formal->attr.function && !act_sym->attr.function)
+	{
+	  gfc_add_function (&act_sym->attr, act_sym->name,
+	  &act_sym->declared_at);
+	  if (act_sym->ts.type == BT_UNKNOWN
+	      && gfc_set_default_type (act_sym, 1, act_sym->ns) == FAILURE)
+	    return 0;
+	}
+      else if (formal->attr.subroutine && !act_sym->attr.subroutine)
+	gfc_add_subroutine (&act_sym->attr, act_sym->name,
+			    &act_sym->declared_at);
+
+      return 1;
+    }
+
+  /* F2008, C1241.  */
+  if (formal->attr.pointer && formal->attr.contiguous
+      && !gfc_is_simply_contiguous (actual, true))
+    {
+      if (where)
+	gfc_error ("Actual argument to contiguous pointer dummy '%s' at %L "
+		   "must be simply contigous", formal->name, &actual->where);
+      return 0;
+    }
+
+  if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN)
+      && actual->ts.type != BT_HOLLERITH
+      && !gfc_compare_types (&formal->ts, &actual->ts))
+    {
+      if (where)
+	gfc_error ("Type mismatch in argument '%s' at %L; passed %s to %s",
+		   formal->name, &actual->where, gfc_typename (&actual->ts),
+		   gfc_typename (&formal->ts));
+      return 0;
+    }
+    
+  /* F2008, 12.5.2.5.  */
+  if (formal->ts.type == BT_CLASS
+      && (CLASS_DATA (formal)->attr.class_pointer
+          || CLASS_DATA (formal)->attr.allocatable))
+    {
+      if (actual->ts.type != BT_CLASS)
+	{
+	  if (where)
+	    gfc_error ("Actual argument to '%s' at %L must be polymorphic",
+			formal->name, &actual->where);
+	  return 0;
+	}
+      if (!gfc_compare_derived_types (CLASS_DATA (actual)->ts.u.derived,
+				      CLASS_DATA (formal)->ts.u.derived))
+	{
+	  if (where)
+	    gfc_error ("Actual argument to '%s' at %L must have the same "
+		       "declared type", formal->name, &actual->where);
+	  return 0;
+	}
+    }
+
+  if (formal->attr.codimension)
+    {
+      gfc_ref *last = NULL;
+
+      if (actual->expr_type != EXPR_VARIABLE
+	  || (actual->ref == NULL
+	      && !actual->symtree->n.sym->attr.codimension))
+	{
+	  if (where)
+	    gfc_error ("Actual argument to '%s' at %L must be a coarray",
+		       formal->name, &actual->where);
+	  return 0;
+	}
+
+      for (ref = actual->ref; ref; ref = ref->next)
+	{
+	  if (ref->type == REF_ARRAY && ref->u.ar.codimen != 0)
+	    {
+	      if (where)
+		gfc_error ("Actual argument to '%s' at %L must be a coarray "
+			   "and not coindexed", formal->name, &ref->u.ar.where);
+	      return 0;
+	    }
+	  if (ref->type == REF_ARRAY && ref->u.ar.as->corank
+	      && ref->u.ar.type != AR_FULL && ref->u.ar.dimen != 0)
+	    {
+	      if (where)
+		gfc_error ("Actual argument to '%s' at %L must be a coarray "
+			   "and thus shall not have an array designator",
+			   formal->name, &ref->u.ar.where);
+	      return 0;
+	    }
+	  if (ref->type == REF_COMPONENT)
+	    last = ref;
+	}
+
+      if (last && !last->u.c.component->attr.codimension)
+      	{
+	  if (where)
+	    gfc_error ("Actual argument to '%s' at %L must be a coarray",
+		       formal->name, &actual->where);
+	  return 0;
+	}
+
+      /* F2008, 12.5.2.6.  */
+      if (formal->attr.allocatable &&
+	  ((last && last->u.c.component->as->corank != formal->as->corank)
+	   || (!last
+	       && actual->symtree->n.sym->as->corank != formal->as->corank)))
+	{
+	  if (where)
+	    gfc_error ("Corank mismatch in argument '%s' at %L (%d and %d)",
+		   formal->name, &actual->where, formal->as->corank,
+		   last ? last->u.c.component->as->corank
+			: actual->symtree->n.sym->as->corank);
+	  return 0;
+	}
+
+      /* F2008, 12.5.2.8.  */
+      if (formal->attr.dimension
+	  && (formal->attr.contiguous || formal->as->type != AS_ASSUMED_SHAPE)
+	  && !gfc_is_simply_contiguous (actual, true))
+	{
+	  if (where)
+	    gfc_error ("Actual argument to '%s' at %L must be simply "
+		       "contiguous", formal->name, &actual->where);
+	  return 0;
+	}
+    }
+
+  /* F2008, C1239/C1240.  */
+  if (actual->expr_type == EXPR_VARIABLE
+      && (actual->symtree->n.sym->attr.asynchronous
+         || actual->symtree->n.sym->attr.volatile_)
+      &&  (formal->attr.asynchronous || formal->attr.volatile_)
+      && actual->rank && !gfc_is_simply_contiguous (actual, true)
+      && ((formal->as->type != AS_ASSUMED_SHAPE && !formal->attr.pointer)
+	  || formal->attr.contiguous))
+    {
+      if (where)
+	gfc_error ("Dummy argument '%s' has to be a pointer or assumed-shape "
+		   "array without CONTIGUOUS attribute - as actual argument at"
+		   " %L is not simply contiguous and both are ASYNCHRONOUS "
+		   "or VOLATILE", formal->name, &actual->where);
+      return 0;
+    }
+
+  if (symbol_rank (formal) == actual->rank)
+    return 1;
+
+  rank_check = where != NULL && !is_elemental && formal->as
+	       && (formal->as->type == AS_ASSUMED_SHAPE
+		   || formal->as->type == AS_DEFERRED)
+	       && actual->expr_type != EXPR_NULL;
+
+  /* Scalar & coindexed, see: F2008, Section 12.5.2.4.  */
+  if (rank_check || ranks_must_agree
+      || (formal->attr.pointer && actual->expr_type != EXPR_NULL)
+      || (actual->rank != 0 && !(is_elemental || formal->attr.dimension))
+      || (actual->rank == 0 && formal->as->type == AS_ASSUMED_SHAPE
+	  && actual->expr_type != EXPR_NULL)
+      || (actual->rank == 0 && formal->attr.dimension
+	  && gfc_is_coindexed (actual)))
+    {
+      if (where)
+	argument_rank_mismatch (formal->name, &actual->where,
+				symbol_rank (formal), actual->rank);
+      return 0;
+    }
+  else if (actual->rank != 0 && (is_elemental || formal->attr.dimension))
+    return 1;
+
+  /* At this point, we are considering a scalar passed to an array.   This
+     is valid (cf. F95 12.4.1.1, F2003 12.4.1.2, and F2008 12.5.2.4),
+     - if the actual argument is (a substring of) an element of a
+       non-assumed-shape/non-pointer/non-polymorphic array; or
+     - (F2003) if the actual argument is of type character of default/c_char
+       kind.  */
+
+  is_pointer = actual->expr_type == EXPR_VARIABLE
+	       ? actual->symtree->n.sym->attr.pointer : false;
+
+  for (ref = actual->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_COMPONENT)
+	is_pointer = ref->u.c.component->attr.pointer;
+      else if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT
+	       && ref->u.ar.dimen > 0
+	       && (!ref->next 
+		   || (ref->next->type == REF_SUBSTRING && !ref->next->next)))
+        break;
+    }
+
+  if (actual->ts.type == BT_CLASS && actual->expr_type != EXPR_NULL)
+    {
+      if (where)
+	gfc_error ("Polymorphic scalar passed to array dummy argument '%s' "
+		   "at %L", formal->name, &actual->where);
+      return 0;
+    }
+
+  if (actual->expr_type != EXPR_NULL && ref && actual->ts.type != BT_CHARACTER
+      && (is_pointer || ref->u.ar.as->type == AS_ASSUMED_SHAPE))
+    {
+      if (where)
+	gfc_error ("Element of assumed-shaped or pointer "
+		   "array passed to array dummy argument '%s' at %L",
+		   formal->name, &actual->where);
+      return 0;
+    }
+
+  if (actual->ts.type == BT_CHARACTER && actual->expr_type != EXPR_NULL
+      && (!ref || is_pointer || ref->u.ar.as->type == AS_ASSUMED_SHAPE))
+    {
+      if (formal->ts.kind != 1 && (gfc_option.allow_std & GFC_STD_GNU) == 0)
+	{
+	  if (where)
+	    gfc_error ("Extension: Scalar non-default-kind, non-C_CHAR-kind "
+		       "CHARACTER actual argument with array dummy argument "
+		       "'%s' at %L", formal->name, &actual->where);
+	  return 0;
+	}
+
+      if (where && (gfc_option.allow_std & GFC_STD_F2003) == 0)
+	{
+	  gfc_error ("Fortran 2003: Scalar CHARACTER actual argument with "
+		     "array dummy argument '%s' at %L",
+		     formal->name, &actual->where);
+	  return 0;
+	}
+      else if ((gfc_option.allow_std & GFC_STD_F2003) == 0)
+	return 0;
+      else
+	return 1;
+    }
+
+  if (ref == NULL && actual->expr_type != EXPR_NULL)
+    {
+      if (where)
+	argument_rank_mismatch (formal->name, &actual->where,
+				symbol_rank (formal), actual->rank);
+      return 0;
+    }
+
+  return 1;
+}
+
+
+/* Returns the storage size of a symbol (formal argument) or
+   zero if it cannot be determined.  */
+
+static unsigned long
+get_sym_storage_size (gfc_symbol *sym)
+{
+  int i;
+  unsigned long strlen, elements;
+
+  if (sym->ts.type == BT_CHARACTER)
+    {
+      if (sym->ts.u.cl && sym->ts.u.cl->length
+          && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+	strlen = mpz_get_ui (sym->ts.u.cl->length->value.integer);
+      else
+	return 0;
+    }
+  else
+    strlen = 1; 
+
+  if (symbol_rank (sym) == 0)
+    return strlen;
+
+  elements = 1;
+  if (sym->as->type != AS_EXPLICIT)
+    return 0;
+  for (i = 0; i < sym->as->rank; i++)
+    {
+      if (!sym->as || sym->as->upper[i]->expr_type != EXPR_CONSTANT
+	  || sym->as->lower[i]->expr_type != EXPR_CONSTANT)
+	return 0;
+
+      elements *= mpz_get_si (sym->as->upper[i]->value.integer)
+		  - mpz_get_si (sym->as->lower[i]->value.integer) + 1L;
+    }
+
+  return strlen*elements;
+}
+
+
+/* Returns the storage size of an expression (actual argument) or
+   zero if it cannot be determined. For an array element, it returns
+   the remaining size as the element sequence consists of all storage
+   units of the actual argument up to the end of the array.  */
+
+static unsigned long
+get_expr_storage_size (gfc_expr *e)
+{
+  int i;
+  long int strlen, elements;
+  long int substrlen = 0;
+  bool is_str_storage = false;
+  gfc_ref *ref;
+
+  if (e == NULL)
+    return 0;
+  
+  if (e->ts.type == BT_CHARACTER)
+    {
+      if (e->ts.u.cl && e->ts.u.cl->length
+          && e->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+	strlen = mpz_get_si (e->ts.u.cl->length->value.integer);
+      else if (e->expr_type == EXPR_CONSTANT
+	       && (e->ts.u.cl == NULL || e->ts.u.cl->length == NULL))
+	strlen = e->value.character.length;
+      else
+	return 0;
+    }
+  else
+    strlen = 1; /* Length per element.  */
+
+  if (e->rank == 0 && !e->ref)
+    return strlen;
+
+  elements = 1;
+  if (!e->ref)
+    {
+      if (!e->shape)
+	return 0;
+      for (i = 0; i < e->rank; i++)
+	elements *= mpz_get_si (e->shape[i]);
+      return elements*strlen;
+    }
+
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_SUBSTRING && ref->u.ss.start
+	  && ref->u.ss.start->expr_type == EXPR_CONSTANT)
+	{
+	  if (is_str_storage)
+	    {
+	      /* The string length is the substring length.
+		 Set now to full string length.  */
+	      if (!ref->u.ss.length || !ref->u.ss.length->length
+		  || ref->u.ss.length->length->expr_type != EXPR_CONSTANT)
+		return 0;
+
+	      strlen = mpz_get_ui (ref->u.ss.length->length->value.integer);
+	    }
+	  substrlen = strlen - mpz_get_ui (ref->u.ss.start->value.integer) + 1;
+	  continue;
+	}
+
+      if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION
+	  && ref->u.ar.start && ref->u.ar.end && ref->u.ar.stride
+	  && ref->u.ar.as->upper)
+	for (i = 0; i < ref->u.ar.dimen; i++)
+	  {
+	    long int start, end, stride;
+	    stride = 1;
+
+	    if (ref->u.ar.stride[i])
+	      {
+		if (ref->u.ar.stride[i]->expr_type == EXPR_CONSTANT)
+		  stride = mpz_get_si (ref->u.ar.stride[i]->value.integer);
+		else
+		  return 0;
+	      }
+
+	    if (ref->u.ar.start[i])
+	      {
+		if (ref->u.ar.start[i]->expr_type == EXPR_CONSTANT)
+		  start = mpz_get_si (ref->u.ar.start[i]->value.integer);
+		else
+		  return 0;
+	      }
+	    else if (ref->u.ar.as->lower[i]
+		     && ref->u.ar.as->lower[i]->expr_type == EXPR_CONSTANT)
+	      start = mpz_get_si (ref->u.ar.as->lower[i]->value.integer);
+	    else
+	      return 0;
+
+	    if (ref->u.ar.end[i])
+	      {
+		if (ref->u.ar.end[i]->expr_type == EXPR_CONSTANT)
+		  end = mpz_get_si (ref->u.ar.end[i]->value.integer);
+		else
+		  return 0;
+	      }
+	    else if (ref->u.ar.as->upper[i]
+		     && ref->u.ar.as->upper[i]->expr_type == EXPR_CONSTANT)
+	      end = mpz_get_si (ref->u.ar.as->upper[i]->value.integer);
+	    else
+	      return 0;
+
+	    elements *= (end - start)/stride + 1L;
+	  }
+      else if (ref->type == REF_ARRAY && ref->u.ar.type == AR_FULL
+	       && ref->u.ar.as->lower && ref->u.ar.as->upper)
+	for (i = 0; i < ref->u.ar.as->rank; i++)
+	  {
+	    if (ref->u.ar.as->lower[i] && ref->u.ar.as->upper[i]
+		&& ref->u.ar.as->lower[i]->expr_type == EXPR_CONSTANT
+		&& ref->u.ar.as->upper[i]->expr_type == EXPR_CONSTANT)
+	      elements *= mpz_get_si (ref->u.ar.as->upper[i]->value.integer)
+			  - mpz_get_si (ref->u.ar.as->lower[i]->value.integer)
+			  + 1L;
+	    else
+	      return 0;
+	  }
+      else if (ref->type == REF_ARRAY && ref->u.ar.type == AR_ELEMENT
+	       && e->expr_type == EXPR_VARIABLE)
+	{
+	  if (ref->u.ar.as->type == AS_ASSUMED_SHAPE
+	      || e->symtree->n.sym->attr.pointer)
+	    {
+	      elements = 1;
+	      continue;
+	    }
+
+	  /* Determine the number of remaining elements in the element
+	     sequence for array element designators.  */
+	  is_str_storage = true;
+	  for (i = ref->u.ar.dimen - 1; i >= 0; i--)
+	    {
+	      if (ref->u.ar.start[i] == NULL
+		  || ref->u.ar.start[i]->expr_type != EXPR_CONSTANT
+		  || ref->u.ar.as->upper[i] == NULL
+		  || ref->u.ar.as->lower[i] == NULL
+		  || ref->u.ar.as->upper[i]->expr_type != EXPR_CONSTANT
+		  || ref->u.ar.as->lower[i]->expr_type != EXPR_CONSTANT)
+		return 0;
+
+	      elements
+		   = elements
+		     * (mpz_get_si (ref->u.ar.as->upper[i]->value.integer)
+			- mpz_get_si (ref->u.ar.as->lower[i]->value.integer)
+			+ 1L)
+		     - (mpz_get_si (ref->u.ar.start[i]->value.integer)
+			- mpz_get_si (ref->u.ar.as->lower[i]->value.integer));
+	    }
+        }
+    }
+
+  if (substrlen)
+    return (is_str_storage) ? substrlen + (elements-1)*strlen
+			    : elements*strlen;
+  else
+    return elements*strlen;
+}
+
+
+/* Given an expression, check whether it is an array section
+   which has a vector subscript. If it has, one is returned,
+   otherwise zero.  */
+
+int
+gfc_has_vector_subscript (gfc_expr *e)
+{
+  int i;
+  gfc_ref *ref;
+
+  if (e == NULL || e->rank == 0 || e->expr_type != EXPR_VARIABLE)
+    return 0;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
+      for (i = 0; i < ref->u.ar.dimen; i++)
+	if (ref->u.ar.dimen_type[i] == DIMEN_VECTOR)
+	  return 1;
+
+  return 0;
+}
+
+
+/* Given formal and actual argument lists, see if they are compatible.
+   If they are compatible, the actual argument list is sorted to
+   correspond with the formal list, and elements for missing optional
+   arguments are inserted. If WHERE pointer is nonnull, then we issue
+   errors when things don't match instead of just returning the status
+   code.  */
+
+static int
+compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
+	 	       int ranks_must_agree, int is_elemental, locus *where)
+{
+  gfc_actual_arglist **new_arg, *a, *actual, temp;
+  gfc_formal_arglist *f;
+  int i, n, na;
+  unsigned long actual_size, formal_size;
+
+  actual = *ap;
+
+  if (actual == NULL && formal == NULL)
+    return 1;
+
+  n = 0;
+  for (f = formal; f; f = f->next)
+    n++;
+
+  new_arg = XALLOCAVEC (gfc_actual_arglist *, n);
+
+  for (i = 0; i < n; i++)
+    new_arg[i] = NULL;
+
+  na = 0;
+  f = formal;
+  i = 0;
+
+  for (a = actual; a; a = a->next, f = f->next)
+    {
+      /* Look for keywords but ignore g77 extensions like %VAL.  */
+      if (a->name != NULL && a->name[0] != '%')
+	{
+	  i = 0;
+	  for (f = formal; f; f = f->next, i++)
+	    {
+	      if (f->sym == NULL)
+		continue;
+	      if (strcmp (f->sym->name, a->name) == 0)
+		break;
+	    }
+
+	  if (f == NULL)
+	    {
+	      if (where)
+		gfc_error ("Keyword argument '%s' at %L is not in "
+			   "the procedure", a->name, &a->expr->where);
+	      return 0;
+	    }
+
+	  if (new_arg[i] != NULL)
+	    {
+	      if (where)
+		gfc_error ("Keyword argument '%s' at %L is already associated "
+			   "with another actual argument", a->name,
+			   &a->expr->where);
+	      return 0;
+	    }
+	}
+
+      if (f == NULL)
+	{
+	  if (where)
+	    gfc_error ("More actual than formal arguments in procedure "
+		       "call at %L", where);
+
+	  return 0;
+	}
+
+      if (f->sym == NULL && a->expr == NULL)
+	goto match;
+
+      if (f->sym == NULL)
+	{
+	  if (where)
+	    gfc_error ("Missing alternate return spec in subroutine call "
+		       "at %L", where);
+	  return 0;
+	}
+
+      if (a->expr == NULL)
+	{
+	  if (where)
+	    gfc_error ("Unexpected alternate return spec in subroutine "
+		       "call at %L", where);
+	  return 0;
+	}
+
+      if (a->expr->expr_type == EXPR_NULL && !f->sym->attr.pointer
+	  && (f->sym->attr.allocatable || !f->sym->attr.optional
+	      || (gfc_option.allow_std & GFC_STD_F2008) == 0))
+	{
+	  if (where && (f->sym->attr.allocatable || !f->sym->attr.optional))
+	    gfc_error ("Unexpected NULL() intrinsic at %L to dummy '%s'",
+		       where, f->sym->name);
+	  else if (where)
+	    gfc_error ("Fortran 2008: Null pointer at %L to non-pointer "
+		       "dummy '%s'", where, f->sym->name);
+
+	  return 0;
+	}
+      
+      if (!compare_parameter (f->sym, a->expr, ranks_must_agree,
+			      is_elemental, where))
+	return 0;
+
+      /* Special case for character arguments.  For allocatable, pointer
+	 and assumed-shape dummies, the string length needs to match
+	 exactly.  */
+      if (a->expr->ts.type == BT_CHARACTER
+	   && a->expr->ts.u.cl && a->expr->ts.u.cl->length
+	   && a->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT
+	   && f->sym->ts.u.cl && f->sym->ts.u.cl && f->sym->ts.u.cl->length
+	   && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
+	   && (f->sym->attr.pointer || f->sym->attr.allocatable
+	       || (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
+	   && (mpz_cmp (a->expr->ts.u.cl->length->value.integer,
+			f->sym->ts.u.cl->length->value.integer) != 0))
+	 {
+	   if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
+	     gfc_warning ("Character length mismatch (%ld/%ld) between actual "
+			  "argument and pointer or allocatable dummy argument "
+			  "'%s' at %L",
+			  mpz_get_si (a->expr->ts.u.cl->length->value.integer),
+			  mpz_get_si (f->sym->ts.u.cl->length->value.integer),
+			  f->sym->name, &a->expr->where);
+	   else if (where)
+	     gfc_warning ("Character length mismatch (%ld/%ld) between actual "
+			  "argument and assumed-shape dummy argument '%s' "
+			  "at %L",
+			  mpz_get_si (a->expr->ts.u.cl->length->value.integer),
+			  mpz_get_si (f->sym->ts.u.cl->length->value.integer),
+			  f->sym->name, &a->expr->where);
+	   return 0;
+	 }
+
+      if ((f->sym->attr.pointer || f->sym->attr.allocatable)
+	    && f->sym->ts.deferred != a->expr->ts.deferred
+	    && a->expr->ts.type == BT_CHARACTER)
+	{
+	  if (where)
+	    gfc_error ("Actual argument argument at %L to allocatable or "
+		       "pointer dummy argument '%s' must have a deferred "
+		       "length type parameter if and only if the dummy has one",
+		       &a->expr->where, f->sym->name);
+	  return 0;
+	}
+
+      actual_size = get_expr_storage_size (a->expr);
+      formal_size = get_sym_storage_size (f->sym);
+      if (actual_size != 0 && actual_size < formal_size
+	  && a->expr->ts.type != BT_PROCEDURE
+	  && f->sym->attr.flavor != FL_PROCEDURE)
+	{
+	  if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where)
+	    gfc_warning ("Character length of actual argument shorter "
+			 "than of dummy argument '%s' (%lu/%lu) at %L",
+			 f->sym->name, actual_size, formal_size,
+			 &a->expr->where);
+          else if (where)
+	    gfc_warning ("Actual argument contains too few "
+			 "elements for dummy argument '%s' (%lu/%lu) at %L",
+			 f->sym->name, actual_size, formal_size,
+			 &a->expr->where);
+	  return  0;
+	}
+
+      /* Satisfy 12.4.1.3 by ensuring that a procedure pointer actual argument
+	 is provided for a procedure pointer formal argument.  */
+      if (f->sym->attr.proc_pointer
+	  && !((a->expr->expr_type == EXPR_VARIABLE
+		&& a->expr->symtree->n.sym->attr.proc_pointer)
+	       || (a->expr->expr_type == EXPR_FUNCTION
+		   && a->expr->symtree->n.sym->result->attr.proc_pointer)
+	       || gfc_is_proc_ptr_comp (a->expr, NULL)))
+	{
+	  if (where)
+	    gfc_error ("Expected a procedure pointer for argument '%s' at %L",
+		       f->sym->name, &a->expr->where);
+	  return 0;
+	}
+
+      /* Satisfy 12.4.1.2 by ensuring that a procedure actual argument is
+	 provided for a procedure formal argument.  */
+      if (a->expr->ts.type != BT_PROCEDURE && !gfc_is_proc_ptr_comp (a->expr, NULL)
+	  && a->expr->expr_type == EXPR_VARIABLE
+	  && f->sym->attr.flavor == FL_PROCEDURE)
+	{
+	  if (where)
+	    gfc_error ("Expected a procedure for argument '%s' at %L",
+		       f->sym->name, &a->expr->where);
+	  return 0;
+	}
+
+      if (f->sym->attr.flavor == FL_PROCEDURE && f->sym->attr.pure
+	  && a->expr->ts.type == BT_PROCEDURE
+	  && !a->expr->symtree->n.sym->attr.pure)
+	{
+	  if (where)
+	    gfc_error ("Expected a PURE procedure for argument '%s' at %L",
+		       f->sym->name, &a->expr->where);
+	  return 0;
+	}
+
+      if (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE
+	  && a->expr->expr_type == EXPR_VARIABLE
+	  && a->expr->symtree->n.sym->as
+	  && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SIZE
+	  && (a->expr->ref == NULL
+	      || (a->expr->ref->type == REF_ARRAY
+		  && a->expr->ref->u.ar.type == AR_FULL)))
+	{
+	  if (where)
+	    gfc_error ("Actual argument for '%s' cannot be an assumed-size"
+		       " array at %L", f->sym->name, where);
+	  return 0;
+	}
+
+      if (a->expr->expr_type != EXPR_NULL
+	  && compare_pointer (f->sym, a->expr) == 0)
+	{
+	  if (where)
+	    gfc_error ("Actual argument for '%s' must be a pointer at %L",
+		       f->sym->name, &a->expr->where);
+	  return 0;
+	}
+
+      if (a->expr->expr_type != EXPR_NULL
+	  && (gfc_option.allow_std & GFC_STD_F2008) == 0
+	  && compare_pointer (f->sym, a->expr) == 2)
+	{
+	  if (where)
+	    gfc_error ("Fortran 2008: Non-pointer actual argument at %L to "
+		       "pointer dummy '%s'", &a->expr->where,f->sym->name);
+	  return 0;
+	}
+	
+
+      /* Fortran 2008, C1242.  */
+      if (f->sym->attr.pointer && gfc_is_coindexed (a->expr))
+	{
+	  if (where)
+	    gfc_error ("Coindexed actual argument at %L to pointer "
+		       "dummy '%s'",
+		       &a->expr->where, f->sym->name);
+	  return 0;
+	}
+
+      /* Fortran 2008, 12.5.2.5 (no constraint).  */
+      if (a->expr->expr_type == EXPR_VARIABLE
+	  && f->sym->attr.intent != INTENT_IN
+	  && f->sym->attr.allocatable
+	  && gfc_is_coindexed (a->expr))
+	{
+	  if (where)
+	    gfc_error ("Coindexed actual argument at %L to allocatable "
+		       "dummy '%s' requires INTENT(IN)",
+		       &a->expr->where, f->sym->name);
+	  return 0;
+	}
+
+      /* Fortran 2008, C1237.  */
+      if (a->expr->expr_type == EXPR_VARIABLE
+	  && (f->sym->attr.asynchronous || f->sym->attr.volatile_)
+	  && gfc_is_coindexed (a->expr)
+	  && (a->expr->symtree->n.sym->attr.volatile_
+	      || a->expr->symtree->n.sym->attr.asynchronous))
+	{
+	  if (where)
+	    gfc_error ("Coindexed ASYNCHRONOUS or VOLATILE actual argument at "
+		       "at %L requires that dummy %s' has neither "
+		       "ASYNCHRONOUS nor VOLATILE", &a->expr->where,
+		       f->sym->name);
+	  return 0;
+	}
+
+      /* Fortran 2008, 12.5.2.4 (no constraint).  */
+      if (a->expr->expr_type == EXPR_VARIABLE
+	  && f->sym->attr.intent != INTENT_IN && !f->sym->attr.value
+	  && gfc_is_coindexed (a->expr)
+	  && gfc_has_ultimate_allocatable (a->expr))
+	{
+	  if (where)
+	    gfc_error ("Coindexed actual argument at %L with allocatable "
+		       "ultimate component to dummy '%s' requires either VALUE "
+		       "or INTENT(IN)", &a->expr->where, f->sym->name);
+	  return 0;
+	}
+
+      if (a->expr->expr_type != EXPR_NULL
+	  && compare_allocatable (f->sym, a->expr) == 0)
+	{
+	  if (where)
+	    gfc_error ("Actual argument for '%s' must be ALLOCATABLE at %L",
+		       f->sym->name, &a->expr->where);
+	  return 0;
+	}
+
+      /* Check intent = OUT/INOUT for definable actual argument.  */
+      if ((f->sym->attr.intent == INTENT_OUT
+	  || f->sym->attr.intent == INTENT_INOUT))
+	{
+	  const char* context = (where
+				 ? _("actual argument to INTENT = OUT/INOUT")
+				 : NULL);
+
+	  if (f->sym->attr.pointer
+	      && gfc_check_vardef_context (a->expr, true, context)
+		   == FAILURE)
+	    return 0;
+	  if (gfc_check_vardef_context (a->expr, false, context)
+		== FAILURE)
+	    return 0;
+	}
+
+      if ((f->sym->attr.intent == INTENT_OUT
+	   || f->sym->attr.intent == INTENT_INOUT
+	   || f->sym->attr.volatile_
+	   || f->sym->attr.asynchronous)
+	  && gfc_has_vector_subscript (a->expr))
+	{
+	  if (where)
+	    gfc_error ("Array-section actual argument with vector "
+		       "subscripts at %L is incompatible with INTENT(OUT), "
+		       "INTENT(INOUT), VOLATILE or ASYNCHRONOUS attribute "
+		       "of the dummy argument '%s'",
+		       &a->expr->where, f->sym->name);
+	  return 0;
+	}
+
+      /* C1232 (R1221) For an actual argument which is an array section or
+	 an assumed-shape array, the dummy argument shall be an assumed-
+	 shape array, if the dummy argument has the VOLATILE attribute.  */
+
+      if (f->sym->attr.volatile_
+	  && a->expr->symtree->n.sym->as
+	  && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SHAPE
+	  && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
+	{
+	  if (where)
+	    gfc_error ("Assumed-shape actual argument at %L is "
+		       "incompatible with the non-assumed-shape "
+		       "dummy argument '%s' due to VOLATILE attribute",
+		       &a->expr->where,f->sym->name);
+	  return 0;
+	}
+
+      if (f->sym->attr.volatile_
+	  && a->expr->ref && a->expr->ref->u.ar.type == AR_SECTION
+	  && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
+	{
+	  if (where)
+	    gfc_error ("Array-section actual argument at %L is "
+		       "incompatible with the non-assumed-shape "
+		       "dummy argument '%s' due to VOLATILE attribute",
+		       &a->expr->where,f->sym->name);
+	  return 0;
+	}
+
+      /* C1233 (R1221) For an actual argument which is a pointer array, the
+	 dummy argument shall be an assumed-shape or pointer array, if the
+	 dummy argument has the VOLATILE attribute.  */
+
+      if (f->sym->attr.volatile_
+	  && a->expr->symtree->n.sym->attr.pointer
+	  && a->expr->symtree->n.sym->as
+	  && !(f->sym->as
+	       && (f->sym->as->type == AS_ASSUMED_SHAPE
+		   || f->sym->attr.pointer)))
+	{
+	  if (where)
+	    gfc_error ("Pointer-array actual argument at %L requires "
+		       "an assumed-shape or pointer-array dummy "
+		       "argument '%s' due to VOLATILE attribute",
+		       &a->expr->where,f->sym->name);
+	  return 0;
+	}
+
+    match:
+      if (a == actual)
+	na = i;
+
+      new_arg[i++] = a;
+    }
+
+  /* Make sure missing actual arguments are optional.  */
+  i = 0;
+  for (f = formal; f; f = f->next, i++)
+    {
+      if (new_arg[i] != NULL)
+	continue;
+      if (f->sym == NULL)
+	{
+	  if (where)
+	    gfc_error ("Missing alternate return spec in subroutine call "
+		       "at %L", where);
+	  return 0;
+	}
+      if (!f->sym->attr.optional)
+	{
+	  if (where)
+	    gfc_error ("Missing actual argument for argument '%s' at %L",
+		       f->sym->name, where);
+	  return 0;
+	}
+    }
+
+  /* The argument lists are compatible.  We now relink a new actual
+     argument list with null arguments in the right places.  The head
+     of the list remains the head.  */
+  for (i = 0; i < n; i++)
+    if (new_arg[i] == NULL)
+      new_arg[i] = gfc_get_actual_arglist ();
+
+  if (na != 0)
+    {
+      temp = *new_arg[0];
+      *new_arg[0] = *actual;
+      *actual = temp;
+
+      a = new_arg[0];
+      new_arg[0] = new_arg[na];
+      new_arg[na] = a;
+    }
+
+  for (i = 0; i < n - 1; i++)
+    new_arg[i]->next = new_arg[i + 1];
+
+  new_arg[i]->next = NULL;
+
+  if (*ap == NULL && n > 0)
+    *ap = new_arg[0];
+
+  /* Note the types of omitted optional arguments.  */
+  for (a = *ap, f = formal; a; a = a->next, f = f->next)
+    if (a->expr == NULL && a->label == NULL)
+      a->missing_arg_type = f->sym->ts.type;
+
+  return 1;
+}
+
+
+typedef struct
+{
+  gfc_formal_arglist *f;
+  gfc_actual_arglist *a;
+}
+argpair;
+
+/* qsort comparison function for argument pairs, with the following
+   order:
+    - p->a->expr == NULL
+    - p->a->expr->expr_type != EXPR_VARIABLE
+    - growing p->a->expr->symbol.  */
+
+static int
+pair_cmp (const void *p1, const void *p2)
+{
+  const gfc_actual_arglist *a1, *a2;
+
+  /* *p1 and *p2 are elements of the to-be-sorted array.  */
+  a1 = ((const argpair *) p1)->a;
+  a2 = ((const argpair *) p2)->a;
+  if (!a1->expr)
+    {
+      if (!a2->expr)
+	return 0;
+      return -1;
+    }
+  if (!a2->expr)
+    return 1;
+  if (a1->expr->expr_type != EXPR_VARIABLE)
+    {
+      if (a2->expr->expr_type != EXPR_VARIABLE)
+	return 0;
+      return -1;
+    }
+  if (a2->expr->expr_type != EXPR_VARIABLE)
+    return 1;
+  return a1->expr->symtree->n.sym < a2->expr->symtree->n.sym;
+}
+
+
+/* Given two expressions from some actual arguments, test whether they
+   refer to the same expression. The analysis is conservative.
+   Returning FAILURE will produce no warning.  */
+
+static gfc_try
+compare_actual_expr (gfc_expr *e1, gfc_expr *e2)
+{
+  const gfc_ref *r1, *r2;
+
+  if (!e1 || !e2
+      || e1->expr_type != EXPR_VARIABLE
+      || e2->expr_type != EXPR_VARIABLE
+      || e1->symtree->n.sym != e2->symtree->n.sym)
+    return FAILURE;
+
+  /* TODO: improve comparison, see expr.c:show_ref().  */
+  for (r1 = e1->ref, r2 = e2->ref; r1 && r2; r1 = r1->next, r2 = r2->next)
+    {
+      if (r1->type != r2->type)
+	return FAILURE;
+      switch (r1->type)
+	{
+	case REF_ARRAY:
+	  if (r1->u.ar.type != r2->u.ar.type)
+	    return FAILURE;
+	  /* TODO: At the moment, consider only full arrays;
+	     we could do better.  */
+	  if (r1->u.ar.type != AR_FULL || r2->u.ar.type != AR_FULL)
+	    return FAILURE;
+	  break;
+
+	case REF_COMPONENT:
+	  if (r1->u.c.component != r2->u.c.component)
+	    return FAILURE;
+	  break;
+
+	case REF_SUBSTRING:
+	  return FAILURE;
+
+	default:
+	  gfc_internal_error ("compare_actual_expr(): Bad component code");
+	}
+    }
+  if (!r1 && !r2)
+    return SUCCESS;
+  return FAILURE;
+}
+
+
+/* Given formal and actual argument lists that correspond to one
+   another, check that identical actual arguments aren't not
+   associated with some incompatible INTENTs.  */
+
+static gfc_try
+check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a)
+{
+  sym_intent f1_intent, f2_intent;
+  gfc_formal_arglist *f1;
+  gfc_actual_arglist *a1;
+  size_t n, i, j;
+  argpair *p;
+  gfc_try t = SUCCESS;
+
+  n = 0;
+  for (f1 = f, a1 = a;; f1 = f1->next, a1 = a1->next)
+    {
+      if (f1 == NULL && a1 == NULL)
+	break;
+      if (f1 == NULL || a1 == NULL)
+	gfc_internal_error ("check_some_aliasing(): List mismatch");
+      n++;
+    }
+  if (n == 0)
+    return t;
+  p = XALLOCAVEC (argpair, n);
+
+  for (i = 0, f1 = f, a1 = a; i < n; i++, f1 = f1->next, a1 = a1->next)
+    {
+      p[i].f = f1;
+      p[i].a = a1;
+    }
+
+  qsort (p, n, sizeof (argpair), pair_cmp);
+
+  for (i = 0; i < n; i++)
+    {
+      if (!p[i].a->expr
+	  || p[i].a->expr->expr_type != EXPR_VARIABLE
+	  || p[i].a->expr->ts.type == BT_PROCEDURE)
+	continue;
+      f1_intent = p[i].f->sym->attr.intent;
+      for (j = i + 1; j < n; j++)
+	{
+	  /* Expected order after the sort.  */
+	  if (!p[j].a->expr || p[j].a->expr->expr_type != EXPR_VARIABLE)
+	    gfc_internal_error ("check_some_aliasing(): corrupted data");
+
+	  /* Are the expression the same?  */
+	  if (compare_actual_expr (p[i].a->expr, p[j].a->expr) == FAILURE)
+	    break;
+	  f2_intent = p[j].f->sym->attr.intent;
+	  if ((f1_intent == INTENT_IN && f2_intent == INTENT_OUT)
+	      || (f1_intent == INTENT_OUT && f2_intent == INTENT_IN))
+	    {
+	      gfc_warning ("Same actual argument associated with INTENT(%s) "
+			   "argument '%s' and INTENT(%s) argument '%s' at %L",
+			   gfc_intent_string (f1_intent), p[i].f->sym->name,
+			   gfc_intent_string (f2_intent), p[j].f->sym->name,
+			   &p[i].a->expr->where);
+	      t = FAILURE;
+	    }
+	}
+    }
+
+  return t;
+}
+
+
+/* Given a symbol of a formal argument list and an expression,
+   return nonzero if their intents are compatible, zero otherwise.  */
+
+static int
+compare_parameter_intent (gfc_symbol *formal, gfc_expr *actual)
+{
+  if (actual->symtree->n.sym->attr.pointer && !formal->attr.pointer)
+    return 1;
+
+  if (actual->symtree->n.sym->attr.intent != INTENT_IN)
+    return 1;
+
+  if (formal->attr.intent == INTENT_INOUT || formal->attr.intent == INTENT_OUT)
+    return 0;
+
+  return 1;
+}
+
+
+/* Given formal and actual argument lists that correspond to one
+   another, check that they are compatible in the sense that intents
+   are not mismatched.  */
+
+static gfc_try
+check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
+{
+  sym_intent f_intent;
+
+  for (;; f = f->next, a = a->next)
+    {
+      if (f == NULL && a == NULL)
+	break;
+      if (f == NULL || a == NULL)
+	gfc_internal_error ("check_intents(): List mismatch");
+
+      if (a->expr == NULL || a->expr->expr_type != EXPR_VARIABLE)
+	continue;
+
+      f_intent = f->sym->attr.intent;
+
+      if (!compare_parameter_intent(f->sym, a->expr))
+	{
+	  gfc_error ("Procedure argument at %L is INTENT(IN) while interface "
+		     "specifies INTENT(%s)", &a->expr->where,
+		     gfc_intent_string (f_intent));
+	  return FAILURE;
+	}
+
+      if (gfc_pure (NULL) && gfc_impure_variable (a->expr->symtree->n.sym))
+	{
+	  if (f_intent == INTENT_INOUT || f_intent == INTENT_OUT)
+	    {
+	      gfc_error ("Procedure argument at %L is local to a PURE "
+			 "procedure and is passed to an INTENT(%s) argument",
+			 &a->expr->where, gfc_intent_string (f_intent));
+	      return FAILURE;
+	    }
+
+	  if (f->sym->attr.pointer)
+	    {
+	      gfc_error ("Procedure argument at %L is local to a PURE "
+			 "procedure and has the POINTER attribute",
+			 &a->expr->where);
+	      return FAILURE;
+	    }
+	}
+
+       /* Fortran 2008, C1283.  */
+       if (gfc_pure (NULL) && gfc_is_coindexed (a->expr))
+	{
+	  if (f_intent == INTENT_INOUT || f_intent == INTENT_OUT)
+	    {
+	      gfc_error ("Coindexed actual argument at %L in PURE procedure "
+			 "is passed to an INTENT(%s) argument",
+			 &a->expr->where, gfc_intent_string (f_intent));
+	      return FAILURE;
+	    }
+
+	  if (f->sym->attr.pointer)
+	    {
+	      gfc_error ("Coindexed actual argument at %L in PURE procedure "
+			 "is passed to a POINTER dummy argument",
+			 &a->expr->where);
+	      return FAILURE;
+	    }
+	}
+
+       /* F2008, Section 12.5.2.4.  */
+       if (a->expr->ts.type == BT_CLASS && f->sym->ts.type == BT_CLASS
+	   && gfc_is_coindexed (a->expr))
+	 {
+	   gfc_error ("Coindexed polymorphic actual argument at %L is passed "
+		      "polymorphic dummy argument '%s'",
+			 &a->expr->where, f->sym->name);
+	   return FAILURE;
+	 }
+    }
+
+  return SUCCESS;
+}
+
+
+/* Check how a procedure is used against its interface.  If all goes
+   well, the actual argument list will also end up being properly
+   sorted.  */
+
+void
+gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
+{
+
+  /* Warn about calls with an implicit interface.  Special case
+     for calling a ISO_C_BINDING becase c_loc and c_funloc
+     are pseudo-unknown.  Additionally, warn about procedures not
+     explicitly declared at all if requested.  */
+  if (sym->attr.if_source == IFSRC_UNKNOWN && ! sym->attr.is_iso_c)
+    {
+      if (gfc_option.warn_implicit_interface)
+	gfc_warning ("Procedure '%s' called with an implicit interface at %L",
+		     sym->name, where);
+      else if (gfc_option.warn_implicit_procedure
+	       && sym->attr.proc == PROC_UNKNOWN)
+	gfc_warning ("Procedure '%s' called at %L is not explicitly declared",
+		     sym->name, where);
+    }
+
+  if (sym->attr.if_source == IFSRC_UNKNOWN)
+    {
+      gfc_actual_arglist *a;
+
+      if (sym->attr.pointer)
+	{
+	  gfc_error("The pointer object '%s' at %L must have an explicit "
+		    "function interface or be declared as array",
+		    sym->name, where);
+	  return;
+	}
+
+      if (sym->attr.allocatable && !sym->attr.external)
+	{
+	  gfc_error("The allocatable object '%s' at %L must have an explicit "
+		    "function interface or be declared as array",
+		    sym->name, where);
+	  return;
+	}
+
+      if (sym->attr.allocatable)
+	{
+	  gfc_error("Allocatable function '%s' at %L must have an explicit "
+		    "function interface", sym->name, where);
+	  return;
+	}
+
+      for (a = *ap; a; a = a->next)
+	{
+	  /* Skip g77 keyword extensions like %VAL, %REF, %LOC.  */
+	  if (a->name != NULL && a->name[0] != '%')
+	    {
+	      gfc_error("Keyword argument requires explicit interface "
+			"for procedure '%s' at %L", sym->name, &a->expr->where);
+	      break;
+	    }
+	}
+
+      return;
+    }
+
+  if (!compare_actual_formal (ap, sym->formal, 0, sym->attr.elemental, where))
+    return;
+
+  check_intents (sym->formal, *ap);
+  if (gfc_option.warn_aliasing)
+    check_some_aliasing (sym->formal, *ap);
+}
+
+
+/* Check how a procedure pointer component is used against its interface.
+   If all goes well, the actual argument list will also end up being properly
+   sorted. Completely analogous to gfc_procedure_use.  */
+
+void
+gfc_ppc_use (gfc_component *comp, gfc_actual_arglist **ap, locus *where)
+{
+
+  /* Warn about calls with an implicit interface.  Special case
+     for calling a ISO_C_BINDING becase c_loc and c_funloc
+     are pseudo-unknown.  */
+  if (gfc_option.warn_implicit_interface
+      && comp->attr.if_source == IFSRC_UNKNOWN
+      && !comp->attr.is_iso_c)
+    gfc_warning ("Procedure pointer component '%s' called with an implicit "
+		 "interface at %L", comp->name, where);
+
+  if (comp->attr.if_source == IFSRC_UNKNOWN)
+    {
+      gfc_actual_arglist *a;
+      for (a = *ap; a; a = a->next)
+	{
+	  /* Skip g77 keyword extensions like %VAL, %REF, %LOC.  */
+	  if (a->name != NULL && a->name[0] != '%')
+	    {
+	      gfc_error("Keyword argument requires explicit interface "
+			"for procedure pointer component '%s' at %L",
+			comp->name, &a->expr->where);
+	      break;
+	    }
+	}
+
+      return;
+    }
+
+  if (!compare_actual_formal (ap, comp->formal, 0, comp->attr.elemental, where))
+    return;
+
+  check_intents (comp->formal, *ap);
+  if (gfc_option.warn_aliasing)
+    check_some_aliasing (comp->formal, *ap);
+}
+
+
+/* Try if an actual argument list matches the formal list of a symbol,
+   respecting the symbol's attributes like ELEMENTAL.  This is used for
+   GENERIC resolution.  */
+
+bool
+gfc_arglist_matches_symbol (gfc_actual_arglist** args, gfc_symbol* sym)
+{
+  bool r;
+
+  gcc_assert (sym->attr.flavor == FL_PROCEDURE);
+
+  r = !sym->attr.elemental;
+  if (compare_actual_formal (args, sym->formal, r, !r, NULL))
+    {
+      check_intents (sym->formal, *args);
+      if (gfc_option.warn_aliasing)
+	check_some_aliasing (sym->formal, *args);
+      return true;
+    }
+
+  return false;
+}
+
+
+/* Given an interface pointer and an actual argument list, search for
+   a formal argument list that matches the actual.  If found, returns
+   a pointer to the symbol of the correct interface.  Returns NULL if
+   not found.  */
+
+gfc_symbol *
+gfc_search_interface (gfc_interface *intr, int sub_flag,
+		      gfc_actual_arglist **ap)
+{
+  gfc_symbol *elem_sym = NULL;
+  for (; intr; intr = intr->next)
+    {
+      if (sub_flag && intr->sym->attr.function)
+	continue;
+      if (!sub_flag && intr->sym->attr.subroutine)
+	continue;
+
+      if (gfc_arglist_matches_symbol (ap, intr->sym))
+	{
+	  /* Satisfy 12.4.4.1 such that an elemental match has lower
+	     weight than a non-elemental match.  */ 
+	  if (intr->sym->attr.elemental)
+	    {
+	      elem_sym = intr->sym;
+	      continue;
+	    }
+	  return intr->sym;
+	}
+    }
+
+  return elem_sym ? elem_sym : NULL;
+}
+
+
+/* Do a brute force recursive search for a symbol.  */
+
+static gfc_symtree *
+find_symtree0 (gfc_symtree *root, gfc_symbol *sym)
+{
+  gfc_symtree * st;
+
+  if (root->n.sym == sym)
+    return root;
+
+  st = NULL;
+  if (root->left)
+    st = find_symtree0 (root->left, sym);
+  if (root->right && ! st)
+    st = find_symtree0 (root->right, sym);
+  return st;
+}
+
+
+/* Find a symtree for a symbol.  */
+
+gfc_symtree *
+gfc_find_sym_in_symtree (gfc_symbol *sym)
+{
+  gfc_symtree *st;
+  gfc_namespace *ns;
+
+  /* First try to find it by name.  */
+  gfc_find_sym_tree (sym->name, gfc_current_ns, 1, &st);
+  if (st && st->n.sym == sym)
+    return st;
+
+  /* If it's been renamed, resort to a brute-force search.  */
+  /* TODO: avoid having to do this search.  If the symbol doesn't exist
+     in the symtree for the current namespace, it should probably be added.  */
+  for (ns = gfc_current_ns; ns; ns = ns->parent)
+    {
+      st = find_symtree0 (ns->sym_root, sym);
+      if (st)
+	return st;
+    }
+  gfc_internal_error ("Unable to find symbol %s", sym->name);
+  /* Not reached.  */
+}
+
+
+/* See if the arglist to an operator-call contains a derived-type argument
+   with a matching type-bound operator.  If so, return the matching specific
+   procedure defined as operator-target as well as the base-object to use
+   (which is the found derived-type argument with operator).  The generic
+   name, if any, is transmitted to the final expression via 'gname'.  */
+
+static gfc_typebound_proc*
+matching_typebound_op (gfc_expr** tb_base,
+		       gfc_actual_arglist* args,
+		       gfc_intrinsic_op op, const char* uop,
+		       const char ** gname)
+{
+  gfc_actual_arglist* base;
+
+  for (base = args; base; base = base->next)
+    if (base->expr->ts.type == BT_DERIVED || base->expr->ts.type == BT_CLASS)
+      {
+	gfc_typebound_proc* tb;
+	gfc_symbol* derived;
+	gfc_try result;
+
+	if (base->expr->ts.type == BT_CLASS)
+	  {
+	    if (!gfc_expr_attr (base->expr).class_ok)
+	      continue;
+	    derived = CLASS_DATA (base->expr)->ts.u.derived;
+	  }
+	else
+	  derived = base->expr->ts.u.derived;
+
+	if (op == INTRINSIC_USER)
+	  {
+	    gfc_symtree* tb_uop;
+
+	    gcc_assert (uop);
+	    tb_uop = gfc_find_typebound_user_op (derived, &result, uop,
+						 false, NULL);
+
+	    if (tb_uop)
+	      tb = tb_uop->n.tb;
+	    else
+	      tb = NULL;
+	  }
+	else
+	  tb = gfc_find_typebound_intrinsic_op (derived, &result, op,
+						false, NULL);
+
+	/* This means we hit a PRIVATE operator which is use-associated and
+	   should thus not be seen.  */
+	if (result == FAILURE)
+	  tb = NULL;
+
+	/* Look through the super-type hierarchy for a matching specific
+	   binding.  */
+	for (; tb; tb = tb->overridden)
+	  {
+	    gfc_tbp_generic* g;
+
+	    gcc_assert (tb->is_generic);
+	    for (g = tb->u.generic; g; g = g->next)
+	      {
+		gfc_symbol* target;
+		gfc_actual_arglist* argcopy;
+		bool matches;
+
+		gcc_assert (g->specific);
+		if (g->specific->error)
+		  continue;
+
+		target = g->specific->u.specific->n.sym;
+
+		/* Check if this arglist matches the formal.  */
+		argcopy = gfc_copy_actual_arglist (args);
+		matches = gfc_arglist_matches_symbol (&argcopy, target);
+		gfc_free_actual_arglist (argcopy);
+
+		/* Return if we found a match.  */
+		if (matches)
+		  {
+		    *tb_base = base->expr;
+		    *gname = g->specific_st->name;
+		    return g->specific;
+		  }
+	      }
+	  }
+      }
+
+  return NULL;
+}
+
+
+/* For the 'actual arglist' of an operator call and a specific typebound
+   procedure that has been found the target of a type-bound operator, build the
+   appropriate EXPR_COMPCALL and resolve it.  We take this indirection over
+   type-bound procedures rather than resolving type-bound operators 'directly'
+   so that we can reuse the existing logic.  */
+
+static void
+build_compcall_for_operator (gfc_expr* e, gfc_actual_arglist* actual,
+			     gfc_expr* base, gfc_typebound_proc* target,
+			     const char *gname)
+{
+  e->expr_type = EXPR_COMPCALL;
+  e->value.compcall.tbp = target;
+  e->value.compcall.name = gname ? gname : "$op";
+  e->value.compcall.actual = actual;
+  e->value.compcall.base_object = base;
+  e->value.compcall.ignore_pass = 1;
+  e->value.compcall.assign = 0;
+}
+
+
+/* This subroutine is called when an expression is being resolved.
+   The expression node in question is either a user defined operator
+   or an intrinsic operator with arguments that aren't compatible
+   with the operator.  This subroutine builds an actual argument list
+   corresponding to the operands, then searches for a compatible
+   interface.  If one is found, the expression node is replaced with
+   the appropriate function call.
+   real_error is an additional output argument that specifies if FAILURE
+   is because of some real error and not because no match was found.  */
+
+gfc_try
+gfc_extend_expr (gfc_expr *e, bool *real_error)
+{
+  gfc_actual_arglist *actual;
+  gfc_symbol *sym;
+  gfc_namespace *ns;
+  gfc_user_op *uop;
+  gfc_intrinsic_op i;
+  const char *gname;
+
+  sym = NULL;
+
+  actual = gfc_get_actual_arglist ();
+  actual->expr = e->value.op.op1;
+
+  *real_error = false;
+  gname = NULL;
+
+  if (e->value.op.op2 != NULL)
+    {
+      actual->next = gfc_get_actual_arglist ();
+      actual->next->expr = e->value.op.op2;
+    }
+
+  i = fold_unary_intrinsic (e->value.op.op);
+
+  if (i == INTRINSIC_USER)
+    {
+      for (ns = gfc_current_ns; ns; ns = ns->parent)
+	{
+	  uop = gfc_find_uop (e->value.op.uop->name, ns);
+	  if (uop == NULL)
+	    continue;
+
+	  sym = gfc_search_interface (uop->op, 0, &actual);
+	  if (sym != NULL)
+	    break;
+	}
+    }
+  else
+    {
+      for (ns = gfc_current_ns; ns; ns = ns->parent)
+	{
+	  /* Due to the distinction between '==' and '.eq.' and friends, one has
+	     to check if either is defined.  */
+	  switch (i)
+	    {
+#define CHECK_OS_COMPARISON(comp) \
+  case INTRINSIC_##comp: \
+  case INTRINSIC_##comp##_OS: \
+    sym = gfc_search_interface (ns->op[INTRINSIC_##comp], 0, &actual); \
+    if (!sym) \
+      sym = gfc_search_interface (ns->op[INTRINSIC_##comp##_OS], 0, &actual); \
+    break;
+	      CHECK_OS_COMPARISON(EQ)
+	      CHECK_OS_COMPARISON(NE)
+	      CHECK_OS_COMPARISON(GT)
+	      CHECK_OS_COMPARISON(GE)
+	      CHECK_OS_COMPARISON(LT)
+	      CHECK_OS_COMPARISON(LE)
+#undef CHECK_OS_COMPARISON
+
+	      default:
+		sym = gfc_search_interface (ns->op[i], 0, &actual);
+	    }
+
+	  if (sym != NULL)
+	    break;
+	}
+    }
+
+  /* TODO: Do an ambiguity-check and error if multiple matching interfaces are
+     found rather than just taking the first one and not checking further.  */
+
+  if (sym == NULL)
+    {
+      gfc_typebound_proc* tbo;
+      gfc_expr* tb_base;
+
+      /* See if we find a matching type-bound operator.  */
+      if (i == INTRINSIC_USER)
+	tbo = matching_typebound_op (&tb_base, actual,
+				     i, e->value.op.uop->name, &gname);
+      else
+	switch (i)
+	  {
+#define CHECK_OS_COMPARISON(comp) \
+  case INTRINSIC_##comp: \
+  case INTRINSIC_##comp##_OS: \
+    tbo = matching_typebound_op (&tb_base, actual, \
+				 INTRINSIC_##comp, NULL, &gname); \
+    if (!tbo) \
+      tbo = matching_typebound_op (&tb_base, actual, \
+				   INTRINSIC_##comp##_OS, NULL, &gname); \
+    break;
+	    CHECK_OS_COMPARISON(EQ)
+	    CHECK_OS_COMPARISON(NE)
+	    CHECK_OS_COMPARISON(GT)
+	    CHECK_OS_COMPARISON(GE)
+	    CHECK_OS_COMPARISON(LT)
+	    CHECK_OS_COMPARISON(LE)
+#undef CHECK_OS_COMPARISON
+
+	    default:
+	      tbo = matching_typebound_op (&tb_base, actual, i, NULL, &gname);
+	      break;
+	  }
+	      
+      /* If there is a matching typebound-operator, replace the expression with
+	 a call to it and succeed.  */
+      if (tbo)
+	{
+	  gfc_try result;
+
+	  gcc_assert (tb_base);
+	  build_compcall_for_operator (e, actual, tb_base, tbo, gname);
+
+	  result = gfc_resolve_expr (e);
+	  if (result == FAILURE)
+	    *real_error = true;
+
+	  return result;
+	}
+
+      /* Don't use gfc_free_actual_arglist().  */
+      if (actual->next != NULL)
+	gfc_free (actual->next);
+      gfc_free (actual);
+
+      return FAILURE;
+    }
+
+  /* Change the expression node to a function call.  */
+  e->expr_type = EXPR_FUNCTION;
+  e->symtree = gfc_find_sym_in_symtree (sym);
+  e->value.function.actual = actual;
+  e->value.function.esym = NULL;
+  e->value.function.isym = NULL;
+  e->value.function.name = NULL;
+  e->user_operator = 1;
+
+  if (gfc_resolve_expr (e) == FAILURE)
+    {
+      *real_error = true;
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Tries to replace an assignment code node with a subroutine call to
+   the subroutine associated with the assignment operator.  Return
+   SUCCESS if the node was replaced.  On FAILURE, no error is
+   generated.  */
+
+gfc_try
+gfc_extend_assign (gfc_code *c, gfc_namespace *ns)
+{
+  gfc_actual_arglist *actual;
+  gfc_expr *lhs, *rhs;
+  gfc_symbol *sym;
+  const char *gname;
+
+  gname = NULL;
+
+  lhs = c->expr1;
+  rhs = c->expr2;
+
+  /* Don't allow an intrinsic assignment to be replaced.  */
+  if (lhs->ts.type != BT_DERIVED && lhs->ts.type != BT_CLASS
+      && (rhs->rank == 0 || rhs->rank == lhs->rank)
+      && (lhs->ts.type == rhs->ts.type
+	  || (gfc_numeric_ts (&lhs->ts) && gfc_numeric_ts (&rhs->ts))))
+    return FAILURE;
+
+  actual = gfc_get_actual_arglist ();
+  actual->expr = lhs;
+
+  actual->next = gfc_get_actual_arglist ();
+  actual->next->expr = rhs;
+
+  sym = NULL;
+
+  for (; ns; ns = ns->parent)
+    {
+      sym = gfc_search_interface (ns->op[INTRINSIC_ASSIGN], 1, &actual);
+      if (sym != NULL)
+	break;
+    }
+
+  /* TODO: Ambiguity-check, see above for gfc_extend_expr.  */
+
+  if (sym == NULL)
+    {
+      gfc_typebound_proc* tbo;
+      gfc_expr* tb_base;
+
+      /* See if we find a matching type-bound assignment.  */
+      tbo = matching_typebound_op (&tb_base, actual,
+				   INTRINSIC_ASSIGN, NULL, &gname);
+	      
+      /* If there is one, replace the expression with a call to it and
+	 succeed.  */
+      if (tbo)
+	{
+	  gcc_assert (tb_base);
+	  c->expr1 = gfc_get_expr ();
+	  build_compcall_for_operator (c->expr1, actual, tb_base, tbo, gname);
+	  c->expr1->value.compcall.assign = 1;
+	  c->expr1->where = c->loc;
+	  c->expr2 = NULL;
+	  c->op = EXEC_COMPCALL;
+
+	  /* c is resolved from the caller, so no need to do it here.  */
+
+	  return SUCCESS;
+	}
+
+      gfc_free (actual->next);
+      gfc_free (actual);
+      return FAILURE;
+    }
+
+  /* Replace the assignment with the call.  */
+  c->op = EXEC_ASSIGN_CALL;
+  c->symtree = gfc_find_sym_in_symtree (sym);
+  c->expr1 = NULL;
+  c->expr2 = NULL;
+  c->ext.actual = actual;
+
+  return SUCCESS;
+}
+
+
+/* Make sure that the interface just parsed is not already present in
+   the given interface list.  Ambiguity isn't checked yet since module
+   procedures can be present without interfaces.  */
+
+static gfc_try
+check_new_interface (gfc_interface *base, gfc_symbol *new_sym)
+{
+  gfc_interface *ip;
+
+  for (ip = base; ip; ip = ip->next)
+    {
+      if (ip->sym == new_sym)
+	{
+	  gfc_error ("Entity '%s' at %C is already present in the interface",
+		     new_sym->name);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* Add a symbol to the current interface.  */
+
+gfc_try
+gfc_add_interface (gfc_symbol *new_sym)
+{
+  gfc_interface **head, *intr;
+  gfc_namespace *ns;
+  gfc_symbol *sym;
+
+  switch (current_interface.type)
+    {
+    case INTERFACE_NAMELESS:
+    case INTERFACE_ABSTRACT:
+      return SUCCESS;
+
+    case INTERFACE_INTRINSIC_OP:
+      for (ns = current_interface.ns; ns; ns = ns->parent)
+	switch (current_interface.op)
+	  {
+	    case INTRINSIC_EQ:
+	    case INTRINSIC_EQ_OS:
+	      if (check_new_interface (ns->op[INTRINSIC_EQ], new_sym) == FAILURE ||
+	          check_new_interface (ns->op[INTRINSIC_EQ_OS], new_sym) == FAILURE)
+		return FAILURE;
+	      break;
+
+	    case INTRINSIC_NE:
+	    case INTRINSIC_NE_OS:
+	      if (check_new_interface (ns->op[INTRINSIC_NE], new_sym) == FAILURE ||
+	          check_new_interface (ns->op[INTRINSIC_NE_OS], new_sym) == FAILURE)
+		return FAILURE;
+	      break;
+
+	    case INTRINSIC_GT:
+	    case INTRINSIC_GT_OS:
+	      if (check_new_interface (ns->op[INTRINSIC_GT], new_sym) == FAILURE ||
+	          check_new_interface (ns->op[INTRINSIC_GT_OS], new_sym) == FAILURE)
+		return FAILURE;
+	      break;
+
+	    case INTRINSIC_GE:
+	    case INTRINSIC_GE_OS:
+	      if (check_new_interface (ns->op[INTRINSIC_GE], new_sym) == FAILURE ||
+	          check_new_interface (ns->op[INTRINSIC_GE_OS], new_sym) == FAILURE)
+		return FAILURE;
+	      break;
+
+	    case INTRINSIC_LT:
+	    case INTRINSIC_LT_OS:
+	      if (check_new_interface (ns->op[INTRINSIC_LT], new_sym) == FAILURE ||
+	          check_new_interface (ns->op[INTRINSIC_LT_OS], new_sym) == FAILURE)
+		return FAILURE;
+	      break;
+
+	    case INTRINSIC_LE:
+	    case INTRINSIC_LE_OS:
+	      if (check_new_interface (ns->op[INTRINSIC_LE], new_sym) == FAILURE ||
+	          check_new_interface (ns->op[INTRINSIC_LE_OS], new_sym) == FAILURE)
+		return FAILURE;
+	      break;
+
+	    default:
+	      if (check_new_interface (ns->op[current_interface.op], new_sym) == FAILURE)
+		return FAILURE;
+	  }
+
+      head = &current_interface.ns->op[current_interface.op];
+      break;
+
+    case INTERFACE_GENERIC:
+      for (ns = current_interface.ns; ns; ns = ns->parent)
+	{
+	  gfc_find_symbol (current_interface.sym->name, ns, 0, &sym);
+	  if (sym == NULL)
+	    continue;
+
+	  if (check_new_interface (sym->generic, new_sym) == FAILURE)
+	    return FAILURE;
+	}
+
+      head = &current_interface.sym->generic;
+      break;
+
+    case INTERFACE_USER_OP:
+      if (check_new_interface (current_interface.uop->op, new_sym)
+	  == FAILURE)
+	return FAILURE;
+
+      head = &current_interface.uop->op;
+      break;
+
+    default:
+      gfc_internal_error ("gfc_add_interface(): Bad interface type");
+    }
+
+  intr = gfc_get_interface ();
+  intr->sym = new_sym;
+  intr->where = gfc_current_locus;
+
+  intr->next = *head;
+  *head = intr;
+
+  return SUCCESS;
+}
+
+
+gfc_interface *
+gfc_current_interface_head (void)
+{
+  switch (current_interface.type)
+    {
+      case INTERFACE_INTRINSIC_OP:
+	return current_interface.ns->op[current_interface.op];
+	break;
+
+      case INTERFACE_GENERIC:
+	return current_interface.sym->generic;
+	break;
+
+      case INTERFACE_USER_OP:
+	return current_interface.uop->op;
+	break;
+
+      default:
+	gcc_unreachable ();
+    }
+}
+
+
+void
+gfc_set_current_interface_head (gfc_interface *i)
+{
+  switch (current_interface.type)
+    {
+      case INTERFACE_INTRINSIC_OP:
+	current_interface.ns->op[current_interface.op] = i;
+	break;
+
+      case INTERFACE_GENERIC:
+	current_interface.sym->generic = i;
+	break;
+
+      case INTERFACE_USER_OP:
+	current_interface.uop->op = i;
+	break;
+
+      default:
+	gcc_unreachable ();
+    }
+}
+
+
+/* Gets rid of a formal argument list.  We do not free symbols.
+   Symbols are freed when a namespace is freed.  */
+
+void
+gfc_free_formal_arglist (gfc_formal_arglist *p)
+{
+  gfc_formal_arglist *q;
+
+  for (; p; p = q)
+    {
+      q = p->next;
+      gfc_free (p);
+    }
+}
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
new file mode 100644
index 000000000..a1ca01eb4
--- /dev/null
+++ b/gcc/fortran/intrinsic.c
@@ -0,0 +1,4489 @@
+/* Build up a list of intrinsic subroutines and functions for the
+   name-resolution stage.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2009, 2010, 2011
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught & Katherine Holcomb
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "intrinsic.h"
+
+/* Namespace to hold the resolved symbols for intrinsic subroutines.  */
+static gfc_namespace *gfc_intrinsic_namespace;
+
+bool gfc_init_expr_flag = false;
+
+/* Pointers to an intrinsic function and its argument names that are being
+   checked.  */
+
+const char *gfc_current_intrinsic;
+gfc_intrinsic_arg *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
+locus *gfc_current_intrinsic_where;
+
+static gfc_intrinsic_sym *functions, *subroutines, *conversion, *next_sym;
+static gfc_intrinsic_sym *char_conversions;
+static gfc_intrinsic_arg *next_arg;
+
+static int nfunc, nsub, nargs, nconv, ncharconv;
+
+static enum
+{ SZ_NOTHING = 0, SZ_SUBS, SZ_FUNCS, SZ_CONVS }
+sizing;
+
+enum klass
+{ CLASS_IMPURE = 0, CLASS_PURE, CLASS_ELEMENTAL,
+  CLASS_INQUIRY, CLASS_TRANSFORMATIONAL };
+
+#define ACTUAL_NO	0
+#define ACTUAL_YES	1
+
+#define REQUIRED	0
+#define OPTIONAL	1
+
+
+/* Return a letter based on the passed type.  Used to construct the
+   name of a type-dependent subroutine.  */
+
+char
+gfc_type_letter (bt type)
+{
+  char c;
+
+  switch (type)
+    {
+    case BT_LOGICAL:
+      c = 'l';
+      break;
+    case BT_CHARACTER:
+      c = 's';
+      break;
+    case BT_INTEGER:
+      c = 'i';
+      break;
+    case BT_REAL:
+      c = 'r';
+      break;
+    case BT_COMPLEX:
+      c = 'c';
+      break;
+
+    case BT_HOLLERITH:
+      c = 'h';
+      break;
+
+    default:
+      c = 'u';
+      break;
+    }
+
+  return c;
+}
+
+
+/* Get a symbol for a resolved name. Note, if needed be, the elemental
+   attribute has be added afterwards.  */
+
+gfc_symbol *
+gfc_get_intrinsic_sub_symbol (const char *name)
+{
+  gfc_symbol *sym;
+
+  gfc_get_symbol (name, gfc_intrinsic_namespace, &sym);
+  sym->attr.always_explicit = 1;
+  sym->attr.subroutine = 1;
+  sym->attr.flavor = FL_PROCEDURE;
+  sym->attr.proc = PROC_INTRINSIC;
+
+  gfc_commit_symbol (sym);
+
+  return sym;
+}
+
+
+/* Return a pointer to the name of a conversion function given two
+   typespecs.  */
+
+static const char *
+conv_name (gfc_typespec *from, gfc_typespec *to)
+{
+  return gfc_get_string ("__convert_%c%d_%c%d",
+			 gfc_type_letter (from->type), from->kind,
+			 gfc_type_letter (to->type), to->kind);
+}
+
+
+/* Given a pair of typespecs, find the gfc_intrinsic_sym node that
+   corresponds to the conversion.  Returns NULL if the conversion
+   isn't found.  */
+
+static gfc_intrinsic_sym *
+find_conv (gfc_typespec *from, gfc_typespec *to)
+{
+  gfc_intrinsic_sym *sym;
+  const char *target;
+  int i;
+
+  target = conv_name (from, to);
+  sym = conversion;
+
+  for (i = 0; i < nconv; i++, sym++)
+    if (target == sym->name)
+      return sym;
+
+  return NULL;
+}
+
+
+/* Given a pair of CHARACTER typespecs, find the gfc_intrinsic_sym node
+   that corresponds to the conversion.  Returns NULL if the conversion
+   isn't found.  */
+
+static gfc_intrinsic_sym *
+find_char_conv (gfc_typespec *from, gfc_typespec *to)
+{
+  gfc_intrinsic_sym *sym;
+  const char *target;
+  int i;
+
+  target = conv_name (from, to);
+  sym = char_conversions;
+
+  for (i = 0; i < ncharconv; i++, sym++)
+    if (target == sym->name)
+      return sym;
+
+  return NULL;
+}
+
+
+/* Interface to the check functions.  We break apart an argument list
+   and call the proper check function rather than forcing each
+   function to manipulate the argument list.  */
+
+static gfc_try
+do_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg)
+{
+  gfc_expr *a1, *a2, *a3, *a4, *a5;
+
+  if (arg == NULL)
+    return (*specific->check.f0) ();
+
+  a1 = arg->expr;
+  arg = arg->next;
+  if (arg == NULL)
+    return (*specific->check.f1) (a1);
+
+  a2 = arg->expr;
+  arg = arg->next;
+  if (arg == NULL)
+    return (*specific->check.f2) (a1, a2);
+
+  a3 = arg->expr;
+  arg = arg->next;
+  if (arg == NULL)
+    return (*specific->check.f3) (a1, a2, a3);
+
+  a4 = arg->expr;
+  arg = arg->next;
+  if (arg == NULL)
+    return (*specific->check.f4) (a1, a2, a3, a4);
+
+  a5 = arg->expr;
+  arg = arg->next;
+  if (arg == NULL)
+    return (*specific->check.f5) (a1, a2, a3, a4, a5);
+
+  gfc_internal_error ("do_check(): too many args");
+}
+
+
+/*********** Subroutines to build the intrinsic list ****************/
+
+/* Add a single intrinsic symbol to the current list.
+
+   Argument list:
+      char *     name of function
+      int	whether function is elemental
+      int	If the function can be used as an actual argument [1]
+      bt	 return type of function
+      int	kind of return type of function
+      int	Fortran standard version
+      check      pointer to check function
+      simplify   pointer to simplification function
+      resolve    pointer to resolution function
+
+   Optional arguments come in multiples of five:
+      char *      name of argument
+      bt          type of argument
+      int         kind of argument
+      int         arg optional flag (1=optional, 0=required)
+      sym_intent  intent of argument
+
+   The sequence is terminated by a NULL name.
+
+
+ [1] Whether a function can or cannot be used as an actual argument is
+     determined by its presence on the 13.6 list in Fortran 2003.  The
+     following intrinsics, which are GNU extensions, are considered allowed
+     as actual arguments: ACOSH ATANH DACOSH DASINH DATANH DCONJG DIMAG
+     ZABS ZCOS ZEXP ZLOG ZSIN ZSQRT.  */
+
+static void
+add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type, int kind,
+	 int standard, gfc_check_f check, gfc_simplify_f simplify,
+	 gfc_resolve_f resolve, ...)
+{
+  char buf[GFC_MAX_SYMBOL_LEN + 11]; /* 10 for '_gfortran_', 1 for '\0'  */
+  int optional, first_flag;
+  sym_intent intent;
+  va_list argp;
+
+  switch (sizing)
+    {
+    case SZ_SUBS:
+      nsub++;
+      break;
+
+    case SZ_FUNCS:
+      nfunc++;
+      break;
+
+    case SZ_NOTHING:
+      next_sym->name = gfc_get_string (name);
+
+      strcpy (buf, "_gfortran_");
+      strcat (buf, name);
+      next_sym->lib_name = gfc_get_string (buf);
+
+      next_sym->pure = (cl != CLASS_IMPURE);
+      next_sym->elemental = (cl == CLASS_ELEMENTAL);
+      next_sym->inquiry = (cl == CLASS_INQUIRY);
+      next_sym->transformational = (cl == CLASS_TRANSFORMATIONAL);
+      next_sym->actual_ok = actual_ok;
+      next_sym->ts.type = type;
+      next_sym->ts.kind = kind;
+      next_sym->standard = standard;
+      next_sym->simplify = simplify;
+      next_sym->check = check;
+      next_sym->resolve = resolve;
+      next_sym->specific = 0;
+      next_sym->generic = 0;
+      next_sym->conversion = 0;
+      next_sym->id = id;
+      break;
+
+    default:
+      gfc_internal_error ("add_sym(): Bad sizing mode");
+    }
+
+  va_start (argp, resolve);
+
+  first_flag = 1;
+
+  for (;;)
+    {
+      name = va_arg (argp, char *);
+      if (name == NULL)
+	break;
+
+      type = (bt) va_arg (argp, int);
+      kind = va_arg (argp, int);
+      optional = va_arg (argp, int);
+      intent = (sym_intent) va_arg (argp, int);
+
+      if (sizing != SZ_NOTHING)
+	nargs++;
+      else
+	{
+	  next_arg++;
+
+	  if (first_flag)
+	    next_sym->formal = next_arg;
+	  else
+	    (next_arg - 1)->next = next_arg;
+
+	  first_flag = 0;
+
+	  strcpy (next_arg->name, name);
+	  next_arg->ts.type = type;
+	  next_arg->ts.kind = kind;
+	  next_arg->optional = optional;
+	  next_arg->value = 0;
+	  next_arg->intent = intent;
+	}
+    }
+
+  va_end (argp);
+
+  next_sym++;
+}
+
+
+/* Add a symbol to the function list where the function takes
+   0 arguments.  */
+
+static void
+add_sym_0 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
+	   int kind, int standard,
+	   gfc_try (*check) (void),
+	   gfc_expr *(*simplify) (void),
+	   void (*resolve) (gfc_expr *))
+{
+  gfc_simplify_f sf;
+  gfc_check_f cf;
+  gfc_resolve_f rf;
+
+  cf.f0 = check;
+  sf.f0 = simplify;
+  rf.f0 = resolve;
+
+  add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
+	   (void *) 0);
+}
+
+
+/* Add a symbol to the subroutine list where the subroutine takes
+   0 arguments.  */
+
+static void
+add_sym_0s (const char *name, gfc_isym_id id, int standard,
+	    void (*resolve) (gfc_code *))
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f1 = NULL;
+  sf.f1 = NULL;
+  rf.s1 = resolve;
+
+  add_sym (name, id, CLASS_IMPURE, ACTUAL_NO, BT_UNKNOWN, 0, standard, cf, sf,
+	   rf, (void *) 0);
+}
+
+
+/* Add a symbol to the function list where the function takes
+   1 arguments.  */
+
+static void
+add_sym_1 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
+	   int kind, int standard,
+	   gfc_try (*check) (gfc_expr *),
+	   gfc_expr *(*simplify) (gfc_expr *),
+	   void (*resolve) (gfc_expr *, gfc_expr *),
+	   const char *a1, bt type1, int kind1, int optional1)
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f1 = check;
+  sf.f1 = simplify;
+  rf.f1 = resolve;
+
+  add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, INTENT_IN,
+	   (void *) 0);
+}
+
+
+/* Add a symbol to the function list where the function takes
+   1 arguments, specifying the intent of the argument.  */
+
+static void
+add_sym_1_intent (const char *name, gfc_isym_id id, enum klass cl,
+		  int actual_ok, bt type, int kind, int standard,
+		  gfc_try (*check) (gfc_expr *),
+		  gfc_expr *(*simplify) (gfc_expr *),
+		  void (*resolve) (gfc_expr *, gfc_expr *),
+		  const char *a1, bt type1, int kind1, int optional1,
+		  sym_intent intent1)
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f1 = check;
+  sf.f1 = simplify;
+  rf.f1 = resolve;
+
+  add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, intent1,
+	   (void *) 0);
+}
+
+
+/* Add a symbol to the subroutine list where the subroutine takes
+   1 arguments, specifying the intent of the argument.  */
+
+static void
+add_sym_1s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
+	    int standard, gfc_try (*check) (gfc_expr *),
+	    gfc_expr *(*simplify) (gfc_expr *), void (*resolve) (gfc_code *),
+	    const char *a1, bt type1, int kind1, int optional1,
+	    sym_intent intent1)
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f1 = check;
+  sf.f1 = simplify;
+  rf.s1 = resolve;
+
+  add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, intent1,
+	   (void *) 0);
+}
+
+
+/* Add a symbol from the MAX/MIN family of intrinsic functions to the
+   function.  MAX et al take 2 or more arguments.  */
+
+static void
+add_sym_1m (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
+	    int kind, int standard,
+	    gfc_try (*check) (gfc_actual_arglist *),
+	    gfc_expr *(*simplify) (gfc_expr *),
+	    void (*resolve) (gfc_expr *, gfc_actual_arglist *),
+	    const char *a1, bt type1, int kind1, int optional1,
+	    const char *a2, bt type2, int kind2, int optional2)
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f1m = check;
+  sf.f1 = simplify;
+  rf.f1m = resolve;
+
+  add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, INTENT_IN,
+	   a2, type2, kind2, optional2, INTENT_IN,
+	   (void *) 0);
+}
+
+
+/* Add a symbol to the function list where the function takes
+   2 arguments.  */
+
+static void
+add_sym_2 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
+	   int kind, int standard,
+	   gfc_try (*check) (gfc_expr *, gfc_expr *),
+	   gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
+	   void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
+	   const char *a1, bt type1, int kind1, int optional1,
+	   const char *a2, bt type2, int kind2, int optional2)
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f2 = check;
+  sf.f2 = simplify;
+  rf.f2 = resolve;
+
+  add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, INTENT_IN,
+	   a2, type2, kind2, optional2, INTENT_IN,
+	   (void *) 0);
+}
+
+
+/* Add a symbol to the function list where the function takes
+   2 arguments; same as add_sym_2 - but allows to specify the intent.  */
+
+static void
+add_sym_2_intent (const char *name, gfc_isym_id id, enum klass cl,
+		  int actual_ok, bt type, int kind, int standard,
+		  gfc_try (*check) (gfc_expr *, gfc_expr *),
+		  gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
+		  void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *),
+		  const char *a1, bt type1, int kind1, int optional1,
+		  sym_intent intent1, const char *a2, bt type2, int kind2,
+		  int optional2, sym_intent intent2)
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f2 = check;
+  sf.f2 = simplify;
+  rf.f2 = resolve;
+
+  add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, intent1,
+	   a2, type2, kind2, optional2, intent2,
+	   (void *) 0);
+}
+
+
+/* Add a symbol to the subroutine list where the subroutine takes
+   2 arguments, specifying the intent of the arguments.  */
+
+static void
+add_sym_2s (const char *name, gfc_isym_id id, enum klass cl, bt type,
+	    int kind, int standard,
+	    gfc_try (*check) (gfc_expr *, gfc_expr *),
+	    gfc_expr *(*simplify) (gfc_expr *, gfc_expr *),
+	    void (*resolve) (gfc_code *),
+	    const char *a1, bt type1, int kind1, int optional1,
+	    sym_intent intent1, const char *a2, bt type2, int kind2,
+	    int optional2, sym_intent intent2)
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f2 = check;
+  sf.f2 = simplify;
+  rf.s1 = resolve;
+
+  add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, intent1,
+	   a2, type2, kind2, optional2, intent2,
+	   (void *) 0);
+}
+
+
+/* Add a symbol to the function list where the function takes
+   3 arguments.  */
+
+static void
+add_sym_3 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
+	   int kind, int standard,
+	   gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
+	   gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
+	   void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
+	   const char *a1, bt type1, int kind1, int optional1,
+	   const char *a2, bt type2, int kind2, int optional2,
+	   const char *a3, bt type3, int kind3, int optional3)
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f3 = check;
+  sf.f3 = simplify;
+  rf.f3 = resolve;
+
+  add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, INTENT_IN,
+	   a2, type2, kind2, optional2, INTENT_IN,
+	   a3, type3, kind3, optional3, INTENT_IN,
+	   (void *) 0);
+}
+
+
+/* MINLOC and MAXLOC get special treatment because their argument
+   might have to be reordered.  */
+
+static void
+add_sym_3ml (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
+	     int kind, int standard,
+	     gfc_try (*check) (gfc_actual_arglist *),
+	     gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
+	     void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
+	     const char *a1, bt type1, int kind1, int optional1,
+	     const char *a2, bt type2, int kind2, int optional2,
+	     const char *a3, bt type3, int kind3, int optional3)
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f3ml = check;
+  sf.f3 = simplify;
+  rf.f3 = resolve;
+
+  add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, INTENT_IN,
+	   a2, type2, kind2, optional2, INTENT_IN,
+	   a3, type3, kind3, optional3, INTENT_IN,
+	   (void *) 0);
+}
+
+
+/* MINVAL, MAXVAL, PRODUCT, and SUM also get special treatment because
+   their argument also might have to be reordered.  */
+
+static void
+add_sym_3red (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
+	      int kind, int standard,
+	      gfc_try (*check) (gfc_actual_arglist *),
+	      gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
+	      void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
+	      const char *a1, bt type1, int kind1, int optional1,
+	      const char *a2, bt type2, int kind2, int optional2,
+	      const char *a3, bt type3, int kind3, int optional3)
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f3red = check;
+  sf.f3 = simplify;
+  rf.f3 = resolve;
+
+  add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, INTENT_IN,
+	   a2, type2, kind2, optional2, INTENT_IN,
+	   a3, type3, kind3, optional3, INTENT_IN,
+	   (void *) 0);
+}
+
+
+/* Add a symbol to the subroutine list where the subroutine takes
+   3 arguments, specifying the intent of the arguments.  */
+
+static void
+add_sym_3s (const char *name, gfc_isym_id id, enum klass cl, bt type,
+	    int kind, int standard,
+	    gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *),
+	    gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *),
+	    void (*resolve) (gfc_code *),
+	    const char *a1, bt type1, int kind1, int optional1,
+	    sym_intent intent1, const char *a2, bt type2, int kind2,
+	    int optional2, sym_intent intent2, const char *a3, bt type3,
+	    int kind3, int optional3, sym_intent intent3)
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f3 = check;
+  sf.f3 = simplify;
+  rf.s1 = resolve;
+
+  add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, intent1,
+	   a2, type2, kind2, optional2, intent2,
+	   a3, type3, kind3, optional3, intent3,
+	   (void *) 0);
+}
+
+
+/* Add a symbol to the function list where the function takes
+   4 arguments.  */
+
+static void
+add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type,
+	   int kind, int standard,
+	   gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
+	   gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
+				  gfc_expr *),
+	   void (*resolve) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
+			    gfc_expr *),
+	   const char *a1, bt type1, int kind1, int optional1,
+	   const char *a2, bt type2, int kind2, int optional2,
+	   const char *a3, bt type3, int kind3, int optional3,
+	   const char *a4, bt type4, int kind4, int optional4 )
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f4 = check;
+  sf.f4 = simplify;
+  rf.f4 = resolve;
+
+  add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, INTENT_IN,
+	   a2, type2, kind2, optional2, INTENT_IN,
+	   a3, type3, kind3, optional3, INTENT_IN,
+	   a4, type4, kind4, optional4, INTENT_IN,
+	   (void *) 0);
+}
+
+
+/* Add a symbol to the subroutine list where the subroutine takes
+   4 arguments.  */
+
+static void
+add_sym_4s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
+	    int standard,
+	    gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
+	    gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
+				   gfc_expr *),
+	    void (*resolve) (gfc_code *),
+	    const char *a1, bt type1, int kind1, int optional1,
+	    sym_intent intent1, const char *a2, bt type2, int kind2,
+	    int optional2, sym_intent intent2, const char *a3, bt type3,
+	    int kind3, int optional3, sym_intent intent3, const char *a4,
+	    bt type4, int kind4, int optional4, sym_intent intent4)
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f4 = check;
+  sf.f4 = simplify;
+  rf.s1 = resolve;
+
+  add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, intent1,
+	   a2, type2, kind2, optional2, intent2,
+	   a3, type3, kind3, optional3, intent3,
+	   a4, type4, kind4, optional4, intent4,
+	   (void *) 0);
+}
+
+
+/* Add a symbol to the subroutine list where the subroutine takes
+   5 arguments.  */
+
+static void
+add_sym_5s (const char *name, gfc_isym_id id, enum klass cl, bt type, int kind,
+	    int standard,
+	    gfc_try (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
+			  gfc_expr *),
+	    gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
+				   gfc_expr *, gfc_expr *),
+	    void (*resolve) (gfc_code *),
+	    const char *a1, bt type1, int kind1, int optional1,
+	    sym_intent intent1, const char *a2, bt type2, int kind2,
+	    int optional2, sym_intent intent2, const char *a3, bt type3,
+	    int kind3, int optional3, sym_intent intent3, const char *a4,
+	    bt type4, int kind4, int optional4, sym_intent intent4,
+	    const char *a5, bt type5, int kind5, int optional5,
+	    sym_intent intent5) 
+{
+  gfc_check_f cf;
+  gfc_simplify_f sf;
+  gfc_resolve_f rf;
+
+  cf.f5 = check;
+  sf.f5 = simplify;
+  rf.s1 = resolve;
+
+  add_sym (name, id, cl, ACTUAL_NO, type, kind, standard, cf, sf, rf,
+	   a1, type1, kind1, optional1, intent1,
+	   a2, type2, kind2, optional2, intent2,
+	   a3, type3, kind3, optional3, intent3,
+	   a4, type4, kind4, optional4, intent4,
+	   a5, type5, kind5, optional5, intent5,
+	   (void *) 0);
+}
+
+
+/* Locate an intrinsic symbol given a base pointer, number of elements
+   in the table and a pointer to a name.  Returns the NULL pointer if
+   a name is not found.  */
+
+static gfc_intrinsic_sym *
+find_sym (gfc_intrinsic_sym *start, int n, const char *name)
+{
+  /* name may be a user-supplied string, so we must first make sure
+     that we're comparing against a pointer into the global string
+     table.  */
+  const char *p = gfc_get_string (name);
+
+  while (n > 0)
+    {
+      if (p == start->name)
+	return start;
+
+      start++;
+      n--;
+    }
+
+  return NULL;
+}
+
+
+gfc_intrinsic_sym *
+gfc_intrinsic_function_by_id (gfc_isym_id id)
+{
+  gfc_intrinsic_sym *start = functions;
+  int n = nfunc;
+
+  while (true)
+    {
+      gcc_assert (n > 0);
+      if (id == start->id)
+	return start;
+
+      start++;
+      n--;
+    }
+}
+
+
+/* Given a name, find a function in the intrinsic function table.
+   Returns NULL if not found.  */
+
+gfc_intrinsic_sym *
+gfc_find_function (const char *name)
+{
+  gfc_intrinsic_sym *sym;
+
+  sym = find_sym (functions, nfunc, name);
+  if (!sym || sym->from_module)
+    sym = find_sym (conversion, nconv, name);
+
+  return (!sym || sym->from_module) ? NULL : sym;
+}
+
+
+/* Given a name, find a function in the intrinsic subroutine table.
+   Returns NULL if not found.  */
+
+gfc_intrinsic_sym *
+gfc_find_subroutine (const char *name)
+{
+  gfc_intrinsic_sym *sym;
+  sym = find_sym (subroutines, nsub, name);
+  return (!sym || sym->from_module) ? NULL : sym;
+}
+
+
+/* Given a string, figure out if it is the name of a generic intrinsic
+   function or not.  */
+
+int
+gfc_generic_intrinsic (const char *name)
+{
+  gfc_intrinsic_sym *sym;
+
+  sym = gfc_find_function (name);
+  return (!sym || sym->from_module) ? 0 : sym->generic;
+}
+
+
+/* Given a string, figure out if it is the name of a specific
+   intrinsic function or not.  */
+
+int
+gfc_specific_intrinsic (const char *name)
+{
+  gfc_intrinsic_sym *sym;
+
+  sym = gfc_find_function (name);
+  return (!sym || sym->from_module) ? 0 : sym->specific;
+}
+
+
+/* Given a string, figure out if it is the name of an intrinsic function
+   or subroutine allowed as an actual argument or not.  */
+int
+gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
+{
+  gfc_intrinsic_sym *sym;
+
+  /* Intrinsic subroutines are not allowed as actual arguments.  */
+  if (subroutine_flag)
+    return 0;
+  else
+    {
+      sym = gfc_find_function (name);
+      return (sym == NULL) ? 0 : sym->actual_ok;
+    }
+}
+
+
+/* Given a symbol, find out if it is (and is to be treated) an intrinsic.  If
+   it's name refers to an intrinsic but this intrinsic is not included in the
+   selected standard, this returns FALSE and sets the symbol's external
+   attribute.  */
+
+bool
+gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
+{
+  gfc_intrinsic_sym* isym;
+  const char* symstd;
+
+  /* If INTRINSIC/EXTERNAL state is already known, return.  */
+  if (sym->attr.intrinsic)
+    return true;
+  if (sym->attr.external)
+    return false;
+
+  if (subroutine_flag)
+    isym = gfc_find_subroutine (sym->name);
+  else
+    isym = gfc_find_function (sym->name);
+
+  /* No such intrinsic available at all?  */
+  if (!isym)
+    return false;
+
+  /* See if this intrinsic is allowed in the current standard.  */
+  if (gfc_check_intrinsic_standard (isym, &symstd, false, loc) == FAILURE)
+    {
+      if (sym->attr.proc == PROC_UNKNOWN
+	  && gfc_option.warn_intrinsics_std)
+	gfc_warning_now ("The intrinsic '%s' at %L is not included in the"
+			 " selected standard but %s and '%s' will be"
+			 " treated as if declared EXTERNAL.  Use an"
+			 " appropriate -std=* option or define"
+			 " -fall-intrinsics to allow this intrinsic.",
+			 sym->name, &loc, symstd, sym->name);
+
+      return false;
+    }
+
+  return true;
+}
+
+
+/* Collect a set of intrinsic functions into a generic collection.
+   The first argument is the name of the generic function, which is
+   also the name of a specific function.  The rest of the specifics
+   currently in the table are placed into the list of specific
+   functions associated with that generic.
+
+   PR fortran/32778
+   FIXME: Remove the argument STANDARD if no regressions are
+          encountered. Change all callers (approx. 360).
+*/
+
+static void
+make_generic (const char *name, gfc_isym_id id, int standard ATTRIBUTE_UNUSED)
+{
+  gfc_intrinsic_sym *g;
+
+  if (sizing != SZ_NOTHING)
+    return;
+
+  g = gfc_find_function (name);
+  if (g == NULL)
+    gfc_internal_error ("make_generic(): Can't find generic symbol '%s'",
+			name);
+
+  gcc_assert (g->id == id);
+
+  g->generic = 1;
+  g->specific = 1;
+  if ((g + 1)->name != NULL)
+    g->specific_head = g + 1;
+  g++;
+
+  while (g->name != NULL)
+    {
+      g->next = g + 1;
+      g->specific = 1;
+      g++;
+    }
+
+  g--;
+  g->next = NULL;
+}
+
+
+/* Create a duplicate intrinsic function entry for the current
+   function, the only differences being the alternate name and
+   a different standard if necessary. Note that we use argument
+   lists more than once, but all argument lists are freed as a
+   single block.  */
+
+static void
+make_alias (const char *name, int standard)
+{
+  switch (sizing)
+    {
+    case SZ_FUNCS:
+      nfunc++;
+      break;
+
+    case SZ_SUBS:
+      nsub++;
+      break;
+
+    case SZ_NOTHING:
+      next_sym[0] = next_sym[-1];
+      next_sym->name = gfc_get_string (name);
+      next_sym->standard = standard;
+      next_sym++;
+      break;
+
+    default:
+      break;
+    }
+}
+
+
+/* Make the current subroutine noreturn.  */
+
+static void
+make_noreturn (void)
+{
+  if (sizing == SZ_NOTHING)
+    next_sym[-1].noreturn = 1;
+}
+
+
+/* Mark current intrinsic as module intrinsic.  */
+static void
+make_from_module (void)
+{
+  if (sizing == SZ_NOTHING)
+    next_sym[-1].from_module = 1;
+}
+
+/* Set the attr.value of the current procedure.  */
+
+static void
+set_attr_value (int n, ...)
+{
+  gfc_intrinsic_arg *arg;
+  va_list argp;
+  int i;
+
+  if (sizing != SZ_NOTHING)
+    return;
+
+  va_start (argp, n);
+  arg = next_sym[-1].formal;
+
+  for (i = 0; i < n; i++)
+    {
+      gcc_assert (arg != NULL);
+      arg->value = va_arg (argp, int);
+      arg = arg->next;
+    }
+  va_end (argp);
+}
+
+
+/* Add intrinsic functions.  */
+
+static void
+add_functions (void)
+{
+  /* Argument names as in the standard (to be used as argument keywords).  */
+  const char
+    *a = "a", *f = "field", *pt = "pointer", *tg = "target",
+    *b = "b", *m = "matrix", *ma = "matrix_a", *mb = "matrix_b",
+    *c = "c", *n = "n", *ncopies= "ncopies", *pos = "pos", *bck = "back",
+    *i = "i", *v = "vector", *va = "vector_a", *vb = "vector_b",
+    *j = "j", *a1 = "a1", *fs = "fsource", *ts = "tsource",
+    *l = "l", *a2 = "a2", *mo = "mold", *ord = "order",
+    *p = "p", *ar = "array", *shp = "shape", *src = "source",
+    *r = "r", *bd = "boundary", *pad = "pad", *set = "set",
+    *s = "s", *dm = "dim", *kind = "kind", *msk = "mask",
+    *x = "x", *sh = "shift", *stg = "string", *ssg = "substring",
+    *y = "y", *sz = "size", *sta = "string_a", *stb = "string_b",
+    *z = "z", *ln = "len", *ut = "unit", *han = "handler",
+    *num = "number", *tm = "time", *nm = "name", *md = "mode",
+    *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command",
+    *ca = "coarray", *sub = "sub";
+
+  int di, dr, dd, dl, dc, dz, ii;
+
+  di = gfc_default_integer_kind;
+  dr = gfc_default_real_kind;
+  dd = gfc_default_double_kind;
+  dl = gfc_default_logical_kind;
+  dc = gfc_default_character_kind;
+  dz = gfc_default_complex_kind;
+  ii = gfc_index_integer_kind;
+
+  add_sym_1 ("abs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_abs, gfc_simplify_abs, gfc_resolve_abs,
+	     a, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("iabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
+	     NULL, gfc_simplify_abs, gfc_resolve_abs,
+	     a, BT_INTEGER, di, REQUIRED);
+
+  add_sym_1 ("dabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_abs, gfc_resolve_abs,
+	     a, BT_REAL, dd, REQUIRED);
+
+  add_sym_1 ("cabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     NULL, gfc_simplify_abs, gfc_resolve_abs,
+	     a, BT_COMPLEX, dz, REQUIRED);
+
+  add_sym_1 ("zabs", GFC_ISYM_ABS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, 
+	     NULL, gfc_simplify_abs, gfc_resolve_abs, 
+	     a, BT_COMPLEX, dd, REQUIRED);
+
+  make_alias ("cdabs", GFC_STD_GNU);
+
+  make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77);
+
+  /* The checking function for ACCESS is called gfc_check_access_func
+     because the name gfc_check_access is already used in module.c.  */
+  add_sym_2 ("access", GFC_ISYM_ACCESS, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, gfc_check_access_func, NULL, gfc_resolve_access,
+	     nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("access", GFC_ISYM_ACCESS, GFC_STD_GNU);
+
+  add_sym_2 ("achar", GFC_ISYM_ACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_CHARACTER, dc, GFC_STD_F95,
+	     gfc_check_achar, gfc_simplify_achar, gfc_resolve_achar,
+	     i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("achar", GFC_ISYM_ACHAR, GFC_STD_F95);
+
+  add_sym_1 ("acos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_fn_rc2008, gfc_simplify_acos, gfc_resolve_acos,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dacos", GFC_ISYM_ACOS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_acos, gfc_resolve_acos,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("acos", GFC_ISYM_ACOS, GFC_STD_F77);
+
+  add_sym_1 ("acosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
+	     GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_acosh,
+	     gfc_resolve_acosh, x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dacosh", GFC_ISYM_ACOSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
+	     gfc_check_fn_d, gfc_simplify_acosh, gfc_resolve_acosh,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("acosh", GFC_ISYM_ACOSH, GFC_STD_F2008);
+
+  add_sym_1 ("adjustl", GFC_ISYM_ADJUSTL, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustl,
+	     gfc_resolve_adjustl, stg, BT_CHARACTER, 0, REQUIRED);
+
+  make_generic ("adjustl", GFC_ISYM_ADJUSTL, GFC_STD_F95);
+
+  add_sym_1 ("adjustr", GFC_ISYM_ADJUSTR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_CHARACTER, dc, GFC_STD_F95, NULL, gfc_simplify_adjustr,
+	     gfc_resolve_adjustr, stg, BT_CHARACTER, 0, REQUIRED);
+
+  make_generic ("adjustr", GFC_ISYM_ADJUSTR, GFC_STD_F95);
+
+  add_sym_1 ("aimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_fn_c, gfc_simplify_aimag, gfc_resolve_aimag,
+	     z, BT_COMPLEX, dz, REQUIRED);
+
+  make_alias ("imag", GFC_STD_GNU);
+  make_alias ("imagpart", GFC_STD_GNU);
+
+  add_sym_1 ("dimag", GFC_ISYM_AIMAG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU, 
+	     NULL, gfc_simplify_aimag, gfc_resolve_aimag, 
+	     z, BT_COMPLEX, dd, REQUIRED);
+
+  make_generic ("aimag", GFC_ISYM_AIMAG, GFC_STD_F77);
+
+  add_sym_2 ("aint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_a_xkind, gfc_simplify_aint, gfc_resolve_aint,
+	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  add_sym_1 ("dint", GFC_ISYM_AINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     NULL, gfc_simplify_dint, gfc_resolve_dint,
+	     a, BT_REAL, dd, REQUIRED);
+
+  make_generic ("aint", GFC_ISYM_AINT, GFC_STD_F77);
+
+  add_sym_2 ("all", GFC_ISYM_ALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
+	     gfc_check_all_any, gfc_simplify_all, gfc_resolve_all,
+	     msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
+
+  make_generic ("all", GFC_ISYM_ALL, GFC_STD_F95);
+
+  add_sym_1 ("allocated", GFC_ISYM_ALLOCATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
+	     gfc_check_allocated, NULL, NULL,
+	     ar, BT_UNKNOWN, 0, REQUIRED);
+
+  make_generic ("allocated", GFC_ISYM_ALLOCATED, GFC_STD_F95);
+
+  add_sym_2 ("anint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_a_xkind, gfc_simplify_anint, gfc_resolve_anint,
+	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  add_sym_1 ("dnint", GFC_ISYM_ANINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     NULL, gfc_simplify_dnint, gfc_resolve_dnint,
+	     a, BT_REAL, dd, REQUIRED);
+
+  make_generic ("anint", GFC_ISYM_ANINT, GFC_STD_F77);
+
+  add_sym_2 ("any", GFC_ISYM_ANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
+	     gfc_check_all_any, gfc_simplify_any, gfc_resolve_any,
+	     msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL);
+
+  make_generic ("any", GFC_ISYM_ANY, GFC_STD_F95);
+
+  add_sym_1 ("asin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_fn_rc2008, gfc_simplify_asin, gfc_resolve_asin,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dasin", GFC_ISYM_ASIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_asin, gfc_resolve_asin,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("asin", GFC_ISYM_ASIN, GFC_STD_F77);
+  
+  add_sym_1 ("asinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
+	     GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_asinh,
+	     gfc_resolve_asinh, x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dasinh", GFC_ISYM_ASINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
+	     gfc_check_fn_d, gfc_simplify_asinh, gfc_resolve_asinh,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("asinh", GFC_ISYM_ASINH, GFC_STD_F2008);
+
+  add_sym_2 ("associated", GFC_ISYM_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO, BT_LOGICAL, dl,
+	     GFC_STD_F95, gfc_check_associated, NULL, NULL,
+	     pt, BT_UNKNOWN, 0, REQUIRED, tg, BT_UNKNOWN, 0, OPTIONAL);
+
+  make_generic ("associated", GFC_ISYM_ASSOCIATED, GFC_STD_F95);
+
+  add_sym_1 ("atan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_fn_rc2008, gfc_simplify_atan, gfc_resolve_atan,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("datan", GFC_ISYM_ATAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_atan, gfc_resolve_atan,
+	     x, BT_REAL, dd, REQUIRED);
+
+  /* Two-argument version of atan, equivalent to atan2.  */
+  add_sym_2 ("atan", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F2008,
+	     gfc_check_atan_2, gfc_simplify_atan2, gfc_resolve_atan2,
+	     y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
+
+  make_generic ("atan", GFC_ISYM_ATAN, GFC_STD_F77);
+  
+  add_sym_1 ("atanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,
+	     GFC_STD_F2008, gfc_check_fn_rc2008, gfc_simplify_atanh,
+	     gfc_resolve_atanh, x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("datanh", GFC_ISYM_ATANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_GNU,
+	     gfc_check_fn_d, gfc_simplify_atanh, gfc_resolve_atanh,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("atanh", GFC_ISYM_ATANH, GFC_STD_F2008);
+
+  add_sym_2 ("atan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_atan2, gfc_simplify_atan2, gfc_resolve_atan2,
+	     y, BT_REAL, dr, REQUIRED, x, BT_REAL, dr, REQUIRED);
+
+  add_sym_2 ("datan2", GFC_ISYM_ATAN2, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_datan2, gfc_simplify_atan2, gfc_resolve_atan2,
+	     y, BT_REAL, dd, REQUIRED, x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("atan2", GFC_ISYM_ATAN2, GFC_STD_F77);
+  
+  /* Bessel and Neumann functions for G77 compatibility.  */
+  add_sym_1 ("besj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
+	     gfc_check_fn_r, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_alias ("bessel_j0", GFC_STD_F2008);
+
+  add_sym_1 ("dbesj0", GFC_ISYM_J0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
+	     gfc_check_fn_d, gfc_simplify_bessel_j0, gfc_resolve_g77_math1,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("bessel_j0", GFC_ISYM_J0, GFC_STD_F2008);
+
+  add_sym_1 ("besj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
+	     gfc_check_fn_r, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_alias ("bessel_j1", GFC_STD_F2008);
+
+  add_sym_1 ("dbesj1", GFC_ISYM_J1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
+	     gfc_check_fn_d, gfc_simplify_bessel_j1, gfc_resolve_g77_math1,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("bessel_j1", GFC_ISYM_J1, GFC_STD_F2008);
+
+  add_sym_2 ("besjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
+	     gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
+	     n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
+
+  make_alias ("bessel_jn", GFC_STD_F2008);
+
+  add_sym_2 ("dbesjn", GFC_ISYM_JN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
+	     gfc_check_besn, gfc_simplify_bessel_jn, gfc_resolve_besn,
+	     n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
+
+  add_sym_3 ("bessel_jn", GFC_ISYM_JN2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
+	     gfc_check_bessel_n2, gfc_simplify_bessel_jn2, gfc_resolve_bessel_n2,
+	     "n1", BT_INTEGER, di, REQUIRED,"n2", BT_INTEGER, di, REQUIRED,
+	     x, BT_REAL, dr, REQUIRED);
+  set_attr_value (3, true, true, true);
+
+  make_generic ("bessel_jn", GFC_ISYM_JN, GFC_STD_F2008);
+
+  add_sym_1 ("besy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
+	     gfc_check_fn_r, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_alias ("bessel_y0", GFC_STD_F2008);
+
+  add_sym_1 ("dbesy0", GFC_ISYM_Y0, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
+	     gfc_check_fn_d, gfc_simplify_bessel_y0, gfc_resolve_g77_math1,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("bessel_y0", GFC_ISYM_Y0, GFC_STD_F2008);
+
+  add_sym_1 ("besy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
+	     gfc_check_fn_r, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_alias ("bessel_y1", GFC_STD_F2008);
+
+  add_sym_1 ("dbesy1", GFC_ISYM_Y1, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
+	     gfc_check_fn_d, gfc_simplify_bessel_y1, gfc_resolve_g77_math1,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("bessel_y1", GFC_ISYM_Y1, GFC_STD_F2008);
+
+  add_sym_2 ("besyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
+	     gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
+	     n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dr, REQUIRED);
+
+  make_alias ("bessel_yn", GFC_STD_F2008);
+
+  add_sym_2 ("dbesyn", GFC_ISYM_YN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
+	     gfc_check_besn, gfc_simplify_bessel_yn, gfc_resolve_besn,
+	     n, BT_INTEGER, di, REQUIRED, x, BT_REAL, dd, REQUIRED);
+
+  add_sym_3 ("bessel_yn", GFC_ISYM_YN2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
+	     gfc_check_bessel_n2, gfc_simplify_bessel_yn2, gfc_resolve_bessel_n2,
+	     "n1", BT_INTEGER, di, REQUIRED,"n2", BT_INTEGER, di, REQUIRED,
+	      x, BT_REAL, dr, REQUIRED);
+  set_attr_value (3, true, true, true);
+
+  make_generic ("bessel_yn", GFC_ISYM_YN, GFC_STD_F2008);
+
+  add_sym_2 ("bge", GFC_ISYM_BGE, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_LOGICAL, dl, GFC_STD_F2008,
+	     gfc_check_bge_bgt_ble_blt, gfc_simplify_bge, NULL,
+	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("bge", GFC_ISYM_BGE, GFC_STD_F2008);
+
+  add_sym_2 ("bgt", GFC_ISYM_BGT, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_LOGICAL, dl, GFC_STD_F2008,
+	     gfc_check_bge_bgt_ble_blt, gfc_simplify_bgt, NULL,
+	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("bgt", GFC_ISYM_BGT, GFC_STD_F2008);
+
+  add_sym_1 ("bit_size", GFC_ISYM_BIT_SIZE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_i, gfc_simplify_bit_size, NULL,
+	     i, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("bit_size", GFC_ISYM_BIT_SIZE, GFC_STD_F95);
+
+  add_sym_2 ("ble", GFC_ISYM_BLE, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_LOGICAL, dl, GFC_STD_F2008,
+	     gfc_check_bge_bgt_ble_blt, gfc_simplify_ble, NULL,
+	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("ble", GFC_ISYM_BLE, GFC_STD_F2008);
+
+  add_sym_2 ("blt", GFC_ISYM_BLT, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_LOGICAL, dl, GFC_STD_F2008,
+	     gfc_check_bge_bgt_ble_blt, gfc_simplify_blt, NULL,
+	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("blt", GFC_ISYM_BLT, GFC_STD_F2008);
+
+  add_sym_2 ("btest", GFC_ISYM_BTEST, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
+	     gfc_check_bitfcn, gfc_simplify_btest, gfc_resolve_btest,
+	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("btest", GFC_ISYM_BTEST, GFC_STD_F95);
+
+  add_sym_2 ("ceiling", GFC_ISYM_CEILING, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_a_ikind, gfc_simplify_ceiling, gfc_resolve_ceiling,
+	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("ceiling", GFC_ISYM_CEILING, GFC_STD_F95);
+
+  add_sym_2 ("char", GFC_ISYM_CHAR, CLASS_ELEMENTAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F77,
+	     gfc_check_char, gfc_simplify_char, gfc_resolve_char,
+	     i, BT_INTEGER, di, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("char", GFC_ISYM_CHAR, GFC_STD_F77);
+
+  add_sym_1 ("chdir", GFC_ISYM_CHDIR, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
+	     GFC_STD_GNU, gfc_check_chdir, NULL, gfc_resolve_chdir,
+	     nm, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("chdir", GFC_ISYM_CHDIR, GFC_STD_GNU);
+
+  add_sym_2 ("chmod", GFC_ISYM_CHMOD, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, gfc_check_chmod, NULL, gfc_resolve_chmod,
+	     nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("chmod", GFC_ISYM_CHMOD, GFC_STD_GNU);
+
+  add_sym_3 ("cmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_F77,
+	     gfc_check_cmplx, gfc_simplify_cmplx, gfc_resolve_cmplx,
+	     x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, OPTIONAL,
+	     kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("cmplx", GFC_ISYM_CMPLX, GFC_STD_F77);
+
+  add_sym_0 ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT, CLASS_INQUIRY, 
+	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003, NULL, NULL, NULL);
+
+  make_generic ("command_argument_count", GFC_ISYM_COMMAND_ARGUMENT_COUNT,
+		GFC_STD_F2003);
+
+  add_sym_2 ("complex", GFC_ISYM_COMPLEX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dz, GFC_STD_GNU,
+	     gfc_check_complex, gfc_simplify_complex, gfc_resolve_complex,
+	     x, BT_UNKNOWN, dr, REQUIRED, y, BT_UNKNOWN, dr, REQUIRED);
+
+  make_generic ("complex", GFC_ISYM_COMPLEX, GFC_STD_GNU);
+
+  /* Making dcmplx a specific of cmplx causes cmplx to return a double
+     complex instead of the default complex.  */
+
+  add_sym_2 ("dcmplx", GFC_ISYM_CMPLX, CLASS_ELEMENTAL, ACTUAL_NO, BT_COMPLEX, dd, GFC_STD_GNU,
+	     gfc_check_dcmplx, gfc_simplify_dcmplx, gfc_resolve_dcmplx,
+	     x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, OPTIONAL);
+
+  make_generic ("dcmplx", GFC_ISYM_CMPLX, GFC_STD_GNU);
+
+  add_sym_1 ("conjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
+	     gfc_check_fn_c, gfc_simplify_conjg, gfc_resolve_conjg,
+	     z, BT_COMPLEX, dz, REQUIRED);
+
+  add_sym_1 ("dconjg", GFC_ISYM_CONJG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
+	     NULL, gfc_simplify_conjg, gfc_resolve_conjg, 
+	     z, BT_COMPLEX, dd, REQUIRED);
+
+  make_generic ("conjg", GFC_ISYM_CONJG, GFC_STD_F77);
+
+  add_sym_1 ("cos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_fn_rc, gfc_simplify_cos, gfc_resolve_cos,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_cos, gfc_resolve_cos,
+	     x, BT_REAL, dd, REQUIRED);
+
+  add_sym_1 ("ccos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
+	     NULL, gfc_simplify_cos, gfc_resolve_cos,
+	     x, BT_COMPLEX, dz, REQUIRED);
+
+  add_sym_1 ("zcos", GFC_ISYM_COS, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
+	     NULL, gfc_simplify_cos, gfc_resolve_cos, 
+	     x, BT_COMPLEX, dd, REQUIRED);
+
+  make_alias ("cdcos", GFC_STD_GNU);
+
+  make_generic ("cos", GFC_ISYM_COS, GFC_STD_F77);
+
+  add_sym_1 ("cosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_fn_rc2008, gfc_simplify_cosh, gfc_resolve_cosh,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dcosh", GFC_ISYM_COSH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_cosh, gfc_resolve_cosh,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("cosh", GFC_ISYM_COSH, GFC_STD_F77);
+
+  add_sym_3 ("count", GFC_ISYM_COUNT, CLASS_TRANSFORMATIONAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_count, gfc_simplify_count, gfc_resolve_count,
+	     msk, BT_LOGICAL, dl, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+	     kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95);
+
+  add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_cshift, NULL, gfc_resolve_cshift,
+	     ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
+	     dm, BT_INTEGER, ii, OPTIONAL);
+
+  make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95);
+
+  add_sym_1 ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
+	     0, GFC_STD_GNU, gfc_check_ctime, NULL, gfc_resolve_ctime,
+	     tm, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("ctime", GFC_ISYM_CTIME, GFC_STD_GNU);
+
+  add_sym_1 ("dble", GFC_ISYM_DBLE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_dble, gfc_simplify_dble, gfc_resolve_dble,
+	     a, BT_REAL, dr, REQUIRED);
+
+  make_generic ("dble", GFC_ISYM_DBLE, GFC_STD_F77);
+
+  add_sym_1 ("digits", GFC_ISYM_DIGITS, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_digits, gfc_simplify_digits, NULL,
+	     x, BT_UNKNOWN, dr, REQUIRED);
+
+  make_generic ("digits", GFC_ISYM_DIGITS, GFC_STD_F95);
+
+  add_sym_2 ("dim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_a_p, gfc_simplify_dim, gfc_resolve_dim,
+	     x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
+
+  add_sym_2 ("idim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
+	     NULL, gfc_simplify_dim, gfc_resolve_dim,
+	     x, BT_INTEGER, di, REQUIRED, y, BT_INTEGER, di, REQUIRED);
+
+  add_sym_2 ("ddim", GFC_ISYM_DIM, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_x_yd, gfc_simplify_dim, gfc_resolve_dim,
+	     x, BT_REAL, dd, REQUIRED, y, BT_REAL, dd, REQUIRED);
+
+  make_generic ("dim", GFC_ISYM_DIM, GFC_STD_F77);
+
+  add_sym_2 ("dot_product", GFC_ISYM_DOT_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
+	     GFC_STD_F95, gfc_check_dot_product, gfc_simplify_dot_product, gfc_resolve_dot_product,
+	     va, BT_REAL, dr, REQUIRED, vb, BT_REAL, dr, REQUIRED);
+
+  make_generic ("dot_product", GFC_ISYM_DOT_PRODUCT, GFC_STD_F95);
+
+  add_sym_2 ("dprod", GFC_ISYM_DPROD,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_dprod, gfc_simplify_dprod, gfc_resolve_dprod,
+	     x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
+
+  make_generic ("dprod", GFC_ISYM_DPROD, GFC_STD_F77);
+
+  add_sym_1 ("dreal", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
+	     NULL, NULL, NULL,
+	     a, BT_COMPLEX, dd, REQUIRED);
+
+  make_generic ("dreal", GFC_ISYM_REAL, GFC_STD_GNU);
+
+  add_sym_3 ("dshiftl", GFC_ISYM_DSHIFTL, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_dshift, gfc_simplify_dshiftl, gfc_resolve_dshift,
+	     i, BT_INTEGER, di, REQUIRED,
+	     j, BT_INTEGER, di, REQUIRED,
+	     sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("dshiftl", GFC_ISYM_DSHIFTL, GFC_STD_F2008);
+
+  add_sym_3 ("dshiftr", GFC_ISYM_DSHIFTR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_dshift, gfc_simplify_dshiftr, gfc_resolve_dshift,
+	     i, BT_INTEGER, di, REQUIRED,
+	     j, BT_INTEGER, di, REQUIRED,
+	     sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("dshiftr", GFC_ISYM_DSHIFTR, GFC_STD_F2008);
+
+  add_sym_4 ("eoshift", GFC_ISYM_EOSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_eoshift, NULL, gfc_resolve_eoshift,
+	     ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, ii, REQUIRED,
+	     bd, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
+
+  make_generic ("eoshift", GFC_ISYM_EOSHIFT, GFC_STD_F95);
+
+  add_sym_1 ("epsilon", GFC_ISYM_EPSILON, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_x, gfc_simplify_epsilon, NULL,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_generic ("epsilon", GFC_ISYM_EPSILON, GFC_STD_F95);
+
+  /* G77 compatibility for the ERF() and ERFC() functions.  */
+  add_sym_1 ("erf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
+	     GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erf,
+	     gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("derf", GFC_ISYM_ERF, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
+	     GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erf,
+	     gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("erf", GFC_ISYM_ERF, GFC_STD_F2008);
+
+  add_sym_1 ("erfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
+	     GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_erfc,
+	     gfc_resolve_g77_math1, x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("derfc", GFC_ISYM_ERFC, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd,
+	     GFC_STD_GNU, gfc_check_fn_d, gfc_simplify_erfc,
+	     gfc_resolve_g77_math1, x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("erfc", GFC_ISYM_ERFC, GFC_STD_F2008);
+
+  add_sym_1 ("erfc_scaled", GFC_ISYM_ERFC_SCALED, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_REAL, dr, GFC_STD_F2008, gfc_check_fn_r,
+	     gfc_simplify_erfc_scaled, gfc_resolve_g77_math1, x, BT_REAL,
+	     dr, REQUIRED);
+
+  make_generic ("erfc_scaled", GFC_ISYM_ERFC_SCALED, GFC_STD_F2008);
+
+  /* G77 compatibility */
+  add_sym_1 ("dtime", GFC_ISYM_DTIME, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
+	     4, GFC_STD_GNU, gfc_check_dtime_etime, NULL, NULL,
+	     x, BT_REAL, 4, REQUIRED);
+
+  make_generic ("dtime", GFC_ISYM_DTIME, GFC_STD_GNU);
+
+  add_sym_1 ("etime", GFC_ISYM_ETIME, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
+	     4, GFC_STD_GNU, gfc_check_dtime_etime, NULL, NULL,
+	     x, BT_REAL, 4, REQUIRED);
+
+  make_generic ("etime", GFC_ISYM_ETIME, GFC_STD_GNU);
+
+  add_sym_1 ("exp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr,  GFC_STD_F77,
+	     gfc_check_fn_rc, gfc_simplify_exp, gfc_resolve_exp,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_exp, gfc_resolve_exp,
+	     x, BT_REAL, dd, REQUIRED);
+
+  add_sym_1 ("cexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
+	     NULL, gfc_simplify_exp, gfc_resolve_exp,
+	     x, BT_COMPLEX, dz, REQUIRED);
+
+  add_sym_1 ("zexp", GFC_ISYM_EXP, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
+	     NULL, gfc_simplify_exp, gfc_resolve_exp, 
+	     x, BT_COMPLEX, dd, REQUIRED);
+
+  make_alias ("cdexp", GFC_STD_GNU);
+
+  make_generic ("exp", GFC_ISYM_EXP, GFC_STD_F77);
+
+  add_sym_1 ("exponent", GFC_ISYM_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_x, gfc_simplify_exponent, gfc_resolve_exponent,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_generic ("exponent", GFC_ISYM_EXPONENT, GFC_STD_F95);
+
+  add_sym_2 ("extends_type_of", GFC_ISYM_EXTENDS_TYPE_OF, CLASS_INQUIRY,
+	     ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
+	     gfc_check_same_type_as, gfc_simplify_extends_type_of,
+	     gfc_resolve_extends_type_of,
+	     a, BT_UNKNOWN, 0, REQUIRED,
+	     mo, BT_UNKNOWN, 0, REQUIRED);
+
+  add_sym_0 ("fdate",  GFC_ISYM_FDATE, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
+	     dc, GFC_STD_GNU, NULL, NULL, gfc_resolve_fdate);
+
+  make_generic ("fdate", GFC_ISYM_FDATE, GFC_STD_GNU);
+
+  add_sym_2 ("floor", GFC_ISYM_FLOOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_a_ikind, gfc_simplify_floor, gfc_resolve_floor,
+	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("floor", GFC_ISYM_FLOOR, GFC_STD_F95);
+
+  /* G77 compatible fnum */
+  add_sym_1 ("fnum", GFC_ISYM_FNUM, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, gfc_check_fnum, NULL, gfc_resolve_fnum,
+	     ut, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("fnum", GFC_ISYM_FNUM, GFC_STD_GNU);
+
+  add_sym_1 ("fraction", GFC_ISYM_FRACTION, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_x, gfc_simplify_fraction, gfc_resolve_fraction,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_generic ("fraction", GFC_ISYM_FRACTION, GFC_STD_F95);
+
+  add_sym_2_intent ("fstat", GFC_ISYM_FSTAT, CLASS_IMPURE, ACTUAL_NO,
+		    BT_INTEGER, di, GFC_STD_GNU,
+		    gfc_check_fstat, NULL, gfc_resolve_fstat,
+		    ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
+		    vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
+
+  make_generic ("fstat", GFC_ISYM_FSTAT, GFC_STD_GNU);
+
+  add_sym_1 ("ftell", GFC_ISYM_FTELL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     ii, GFC_STD_GNU, gfc_check_ftell, NULL, gfc_resolve_ftell,
+	     ut, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("ftell", GFC_ISYM_FTELL, GFC_STD_GNU);
+
+  add_sym_2_intent ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, ACTUAL_NO,
+		    BT_INTEGER, di, GFC_STD_GNU,
+		    gfc_check_fgetputc, NULL, gfc_resolve_fgetc,
+		    ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
+		    c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
+
+  make_generic ("fgetc", GFC_ISYM_FGETC, GFC_STD_GNU);
+
+  add_sym_1_intent ("fget", GFC_ISYM_FGET, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, gfc_check_fgetput, NULL, gfc_resolve_fget,
+	     c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
+
+  make_generic ("fget", GFC_ISYM_FGET, GFC_STD_GNU);
+
+  add_sym_2 ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, gfc_check_fgetputc, NULL, gfc_resolve_fputc,
+	     ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("fputc", GFC_ISYM_FPUTC, GFC_STD_GNU);
+
+  add_sym_1 ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, gfc_check_fgetput, NULL, gfc_resolve_fput,
+	     c, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("fput", GFC_ISYM_FPUT, GFC_STD_GNU);
+
+  add_sym_1 ("gamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr,
+	     GFC_STD_F2008, gfc_check_fn_r, gfc_simplify_gamma,
+	     gfc_resolve_gamma, x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dgamma", GFC_ISYM_TGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
+	     gfc_check_fn_d, gfc_simplify_gamma, gfc_resolve_gamma,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_generic ("gamma", GFC_ISYM_TGAMMA, GFC_STD_F2008);
+
+  /* Unix IDs (g77 compatibility)  */
+  add_sym_1 ("getcwd", GFC_ISYM_GETCWD, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di,  GFC_STD_GNU, NULL, NULL, gfc_resolve_getcwd,
+	     c, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("getcwd", GFC_ISYM_GETCWD, GFC_STD_GNU);
+
+  add_sym_0 ("getgid", GFC_ISYM_GETGID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getgid);
+
+  make_generic ("getgid", GFC_ISYM_GETGID, GFC_STD_GNU);
+
+  add_sym_0 ("getpid", GFC_ISYM_GETPID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getpid);
+
+  make_generic ("getpid", GFC_ISYM_GETPID, GFC_STD_GNU);
+
+  add_sym_0 ("getuid", GFC_ISYM_GETUID, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_getuid);
+
+  make_generic ("getuid", GFC_ISYM_GETUID, GFC_STD_GNU);
+
+  add_sym_1_intent ("hostnm", GFC_ISYM_HOSTNM, CLASS_IMPURE, ACTUAL_NO,
+		    BT_INTEGER, di, GFC_STD_GNU,
+		    gfc_check_hostnm, NULL, gfc_resolve_hostnm,
+		    c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
+
+  make_generic ("hostnm", GFC_ISYM_HOSTNM, GFC_STD_GNU);
+
+  add_sym_1 ("huge", GFC_ISYM_HUGE, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_huge, gfc_simplify_huge, NULL,
+	     x, BT_UNKNOWN, dr, REQUIRED);
+
+  make_generic ("huge", GFC_ISYM_HUGE, GFC_STD_F95);
+
+  add_sym_2 ("hypot", GFC_ISYM_HYPOT, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_REAL, dr, GFC_STD_F2008,
+	     gfc_check_hypot, gfc_simplify_hypot, gfc_resolve_hypot,
+	     x, BT_REAL, dr, REQUIRED, y, BT_REAL, dr, REQUIRED);
+
+  make_generic ("hypot", GFC_ISYM_HYPOT, GFC_STD_F2008);
+
+  add_sym_2 ("iachar", GFC_ISYM_IACHAR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_ichar_iachar, gfc_simplify_iachar, gfc_resolve_iachar,
+	     c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("iachar", GFC_ISYM_IACHAR, GFC_STD_F95);
+
+  add_sym_2 ("iand", GFC_ISYM_IAND, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_iand, gfc_simplify_iand, gfc_resolve_iand,
+	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("iand", GFC_ISYM_IAND, GFC_STD_F95);
+
+  add_sym_2 ("and", GFC_ISYM_AND, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
+	     dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_and, gfc_resolve_and,
+	     i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
+
+  make_generic ("and", GFC_ISYM_AND, GFC_STD_GNU);
+
+  add_sym_3red ("iall", GFC_ISYM_IALL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
+		gfc_check_transf_bit_intrins, gfc_simplify_iall, gfc_resolve_iall,
+		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+		msk, BT_LOGICAL, dl, OPTIONAL);
+
+  make_generic ("iall", GFC_ISYM_IALL, GFC_STD_F2008);
+
+  add_sym_3red ("iany", GFC_ISYM_IANY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
+		gfc_check_transf_bit_intrins, gfc_simplify_iany, gfc_resolve_iany,
+		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+		msk, BT_LOGICAL, dl, OPTIONAL);
+
+  make_generic ("iany", GFC_ISYM_IANY, GFC_STD_F2008);
+
+  add_sym_0 ("iargc", GFC_ISYM_IARGC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, NULL, NULL, NULL);
+
+  make_generic ("iargc", GFC_ISYM_IARGC, GFC_STD_GNU);
+
+  add_sym_2 ("ibclr", GFC_ISYM_IBCLR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_bitfcn, gfc_simplify_ibclr, gfc_resolve_ibclr,
+	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("ibclr", GFC_ISYM_IBCLR, GFC_STD_F95);
+
+  add_sym_3 ("ibits", GFC_ISYM_IBITS, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_ibits, gfc_simplify_ibits, gfc_resolve_ibits,
+	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED,
+	     ln, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("ibits", GFC_ISYM_IBITS, GFC_STD_F95);
+
+  add_sym_2 ("ibset", GFC_ISYM_IBSET, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_bitfcn, gfc_simplify_ibset, gfc_resolve_ibset,
+	     i, BT_INTEGER, di, REQUIRED, pos, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("ibset", GFC_ISYM_IBSET, GFC_STD_F95);
+
+  add_sym_2 ("ichar", GFC_ISYM_ICHAR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F77,
+	     gfc_check_ichar_iachar, gfc_simplify_ichar, gfc_resolve_ichar,
+	     c, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
+
+  add_sym_2 ("ieor", GFC_ISYM_IEOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
+	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
+
+  add_sym_2 ("xor", GFC_ISYM_XOR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
+	     dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_xor, gfc_resolve_xor,
+	     i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
+
+  make_generic ("xor", GFC_ISYM_XOR, GFC_STD_GNU);
+
+  add_sym_0 ("ierrno", GFC_ISYM_IERRNO, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_ierrno);
+
+  make_generic ("ierrno", GFC_ISYM_IERRNO, GFC_STD_GNU);
+
+  add_sym_2 ("image_index", GFC_ISYM_IMAGE_INDEX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_image_index, gfc_simplify_image_index, gfc_resolve_image_index,
+	     ca, BT_REAL, dr, REQUIRED, sub, BT_INTEGER, ii, REQUIRED);
+
+  /* The resolution function for INDEX is called gfc_resolve_index_func
+     because the name gfc_resolve_index is already used in resolve.c.  */
+  add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
+	     BT_INTEGER, di, GFC_STD_F77,
+	     gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
+	     stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
+	     bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
+
+  add_sym_2 ("int", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
+	     gfc_check_int, gfc_simplify_int, gfc_resolve_int,
+	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  add_sym_1 ("ifix", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
+	     NULL, gfc_simplify_ifix, NULL,
+	     a, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("idint", GFC_ISYM_INT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
+	     NULL, gfc_simplify_idint, NULL,
+	     a, BT_REAL, dd, REQUIRED);
+
+  make_generic ("int", GFC_ISYM_INT, GFC_STD_F77);
+
+  add_sym_1 ("int2", GFC_ISYM_INT2, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_intconv, gfc_simplify_int2, gfc_resolve_int2,
+	     a, BT_REAL, dr, REQUIRED);
+
+  make_alias ("short", GFC_STD_GNU);
+
+  make_generic ("int2", GFC_ISYM_INT2, GFC_STD_GNU);
+
+  add_sym_1 ("int8", GFC_ISYM_INT8, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_intconv, gfc_simplify_int8, gfc_resolve_int8,
+	     a, BT_REAL, dr, REQUIRED);
+
+  make_generic ("int8", GFC_ISYM_INT8, GFC_STD_GNU);
+
+  add_sym_1 ("long", GFC_ISYM_LONG, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_intconv, gfc_simplify_long, gfc_resolve_long,
+	     a, BT_REAL, dr, REQUIRED);
+
+  make_generic ("long", GFC_ISYM_LONG, GFC_STD_GNU);
+
+  add_sym_2 ("ior", GFC_ISYM_IOR, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_ior, gfc_simplify_ior, gfc_resolve_ior,
+	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("ior", GFC_ISYM_IOR, GFC_STD_F95);
+
+  add_sym_2 ("or", GFC_ISYM_OR, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
+	     dl, GFC_STD_GNU, gfc_check_and, gfc_simplify_or, gfc_resolve_or,
+	     i, BT_UNKNOWN, 0, REQUIRED, j, BT_UNKNOWN, 0, REQUIRED);
+
+  make_generic ("or", GFC_ISYM_OR, GFC_STD_GNU);
+
+  add_sym_3red ("iparity", GFC_ISYM_IPARITY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F2008,
+		gfc_check_transf_bit_intrins, gfc_simplify_iparity, gfc_resolve_iparity,
+		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+		msk, BT_LOGICAL, dl, OPTIONAL);
+
+  make_generic ("iparity", GFC_ISYM_IPARITY, GFC_STD_F2008);
+
+  /* The following function is for G77 compatibility.  */
+  add_sym_1 ("irand", GFC_ISYM_IRAND, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     4, GFC_STD_GNU, gfc_check_irand, NULL, NULL,
+	     i, BT_INTEGER, 4, OPTIONAL);
+
+  make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU);
+
+  add_sym_1 ("isatty", GFC_ISYM_ISATTY, CLASS_IMPURE, ACTUAL_NO, BT_LOGICAL,
+	     dl, GFC_STD_GNU, gfc_check_isatty, NULL, gfc_resolve_isatty,
+	     ut, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU);
+
+  add_sym_1 ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END,
+	     CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
+	     gfc_check_i, gfc_simplify_is_iostat_end, NULL,
+	     i, BT_INTEGER, 0, REQUIRED);
+
+  make_generic ("is_iostat_end", GFC_ISYM_IS_IOSTAT_END, GFC_STD_F2003);
+
+  add_sym_1 ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR,
+	     CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F2003,
+	     gfc_check_i, gfc_simplify_is_iostat_eor, NULL,
+	     i, BT_INTEGER, 0, REQUIRED);
+
+  make_generic ("is_iostat_eor", GFC_ISYM_IS_IOSTAT_EOR, GFC_STD_F2003);
+
+  add_sym_1 ("isnan", GFC_ISYM_ISNAN, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_LOGICAL, dl, GFC_STD_GNU,
+	     gfc_check_isnan, gfc_simplify_isnan, NULL,
+	     x, BT_REAL, 0, REQUIRED);
+
+  make_generic ("isnan", GFC_ISYM_ISNAN, GFC_STD_GNU);
+
+  add_sym_2 ("rshift", GFC_ISYM_RSHIFT, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_ishft, gfc_simplify_rshift, gfc_resolve_rshift,
+	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("rshift", GFC_ISYM_RSHIFT, GFC_STD_GNU);
+
+  add_sym_2 ("lshift", GFC_ISYM_LSHIFT, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_GNU,
+	     gfc_check_ishft, gfc_simplify_lshift, gfc_resolve_lshift,
+	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("lshift", GFC_ISYM_LSHIFT, GFC_STD_GNU);
+
+  add_sym_2 ("ishft", GFC_ISYM_ISHFT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft,
+	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("ishft", GFC_ISYM_ISHFT, GFC_STD_F95);
+
+  add_sym_3 ("ishftc", GFC_ISYM_ISHFTC, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_ishftc, gfc_simplify_ishftc, gfc_resolve_ishftc,
+	     i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED,
+	     sz, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("ishftc", GFC_ISYM_ISHFTC, GFC_STD_F95);
+
+  add_sym_2 ("kill", GFC_ISYM_KILL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, gfc_check_kill, NULL, gfc_resolve_kill,
+	     a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("kill", GFC_ISYM_KILL, GFC_STD_GNU);
+
+  add_sym_1 ("kind", GFC_ISYM_KIND, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_kind, gfc_simplify_kind, NULL,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_generic ("kind", GFC_ISYM_KIND, GFC_STD_F95);
+
+  add_sym_3 ("lbound", GFC_ISYM_LBOUND, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_lbound, gfc_simplify_lbound, gfc_resolve_lbound,
+	     ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, di, OPTIONAL,
+	     kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("lbound", GFC_ISYM_LBOUND, GFC_STD_F95);
+
+  add_sym_3 ("lcobound", GFC_ISYM_LCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_lcobound, gfc_simplify_lcobound, gfc_resolve_lcobound,
+	     ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+	     kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("lcobound", GFC_ISYM_LCOBOUND, GFC_STD_F2008);
+
+  add_sym_1 ("leadz", GFC_ISYM_LEADZ, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_i, gfc_simplify_leadz, NULL,
+	     i, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("leadz", GFC_ISYM_LEADZ, GFC_STD_F2008);
+
+  add_sym_2 ("len", GFC_ISYM_LEN, CLASS_INQUIRY, ACTUAL_YES,
+	     BT_INTEGER, di, GFC_STD_F77,
+	     gfc_check_len_lentrim, gfc_simplify_len, gfc_resolve_len,
+	     stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("len", GFC_ISYM_LEN, GFC_STD_F77);
+
+  add_sym_2 ("len_trim", GFC_ISYM_LEN_TRIM, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_len_lentrim, gfc_simplify_len_trim, gfc_resolve_len_trim,
+	     stg, BT_CHARACTER, dc, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_alias ("lnblnk", GFC_STD_GNU);
+
+  make_generic ("len_trim", GFC_ISYM_LEN_TRIM, GFC_STD_F95);
+
+  add_sym_1 ("lgamma", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL,
+	     dr, GFC_STD_GNU,
+	     gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_alias ("log_gamma", GFC_STD_F2008);
+
+  add_sym_1 ("algama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
+	     gfc_check_fn_r, gfc_simplify_lgamma, gfc_resolve_lgamma,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dlgama", GFC_ISYM_LGAMMA, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
+	     gfc_check_fn_d, gfc_simplify_lgamma, gfc_resolve_lgamma,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_generic ("log_gamma", GFC_ISYM_LGAMMA, GFC_STD_F2008);
+
+
+  add_sym_2 ("lge", GFC_ISYM_LGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
+	     GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lge, NULL,
+	     sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("lge", GFC_ISYM_LGE, GFC_STD_F77);
+
+  add_sym_2 ("lgt", GFC_ISYM_LGT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
+	     GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lgt, NULL,
+	     sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("lgt", GFC_ISYM_LGT, GFC_STD_F77);
+
+  add_sym_2 ("lle",GFC_ISYM_LLE,  CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
+	     GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_lle, NULL,
+	     sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("lle", GFC_ISYM_LLE, GFC_STD_F77);
+
+  add_sym_2 ("llt", GFC_ISYM_LLT, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl,
+	     GFC_STD_F77, gfc_check_lge_lgt_lle_llt, gfc_simplify_llt, NULL,
+	     sta, BT_CHARACTER, dc, REQUIRED, stb, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("llt", GFC_ISYM_LLT, GFC_STD_F77);
+
+  add_sym_2 ("link", GFC_ISYM_LINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
+	     GFC_STD_GNU, gfc_check_link, NULL, gfc_resolve_link,
+	     p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("link", GFC_ISYM_LINK, GFC_STD_GNU);
+  
+  add_sym_1 ("log", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_fn_rc, gfc_simplify_log, gfc_resolve_log,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("alog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     NULL, gfc_simplify_log, gfc_resolve_log,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_log, gfc_resolve_log,
+	     x, BT_REAL, dd, REQUIRED);
+
+  add_sym_1 ("clog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
+	     NULL, gfc_simplify_log, gfc_resolve_log,
+	     x, BT_COMPLEX, dz, REQUIRED);
+
+  add_sym_1 ("zlog", GFC_ISYM_LOG, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd,  GFC_STD_GNU,
+	     NULL, gfc_simplify_log, gfc_resolve_log,
+	     x, BT_COMPLEX, dd, REQUIRED);
+
+  make_alias ("cdlog", GFC_STD_GNU);
+
+  make_generic ("log", GFC_ISYM_LOG, GFC_STD_F77);
+
+  add_sym_1 ("log10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_fn_r, gfc_simplify_log10, gfc_resolve_log10,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("alog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     NULL, gfc_simplify_log10, gfc_resolve_log10,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dlog10", GFC_ISYM_LOG10, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_log10, gfc_resolve_log10,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("log10", GFC_ISYM_LOG10, GFC_STD_F77);
+
+  add_sym_2 ("logical", GFC_ISYM_LOGICAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_LOGICAL, dl, GFC_STD_F95,
+	     gfc_check_logical, gfc_simplify_logical, gfc_resolve_logical,
+	     l, BT_LOGICAL, dl, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("logical", GFC_ISYM_LOGICAL, GFC_STD_F95);
+
+  add_sym_2_intent ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, ACTUAL_NO,
+		    BT_INTEGER, di, GFC_STD_GNU,
+		    gfc_check_stat, NULL, gfc_resolve_lstat,
+		    nm, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+		    vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
+
+  make_generic ("lstat", GFC_ISYM_LSTAT, GFC_STD_GNU);
+
+  add_sym_1 ("malloc", GFC_ISYM_MALLOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
+	     GFC_STD_GNU, gfc_check_malloc, NULL, gfc_resolve_malloc,
+	     sz, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("malloc", GFC_ISYM_MALLOC, GFC_STD_GNU);
+
+  add_sym_2 ("maskl", GFC_ISYM_MASKL, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_mask, gfc_simplify_maskl, gfc_resolve_mask,
+	     i, BT_INTEGER, di, REQUIRED,
+	     kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("maskl", GFC_ISYM_MASKL, GFC_STD_F2008);
+
+  add_sym_2 ("maskr", GFC_ISYM_MASKR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_mask, gfc_simplify_maskr, gfc_resolve_mask,
+	     i, BT_INTEGER, di, REQUIRED,
+	     kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("maskr", GFC_ISYM_MASKR, GFC_STD_F2008);
+
+  add_sym_2 ("matmul", GFC_ISYM_MATMUL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_matmul, gfc_simplify_matmul, gfc_resolve_matmul,
+	     ma, BT_REAL, dr, REQUIRED, mb, BT_REAL, dr, REQUIRED);
+
+  make_generic ("matmul", GFC_ISYM_MATMUL, GFC_STD_F95);
+
+  /* Note: amax0 is equivalent to real(max), max1 is equivalent to
+     int(max).  The max function must take at least two arguments.  */
+
+  add_sym_1m ("max", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
+	     gfc_check_min_max, gfc_simplify_max, gfc_resolve_max,
+	     a1, BT_UNKNOWN, dr, REQUIRED, a2, BT_UNKNOWN, dr, REQUIRED);
+
+  add_sym_1m ("max0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
+	     gfc_check_min_max_integer, gfc_simplify_max, NULL,
+	     a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
+
+  add_sym_1m ("amax0", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_min_max_integer, gfc_simplify_max, NULL,
+	     a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
+
+  add_sym_1m ("amax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_min_max_real, gfc_simplify_max, NULL,
+	     a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
+
+  add_sym_1m ("max1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
+	     gfc_check_min_max_real, gfc_simplify_max, NULL,
+	     a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
+
+  add_sym_1m ("dmax1", GFC_ISYM_MAX, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_min_max_double, gfc_simplify_max, NULL,
+	     a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
+
+  make_generic ("max", GFC_ISYM_MAX, GFC_STD_F77);
+
+  add_sym_1 ("maxexponent", GFC_ISYM_MAXEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
+	     GFC_STD_F95, gfc_check_x, gfc_simplify_maxexponent, NULL,
+	     x, BT_UNKNOWN, dr, REQUIRED);
+
+  make_generic ("maxexponent", GFC_ISYM_MAXEXPONENT, GFC_STD_F95);
+
+  add_sym_3ml ("maxloc", GFC_ISYM_MAXLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	       gfc_check_minloc_maxloc, NULL, gfc_resolve_maxloc,
+	       ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+	       msk, BT_LOGICAL, dl, OPTIONAL);
+
+  make_generic ("maxloc", GFC_ISYM_MAXLOC, GFC_STD_F95);
+
+  add_sym_3red ("maxval", GFC_ISYM_MAXVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+		gfc_check_minval_maxval, gfc_simplify_maxval, gfc_resolve_maxval,
+		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+		msk, BT_LOGICAL, dl, OPTIONAL);
+
+  make_generic ("maxval", GFC_ISYM_MAXVAL, GFC_STD_F95);
+
+  add_sym_0 ("mclock", GFC_ISYM_MCLOCK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
+	     GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock);
+
+  make_generic ("mclock", GFC_ISYM_MCLOCK, GFC_STD_GNU);
+
+  add_sym_0 ("mclock8", GFC_ISYM_MCLOCK8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_mclock8);
+
+  make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
+
+  add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
+	     ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
+	     msk, BT_LOGICAL, dl, REQUIRED);
+
+  make_generic ("merge", GFC_ISYM_MERGE, GFC_STD_F95);
+
+  add_sym_3 ("merge_bits", GFC_ISYM_MERGE_BITS, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_merge_bits, gfc_simplify_merge_bits,
+	     gfc_resolve_merge_bits,
+	     i, BT_INTEGER, di, REQUIRED,
+	     j, BT_INTEGER, di, REQUIRED,
+	     msk, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("merge_bits", GFC_ISYM_MERGE_BITS, GFC_STD_F2008);
+
+  /* Note: amin0 is equivalent to real(min), min1 is equivalent to
+     int(min).  */
+
+  add_sym_1m ("min", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_UNKNOWN, 0, GFC_STD_F77,
+	      gfc_check_min_max, gfc_simplify_min, gfc_resolve_min,
+	      a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
+
+  add_sym_1m ("min0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
+	      gfc_check_min_max_integer, gfc_simplify_min, NULL,
+	      a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
+
+  add_sym_1m ("amin0", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
+	      gfc_check_min_max_integer, gfc_simplify_min, NULL,
+	      a1, BT_INTEGER, di, REQUIRED, a2, BT_INTEGER, di, REQUIRED);
+
+  add_sym_1m ("amin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
+	      gfc_check_min_max_real, gfc_simplify_min, NULL,
+	      a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
+
+  add_sym_1m ("min1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F77,
+	      gfc_check_min_max_real, gfc_simplify_min, NULL,
+	      a1, BT_REAL, dr, REQUIRED, a2, BT_REAL, dr, REQUIRED);
+
+  add_sym_1m ("dmin1", GFC_ISYM_MIN, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_F77,
+	      gfc_check_min_max_double, gfc_simplify_min, NULL,
+	      a1, BT_REAL, dd, REQUIRED, a2, BT_REAL, dd, REQUIRED);
+
+  make_generic ("min", GFC_ISYM_MIN, GFC_STD_F77);
+
+  add_sym_1 ("minexponent", GFC_ISYM_MINEXPONENT, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di,
+	     GFC_STD_F95, gfc_check_x, gfc_simplify_minexponent, NULL,
+	     x, BT_UNKNOWN, dr, REQUIRED);
+
+  make_generic ("minexponent", GFC_ISYM_MINEXPONENT, GFC_STD_F95);
+
+  add_sym_3ml ("minloc", GFC_ISYM_MINLOC, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	       gfc_check_minloc_maxloc, NULL, gfc_resolve_minloc,
+	       ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+	       msk, BT_LOGICAL, dl, OPTIONAL);
+
+  make_generic ("minloc", GFC_ISYM_MINLOC, GFC_STD_F95);
+
+  add_sym_3red ("minval", GFC_ISYM_MINVAL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+		gfc_check_minval_maxval, gfc_simplify_minval, gfc_resolve_minval,
+		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+		msk, BT_LOGICAL, dl, OPTIONAL);
+
+  make_generic ("minval", GFC_ISYM_MINVAL, GFC_STD_F95);
+
+  add_sym_2 ("mod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
+	     gfc_check_a_p, gfc_simplify_mod, gfc_resolve_mod,
+	     a, BT_INTEGER, di, REQUIRED, p, BT_INTEGER, di, REQUIRED);
+
+  add_sym_2 ("amod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     NULL, gfc_simplify_mod, gfc_resolve_mod,
+	     a, BT_REAL, dr, REQUIRED, p, BT_REAL, dr, REQUIRED);
+
+  add_sym_2 ("dmod", GFC_ISYM_MOD, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_x_yd, gfc_simplify_mod, gfc_resolve_mod,
+	     a, BT_REAL, dd, REQUIRED, p, BT_REAL, dd, REQUIRED);
+
+  make_generic ("mod", GFC_ISYM_MOD, GFC_STD_F77);
+
+  add_sym_2 ("modulo", GFC_ISYM_MODULO, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, di, GFC_STD_F95,
+	     gfc_check_a_p, gfc_simplify_modulo, gfc_resolve_modulo,
+	     a, BT_REAL, di, REQUIRED, p, BT_REAL, di, REQUIRED);
+
+  make_generic ("modulo", GFC_ISYM_MODULO, GFC_STD_F95);
+
+  add_sym_2 ("nearest", GFC_ISYM_NEAREST, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_nearest, gfc_simplify_nearest, gfc_resolve_nearest,
+	     x, BT_REAL, dr, REQUIRED, s, BT_REAL, dr, REQUIRED);
+
+  make_generic ("nearest", GFC_ISYM_NEAREST, GFC_STD_F95);
+
+  add_sym_1 ("new_line", GFC_ISYM_NEW_LINE, CLASS_INQUIRY, ACTUAL_NO, BT_CHARACTER, dc,
+	     GFC_STD_F2003, gfc_check_new_line, gfc_simplify_new_line, NULL,
+	     a, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("new_line", GFC_ISYM_NEW_LINE, GFC_STD_F2003);
+
+  add_sym_2 ("nint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
+	     gfc_check_a_ikind, gfc_simplify_nint, gfc_resolve_nint,
+	     a, BT_REAL, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  add_sym_1 ("idnint", GFC_ISYM_NINT, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
+	     gfc_check_idnint, gfc_simplify_idnint, gfc_resolve_idnint,
+	     a, BT_REAL, dd, REQUIRED);
+
+  make_generic ("nint", GFC_ISYM_NINT, GFC_STD_F77);
+
+  add_sym_1 ("not", GFC_ISYM_NOT, CLASS_ELEMENTAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_i, gfc_simplify_not, gfc_resolve_not,
+	     i, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("not", GFC_ISYM_NOT, GFC_STD_F95);
+
+  add_sym_2 ("norm2", GFC_ISYM_NORM2, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr,
+	     GFC_STD_F2008, gfc_check_norm2, gfc_simplify_norm2, gfc_resolve_norm2,
+	     x, BT_REAL, dr, REQUIRED,
+	     dm, BT_INTEGER, ii, OPTIONAL);
+
+  make_generic ("norm2", GFC_ISYM_NORM2, GFC_STD_F2008);
+
+  add_sym_1 ("null", GFC_ISYM_NULL, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_null, gfc_simplify_null, NULL,
+	     mo, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
+
+  add_sym_0 ("num_images", GFC_ISYM_NUMIMAGES, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
+	     NULL, gfc_simplify_num_images, NULL);
+
+  add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
+	     ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
+	     v, BT_REAL, dr, OPTIONAL);
+
+  make_generic ("pack", GFC_ISYM_PACK, GFC_STD_F95);
+
+
+  add_sym_2 ("parity", GFC_ISYM_PARITY, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_LOGICAL, dl,
+	     GFC_STD_F2008, gfc_check_parity, gfc_simplify_parity, gfc_resolve_parity,
+	     msk, BT_LOGICAL, dl, REQUIRED,
+	     dm, BT_INTEGER, ii, OPTIONAL);
+
+  make_generic ("parity", GFC_ISYM_PARITY, GFC_STD_F2008);
+
+  add_sym_1 ("popcnt", GFC_ISYM_POPCNT, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_i, gfc_simplify_popcnt, NULL,
+	     i, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("popcnt", GFC_ISYM_POPCNT, GFC_STD_F2008);
+
+  add_sym_1 ("poppar", GFC_ISYM_POPPAR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_i, gfc_simplify_poppar, NULL,
+	     i, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("poppar", GFC_ISYM_POPPAR, GFC_STD_F2008);
+
+  add_sym_1 ("precision", GFC_ISYM_PRECISION, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_precision, gfc_simplify_precision, NULL,
+	     x, BT_UNKNOWN, 0, REQUIRED);
+
+  make_generic ("precision", GFC_ISYM_PRECISION, GFC_STD_F95);
+
+  add_sym_1_intent ("present", GFC_ISYM_PRESENT, CLASS_INQUIRY, ACTUAL_NO,
+		    BT_LOGICAL, dl, GFC_STD_F95, gfc_check_present, NULL, NULL,
+		    a, BT_REAL, dr, REQUIRED, INTENT_UNKNOWN);
+
+  make_generic ("present", GFC_ISYM_PRESENT, GFC_STD_F95);
+
+  add_sym_3red ("product", GFC_ISYM_PRODUCT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+		gfc_check_product_sum, gfc_simplify_product, gfc_resolve_product,
+		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+		msk, BT_LOGICAL, dl, OPTIONAL);
+
+  make_generic ("product", GFC_ISYM_PRODUCT, GFC_STD_F95);
+
+  add_sym_1 ("radix", GFC_ISYM_RADIX, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_radix, gfc_simplify_radix, NULL,
+	     x, BT_UNKNOWN, 0, REQUIRED);
+
+  make_generic ("radix", GFC_ISYM_RADIX, GFC_STD_F95);
+
+  /* The following function is for G77 compatibility.  */
+  add_sym_1 ("rand", GFC_ISYM_RAND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
+	     4, GFC_STD_GNU, gfc_check_rand, NULL, NULL,
+	     i, BT_INTEGER, 4, OPTIONAL);
+
+  /* Compatibility with HP FORTRAN 77/iX Reference.  Note, rand() and ran()
+     use slightly different shoddy multiplicative congruential PRNG.  */
+  make_alias ("ran", GFC_STD_GNU);
+
+  make_generic ("rand", GFC_ISYM_RAND, GFC_STD_GNU);
+
+  add_sym_1 ("range", GFC_ISYM_RANGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_range, gfc_simplify_range, NULL,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_generic ("range", GFC_ISYM_RANGE, GFC_STD_F95);
+
+  add_sym_2 ("real", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_real, gfc_simplify_real, gfc_resolve_real,
+	     a, BT_UNKNOWN, dr, REQUIRED, kind, BT_INTEGER, di, OPTIONAL);
+
+  /* This provides compatibility with g77.  */
+  add_sym_1 ("realpart", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_GNU,
+	     gfc_check_fn_c, gfc_simplify_realpart, gfc_resolve_realpart,
+	     a, BT_UNKNOWN, dr, REQUIRED);
+
+  add_sym_1 ("float", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_float, gfc_simplify_float, NULL,
+	     a, BT_INTEGER, di, REQUIRED);
+
+  add_sym_1 ("dfloat", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dd, GFC_STD_GNU,
+	     gfc_check_float, gfc_simplify_dble, gfc_resolve_dble,
+	     a, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("sngl", GFC_ISYM_REAL, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_sngl, gfc_simplify_sngl, NULL,
+	     a, BT_REAL, dd, REQUIRED);
+
+  make_generic ("real", GFC_ISYM_REAL, GFC_STD_F77);
+
+  add_sym_2 ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
+	     GFC_STD_GNU, gfc_check_rename, NULL, gfc_resolve_rename,
+	     p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("rename", GFC_ISYM_RENAME, GFC_STD_GNU);
+  
+  add_sym_2 ("repeat", GFC_ISYM_REPEAT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
+	     gfc_check_repeat, gfc_simplify_repeat, gfc_resolve_repeat,
+	     stg, BT_CHARACTER, dc, REQUIRED, ncopies, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("repeat", GFC_ISYM_REPEAT, GFC_STD_F95);
+
+  add_sym_4 ("reshape", GFC_ISYM_RESHAPE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_reshape, gfc_simplify_reshape, gfc_resolve_reshape,
+	     src, BT_REAL, dr, REQUIRED, shp, BT_INTEGER, ii, REQUIRED,
+	     pad, BT_REAL, dr, OPTIONAL, ord, BT_INTEGER, ii, OPTIONAL);
+
+  make_generic ("reshape", GFC_ISYM_RESHAPE, GFC_STD_F95);
+
+  add_sym_1 ("rrspacing", GFC_ISYM_RRSPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_x, gfc_simplify_rrspacing, gfc_resolve_rrspacing,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_generic ("rrspacing", GFC_ISYM_RRSPACING, GFC_STD_F95);
+
+  add_sym_2 ("same_type_as", GFC_ISYM_SAME_TYPE_AS, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_LOGICAL, dl, GFC_STD_F2003,
+	     gfc_check_same_type_as, gfc_simplify_same_type_as, NULL,
+	     a, BT_UNKNOWN, 0, REQUIRED,
+	     b, BT_UNKNOWN, 0, REQUIRED);
+
+  add_sym_2 ("scale", GFC_ISYM_SCALE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_scale, gfc_simplify_scale, gfc_resolve_scale,
+	     x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("scale", GFC_ISYM_SCALE, GFC_STD_F95);
+
+  add_sym_4 ("scan", GFC_ISYM_SCAN, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_scan, gfc_simplify_scan, gfc_resolve_scan,
+	     stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
+	     bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("scan", GFC_ISYM_SCAN, GFC_STD_F95);
+
+  /* Added for G77 compatibility garbage.  */
+  add_sym_0 ("second", GFC_ISYM_SECOND, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
+	     4, GFC_STD_GNU, NULL, NULL, NULL);
+
+  make_generic ("second", GFC_ISYM_SECOND, GFC_STD_GNU);
+
+  /* Added for G77 compatibility.  */
+  add_sym_1 ("secnds", GFC_ISYM_SECNDS, CLASS_IMPURE, ACTUAL_NO, BT_REAL,
+	     dr, GFC_STD_GNU, gfc_check_secnds, NULL, gfc_resolve_secnds,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_generic ("secnds", GFC_ISYM_SECNDS, GFC_STD_GNU);
+
+  add_sym_1 ("selected_char_kind", GFC_ISYM_SC_KIND, CLASS_TRANSFORMATIONAL,
+	     ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2003,
+	     gfc_check_selected_char_kind, gfc_simplify_selected_char_kind,
+	     NULL, nm, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("selected_char_kind", GFC_ISYM_SC_KIND, GFC_STD_F2003);
+
+  add_sym_1 ("selected_int_kind", GFC_ISYM_SI_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
+	     GFC_STD_F95, gfc_check_selected_int_kind,
+	     gfc_simplify_selected_int_kind, NULL, r, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
+
+  add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
+	     GFC_STD_F95, gfc_check_selected_real_kind,
+	     gfc_simplify_selected_real_kind, NULL,
+	     p, BT_INTEGER, di, OPTIONAL, r, BT_INTEGER, di, OPTIONAL,
+	     "radix", BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("selected_real_kind", GFC_ISYM_SR_KIND, GFC_STD_F95);
+
+  add_sym_2 ("set_exponent", GFC_ISYM_SET_EXPONENT, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_set_exponent, gfc_simplify_set_exponent,
+	     gfc_resolve_set_exponent,
+	     x, BT_REAL, dr, REQUIRED, i, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("set_exponent", GFC_ISYM_SET_EXPONENT, GFC_STD_F95);
+
+  add_sym_2 ("shape", GFC_ISYM_SHAPE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_shape, gfc_simplify_shape, gfc_resolve_shape,
+	     src, BT_REAL, dr, REQUIRED,
+	     kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("shape", GFC_ISYM_SHAPE, GFC_STD_F95);
+
+  add_sym_2 ("shifta", GFC_ISYM_SHIFTA, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_shift, gfc_simplify_shifta, gfc_resolve_shift,
+	     i, BT_INTEGER, di, REQUIRED,
+	     sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("shifta", GFC_ISYM_SHIFTA, GFC_STD_F2008);
+
+  add_sym_2 ("shiftl", GFC_ISYM_SHIFTL, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_shift, gfc_simplify_shiftl, gfc_resolve_shift,
+	     i, BT_INTEGER, di, REQUIRED,
+	     sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("shiftl", GFC_ISYM_SHIFTL, GFC_STD_F2008);
+
+  add_sym_2 ("shiftr", GFC_ISYM_SHIFTR, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_shift, gfc_simplify_shiftr, gfc_resolve_shift,
+	     i, BT_INTEGER, di, REQUIRED,
+	     sh, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("shiftr", GFC_ISYM_SHIFTR, GFC_STD_F2008);
+
+  add_sym_2 ("sign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_sign, gfc_simplify_sign, gfc_resolve_sign,
+	     a, BT_REAL, dr, REQUIRED, b, BT_REAL, dr, REQUIRED);
+
+  add_sym_2 ("isign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_INTEGER, di, GFC_STD_F77,
+	     NULL, gfc_simplify_sign, gfc_resolve_sign,
+	     a, BT_INTEGER, di, REQUIRED, b, BT_INTEGER, di, REQUIRED);
+
+  add_sym_2 ("dsign", GFC_ISYM_SIGN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_x_yd, gfc_simplify_sign, gfc_resolve_sign,
+	     a, BT_REAL, dd, REQUIRED, b, BT_REAL, dd, REQUIRED);
+
+  make_generic ("sign", GFC_ISYM_SIGN, GFC_STD_F77);
+
+  add_sym_2 ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, gfc_check_signal, NULL, gfc_resolve_signal,
+	     num, BT_INTEGER, di, REQUIRED, han, BT_VOID, 0, REQUIRED);
+
+  make_generic ("signal", GFC_ISYM_SIGNAL, GFC_STD_GNU);
+
+  add_sym_1 ("sin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_fn_rc, gfc_simplify_sin, gfc_resolve_sin,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_sin, gfc_resolve_sin,
+	     x, BT_REAL, dd, REQUIRED);
+
+  add_sym_1 ("csin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
+	     NULL, gfc_simplify_sin, gfc_resolve_sin,
+	     x, BT_COMPLEX, dz, REQUIRED);
+
+  add_sym_1 ("zsin", GFC_ISYM_SIN, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
+	     NULL, gfc_simplify_sin, gfc_resolve_sin,
+	     x, BT_COMPLEX, dd, REQUIRED);
+
+  make_alias ("cdsin", GFC_STD_GNU);
+
+  make_generic ("sin", GFC_ISYM_SIN, GFC_STD_F77);
+
+  add_sym_1 ("sinh", GFC_ISYM_SINH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_fn_rc2008, gfc_simplify_sinh, gfc_resolve_sinh,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dsinh", GFC_ISYM_SINH,CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_sinh, gfc_resolve_sinh,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("sinh", GFC_ISYM_SINH, GFC_STD_F77);
+
+  add_sym_3 ("size", GFC_ISYM_SIZE, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_size, gfc_simplify_size, gfc_resolve_size,
+	     ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+	     kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
+
+  add_sym_1 ("sizeof", GFC_ISYM_SIZEOF, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
+	     GFC_STD_GNU, gfc_check_sizeof, NULL, NULL,
+	     x, BT_UNKNOWN, 0, REQUIRED);
+
+  make_generic ("sizeof", GFC_ISYM_SIZEOF, GFC_STD_GNU);
+
+  /* C_SIZEOF is part of ISO_C_BINDING.  */
+  add_sym_1 ("c_sizeof", GFC_ISYM_C_SIZEOF, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_INTEGER, ii, GFC_STD_F2008, gfc_check_c_sizeof, NULL, NULL,
+	     x, BT_UNKNOWN, 0, REQUIRED);
+  make_from_module();
+
+  /* COMPILER_OPTIONS and COMPILER_VERSION are part of ISO_FORTRAN_ENV.  */  
+  add_sym_0 ("compiler_options", GFC_ISYM_COMPILER_OPTIONS, CLASS_INQUIRY,
+	     ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F2008,
+	     NULL, gfc_simplify_compiler_options, NULL);
+  make_from_module();
+
+  add_sym_0 ("compiler_version", GFC_ISYM_COMPILER_VERSION, CLASS_INQUIRY,
+	     ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F2008,
+	     NULL, gfc_simplify_compiler_version, NULL);
+  make_from_module();
+
+  add_sym_1 ("spacing", GFC_ISYM_SPACING, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_x, gfc_simplify_spacing, gfc_resolve_spacing,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_generic ("spacing", GFC_ISYM_SPACING, GFC_STD_F95);
+
+  add_sym_3 ("spread", GFC_ISYM_SPREAD, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_spread, gfc_simplify_spread, gfc_resolve_spread,
+	     src, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, REQUIRED,
+	     ncopies, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("spread", GFC_ISYM_SPREAD, GFC_STD_F95);
+
+  add_sym_1 ("sqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_fn_rc, gfc_simplify_sqrt, gfc_resolve_sqrt,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_sqrt, gfc_resolve_sqrt,
+	     x, BT_REAL, dd, REQUIRED);
+
+  add_sym_1 ("csqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dz, GFC_STD_F77,
+	     NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
+	     x, BT_COMPLEX, dz, REQUIRED);
+
+  add_sym_1 ("zsqrt", GFC_ISYM_SQRT, CLASS_ELEMENTAL, ACTUAL_YES, BT_COMPLEX, dd, GFC_STD_GNU,
+	     NULL, gfc_simplify_sqrt, gfc_resolve_sqrt,
+	     x, BT_COMPLEX, dd, REQUIRED);
+
+  make_alias ("cdsqrt", GFC_STD_GNU);
+
+  make_generic ("sqrt", GFC_ISYM_SQRT, GFC_STD_F77);
+
+  add_sym_2_intent ("stat", GFC_ISYM_STAT, CLASS_IMPURE, ACTUAL_NO,
+		    BT_INTEGER, di, GFC_STD_GNU,
+		    gfc_check_stat, NULL, gfc_resolve_stat,
+		    nm, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+		    vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
+
+  make_generic ("stat", GFC_ISYM_STAT, GFC_STD_GNU);
+
+  add_sym_2 ("storage_size", GFC_ISYM_STORAGE_SIZE, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_storage_size, NULL, gfc_resolve_storage_size,
+	     a, BT_UNKNOWN, 0, REQUIRED,
+	     kind, BT_INTEGER, di, OPTIONAL);
+  
+  add_sym_3red ("sum", GFC_ISYM_SUM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+		gfc_check_product_sum, gfc_simplify_sum, gfc_resolve_sum,
+		ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+		msk, BT_LOGICAL, dl, OPTIONAL);
+
+  make_generic ("sum", GFC_ISYM_SUM, GFC_STD_F95);
+
+  add_sym_2 ("symlnk", GFC_ISYM_SYMLNK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
+	     GFC_STD_GNU, gfc_check_symlnk, NULL, gfc_resolve_symlnk,
+	     p1, BT_CHARACTER, dc, REQUIRED, p2, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("symlnk", GFC_ISYM_SYMLNK, GFC_STD_GNU);
+
+  add_sym_1 ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
+	     GFC_STD_GNU, NULL, NULL, NULL,
+	     com, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("system", GFC_ISYM_SYSTEM, GFC_STD_GNU);
+
+  add_sym_1 ("tan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_fn_rc2008, gfc_simplify_tan, gfc_resolve_tan,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dtan", GFC_ISYM_TAN, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_tan, gfc_resolve_tan,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("tan", GFC_ISYM_TAN, GFC_STD_F77);
+
+  add_sym_1 ("tanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dr, GFC_STD_F77,
+	     gfc_check_fn_rc2008, gfc_simplify_tanh, gfc_resolve_tanh,
+	     x, BT_REAL, dr, REQUIRED);
+
+  add_sym_1 ("dtanh", GFC_ISYM_TANH, CLASS_ELEMENTAL, ACTUAL_YES, BT_REAL, dd, GFC_STD_F77,
+	     gfc_check_fn_d, gfc_simplify_tanh, gfc_resolve_tanh,
+	     x, BT_REAL, dd, REQUIRED);
+
+  make_generic ("tanh", GFC_ISYM_TANH, GFC_STD_F77);
+
+  add_sym_2 ("this_image", GFC_ISYM_THIS_IMAGE, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_this_image, gfc_simplify_this_image, gfc_resolve_this_image,
+	     ca, BT_REAL, dr, OPTIONAL, dm, BT_INTEGER, ii, OPTIONAL);
+
+  add_sym_0 ("time", GFC_ISYM_TIME, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time);
+
+  make_generic ("time", GFC_ISYM_TIME, GFC_STD_GNU);
+
+  add_sym_0 ("time8", GFC_ISYM_TIME8, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, NULL, NULL, gfc_resolve_time8);
+
+  make_generic ("time8", GFC_ISYM_TIME8, GFC_STD_GNU);
+
+  add_sym_1 ("tiny", GFC_ISYM_TINY, CLASS_INQUIRY, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_x, gfc_simplify_tiny, NULL,
+	     x, BT_REAL, dr, REQUIRED);
+
+  make_generic ("tiny", GFC_ISYM_TINY, GFC_STD_F95);
+
+  add_sym_1 ("trailz", GFC_ISYM_TRAILZ, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F2008,
+	     gfc_check_i, gfc_simplify_trailz, NULL,
+	     i, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("trailz", GFC_ISYM_TRAILZ, GFC_STD_F2008);
+
+  add_sym_3 ("transfer", GFC_ISYM_TRANSFER, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_transfer, gfc_simplify_transfer, gfc_resolve_transfer,
+	     src, BT_REAL, dr, REQUIRED, mo, BT_REAL, dr, REQUIRED,
+	     sz, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("transfer", GFC_ISYM_TRANSFER, GFC_STD_F95);
+
+  add_sym_1 ("transpose", GFC_ISYM_TRANSPOSE, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_transpose, gfc_simplify_transpose, gfc_resolve_transpose,
+	     m, BT_REAL, dr, REQUIRED);
+
+  make_generic ("transpose", GFC_ISYM_TRANSPOSE, GFC_STD_F95);
+
+  add_sym_1 ("trim", GFC_ISYM_TRIM, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_CHARACTER, dc, GFC_STD_F95,
+	     gfc_check_trim, gfc_simplify_trim, gfc_resolve_trim,
+	     stg, BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("trim", GFC_ISYM_TRIM, GFC_STD_F95);
+
+  add_sym_1 ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, ACTUAL_NO, BT_CHARACTER,
+	     0, GFC_STD_GNU, gfc_check_ttynam, NULL, gfc_resolve_ttynam,
+	     ut, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("ttynam", GFC_ISYM_TTYNAM, GFC_STD_GNU);
+
+  add_sym_3 ("ubound", GFC_ISYM_UBOUND, CLASS_INQUIRY, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_ubound, gfc_simplify_ubound, gfc_resolve_ubound,
+	     ar, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+	     kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("ubound", GFC_ISYM_UBOUND, GFC_STD_F95);
+
+  add_sym_3 ("ucobound", GFC_ISYM_UCOBOUND, CLASS_INQUIRY, ACTUAL_NO,
+	    BT_INTEGER, di, GFC_STD_F2008,
+	    gfc_check_ucobound, gfc_simplify_ucobound, gfc_resolve_ucobound,
+	    ca, BT_REAL, dr, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL,
+	    kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("ucobound", GFC_ISYM_UCOBOUND, GFC_STD_F2008);
+
+  /* g77 compatibility for UMASK.  */
+  add_sym_1 ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di,
+	     GFC_STD_GNU, gfc_check_umask, NULL, gfc_resolve_umask,
+	     msk, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("umask", GFC_ISYM_UMASK, GFC_STD_GNU);
+
+  /* g77 compatibility for UNLINK.  */
+  add_sym_1 ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER,
+	     di, GFC_STD_GNU, gfc_check_unlink, NULL, gfc_resolve_unlink,
+	     "path", BT_CHARACTER, dc, REQUIRED);
+
+  make_generic ("unlink", GFC_ISYM_UNLINK, GFC_STD_GNU);
+
+  add_sym_3 ("unpack", GFC_ISYM_UNPACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
+	     gfc_check_unpack, gfc_simplify_unpack, gfc_resolve_unpack,
+	     v, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
+	     f, BT_REAL, dr, REQUIRED);
+
+  make_generic ("unpack", GFC_ISYM_UNPACK, GFC_STD_F95);
+
+  add_sym_4 ("verify", GFC_ISYM_VERIFY, CLASS_ELEMENTAL, ACTUAL_NO,
+	     BT_INTEGER, di, GFC_STD_F95,
+	     gfc_check_verify, gfc_simplify_verify, gfc_resolve_verify,
+	     stg, BT_CHARACTER, dc, REQUIRED, set, BT_CHARACTER, dc, REQUIRED,
+	     bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
+
+  make_generic ("verify", GFC_ISYM_VERIFY, GFC_STD_F95);
+    
+  add_sym_1 ("loc", GFC_ISYM_LOC, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, ii,
+	     GFC_STD_GNU, gfc_check_loc, NULL, gfc_resolve_loc,
+	     x, BT_UNKNOWN, 0, REQUIRED);
+		
+  make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
+}
+
+
+/* Add intrinsic subroutines.  */
+
+static void
+add_subroutines (void)
+{
+  /* Argument names as in the standard (to be used as argument keywords).  */
+  const char
+    *h = "harvest", *dt = "date", *vl = "values", *pt = "put",
+    *c = "count", *tm = "time", *tp = "topos", *gt = "get",
+    *t = "to", *zn = "zone", *fp = "frompos", *cm = "count_max",
+    *f = "from", *sz = "size", *ln = "len", *cr = "count_rate",
+    *com = "command", *length = "length", *st = "status",
+    *val = "value", *num = "number", *name = "name",
+    *trim_name = "trim_name", *ut = "unit", *han = "handler",
+    *sec = "seconds", *res = "result", *of = "offset", *md = "mode",
+    *whence = "whence", *pos = "pos", *ptr = "ptr", *p1 = "path1",
+    *p2 = "path2", *msk = "mask", *old = "old";
+
+  int di, dr, dc, dl, ii;
+
+  di = gfc_default_integer_kind;
+  dr = gfc_default_real_kind;
+  dc = gfc_default_character_kind;
+  dl = gfc_default_logical_kind;
+  ii = gfc_index_integer_kind;
+
+  add_sym_0s ("abort", GFC_ISYM_ABORT, GFC_STD_GNU, NULL);
+
+  make_noreturn();
+
+  add_sym_1s ("cpu_time", GFC_ISYM_CPU_TIME, CLASS_IMPURE, BT_UNKNOWN, 0,
+	      GFC_STD_F95, gfc_check_cpu_time, NULL, gfc_resolve_cpu_time,
+	      tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
+
+  /* More G77 compatibility garbage.  */
+  add_sym_2s ("ctime", GFC_ISYM_CTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_ctime_sub, NULL, gfc_resolve_ctime_sub,
+	      tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      res, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
+
+  add_sym_1s ("idate", GFC_ISYM_IDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_itime_idate, NULL, gfc_resolve_idate,
+	      vl, BT_INTEGER, 4, REQUIRED, INTENT_OUT);
+
+  add_sym_1s ("itime", GFC_ISYM_ITIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_itime_idate, NULL, gfc_resolve_itime,
+	      vl, BT_INTEGER, 4, REQUIRED, INTENT_OUT);
+
+  add_sym_2s ("ltime", GFC_ISYM_LTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_ltime_gmtime, NULL, gfc_resolve_ltime,
+	      tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
+
+  add_sym_2s ("gmtime", GFC_ISYM_GMTIME, CLASS_IMPURE, BT_UNKNOWN, 0,
+	      GFC_STD_GNU, gfc_check_ltime_gmtime, NULL, gfc_resolve_gmtime,
+	      tm, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      vl, BT_INTEGER, di, REQUIRED, INTENT_OUT);
+
+  add_sym_1s ("second", GFC_ISYM_SECOND, CLASS_IMPURE, BT_UNKNOWN, 0,
+	      GFC_STD_GNU, gfc_check_second_sub, NULL, gfc_resolve_second_sub,
+	      tm, BT_REAL, dr, REQUIRED, INTENT_OUT);
+
+  add_sym_2s ("chdir", GFC_ISYM_CHDIR, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_chdir_sub, NULL, gfc_resolve_chdir_sub,
+	      name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_3s ("chmod", GFC_ISYM_CHMOD, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_chmod_sub, NULL, gfc_resolve_chmod_sub,
+	      name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      md, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_4s ("date_and_time", GFC_ISYM_DATE_AND_TIME, CLASS_IMPURE, BT_UNKNOWN,
+	      0, GFC_STD_F95, gfc_check_date_and_time, NULL, NULL,
+	      dt, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
+	      tm, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
+	      zn, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
+	      vl, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  /* More G77 compatibility garbage.  */
+  add_sym_2s ("etime", GFC_ISYM_ETIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_dtime_etime_sub, NULL, gfc_resolve_etime_sub,
+	      vl, BT_REAL, 4, REQUIRED, INTENT_OUT,
+	      tm, BT_REAL, 4, REQUIRED, INTENT_OUT);
+
+  add_sym_2s ("dtime", GFC_ISYM_DTIME, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_dtime_etime_sub, NULL, gfc_resolve_dtime_sub,
+	      vl, BT_REAL, 4, REQUIRED, INTENT_OUT,
+	      tm, BT_REAL, 4, REQUIRED, INTENT_OUT);
+
+  add_sym_5s ("execute_command_line", GFC_ISYM_EXECUTE_COMMAND_LINE,
+	      CLASS_IMPURE , BT_UNKNOWN, 0, GFC_STD_F2008,
+	      NULL, NULL, gfc_resolve_execute_command_line,
+	      "command", BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      "wait", BT_LOGICAL, dl, OPTIONAL, INTENT_IN,
+	      "exitstat", BT_INTEGER, di, OPTIONAL, INTENT_INOUT,
+	      "cmdstat", BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+	      "cmdmsg", BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT);
+
+  add_sym_1s ("fdate", GFC_ISYM_FDATE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_fdate_sub, NULL, gfc_resolve_fdate_sub,
+	      dt, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
+
+  add_sym_1s ("gerror", GFC_ISYM_GERROR, CLASS_IMPURE, BT_UNKNOWN,
+	      0, GFC_STD_GNU, gfc_check_gerror, NULL, gfc_resolve_gerror,
+	      res, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
+
+  add_sym_2s ("getcwd", GFC_ISYM_GETCWD, CLASS_IMPURE, BT_UNKNOWN, 0,
+	      GFC_STD_GNU, gfc_check_getcwd_sub, NULL, gfc_resolve_getcwd_sub,
+	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_2s ("getenv", GFC_ISYM_GETENV, CLASS_IMPURE, BT_UNKNOWN,
+	      0, GFC_STD_GNU, NULL, NULL, NULL,
+	      name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      val, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
+
+  add_sym_2s ("getarg", GFC_ISYM_GETARG, CLASS_IMPURE, BT_UNKNOWN,
+	      0, GFC_STD_GNU, gfc_check_getarg, NULL, gfc_resolve_getarg,
+	      pos, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      val, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
+
+  add_sym_1s ("getlog", GFC_ISYM_GETLOG, CLASS_IMPURE, BT_UNKNOWN,
+	      0, GFC_STD_GNU, gfc_check_getlog, NULL, gfc_resolve_getlog,
+	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
+
+  /* F2003 commandline routines.  */
+
+  add_sym_3s ("get_command", GFC_ISYM_GET_COMMAND, CLASS_IMPURE,
+	      BT_UNKNOWN, 0, GFC_STD_F2003,
+	      NULL, NULL, gfc_resolve_get_command,
+	      com, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
+	      length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_4s ("get_command_argument", GFC_ISYM_GET_COMMAND_ARGUMENT,
+	      CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003, NULL, NULL,
+	      gfc_resolve_get_command_argument,
+	      num, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
+	      length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  /* F2003 subroutine to get environment variables.  */
+
+  add_sym_5s ("get_environment_variable", GFC_ISYM_GET_ENVIRONMENT_VARIABLE,
+	      CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_F2003,
+	      NULL, NULL, gfc_resolve_get_environment_variable,
+	      name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      val, BT_CHARACTER, dc, OPTIONAL, INTENT_OUT,
+	      length, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+	      trim_name, BT_LOGICAL, dl, OPTIONAL, INTENT_IN);
+
+  add_sym_2s ("move_alloc", GFC_ISYM_MOVE_ALLOC, CLASS_PURE, BT_UNKNOWN, 0,
+	      GFC_STD_F2003,
+	      gfc_check_move_alloc, NULL, NULL,
+	      f, BT_UNKNOWN, 0, REQUIRED, INTENT_INOUT,
+	      t, BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
+
+  add_sym_5s ("mvbits", GFC_ISYM_MVBITS, CLASS_ELEMENTAL, BT_UNKNOWN, 0,
+	      GFC_STD_F95, gfc_check_mvbits, gfc_simplify_mvbits,
+	      gfc_resolve_mvbits,
+	      f, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      fp, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      ln, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      t, BT_INTEGER, di, REQUIRED, INTENT_INOUT,
+	      tp, BT_INTEGER, di, REQUIRED, INTENT_IN);
+
+  add_sym_1s ("random_number", GFC_ISYM_RANDOM_NUMBER, CLASS_IMPURE,
+	      BT_UNKNOWN, 0, GFC_STD_F95,
+	      gfc_check_random_number, NULL, gfc_resolve_random_number,
+	      h, BT_REAL, dr, REQUIRED, INTENT_OUT);
+
+  add_sym_3s ("random_seed", GFC_ISYM_RANDOM_SEED, CLASS_IMPURE,
+	      BT_UNKNOWN, 0, GFC_STD_F95,
+	      gfc_check_random_seed, NULL, gfc_resolve_random_seed,
+	      sz, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+	      pt, BT_INTEGER, di, OPTIONAL, INTENT_IN,
+	      gt, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  /* More G77 compatibility garbage.  */
+  add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
+	      sec, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      han, BT_UNKNOWN, 0, REQUIRED, INTENT_IN,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_1s ("srand", GFC_ISYM_SRAND, CLASS_IMPURE, BT_UNKNOWN,
+	      di, GFC_STD_GNU, gfc_check_srand, NULL, gfc_resolve_srand,
+	      "seed", BT_INTEGER, 4, REQUIRED, INTENT_IN);
+
+  add_sym_1s ("exit", GFC_ISYM_EXIT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_exit, NULL, gfc_resolve_exit,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_IN);
+
+  make_noreturn();
+
+  add_sym_3s ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
+	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_2s ("fget", GFC_ISYM_FGET, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
+	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_1s ("flush", GFC_ISYM_FLUSH, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_flush, NULL, gfc_resolve_flush,
+	      ut, BT_INTEGER, di, OPTIONAL, INTENT_IN);
+
+  add_sym_3s ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
+	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      c, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_2s ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
+	      c, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_1s ("free", GFC_ISYM_FREE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_free, NULL, gfc_resolve_free,
+	      ptr, BT_INTEGER, ii, REQUIRED, INTENT_INOUT);
+
+  add_sym_4s ("fseek", GFC_ISYM_FSEEK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_fseek_sub, NULL, gfc_resolve_fseek_sub,
+	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      of, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      whence, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_2s ("ftell", GFC_ISYM_FTELL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_ftell_sub, NULL, gfc_resolve_ftell_sub,
+	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      of, BT_INTEGER, ii, REQUIRED, INTENT_OUT);
+
+  add_sym_2s ("hostnm", GFC_ISYM_HOSTNM, CLASS_IMPURE, BT_UNKNOWN, 0,
+	      GFC_STD_GNU, gfc_check_hostnm_sub, NULL, gfc_resolve_hostnm_sub,
+	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_3s ("kill", GFC_ISYM_KILL, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_kill_sub, NULL, gfc_resolve_kill_sub,
+	      c, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      val, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_3s ("link", GFC_ISYM_LINK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_link_sub, NULL, gfc_resolve_link_sub,
+	      p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_1s ("perror", GFC_ISYM_PERROR, CLASS_IMPURE, BT_UNKNOWN,
+	      0, GFC_STD_GNU, gfc_check_perror, NULL, gfc_resolve_perror,
+	      "string", BT_CHARACTER, dc, REQUIRED, INTENT_IN);
+
+  add_sym_3s ("rename", GFC_ISYM_RENAME, CLASS_IMPURE, BT_UNKNOWN, 0,
+	      GFC_STD_GNU, gfc_check_rename_sub, NULL, gfc_resolve_rename_sub,
+	      p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_1s ("sleep", GFC_ISYM_SLEEP, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_sleep_sub, NULL, gfc_resolve_sleep_sub,
+	      sec, BT_INTEGER, di, REQUIRED, INTENT_IN);
+
+  add_sym_3s ("fstat", GFC_ISYM_FSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_fstat_sub, NULL, gfc_resolve_fstat_sub,
+	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_3s ("lstat", GFC_ISYM_LSTAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_stat_sub, NULL, gfc_resolve_lstat_sub,
+	      name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_3s ("stat", GFC_ISYM_STAT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_stat_sub, NULL, gfc_resolve_stat_sub,
+	      name, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      vl, BT_INTEGER, di, REQUIRED, INTENT_OUT,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_3s ("signal", GFC_ISYM_SIGNAL, CLASS_IMPURE, BT_UNKNOWN, 0,
+	      GFC_STD_GNU, gfc_check_signal_sub, NULL, gfc_resolve_signal_sub,
+	      num, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      han, BT_UNKNOWN, 0, REQUIRED, INTENT_IN,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_3s ("symlnk", GFC_ISYM_SYMLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
+	      GFC_STD_GNU, gfc_check_symlnk_sub, NULL, gfc_resolve_symlnk_sub,
+	      p1, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      p2, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_2s ("system", GFC_ISYM_SYSTEM, CLASS_IMPURE, BT_UNKNOWN,
+	      0, GFC_STD_GNU, NULL, NULL, gfc_resolve_system_sub,
+	      com, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_3s ("system_clock", GFC_ISYM_SYSTEM_CLOCK, CLASS_IMPURE,
+	      BT_UNKNOWN, 0, GFC_STD_F95,
+	      gfc_check_system_clock, NULL, gfc_resolve_system_clock,
+	      c, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+	      cr, BT_INTEGER, di, OPTIONAL, INTENT_OUT,
+	      cm, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_2s ("ttynam", GFC_ISYM_TTYNAM, CLASS_IMPURE, BT_UNKNOWN, 0,
+	      GFC_STD_GNU, gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub,
+	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      name, BT_CHARACTER, dc, REQUIRED, INTENT_OUT);
+
+  add_sym_2s ("umask", GFC_ISYM_UMASK, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
+	      gfc_check_umask_sub, NULL, gfc_resolve_umask_sub,
+	      msk, BT_INTEGER, di, REQUIRED, INTENT_IN,
+	      old, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+
+  add_sym_2s ("unlink", GFC_ISYM_UNLINK, CLASS_IMPURE, BT_UNKNOWN, 0,
+	      GFC_STD_GNU, gfc_check_unlink_sub, NULL, gfc_resolve_unlink_sub,
+	      "path", BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
+}
+
+
+/* Add a function to the list of conversion symbols.  */
+
+static void
+add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
+{
+  gfc_typespec from, to;
+  gfc_intrinsic_sym *sym;
+
+  if (sizing == SZ_CONVS)
+    {
+      nconv++;
+      return;
+    }
+
+  gfc_clear_ts (&from);
+  from.type = from_type;
+  from.kind = from_kind;
+
+  gfc_clear_ts (&to);
+  to.type = to_type;
+  to.kind = to_kind;
+
+  sym = conversion + nconv;
+
+  sym->name = conv_name (&from, &to);
+  sym->lib_name = sym->name;
+  sym->simplify.cc = gfc_convert_constant;
+  sym->standard = standard;
+  sym->elemental = 1;
+  sym->pure = 1;
+  sym->conversion = 1;
+  sym->ts = to;
+  sym->id = GFC_ISYM_CONVERSION;
+
+  nconv++;
+}
+
+
+/* Create gfc_intrinsic_sym nodes for all intrinsic conversion
+   functions by looping over the kind tables.  */
+
+static void
+add_conversions (void)
+{
+  int i, j;
+
+  /* Integer-Integer conversions.  */
+  for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+    for (j = 0; gfc_integer_kinds[j].kind != 0; j++)
+      {
+	if (i == j)
+	  continue;
+
+	add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
+		  BT_INTEGER, gfc_integer_kinds[j].kind, GFC_STD_F77);
+      }
+
+  /* Integer-Real/Complex conversions.  */
+  for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+    for (j = 0; gfc_real_kinds[j].kind != 0; j++)
+      {
+	add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
+		  BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
+
+	add_conv (BT_REAL, gfc_real_kinds[j].kind,
+		  BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
+
+	add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
+		  BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
+
+	add_conv (BT_COMPLEX, gfc_real_kinds[j].kind,
+		  BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_F77);
+      }
+
+  if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
+    {
+      /* Hollerith-Integer conversions.  */
+      for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+	add_conv (BT_HOLLERITH, gfc_default_character_kind,
+		  BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
+      /* Hollerith-Real conversions.  */
+      for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+	add_conv (BT_HOLLERITH, gfc_default_character_kind,
+		  BT_REAL, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
+      /* Hollerith-Complex conversions.  */
+      for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+	add_conv (BT_HOLLERITH, gfc_default_character_kind,
+		  BT_COMPLEX, gfc_real_kinds[i].kind, GFC_STD_LEGACY);
+
+      /* Hollerith-Character conversions.  */
+      add_conv (BT_HOLLERITH, gfc_default_character_kind, BT_CHARACTER,
+		  gfc_default_character_kind, GFC_STD_LEGACY);
+
+      /* Hollerith-Logical conversions.  */
+      for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
+	add_conv (BT_HOLLERITH, gfc_default_character_kind,
+		  BT_LOGICAL, gfc_logical_kinds[i].kind, GFC_STD_LEGACY);
+    }
+
+  /* Real/Complex - Real/Complex conversions.  */
+  for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+    for (j = 0; gfc_real_kinds[j].kind != 0; j++)
+      {
+	if (i != j)
+	  {
+	    add_conv (BT_REAL, gfc_real_kinds[i].kind,
+		      BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
+
+	    add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
+		      BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
+	  }
+
+	add_conv (BT_REAL, gfc_real_kinds[i].kind,
+		  BT_COMPLEX, gfc_real_kinds[j].kind, GFC_STD_F77);
+
+	add_conv (BT_COMPLEX, gfc_real_kinds[i].kind,
+		  BT_REAL, gfc_real_kinds[j].kind, GFC_STD_F77);
+      }
+
+  /* Logical/Logical kind conversion.  */
+  for (i = 0; gfc_logical_kinds[i].kind; i++)
+    for (j = 0; gfc_logical_kinds[j].kind; j++)
+      {
+	if (i == j)
+	  continue;
+
+	add_conv (BT_LOGICAL, gfc_logical_kinds[i].kind,
+		  BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_F77);
+      }
+
+  /* Integer-Logical and Logical-Integer conversions.  */
+  if ((gfc_option.allow_std & GFC_STD_LEGACY) != 0)
+    for (i=0; gfc_integer_kinds[i].kind; i++)
+      for (j=0; gfc_logical_kinds[j].kind; j++)
+	{
+	  add_conv (BT_INTEGER, gfc_integer_kinds[i].kind,
+		    BT_LOGICAL, gfc_logical_kinds[j].kind, GFC_STD_LEGACY);
+	  add_conv (BT_LOGICAL, gfc_logical_kinds[j].kind,
+		    BT_INTEGER, gfc_integer_kinds[i].kind, GFC_STD_LEGACY);
+	}
+}
+
+
+static void
+add_char_conversions (void)
+{
+  int n, i, j;
+
+  /* Count possible conversions.  */
+  for (i = 0; gfc_character_kinds[i].kind != 0; i++)
+    for (j = 0; gfc_character_kinds[j].kind != 0; j++)
+      if (i != j)
+	ncharconv++;
+
+  /* Allocate memory.  */
+  char_conversions = XCNEWVEC (gfc_intrinsic_sym, ncharconv);
+
+  /* Add the conversions themselves.  */
+  n = 0;
+  for (i = 0; gfc_character_kinds[i].kind != 0; i++)
+    for (j = 0; gfc_character_kinds[j].kind != 0; j++)
+      {
+	gfc_typespec from, to;
+
+	if (i == j)
+	  continue;
+
+	gfc_clear_ts (&from);
+	from.type = BT_CHARACTER;
+	from.kind = gfc_character_kinds[i].kind;
+
+	gfc_clear_ts (&to);
+	to.type = BT_CHARACTER;
+	to.kind = gfc_character_kinds[j].kind;
+
+	char_conversions[n].name = conv_name (&from, &to);
+	char_conversions[n].lib_name = char_conversions[n].name;
+	char_conversions[n].simplify.cc = gfc_convert_char_constant;
+	char_conversions[n].standard = GFC_STD_F2003;
+	char_conversions[n].elemental = 1;
+	char_conversions[n].pure = 1;
+	char_conversions[n].conversion = 0;
+	char_conversions[n].ts = to;
+	char_conversions[n].id = GFC_ISYM_CONVERSION;
+
+	n++;
+      }
+}
+
+
+/* Initialize the table of intrinsics.  */
+void
+gfc_intrinsic_init_1 (void)
+{
+  nargs = nfunc = nsub = nconv = 0;
+
+  /* Create a namespace to hold the resolved intrinsic symbols.  */
+  gfc_intrinsic_namespace = gfc_get_namespace (NULL, 0);
+
+  sizing = SZ_FUNCS;
+  add_functions ();
+  sizing = SZ_SUBS;
+  add_subroutines ();
+  sizing = SZ_CONVS;
+  add_conversions ();
+
+  functions = XCNEWVAR (struct gfc_intrinsic_sym,
+			sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
+			+ sizeof (gfc_intrinsic_arg) * nargs);
+
+  next_sym = functions;
+  subroutines = functions + nfunc;
+
+  conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
+
+  next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
+
+  sizing = SZ_NOTHING;
+  nconv = 0;
+
+  add_functions ();
+  add_subroutines ();
+  add_conversions ();
+
+  /* Character conversion intrinsics need to be treated separately.  */
+  add_char_conversions ();
+}
+
+
+void
+gfc_intrinsic_done_1 (void)
+{
+  gfc_free (functions);
+  gfc_free (conversion);
+  gfc_free (char_conversions);
+  gfc_free_namespace (gfc_intrinsic_namespace);
+}
+
+
+/******** Subroutines to check intrinsic interfaces ***********/
+
+/* Given a formal argument list, remove any NULL arguments that may
+   have been left behind by a sort against some formal argument list.  */
+
+static void
+remove_nullargs (gfc_actual_arglist **ap)
+{
+  gfc_actual_arglist *head, *tail, *next;
+
+  tail = NULL;
+
+  for (head = *ap; head; head = next)
+    {
+      next = head->next;
+
+      if (head->expr == NULL && !head->label)
+	{
+	  head->next = NULL;
+	  gfc_free_actual_arglist (head);
+	}
+      else
+	{
+	  if (tail == NULL)
+	    *ap = head;
+	  else
+	    tail->next = head;
+
+	  tail = head;
+	  tail->next = NULL;
+	}
+    }
+
+  if (tail == NULL)
+    *ap = NULL;
+}
+
+
+/* Given an actual arglist and a formal arglist, sort the actual
+   arglist so that its arguments are in a one-to-one correspondence
+   with the format arglist.  Arguments that are not present are given
+   a blank gfc_actual_arglist structure.  If something is obviously
+   wrong (say, a missing required argument) we abort sorting and
+   return FAILURE.  */
+
+static gfc_try
+sort_actual (const char *name, gfc_actual_arglist **ap,
+	     gfc_intrinsic_arg *formal, locus *where)
+{
+  gfc_actual_arglist *actual, *a;
+  gfc_intrinsic_arg *f;
+
+  remove_nullargs (ap);
+  actual = *ap;
+
+  for (f = formal; f; f = f->next)
+    f->actual = NULL;
+
+  f = formal;
+  a = actual;
+
+  if (f == NULL && a == NULL)	/* No arguments */
+    return SUCCESS;
+
+  for (;;)
+    {		/* Put the nonkeyword arguments in a 1:1 correspondence */
+      if (f == NULL)
+	break;
+      if (a == NULL)
+	goto optional;
+
+      if (a->name != NULL)
+	goto keywords;
+
+      f->actual = a;
+
+      f = f->next;
+      a = a->next;
+    }
+
+  if (a == NULL)
+    goto do_sort;
+
+  gfc_error ("Too many arguments in call to '%s' at %L", name, where);
+  return FAILURE;
+
+keywords:
+  /* Associate the remaining actual arguments, all of which have
+     to be keyword arguments.  */
+  for (; a; a = a->next)
+    {
+      for (f = formal; f; f = f->next)
+	if (strcmp (a->name, f->name) == 0)
+	  break;
+
+      if (f == NULL)
+	{
+	  if (a->name[0] == '%')
+	    gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
+		       "are not allowed in this context at %L", where);
+	  else
+	    gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
+		       a->name, name, where);
+	  return FAILURE;
+	}
+
+      if (f->actual != NULL)
+	{
+	  gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
+		     f->name, name, where);
+	  return FAILURE;
+	}
+
+      f->actual = a;
+    }
+
+optional:
+  /* At this point, all unmatched formal args must be optional.  */
+  for (f = formal; f; f = f->next)
+    {
+      if (f->actual == NULL && f->optional == 0)
+	{
+	  gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
+		     f->name, name, where);
+	  return FAILURE;
+	}
+    }
+
+do_sort:
+  /* Using the formal argument list, string the actual argument list
+     together in a way that corresponds with the formal list.  */
+  actual = NULL;
+
+  for (f = formal; f; f = f->next)
+    {
+      if (f->actual && f->actual->label != NULL && f->ts.type)
+	{
+	  gfc_error ("ALTERNATE RETURN not permitted at %L", where);
+	  return FAILURE;
+	}
+
+      if (f->actual == NULL)
+	{
+	  a = gfc_get_actual_arglist ();
+	  a->missing_arg_type = f->ts.type;
+	}
+      else
+	a = f->actual;
+
+      if (actual == NULL)
+	*ap = a;
+      else
+	actual->next = a;
+
+      actual = a;
+    }
+  actual->next = NULL;		/* End the sorted argument list.  */
+
+  return SUCCESS;
+}
+
+
+/* Compare an actual argument list with an intrinsic's formal argument
+   list.  The lists are checked for agreement of type.  We don't check
+   for arrayness here.  */
+
+static gfc_try
+check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
+	       int error_flag)
+{
+  gfc_actual_arglist *actual;
+  gfc_intrinsic_arg *formal;
+  int i;
+
+  formal = sym->formal;
+  actual = *ap;
+
+  i = 0;
+  for (; formal; formal = formal->next, actual = actual->next, i++)
+    {
+      gfc_typespec ts;
+
+      if (actual->expr == NULL)
+	continue;
+
+      ts = formal->ts;
+
+      /* A kind of 0 means we don't check for kind.  */
+      if (ts.kind == 0)
+	ts.kind = actual->expr->ts.kind;
+
+      if (!gfc_compare_types (&ts, &actual->expr->ts))
+	{
+	  if (error_flag)
+	    gfc_error ("Type of argument '%s' in call to '%s' at %L should "
+		       "be %s, not %s", gfc_current_intrinsic_arg[i]->name,
+		       gfc_current_intrinsic, &actual->expr->where,
+		       gfc_typename (&formal->ts),
+		       gfc_typename (&actual->expr->ts));
+	  return FAILURE;
+	}
+
+      /* If the formal argument is INTENT([IN]OUT), check for definability.  */
+      if (formal->intent == INTENT_INOUT || formal->intent == INTENT_OUT)
+	{
+	  const char* context = (error_flag
+				 ? _("actual argument to INTENT = OUT/INOUT")
+				 : NULL);
+
+	  /* No pointer arguments for intrinsics.  */
+	  if (gfc_check_vardef_context (actual->expr, false, context)
+		== FAILURE)
+	    return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* Given a pointer to an intrinsic symbol and an expression node that
+   represent the function call to that subroutine, figure out the type
+   of the result.  This may involve calling a resolution subroutine.  */
+
+static void
+resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
+{
+  gfc_expr *a1, *a2, *a3, *a4, *a5;
+  gfc_actual_arglist *arg;
+
+  if (specific->resolve.f1 == NULL)
+    {
+      if (e->value.function.name == NULL)
+	e->value.function.name = specific->lib_name;
+
+      if (e->ts.type == BT_UNKNOWN)
+	e->ts = specific->ts;
+      return;
+    }
+
+  arg = e->value.function.actual;
+
+  /* Special case hacks for MIN and MAX.  */
+  if (specific->resolve.f1m == gfc_resolve_max
+      || specific->resolve.f1m == gfc_resolve_min)
+    {
+      (*specific->resolve.f1m) (e, arg);
+      return;
+    }
+
+  if (arg == NULL)
+    {
+      (*specific->resolve.f0) (e);
+      return;
+    }
+
+  a1 = arg->expr;
+  arg = arg->next;
+
+  if (arg == NULL)
+    {
+      (*specific->resolve.f1) (e, a1);
+      return;
+    }
+
+  a2 = arg->expr;
+  arg = arg->next;
+
+  if (arg == NULL)
+    {
+      (*specific->resolve.f2) (e, a1, a2);
+      return;
+    }
+
+  a3 = arg->expr;
+  arg = arg->next;
+
+  if (arg == NULL)
+    {
+      (*specific->resolve.f3) (e, a1, a2, a3);
+      return;
+    }
+
+  a4 = arg->expr;
+  arg = arg->next;
+
+  if (arg == NULL)
+    {
+      (*specific->resolve.f4) (e, a1, a2, a3, a4);
+      return;
+    }
+
+  a5 = arg->expr;
+  arg = arg->next;
+
+  if (arg == NULL)
+    {
+      (*specific->resolve.f5) (e, a1, a2, a3, a4, a5);
+      return;
+    }
+
+  gfc_internal_error ("resolve_intrinsic(): Too many args for intrinsic");
+}
+
+
+/* Given an intrinsic symbol node and an expression node, call the
+   simplification function (if there is one), perhaps replacing the
+   expression with something simpler.  We return FAILURE on an error
+   of the simplification, SUCCESS if the simplification worked, even
+   if nothing has changed in the expression itself.  */
+
+static gfc_try
+do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
+{
+  gfc_expr *result, *a1, *a2, *a3, *a4, *a5;
+  gfc_actual_arglist *arg;
+
+  /* Max and min require special handling due to the variable number
+     of args.  */
+  if (specific->simplify.f1 == gfc_simplify_min)
+    {
+      result = gfc_simplify_min (e);
+      goto finish;
+    }
+
+  if (specific->simplify.f1 == gfc_simplify_max)
+    {
+      result = gfc_simplify_max (e);
+      goto finish;
+    }
+
+  if (specific->simplify.f1 == NULL)
+    {
+      result = NULL;
+      goto finish;
+    }
+
+  arg = e->value.function.actual;
+
+  if (arg == NULL)
+    {
+      result = (*specific->simplify.f0) ();
+      goto finish;
+    }
+
+  a1 = arg->expr;
+  arg = arg->next;
+
+  if (specific->simplify.cc == gfc_convert_constant
+      || specific->simplify.cc == gfc_convert_char_constant)
+    {
+      result = specific->simplify.cc (a1, specific->ts.type, specific->ts.kind);
+      goto finish;
+    }
+
+  if (arg == NULL)
+    result = (*specific->simplify.f1) (a1);
+  else
+    {
+      a2 = arg->expr;
+      arg = arg->next;
+
+      if (arg == NULL)
+	result = (*specific->simplify.f2) (a1, a2);
+      else
+	{
+	  a3 = arg->expr;
+	  arg = arg->next;
+
+	  if (arg == NULL)
+	    result = (*specific->simplify.f3) (a1, a2, a3);
+	  else
+	    {
+	      a4 = arg->expr;
+	      arg = arg->next;
+
+	      if (arg == NULL)
+		result = (*specific->simplify.f4) (a1, a2, a3, a4);
+	      else
+		{
+		  a5 = arg->expr;
+		  arg = arg->next;
+
+		  if (arg == NULL)
+		    result = (*specific->simplify.f5) (a1, a2, a3, a4, a5);
+		  else
+		    gfc_internal_error
+		      ("do_simplify(): Too many args for intrinsic");
+		}
+	    }
+	}
+    }
+
+finish:
+  if (result == &gfc_bad_expr)
+    return FAILURE;
+
+  if (result == NULL)
+    resolve_intrinsic (specific, e);	/* Must call at run-time */
+  else
+    {
+      result->where = e->where;
+      gfc_replace_expr (e, result);
+    }
+
+  return SUCCESS;
+}
+
+
+/* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
+   error messages.  This subroutine returns FAILURE if a subroutine
+   has more than MAX_INTRINSIC_ARGS, in which case the actual argument
+   list cannot match any intrinsic.  */
+
+static void
+init_arglist (gfc_intrinsic_sym *isym)
+{
+  gfc_intrinsic_arg *formal;
+  int i;
+
+  gfc_current_intrinsic = isym->name;
+
+  i = 0;
+  for (formal = isym->formal; formal; formal = formal->next)
+    {
+      if (i >= MAX_INTRINSIC_ARGS)
+	gfc_internal_error ("init_arglist(): too many arguments");
+      gfc_current_intrinsic_arg[i++] = formal;
+    }
+}
+
+
+/* Given a pointer to an intrinsic symbol and an expression consisting
+   of a function call, see if the function call is consistent with the
+   intrinsic's formal argument list.  Return SUCCESS if the expression
+   and intrinsic match, FAILURE otherwise.  */
+
+static gfc_try
+check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
+{
+  gfc_actual_arglist *arg, **ap;
+  gfc_try t;
+
+  ap = &expr->value.function.actual;
+
+  init_arglist (specific);
+
+  /* Don't attempt to sort the argument list for min or max.  */
+  if (specific->check.f1m == gfc_check_min_max
+      || specific->check.f1m == gfc_check_min_max_integer
+      || specific->check.f1m == gfc_check_min_max_real
+      || specific->check.f1m == gfc_check_min_max_double)
+    return (*specific->check.f1m) (*ap);
+
+  if (sort_actual (specific->name, ap, specific->formal,
+		   &expr->where) == FAILURE)
+    return FAILURE;
+
+  if (specific->check.f3ml == gfc_check_minloc_maxloc)
+    /* This is special because we might have to reorder the argument list.  */
+    t = gfc_check_minloc_maxloc (*ap);
+  else if (specific->check.f3red == gfc_check_minval_maxval)
+    /* This is also special because we also might have to reorder the
+       argument list.  */
+    t = gfc_check_minval_maxval (*ap);
+  else if (specific->check.f3red == gfc_check_product_sum)
+    /* Same here. The difference to the previous case is that we allow a
+       general numeric type.  */
+    t = gfc_check_product_sum (*ap);
+  else if (specific->check.f3red == gfc_check_transf_bit_intrins)
+    /* Same as for PRODUCT and SUM, but different checks.  */
+    t = gfc_check_transf_bit_intrins (*ap);
+  else
+     {
+       if (specific->check.f1 == NULL)
+	 {
+	   t = check_arglist (ap, specific, error_flag);
+	   if (t == SUCCESS)
+	     expr->ts = specific->ts;
+	 }
+       else
+	 t = do_check (specific, *ap);
+     }
+
+  /* Check conformance of elemental intrinsics.  */
+  if (t == SUCCESS && specific->elemental)
+    {
+      int n = 0;
+      gfc_expr *first_expr;
+      arg = expr->value.function.actual;
+
+      /* There is no elemental intrinsic without arguments.  */
+      gcc_assert(arg != NULL);
+      first_expr = arg->expr;
+
+      for ( ; arg && arg->expr; arg = arg->next, n++)
+	if (gfc_check_conformance (first_expr, arg->expr,
+				   "arguments '%s' and '%s' for "
+				   "intrinsic '%s'",
+				   gfc_current_intrinsic_arg[0]->name,
+				   gfc_current_intrinsic_arg[n]->name,
+				   gfc_current_intrinsic) == FAILURE)
+	  return FAILURE;
+    }
+
+  if (t == FAILURE)
+    remove_nullargs (ap);
+
+  return t;
+}
+
+
+/* Check whether an intrinsic belongs to whatever standard the user
+   has chosen, taking also into account -fall-intrinsics.  Here, no
+   warning/error is emitted; but if symstd is not NULL, it is pointed to a
+   textual representation of the symbols standard status (like
+   "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
+   can be used to construct a detailed warning/error message in case of
+   a FAILURE.  */
+
+gfc_try
+gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
+			      const char** symstd, bool silent, locus where)
+{
+  const char* symstd_msg;
+
+  /* For -fall-intrinsics, just succeed.  */
+  if (gfc_option.flag_all_intrinsics)
+    return SUCCESS;
+
+  /* Find the symbol's standard message for later usage.  */
+  switch (isym->standard)
+    {
+    case GFC_STD_F77:
+      symstd_msg = "available since Fortran 77";
+      break;
+
+    case GFC_STD_F95_OBS:
+      symstd_msg = "obsolescent in Fortran 95";
+      break;
+
+    case GFC_STD_F95_DEL:
+      symstd_msg = "deleted in Fortran 95";
+      break;
+
+    case GFC_STD_F95:
+      symstd_msg = "new in Fortran 95";
+      break;
+
+    case GFC_STD_F2003:
+      symstd_msg = "new in Fortran 2003";
+      break;
+
+    case GFC_STD_F2008:
+      symstd_msg = "new in Fortran 2008";
+      break;
+
+    case GFC_STD_GNU:
+      symstd_msg = "a GNU Fortran extension";
+      break;
+
+    case GFC_STD_LEGACY:
+      symstd_msg = "for backward compatibility";
+      break;
+
+    default:
+      gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
+			  isym->name, isym->standard);
+    }
+
+  /* If warning about the standard, warn and succeed.  */
+  if (gfc_option.warn_std & isym->standard)
+    {
+      /* Do only print a warning if not a GNU extension.  */
+      if (!silent && isym->standard != GFC_STD_GNU)
+	gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
+		     isym->name, _(symstd_msg), &where);
+
+      return SUCCESS;
+    }
+
+  /* If allowing the symbol's standard, succeed, too.  */
+  if (gfc_option.allow_std & isym->standard)
+    return SUCCESS;
+
+  /* Otherwise, fail.  */
+  if (symstd)
+    *symstd = _(symstd_msg);
+  return FAILURE;
+}
+
+
+/* See if a function call corresponds to an intrinsic function call.
+   We return:
+
+    MATCH_YES    if the call corresponds to an intrinsic, simplification
+		 is done if possible.
+
+    MATCH_NO     if the call does not correspond to an intrinsic
+
+    MATCH_ERROR  if the call corresponds to an intrinsic but there was an
+		 error during the simplification process.
+
+   The error_flag parameter enables an error reporting.  */
+
+match
+gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
+{
+  gfc_intrinsic_sym *isym, *specific;
+  gfc_actual_arglist *actual;
+  const char *name;
+  int flag;
+
+  if (expr->value.function.isym != NULL)
+    return (do_simplify (expr->value.function.isym, expr) == FAILURE)
+	   ? MATCH_ERROR : MATCH_YES;
+
+  if (!error_flag)
+    gfc_push_suppress_errors ();
+  flag = 0;
+
+  for (actual = expr->value.function.actual; actual; actual = actual->next)
+    if (actual->expr != NULL)
+      flag |= (actual->expr->ts.type != BT_INTEGER
+	       && actual->expr->ts.type != BT_CHARACTER);
+
+  name = expr->symtree->n.sym->name;
+
+  if (expr->symtree->n.sym->intmod_sym_id)
+    {
+      int id = expr->symtree->n.sym->intmod_sym_id;
+      isym = specific = gfc_intrinsic_function_by_id ((gfc_isym_id) id);
+    }
+  else
+    isym = specific = gfc_find_function (name);
+
+  if (isym == NULL)
+    {
+      if (!error_flag)
+	gfc_pop_suppress_errors ();
+      return MATCH_NO;
+    }
+
+  if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
+       || isym->id == GFC_ISYM_CMPLX)
+      && gfc_init_expr_flag
+      && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Function '%s' "
+			 "as initialization expression at %L", name,
+			 &expr->where) == FAILURE)
+    {
+      if (!error_flag)
+	gfc_pop_suppress_errors ();
+      return MATCH_ERROR;
+    }
+
+  gfc_current_intrinsic_where = &expr->where;
+
+  /* Bypass the generic list for min and max.  */
+  if (isym->check.f1m == gfc_check_min_max)
+    {
+      init_arglist (isym);
+
+      if (gfc_check_min_max (expr->value.function.actual) == SUCCESS)
+	goto got_specific;
+
+      if (!error_flag)
+	gfc_pop_suppress_errors ();
+      return MATCH_NO;
+    }
+
+  /* If the function is generic, check all of its specific
+     incarnations.  If the generic name is also a specific, we check
+     that name last, so that any error message will correspond to the
+     specific.  */
+  gfc_push_suppress_errors ();
+
+  if (isym->generic)
+    {
+      for (specific = isym->specific_head; specific;
+	   specific = specific->next)
+	{
+	  if (specific == isym)
+	    continue;
+	  if (check_specific (specific, expr, 0) == SUCCESS)
+	    {
+	      gfc_pop_suppress_errors ();
+	      goto got_specific;
+	    }
+	}
+    }
+
+  gfc_pop_suppress_errors ();
+
+  if (check_specific (isym, expr, error_flag) == FAILURE)
+    {
+      if (!error_flag)
+	gfc_pop_suppress_errors ();
+      return MATCH_NO;
+    }
+
+  specific = isym;
+
+got_specific:
+  expr->value.function.isym = specific;
+  gfc_intrinsic_symbol (expr->symtree->n.sym);
+
+  if (!error_flag)
+    gfc_pop_suppress_errors ();
+
+  if (do_simplify (specific, expr) == FAILURE)
+    return MATCH_ERROR;
+
+  /* F95, 7.1.6.1, Initialization expressions
+     (4) An elemental intrinsic function reference of type integer or
+         character where each argument is an initialization expression
+         of type integer or character
+
+     F2003, 7.1.7 Initialization expression
+     (4)   A reference to an elemental standard intrinsic function,
+           where each argument is an initialization expression  */
+
+  if (gfc_init_expr_flag && isym->elemental && flag
+      && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Elemental function "
+			"as initialization expression with non-integer/non-"
+		        "character arguments at %L", &expr->where) == FAILURE)
+    return MATCH_ERROR;
+
+  return MATCH_YES;
+}
+
+
+/* See if a CALL statement corresponds to an intrinsic subroutine.
+   Returns MATCH_YES if the subroutine corresponds to an intrinsic,
+   MATCH_NO if not, and MATCH_ERROR if there was an error (but did
+   correspond).  */
+
+match
+gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
+{
+  gfc_intrinsic_sym *isym;
+  const char *name;
+
+  name = c->symtree->n.sym->name;
+
+  isym = gfc_find_subroutine (name);
+  if (isym == NULL)
+    return MATCH_NO;
+
+  if (!error_flag)
+    gfc_push_suppress_errors ();
+
+  init_arglist (isym);
+
+  if (sort_actual (name, &c->ext.actual, isym->formal, &c->loc) == FAILURE)
+    goto fail;
+
+  if (isym->check.f1 != NULL)
+    {
+      if (do_check (isym, c->ext.actual) == FAILURE)
+	goto fail;
+    }
+  else
+    {
+      if (check_arglist (&c->ext.actual, isym, 1) == FAILURE)
+	goto fail;
+    }
+
+  /* The subroutine corresponds to an intrinsic.  Allow errors to be
+     seen at this point.  */
+  if (!error_flag)
+    gfc_pop_suppress_errors ();
+
+  c->resolved_isym = isym;
+  if (isym->resolve.s1 != NULL)
+    isym->resolve.s1 (c);
+  else
+    {
+      c->resolved_sym = gfc_get_intrinsic_sub_symbol (isym->lib_name);
+      c->resolved_sym->attr.elemental = isym->elemental;
+    }
+
+  if (gfc_pure (NULL) && !isym->pure)
+    {
+      gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
+		 &c->loc);
+      return MATCH_ERROR;
+    }
+
+  c->resolved_sym->attr.noreturn = isym->noreturn;
+
+  return MATCH_YES;
+
+fail:
+  if (!error_flag)
+    gfc_pop_suppress_errors ();
+  return MATCH_NO;
+}
+
+
+/* Call gfc_convert_type() with warning enabled.  */
+
+gfc_try
+gfc_convert_type (gfc_expr *expr, gfc_typespec *ts, int eflag)
+{
+  return gfc_convert_type_warn (expr, ts, eflag, 1);
+}
+
+
+/* Try to convert an expression (in place) from one type to another.
+   'eflag' controls the behavior on error.
+
+   The possible values are:
+
+     1 Generate a gfc_error()
+     2 Generate a gfc_internal_error().
+
+   'wflag' controls the warning related to conversion.  */
+
+gfc_try
+gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
+{
+  gfc_intrinsic_sym *sym;
+  gfc_typespec from_ts;
+  locus old_where;
+  gfc_expr *new_expr;
+  int rank;
+  mpz_t *shape;
+
+  from_ts = expr->ts;		/* expr->ts gets clobbered */
+
+  if (ts->type == BT_UNKNOWN)
+    goto bad;
+
+  /* NULL and zero size arrays get their type here.  */
+  if (expr->expr_type == EXPR_NULL
+      || (expr->expr_type == EXPR_ARRAY && expr->value.constructor == NULL))
+    {
+      /* Sometimes the RHS acquire the type.  */
+      expr->ts = *ts;
+      return SUCCESS;
+    }
+
+  if (expr->ts.type == BT_UNKNOWN)
+    goto bad;
+
+  if (expr->ts.type == BT_DERIVED && ts->type == BT_DERIVED
+      && gfc_compare_types (&expr->ts, ts))
+    return SUCCESS;
+
+  sym = find_conv (&expr->ts, ts);
+  if (sym == NULL)
+    goto bad;
+
+  /* At this point, a conversion is necessary. A warning may be needed.  */
+  if ((gfc_option.warn_std & sym->standard) != 0)
+    {
+      gfc_warning_now ("Extension: Conversion from %s to %s at %L",
+		       gfc_typename (&from_ts), gfc_typename (ts),
+		       &expr->where);
+    }
+  else if (wflag)
+    {
+      if (gfc_option.flag_range_check
+	  && expr->expr_type == EXPR_CONSTANT
+	  && from_ts.type == ts->type)
+	{
+	  /* Do nothing. Constants of the same type are range-checked
+	     elsewhere. If a value too large for the target type is
+	     assigned, an error is generated. Not checking here avoids
+	     duplications of warnings/errors.
+	     If range checking was disabled, but -Wconversion enabled,
+	     a non range checked warning is generated below.  */
+	}
+      else if (from_ts.type == BT_LOGICAL || ts->type == BT_LOGICAL)
+	{
+	  /* Do nothing. This block exists only to simplify the other
+	     else-if expressions.
+	       LOGICAL <> LOGICAL    no warning, independent of kind values
+	       LOGICAL <> INTEGER    extension, warned elsewhere
+	       LOGICAL <> REAL       invalid, error generated elsewhere
+	       LOGICAL <> COMPLEX    invalid, error generated elsewhere  */
+	}
+      else if (from_ts.type == ts->type
+	       || (from_ts.type == BT_INTEGER && ts->type == BT_REAL)
+	       || (from_ts.type == BT_INTEGER && ts->type == BT_COMPLEX)
+	       || (from_ts.type == BT_REAL && ts->type == BT_COMPLEX))
+	{
+	  /* Larger kinds can hold values of smaller kinds without problems.
+	     Hence, only warn if target kind is smaller than the source
+	     kind - or if -Wconversion-extra is specified.  */
+	  if (gfc_option.warn_conversion_extra)
+	    gfc_warning_now ("Conversion from %s to %s at %L",
+			     gfc_typename (&from_ts), gfc_typename (ts),
+			     &expr->where);
+	  else if (gfc_option.gfc_warn_conversion
+		   && from_ts.kind > ts->kind)
+	    gfc_warning_now ("Possible change of value in conversion "
+			     "from %s to %s at %L", gfc_typename (&from_ts),
+			     gfc_typename (ts), &expr->where);
+	}
+      else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
+	       || (from_ts.type == BT_COMPLEX && ts->type == BT_INTEGER)
+	       || (from_ts.type == BT_COMPLEX && ts->type == BT_REAL))
+	{
+	  /* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
+	     usually comes with a loss of information, regardless of kinds.  */
+	  if (gfc_option.warn_conversion_extra
+	      || gfc_option.gfc_warn_conversion)
+	    gfc_warning_now ("Possible change of value in conversion "
+			     "from %s to %s at %L", gfc_typename (&from_ts),
+			     gfc_typename (ts), &expr->where);
+	}
+      else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
+	{
+	  /* If HOLLERITH is involved, all bets are off.  */
+	  if (gfc_option.warn_conversion_extra
+	      || gfc_option.gfc_warn_conversion)
+	    gfc_warning_now ("Conversion from %s to %s at %L",
+			     gfc_typename (&from_ts), gfc_typename (ts),
+			     &expr->where);
+	}
+      else
+        gcc_unreachable ();
+    }
+
+  /* Insert a pre-resolved function call to the right function.  */
+  old_where = expr->where;
+  rank = expr->rank;
+  shape = expr->shape;
+
+  new_expr = gfc_get_expr ();
+  *new_expr = *expr;
+
+  new_expr = gfc_build_conversion (new_expr);
+  new_expr->value.function.name = sym->lib_name;
+  new_expr->value.function.isym = sym;
+  new_expr->where = old_where;
+  new_expr->rank = rank;
+  new_expr->shape = gfc_copy_shape (shape, rank);
+
+  gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
+  new_expr->symtree->n.sym->result = new_expr->symtree->n.sym;
+  new_expr->symtree->n.sym->ts = *ts;
+  new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
+  new_expr->symtree->n.sym->attr.function = 1;
+  new_expr->symtree->n.sym->attr.elemental = 1;
+  new_expr->symtree->n.sym->attr.pure = 1;
+  new_expr->symtree->n.sym->attr.referenced = 1;
+  gfc_intrinsic_symbol(new_expr->symtree->n.sym);
+  gfc_commit_symbol (new_expr->symtree->n.sym);
+
+  *expr = *new_expr;
+
+  gfc_free (new_expr);
+  expr->ts = *ts;
+
+  if (gfc_is_constant_expr (expr->value.function.actual->expr)
+      && do_simplify (sym, expr) == FAILURE)
+    {
+
+      if (eflag == 2)
+	goto bad;
+      return FAILURE;		/* Error already generated in do_simplify() */
+    }
+
+  return SUCCESS;
+
+bad:
+  if (eflag == 1)
+    {
+      gfc_error ("Can't convert %s to %s at %L",
+		 gfc_typename (&from_ts), gfc_typename (ts), &expr->where);
+      return FAILURE;
+    }
+
+  gfc_internal_error ("Can't convert %s to %s at %L",
+		      gfc_typename (&from_ts), gfc_typename (ts),
+		      &expr->where);
+  /* Not reached */
+}
+
+
+gfc_try
+gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
+{
+  gfc_intrinsic_sym *sym;
+  locus old_where;
+  gfc_expr *new_expr;
+  int rank;
+  mpz_t *shape;
+
+  gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
+
+  sym = find_char_conv (&expr->ts, ts);
+  gcc_assert (sym);
+
+  /* Insert a pre-resolved function call to the right function.  */
+  old_where = expr->where;
+  rank = expr->rank;
+  shape = expr->shape;
+
+  new_expr = gfc_get_expr ();
+  *new_expr = *expr;
+
+  new_expr = gfc_build_conversion (new_expr);
+  new_expr->value.function.name = sym->lib_name;
+  new_expr->value.function.isym = sym;
+  new_expr->where = old_where;
+  new_expr->rank = rank;
+  new_expr->shape = gfc_copy_shape (shape, rank);
+
+  gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
+  new_expr->symtree->n.sym->ts = *ts;
+  new_expr->symtree->n.sym->attr.flavor = FL_PROCEDURE;
+  new_expr->symtree->n.sym->attr.function = 1;
+  new_expr->symtree->n.sym->attr.elemental = 1;
+  new_expr->symtree->n.sym->attr.referenced = 1;
+  gfc_intrinsic_symbol(new_expr->symtree->n.sym);
+  gfc_commit_symbol (new_expr->symtree->n.sym);
+
+  *expr = *new_expr;
+
+  gfc_free (new_expr);
+  expr->ts = *ts;
+
+  if (gfc_is_constant_expr (expr->value.function.actual->expr)
+      && do_simplify (sym, expr) == FAILURE)
+    {
+      /* Error already generated in do_simplify() */
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Check if the passed name is name of an intrinsic (taking into account the
+   current -std=* and -fall-intrinsic settings).  If it is, see if we should
+   warn about this as a user-procedure having the same name as an intrinsic
+   (-Wintrinsic-shadow enabled) and do so if we should.  */
+
+void
+gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
+{
+  gfc_intrinsic_sym* isym;
+
+  /* If the warning is disabled, do nothing at all.  */
+  if (!gfc_option.warn_intrinsic_shadow)
+    return;
+
+  /* Try to find an intrinsic of the same name.  */
+  if (func)
+    isym = gfc_find_function (sym->name);
+  else  
+    isym = gfc_find_subroutine (sym->name);
+
+  /* If no intrinsic was found with this name or it's not included in the
+     selected standard, everything's fine.  */
+  if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
+					     sym->declared_at) == FAILURE)
+    return;
+
+  /* Emit the warning.  */
+  if (in_module)
+    gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
+		 " name.  In order to call the intrinsic, explicit INTRINSIC"
+		 " declarations may be required.",
+		 sym->name, &sym->declared_at);
+  else
+    gfc_warning ("'%s' declared at %L is also the name of an intrinsic.  It can"
+		 " only be called via an explicit interface or if declared"
+		 " EXTERNAL.", sym->name, &sym->declared_at);
+}
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
new file mode 100644
index 000000000..033bae0f6
--- /dev/null
+++ b/gcc/fortran/intrinsic.h
@@ -0,0 +1,624 @@
+/* Header file for intrinsics check, resolve and simplify function
+   prototypes.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+   2010, 2011 Free Software Foundation, Inc.
+   Contributed by Andy Vaught & Katherine Holcomb
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* Expression returned when simplification fails.  */
+
+extern gfc_expr gfc_bad_expr;
+
+
+/* Check functions.  */
+gfc_try gfc_check_a_ikind (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_a_xkind (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_a_p (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_x_yd (gfc_expr *, gfc_expr *);
+
+gfc_try gfc_check_abs (gfc_expr *);
+gfc_try gfc_check_access_func (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_achar (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_all_any (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_allocated (gfc_expr *);
+gfc_try gfc_check_associated (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_atan_2 (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_atan2 (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_besn (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_bge_bgt_ble_blt (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_bitfcn (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_char (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_chdir (gfc_expr *);
+gfc_try gfc_check_chmod (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_cmplx (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_complex (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_count (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_ctime (gfc_expr *);
+gfc_try gfc_check_datan2 (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_dcmplx (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_dble (gfc_expr *);
+gfc_try gfc_check_digits (gfc_expr *);
+gfc_try gfc_check_dot_product (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_dprod (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_dshift (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_dtime_etime (gfc_expr *);
+gfc_try gfc_check_fgetputc (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_fgetput (gfc_expr *);
+gfc_try gfc_check_float (gfc_expr *);
+gfc_try gfc_check_fstat (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_ftell (gfc_expr *);
+gfc_try gfc_check_fn_c (gfc_expr *);
+gfc_try gfc_check_fn_d (gfc_expr *);
+gfc_try gfc_check_fn_r (gfc_expr *);
+gfc_try gfc_check_fn_rc (gfc_expr *);
+gfc_try gfc_check_fn_rc2008 (gfc_expr *);
+gfc_try gfc_check_fnum (gfc_expr *);
+gfc_try gfc_check_hostnm (gfc_expr *);
+gfc_try gfc_check_huge (gfc_expr *);
+gfc_try gfc_check_hypot (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_i (gfc_expr *);
+gfc_try gfc_check_iand (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_and (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_ibits (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_ichar_iachar (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_idnint (gfc_expr *);
+gfc_try gfc_check_ieor (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_int (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_intconv (gfc_expr *);
+gfc_try gfc_check_ior (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_irand (gfc_expr *);
+gfc_try gfc_check_isatty (gfc_expr *);
+gfc_try gfc_check_isnan (gfc_expr *);
+gfc_try gfc_check_ishft (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_ishftc (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_kill (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_kind (gfc_expr *);
+gfc_try gfc_check_lbound (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_lcobound (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_len_lentrim (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_link (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_lge_lgt_lle_llt (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_loc (gfc_expr *);
+gfc_try gfc_check_logical (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_min_max (gfc_actual_arglist *);
+gfc_try gfc_check_min_max_integer (gfc_actual_arglist *);
+gfc_try gfc_check_min_max_real (gfc_actual_arglist *);
+gfc_try gfc_check_min_max_double (gfc_actual_arglist *);
+gfc_try gfc_check_malloc (gfc_expr *);
+gfc_try gfc_check_mask (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_matmul (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_merge (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_merge_bits (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_minloc_maxloc (gfc_actual_arglist *);
+gfc_try gfc_check_minval_maxval (gfc_actual_arglist *);
+gfc_try gfc_check_nearest (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_new_line (gfc_expr *);
+gfc_try gfc_check_norm2 (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_null (gfc_expr *);
+gfc_try gfc_check_pack (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_parity (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_precision (gfc_expr *);
+gfc_try gfc_check_present (gfc_expr *);
+gfc_try gfc_check_product_sum (gfc_actual_arglist *);
+gfc_try gfc_check_radix (gfc_expr *);
+gfc_try gfc_check_rand (gfc_expr *);
+gfc_try gfc_check_range (gfc_expr *);
+gfc_try gfc_check_real (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_rename (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_repeat (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_same_type_as (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_scale (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_second_sub (gfc_expr *);
+gfc_try gfc_check_secnds (gfc_expr *);
+gfc_try gfc_check_selected_char_kind (gfc_expr *);
+gfc_try gfc_check_selected_int_kind (gfc_expr *);
+gfc_try gfc_check_selected_real_kind (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_set_exponent (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_shape (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_shift (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_size (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_sign (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_signal (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_sizeof (gfc_expr *);
+gfc_try gfc_check_c_sizeof (gfc_expr *);
+gfc_try gfc_check_sngl (gfc_expr *);
+gfc_try gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_srand (gfc_expr *);
+gfc_try gfc_check_stat (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_storage_size (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_sum (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_symlnk (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_transf_bit_intrins (gfc_actual_arglist *);
+gfc_try gfc_check_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_transpose (gfc_expr *);
+gfc_try gfc_check_trim (gfc_expr *);
+gfc_try gfc_check_ttynam (gfc_expr *);
+gfc_try gfc_check_ubound (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_ucobound (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_umask (gfc_expr *);
+gfc_try gfc_check_unlink (gfc_expr *);
+gfc_try gfc_check_unpack (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_x (gfc_expr *);
+
+
+/* Intrinsic subroutines.  */
+gfc_try gfc_check_alarm_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_chdir_sub (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_chmod_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_cpu_time (gfc_expr *);
+gfc_try gfc_check_ctime_sub (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_system_clock (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_date_and_time (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_exit (gfc_expr *);
+gfc_try gfc_check_fdate_sub (gfc_expr *);
+gfc_try gfc_check_flush (gfc_expr *);
+gfc_try gfc_check_free (gfc_expr *);
+gfc_try gfc_check_fstat_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_gerror (gfc_expr *);
+gfc_try gfc_check_getarg (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_getlog (gfc_expr *);
+gfc_try gfc_check_move_alloc (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
+		      gfc_expr *);
+gfc_try gfc_check_random_number (gfc_expr *);
+gfc_try gfc_check_random_seed (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_dtime_etime_sub (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_fgetputc_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_fgetput_sub (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_fseek_sub (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_ftell_sub (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_getcwd_sub (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_hostnm_sub (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_image_index (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_itime_idate (gfc_expr *);
+gfc_try gfc_check_kill_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_ltime_gmtime (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_perror (gfc_expr *);
+gfc_try gfc_check_rename_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_link_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_symlnk_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_signal_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_sleep_sub (gfc_expr *);
+gfc_try gfc_check_stat_sub (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_try gfc_check_system_sub (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_this_image (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_ttynam_sub (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_umask_sub (gfc_expr *, gfc_expr *);
+gfc_try gfc_check_unlink_sub (gfc_expr *, gfc_expr *);
+
+
+/* Simplification functions.  */
+gfc_expr *gfc_simplify_abs (gfc_expr *);
+gfc_expr *gfc_simplify_achar (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_acos (gfc_expr *);
+gfc_expr *gfc_simplify_acosh (gfc_expr *);
+gfc_expr *gfc_simplify_adjustl (gfc_expr *);
+gfc_expr *gfc_simplify_adjustr (gfc_expr *);
+gfc_expr *gfc_simplify_aimag (gfc_expr *);
+gfc_expr *gfc_simplify_aint (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_all (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_dint (gfc_expr *);
+gfc_expr *gfc_simplify_anint (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_dnint (gfc_expr *);
+gfc_expr *gfc_simplify_and (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_any (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_asin (gfc_expr *);
+gfc_expr *gfc_simplify_asinh (gfc_expr *);
+gfc_expr *gfc_simplify_atan (gfc_expr *);
+gfc_expr *gfc_simplify_atanh (gfc_expr *);
+gfc_expr *gfc_simplify_atan2 (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_bessel_j0 (gfc_expr *);
+gfc_expr *gfc_simplify_bessel_j1 (gfc_expr *);
+gfc_expr *gfc_simplify_bessel_jn (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_bessel_jn2 (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_bessel_y0 (gfc_expr *);
+gfc_expr *gfc_simplify_bessel_y1 (gfc_expr *);
+gfc_expr *gfc_simplify_bessel_yn (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_bessel_yn2 (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_bge (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_bgt (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_bit_size (gfc_expr *);
+gfc_expr *gfc_simplify_ble (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_blt (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_btest (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_ceiling (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_char (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_cmplx (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_compiler_options (void);
+gfc_expr *gfc_simplify_compiler_version (void);
+gfc_expr *gfc_simplify_complex (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_conjg (gfc_expr *);
+gfc_expr *gfc_simplify_cos (gfc_expr *);
+gfc_expr *gfc_simplify_cosh (gfc_expr *);
+gfc_expr *gfc_simplify_count (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_dcmplx (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_dble (gfc_expr *);
+gfc_expr *gfc_simplify_digits (gfc_expr *);
+gfc_expr *gfc_simplify_dim (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_dprod (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_dot_product (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_dshiftl (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_dshiftr (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_epsilon (gfc_expr *);
+gfc_expr *gfc_simplify_erf (gfc_expr *);
+gfc_expr *gfc_simplify_erfc (gfc_expr *);
+gfc_expr *gfc_simplify_erfc_scaled (gfc_expr *);
+gfc_expr *gfc_simplify_exp (gfc_expr *);
+gfc_expr *gfc_simplify_exponent (gfc_expr *);
+gfc_expr *gfc_simplify_extends_type_of (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_float (gfc_expr *);
+gfc_expr *gfc_simplify_floor (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_fraction (gfc_expr *);
+gfc_expr *gfc_simplify_gamma (gfc_expr *);
+gfc_expr *gfc_simplify_huge (gfc_expr *);
+gfc_expr *gfc_simplify_hypot (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_iachar (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_iall (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_iand (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_iany (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_ibclr (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_ibits (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_ibset (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_ichar (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_ieor (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_image_index (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_index (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_int (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_int2 (gfc_expr *);
+gfc_expr *gfc_simplify_int8 (gfc_expr *);
+gfc_expr *gfc_simplify_long (gfc_expr *);
+gfc_expr *gfc_simplify_ifix (gfc_expr *);
+gfc_expr *gfc_simplify_idint (gfc_expr *);
+gfc_expr *gfc_simplify_ior (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_iparity (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_is_iostat_end (gfc_expr *);
+gfc_expr *gfc_simplify_is_iostat_eor (gfc_expr *);
+gfc_expr *gfc_simplify_isnan (gfc_expr *);
+gfc_expr *gfc_simplify_ishft (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_ishftc (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_kind (gfc_expr *);
+gfc_expr *gfc_simplify_lbound (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_lcobound (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_leadz (gfc_expr *);
+gfc_expr *gfc_simplify_len (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_len_trim (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_lgamma (gfc_expr *);
+gfc_expr *gfc_simplify_lge (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_lgt (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_lle (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_llt (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_log (gfc_expr *);
+gfc_expr *gfc_simplify_log10 (gfc_expr *);
+gfc_expr *gfc_simplify_logical (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_lshift (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_matmul (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_maskl (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_maskr (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_merge (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_merge_bits (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_min (gfc_expr *);
+gfc_expr *gfc_simplify_minval (gfc_expr *, gfc_expr*, gfc_expr*);
+gfc_expr *gfc_simplify_max (gfc_expr *);
+gfc_expr *gfc_simplify_maxval (gfc_expr *, gfc_expr*, gfc_expr*);
+gfc_expr *gfc_simplify_maxexponent (gfc_expr *);
+gfc_expr *gfc_simplify_minexponent (gfc_expr *);
+gfc_expr *gfc_simplify_mod (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_modulo (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_mvbits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
+			       gfc_expr *);
+gfc_expr *gfc_simplify_nearest (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_new_line (gfc_expr *);
+gfc_expr *gfc_simplify_nint (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_norm2 (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_null (gfc_expr *);
+gfc_expr *gfc_simplify_num_images (void);
+gfc_expr *gfc_simplify_idnint (gfc_expr *);
+gfc_expr *gfc_simplify_not (gfc_expr *);
+gfc_expr *gfc_simplify_or (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_pack (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_parity (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_popcnt (gfc_expr *);
+gfc_expr *gfc_simplify_poppar (gfc_expr *);
+gfc_expr *gfc_simplify_precision (gfc_expr *);
+gfc_expr *gfc_simplify_product (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_radix (gfc_expr *);
+gfc_expr *gfc_simplify_range (gfc_expr *);
+gfc_expr *gfc_simplify_real (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_realpart (gfc_expr *);
+gfc_expr *gfc_simplify_repeat (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_reshape (gfc_expr *, gfc_expr *, gfc_expr *,
+				gfc_expr *);
+gfc_expr *gfc_simplify_rrspacing (gfc_expr *);
+gfc_expr *gfc_simplify_rshift (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_same_type_as (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_scale (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_selected_char_kind (gfc_expr *);
+gfc_expr *gfc_simplify_selected_int_kind (gfc_expr *);
+gfc_expr *gfc_simplify_selected_real_kind (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_set_exponent (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_sign (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_shape (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_shifta (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_shiftl (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_shiftr (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_sin (gfc_expr *);
+gfc_expr *gfc_simplify_sinh (gfc_expr *);
+gfc_expr *gfc_simplify_size (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_sngl (gfc_expr *);
+gfc_expr *gfc_simplify_spacing (gfc_expr *);
+gfc_expr *gfc_simplify_spread (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_sqrt (gfc_expr *);
+gfc_expr *gfc_simplify_sum (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_tan (gfc_expr *);
+gfc_expr *gfc_simplify_tanh (gfc_expr *);
+gfc_expr *gfc_simplify_this_image (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_tiny (gfc_expr *);
+gfc_expr *gfc_simplify_trailz (gfc_expr *);
+gfc_expr *gfc_simplify_transfer (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_transpose (gfc_expr *);
+gfc_expr *gfc_simplify_trim (gfc_expr *);
+gfc_expr *gfc_simplify_ubound (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_ucobound (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_unpack (gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_xor (gfc_expr *, gfc_expr *);
+
+/* Constant conversion simplification.  */
+gfc_expr *gfc_convert_constant (gfc_expr *, bt, int);
+gfc_expr *gfc_convert_char_constant (gfc_expr *, bt, int);
+
+
+/* Resolution functions.  */
+void gfc_resolve_abs (gfc_expr *, gfc_expr *);
+void gfc_resolve_access (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_adjustl (gfc_expr *, gfc_expr *);
+void gfc_resolve_adjustr (gfc_expr *, gfc_expr *);
+void gfc_resolve_achar (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_acos (gfc_expr *, gfc_expr *);
+void gfc_resolve_acosh (gfc_expr *, gfc_expr *);
+void gfc_resolve_aimag (gfc_expr *, gfc_expr *);
+void gfc_resolve_aint (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_dint (gfc_expr *, gfc_expr *);
+void gfc_resolve_all (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_anint (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_dnint (gfc_expr *, gfc_expr *);
+void gfc_resolve_and (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_any (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_asin (gfc_expr *, gfc_expr *);
+void gfc_resolve_asinh (gfc_expr *, gfc_expr *);
+void gfc_resolve_atan (gfc_expr *, gfc_expr *);
+void gfc_resolve_atanh (gfc_expr *, gfc_expr *);
+void gfc_resolve_atan2 (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_besn (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_bessel_n2 (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *a);
+void gfc_resolve_btest (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_ceiling (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_char (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_chdir (gfc_expr *, gfc_expr *);
+void gfc_resolve_chmod (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_cmplx (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_dcmplx (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_complex (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_conjg (gfc_expr *, gfc_expr *);
+void gfc_resolve_cos (gfc_expr *, gfc_expr *);
+void gfc_resolve_cosh (gfc_expr *, gfc_expr *);
+void gfc_resolve_count (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_cshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_ctime (gfc_expr *, gfc_expr *);
+void gfc_resolve_dble (gfc_expr *, gfc_expr *);
+void gfc_resolve_dim (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_dot_product (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_dprod (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_dshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_dtime_sub (gfc_code *);
+void gfc_resolve_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
+			  gfc_expr *);
+void gfc_resolve_etime_sub (gfc_code *);
+void gfc_resolve_exp (gfc_expr *, gfc_expr *);
+void gfc_resolve_exponent (gfc_expr *, gfc_expr *);
+void gfc_resolve_extends_type_of (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_fdate (gfc_expr *);
+void gfc_resolve_floor (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_fnum (gfc_expr *, gfc_expr *);
+void gfc_resolve_fraction (gfc_expr *, gfc_expr *);
+void gfc_resolve_fstat (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_ftell (gfc_expr *, gfc_expr *);
+void gfc_resolve_fgetc (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_fget (gfc_expr *, gfc_expr *);
+void gfc_resolve_fputc (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_fput (gfc_expr *, gfc_expr *);
+void gfc_resolve_g77_math1 (gfc_expr *, gfc_expr *);
+void gfc_resolve_gamma (gfc_expr *, gfc_expr *);
+void gfc_resolve_getcwd (gfc_expr *, gfc_expr *);
+void gfc_resolve_getgid (gfc_expr *);
+void gfc_resolve_getpid (gfc_expr *);
+void gfc_resolve_getuid (gfc_expr *);
+void gfc_resolve_hostnm (gfc_expr *, gfc_expr *);
+void gfc_resolve_hypot (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_iand (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_ibclr (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_ibset (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_image_index (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_index_func (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
+			     gfc_expr *);
+void gfc_resolve_ierrno (gfc_expr *);
+void gfc_resolve_ieor (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_ichar (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_iachar (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_iall (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_iany (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_idnint (gfc_expr *, gfc_expr *);
+void gfc_resolve_int (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_int2 (gfc_expr *, gfc_expr *);
+void gfc_resolve_int8 (gfc_expr *, gfc_expr *);
+void gfc_resolve_long (gfc_expr *, gfc_expr *);
+void gfc_resolve_ior (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_iparity (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_isatty (gfc_expr *, gfc_expr *);
+void gfc_resolve_rshift (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_lshift (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_ishft (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_ishftc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_kill (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_lbound (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_lcobound (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_len (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_len_trim (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_lgamma (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 *);
+void gfc_resolve_lstat (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_malloc (gfc_expr *, gfc_expr *);
+void gfc_resolve_matmul (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_max (gfc_expr *, gfc_actual_arglist *);
+void gfc_resolve_maxloc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_maxval (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_mclock (gfc_expr *);
+void gfc_resolve_mclock8 (gfc_expr *);
+void gfc_resolve_mask (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_merge (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_merge_bits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_min (gfc_expr *, gfc_actual_arglist *);
+void gfc_resolve_minloc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_minval (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_mod (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_modulo (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_nearest (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_nint (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_norm2 (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_not (gfc_expr *, gfc_expr *);
+void gfc_resolve_or (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_pack (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_parity (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_product (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_real (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_realpart (gfc_expr *, gfc_expr *);
+void gfc_resolve_rename (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_repeat (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_reshape (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
+			  gfc_expr *);
+void gfc_resolve_rrspacing (gfc_expr *, gfc_expr *);
+void gfc_resolve_scale (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
+		       gfc_expr *);
+void gfc_resolve_second_sub (gfc_code *);
+void gfc_resolve_secnds (gfc_expr *, gfc_expr *);
+void gfc_resolve_set_exponent (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_shape (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_shift (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_sign (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_signal (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_sin (gfc_expr *, gfc_expr *);
+void gfc_resolve_sinh (gfc_expr *, gfc_expr *);
+void gfc_resolve_size (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_spacing (gfc_expr *, gfc_expr *);
+void gfc_resolve_spread (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_sqrt (gfc_expr *, gfc_expr *);
+void gfc_resolve_stat (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_storage_size (gfc_expr *f, gfc_expr *a, gfc_expr *kind);
+void gfc_resolve_srand (gfc_code *);
+void gfc_resolve_sum (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_symlnk (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_system (gfc_expr *, gfc_expr *);
+void gfc_resolve_tan (gfc_expr *, gfc_expr *);
+void gfc_resolve_tanh (gfc_expr *, gfc_expr *);
+void gfc_resolve_this_image (gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_time (gfc_expr *);
+void gfc_resolve_time8 (gfc_expr *);
+void gfc_resolve_transfer (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_transpose (gfc_expr *, gfc_expr *);
+void gfc_resolve_trim (gfc_expr *, gfc_expr *);
+void gfc_resolve_ttynam (gfc_expr *, gfc_expr *);
+void gfc_resolve_ubound (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_ucobound (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_umask (gfc_expr *, gfc_expr *);
+void gfc_resolve_unlink (gfc_expr *, gfc_expr *);
+void gfc_resolve_unpack (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
+void gfc_resolve_verify (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
+			 gfc_expr *);
+void gfc_resolve_xor (gfc_expr *, gfc_expr *, gfc_expr *);
+
+
+/* Intrinsic subroutine resolution.  */
+void gfc_resolve_alarm_sub (gfc_code *);
+void gfc_resolve_chdir_sub (gfc_code *);
+void gfc_resolve_chmod_sub (gfc_code *);
+void gfc_resolve_cpu_time (gfc_code *);
+void gfc_resolve_ctime_sub (gfc_code *);
+void gfc_resolve_execute_command_line (gfc_code *);
+void gfc_resolve_exit (gfc_code *);
+void gfc_resolve_fdate_sub (gfc_code *);
+void gfc_resolve_flush (gfc_code *);
+void gfc_resolve_free (gfc_code *);
+void gfc_resolve_fseek_sub (gfc_code *);
+void gfc_resolve_fstat_sub (gfc_code *);
+void gfc_resolve_ftell_sub (gfc_code *);
+void gfc_resolve_fgetc_sub (gfc_code *);
+void gfc_resolve_fget_sub (gfc_code *);
+void gfc_resolve_fputc_sub (gfc_code *);
+void gfc_resolve_fput_sub (gfc_code *);
+void gfc_resolve_gerror (gfc_code *);
+void gfc_resolve_getarg (gfc_code *);
+void gfc_resolve_getcwd_sub (gfc_code *);
+void gfc_resolve_getlog (gfc_code *);
+void gfc_resolve_get_command (gfc_code *);
+void gfc_resolve_get_command_argument (gfc_code *);
+void gfc_resolve_get_environment_variable (gfc_code *);
+void gfc_resolve_gmtime (gfc_code *);
+void gfc_resolve_hostnm_sub (gfc_code *);
+void gfc_resolve_idate (gfc_code *);
+void gfc_resolve_itime (gfc_code *);
+void gfc_resolve_kill_sub (gfc_code *);
+void gfc_resolve_lstat_sub (gfc_code *);
+void gfc_resolve_ltime (gfc_code *);
+void gfc_resolve_mvbits (gfc_code *);
+void gfc_resolve_perror (gfc_code *);
+void gfc_resolve_random_number (gfc_code *);
+void gfc_resolve_random_seed (gfc_code *);
+void gfc_resolve_rename_sub (gfc_code *);
+void gfc_resolve_link_sub (gfc_code *);
+void gfc_resolve_symlnk_sub (gfc_code *);
+void gfc_resolve_signal_sub (gfc_code *);
+void gfc_resolve_sleep_sub (gfc_code *);
+void gfc_resolve_stat_sub (gfc_code *);
+void gfc_resolve_system_clock (gfc_code *);
+void gfc_resolve_system_sub (gfc_code *);
+void gfc_resolve_ttynam_sub (gfc_code *);
+void gfc_resolve_umask_sub (gfc_code *);
+void gfc_resolve_unlink_sub (gfc_code *);
+
+
+/* The mvbits() subroutine requires the most arguments: five.  */
+
+#define MAX_INTRINSIC_ARGS 5
+
+extern const char *gfc_current_intrinsic;
+extern gfc_intrinsic_arg *gfc_current_intrinsic_arg[MAX_INTRINSIC_ARGS];
+extern locus *gfc_current_intrinsic_where;
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
new file mode 100644
index 000000000..a13c83350
--- /dev/null
+++ b/gcc/fortran/intrinsic.texi
@@ -0,0 +1,12970 @@
+@ignore
+Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+Free Software Foundation, Inc.
+This is part of the GNU Fortran manual.   
+For copying conditions, see the file gfortran.texi.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with the
+Invariant Sections being ``Funding Free Software'', the Front-Cover
+Texts being (a) (see below), and with the Back-Cover Texts being (b)
+(see below).  A copy of the license is included in the gfdl(7) man page.
+
+
+Some basic guidelines for editing this document:
+
+  (1) The intrinsic procedures are to be listed in alphabetical order.
+  (2) The generic name is to be used.
+  (3) The specific names are included in the function index and in a
+      table at the end of the node (See ABS entry).
+  (4) Try to maintain the same style for each entry.
+
+
+@end ignore
+
+@tex
+\gdef\acos{\mathop{\rm acos}\nolimits}
+\gdef\asin{\mathop{\rm asin}\nolimits}
+\gdef\atan{\mathop{\rm atan}\nolimits}
+\gdef\acosh{\mathop{\rm acosh}\nolimits}
+\gdef\asinh{\mathop{\rm asinh}\nolimits}
+\gdef\atanh{\mathop{\rm atanh}\nolimits}
+@end tex
+
+
+@node Intrinsic Procedures
+@chapter Intrinsic Procedures
+@cindex intrinsic procedures
+
+@menu
+* Introduction:         Introduction to Intrinsics
+* @code{ABORT}:         ABORT,     Abort the program     
+* @code{ABS}:           ABS,       Absolute value     
+* @code{ACCESS}:        ACCESS,    Checks file access modes
+* @code{ACHAR}:         ACHAR,     Character in @acronym{ASCII} collating sequence
+* @code{ACOS}:          ACOS,      Arccosine function
+* @code{ACOSH}:         ACOSH,     Inverse hyperbolic cosine function
+* @code{ADJUSTL}:       ADJUSTL,   Left adjust a string
+* @code{ADJUSTR}:       ADJUSTR,   Right adjust a string
+* @code{AIMAG}:         AIMAG,     Imaginary part of complex number
+* @code{AINT}:          AINT,      Truncate to a whole number
+* @code{ALARM}:         ALARM,     Set an alarm clock
+* @code{ALL}:           ALL,       Determine if all values are true
+* @code{ALLOCATED}:     ALLOCATED, Status of allocatable entity
+* @code{AND}:           AND,       Bitwise logical AND
+* @code{ANINT}:         ANINT,     Nearest whole number
+* @code{ANY}:           ANY,       Determine if any values are true
+* @code{ASIN}:          ASIN,      Arcsine function
+* @code{ASINH}:         ASINH,     Inverse hyperbolic sine function
+* @code{ASSOCIATED}:    ASSOCIATED, Status of a pointer or pointer/target pair
+* @code{ATAN}:          ATAN,      Arctangent function
+* @code{ATAN2}:         ATAN2,     Arctangent function
+* @code{ATANH}:         ATANH,     Inverse hyperbolic tangent function
+* @code{BESSEL_J0}:     BESSEL_J0, Bessel function of the first kind of order 0
+* @code{BESSEL_J1}:     BESSEL_J1, Bessel function of the first kind of order 1
+* @code{BESSEL_JN}:     BESSEL_JN, Bessel function of the first kind
+* @code{BESSEL_Y0}:     BESSEL_Y0, Bessel function of the second kind of order 0
+* @code{BESSEL_Y1}:     BESSEL_Y1, Bessel function of the second kind of order 1
+* @code{BESSEL_YN}:     BESSEL_YN, Bessel function of the second kind
+* @code{BGE}:           BGE,       Bitwise greater than or equal to
+* @code{BGT}:           BGT,       Bitwise greater than
+* @code{BIT_SIZE}:      BIT_SIZE,  Bit size inquiry function
+* @code{BLE}:           BLE,       Bitwise less than or equal to
+* @code{BLT}:           BLT,       Bitwise less than
+* @code{BTEST}:         BTEST,     Bit test function
+* @code{C_ASSOCIATED}:  C_ASSOCIATED, Status of a C pointer
+* @code{C_F_POINTER}:   C_F_POINTER, Convert C into Fortran pointer
+* @code{C_F_PROCPOINTER}: C_F_PROCPOINTER, Convert C into Fortran procedure pointer
+* @code{C_FUNLOC}:      C_FUNLOC,  Obtain the C address of a procedure
+* @code{C_LOC}:         C_LOC,     Obtain the C address of an object
+* @code{C_SIZEOF}:      C_SIZEOF,  Size in bytes of an expression
+* @code{CEILING}:       CEILING,   Integer ceiling function
+* @code{CHAR}:          CHAR,      Integer-to-character conversion function
+* @code{CHDIR}:         CHDIR,     Change working directory
+* @code{CHMOD}:         CHMOD,     Change access permissions of files
+* @code{CMPLX}:         CMPLX,     Complex conversion function
+* @code{COMMAND_ARGUMENT_COUNT}: COMMAND_ARGUMENT_COUNT, Get number of command line arguments
+* @code{COMPLEX}:       COMPLEX,   Complex conversion function
+* @code{COMPILER_VERSION}: COMPILER_VERSION, Compiler version string
+* @code{COMPILER_OPTIONS}: COMPILER_OPTIONS, Options passed to the compiler
+* @code{CONJG}:         CONJG,     Complex conjugate function
+* @code{COS}:           COS,       Cosine function
+* @code{COSH}:          COSH,      Hyperbolic cosine function
+* @code{COUNT}:         COUNT,     Count occurrences of TRUE in an array
+* @code{CPU_TIME}:      CPU_TIME,  CPU time subroutine
+* @code{CSHIFT}:        CSHIFT,    Circular shift elements of an array
+* @code{CTIME}:         CTIME,     Subroutine (or function) to convert a time into a string
+* @code{DATE_AND_TIME}: DATE_AND_TIME, Date and time subroutine
+* @code{DBLE}:          DBLE,      Double precision conversion function
+* @code{DCMPLX}:        DCMPLX,    Double complex conversion function
+* @code{DIGITS}:        DIGITS,    Significant digits function
+* @code{DIM}:           DIM,       Positive difference
+* @code{DOT_PRODUCT}:   DOT_PRODUCT, Dot product function
+* @code{DPROD}:         DPROD,     Double product function
+* @code{DREAL}:         DREAL,     Double real part function
+* @code{DSHIFTL}:       DSHIFTL,   Combined left shift
+* @code{DSHIFTR}:       DSHIFTR,   Combined right shift
+* @code{DTIME}:         DTIME,     Execution time subroutine (or function)
+* @code{EOSHIFT}:       EOSHIFT,   End-off shift elements of an array
+* @code{EPSILON}:       EPSILON,   Epsilon function
+* @code{ERF}:           ERF,       Error function
+* @code{ERFC}:          ERFC,      Complementary error function
+* @code{ERFC_SCALED}:   ERFC_SCALED, Exponentially-scaled complementary error function
+* @code{ETIME}:         ETIME,     Execution time subroutine (or function)
+* @code{EXECUTE_COMMAND_LINE}: EXECUTE_COMMAND_LINE, Execute a shell command
+* @code{EXIT}:          EXIT,      Exit the program with status.
+* @code{EXP}:           EXP,       Exponential function
+* @code{EXPONENT}:      EXPONENT,  Exponent function
+* @code{EXTENDS_TYPE_OF}: EXTENDS_TYPE_OF,  Query dynamic type for extension
+* @code{FDATE}:         FDATE,     Subroutine (or function) to get the current time as a string
+* @code{FGET}:          FGET,      Read a single character in stream mode from stdin
+* @code{FGETC}:         FGETC,     Read a single character in stream mode
+* @code{FLOOR}:         FLOOR,     Integer floor function
+* @code{FLUSH}:         FLUSH,     Flush I/O unit(s)
+* @code{FNUM}:          FNUM,      File number function
+* @code{FPUT}:          FPUT,      Write a single character in stream mode to stdout
+* @code{FPUTC}:         FPUTC,     Write a single character in stream mode
+* @code{FRACTION}:      FRACTION,  Fractional part of the model representation
+* @code{FREE}:          FREE,      Memory de-allocation subroutine
+* @code{FSEEK}:         FSEEK,     Low level file positioning subroutine
+* @code{FSTAT}:         FSTAT,     Get file status
+* @code{FTELL}:         FTELL,     Current stream position
+* @code{GAMMA}:         GAMMA,     Gamma function
+* @code{GERROR}:        GERROR,    Get last system error message
+* @code{GETARG}:        GETARG,    Get command line arguments
+* @code{GET_COMMAND}:   GET_COMMAND, Get the entire command line
+* @code{GET_COMMAND_ARGUMENT}: GET_COMMAND_ARGUMENT, Get command line arguments
+* @code{GETCWD}:        GETCWD,    Get current working directory
+* @code{GETENV}:        GETENV,    Get an environmental variable
+* @code{GET_ENVIRONMENT_VARIABLE}: GET_ENVIRONMENT_VARIABLE, Get an environmental variable
+* @code{GETGID}:        GETGID,    Group ID function
+* @code{GETLOG}:        GETLOG,    Get login name
+* @code{GETPID}:        GETPID,    Process ID function
+* @code{GETUID}:        GETUID,    User ID function
+* @code{GMTIME}:        GMTIME,    Convert time to GMT info
+* @code{HOSTNM}:        HOSTNM,    Get system host name
+* @code{HUGE}:          HUGE,      Largest number of a kind
+* @code{HYPOT}:         HYPOT,     Euclidean distance function
+* @code{IACHAR}:        IACHAR,    Code in @acronym{ASCII} collating sequence
+* @code{IALL}:          IALL,      Bitwise AND of array elements
+* @code{IAND}:          IAND,      Bitwise logical and
+* @code{IANY}:          IANY,      Bitwise OR of array elements
+* @code{IARGC}:         IARGC,     Get the number of command line arguments
+* @code{IBCLR}:         IBCLR,     Clear bit
+* @code{IBITS}:         IBITS,     Bit extraction
+* @code{IBSET}:         IBSET,     Set bit
+* @code{ICHAR}:         ICHAR,     Character-to-integer conversion function
+* @code{IDATE}:         IDATE,     Current local time (day/month/year)
+* @code{IEOR}:          IEOR,      Bitwise logical exclusive or
+* @code{IERRNO}:        IERRNO,    Function to get the last system error number
+* @code{IMAGE_INDEX}:   IMAGE_INDEX, Cosubscript to image index conversion
+* @code{INDEX}:         INDEX intrinsic, Position of a substring within a string
+* @code{INT}:           INT,       Convert to integer type
+* @code{INT2}:          INT2,      Convert to 16-bit integer type
+* @code{INT8}:          INT8,      Convert to 64-bit integer type
+* @code{IOR}:           IOR,       Bitwise logical or
+* @code{IPARITY}:       IPARITY,   Bitwise XOR of array elements
+* @code{IRAND}:         IRAND,     Integer pseudo-random number
+* @code{IS_IOSTAT_END}:  IS_IOSTAT_END, Test for end-of-file value
+* @code{IS_IOSTAT_EOR}:  IS_IOSTAT_EOR, Test for end-of-record value
+* @code{ISATTY}:        ISATTY,    Whether a unit is a terminal device
+* @code{ISHFT}:         ISHFT,     Shift bits
+* @code{ISHFTC}:        ISHFTC,    Shift bits circularly
+* @code{ISNAN}:         ISNAN,     Tests for a NaN
+* @code{ITIME}:         ITIME,     Current local time (hour/minutes/seconds)
+* @code{KILL}:          KILL,      Send a signal to a process
+* @code{KIND}:          KIND,      Kind of an entity
+* @code{LBOUND}:        LBOUND,    Lower dimension bounds of an array
+* @code{LCOBOUND}:      LCOBOUND,  Lower codimension bounds of an array
+* @code{LEADZ}:         LEADZ,     Number of leading zero bits of an integer
+* @code{LEN}:           LEN,       Length of a character entity
+* @code{LEN_TRIM}:      LEN_TRIM,  Length of a character entity without trailing blank characters
+* @code{LGE}:           LGE,       Lexical greater than or equal
+* @code{LGT}:           LGT,       Lexical greater than
+* @code{LINK}:          LINK,      Create a hard link
+* @code{LLE}:           LLE,       Lexical less than or equal
+* @code{LLT}:           LLT,       Lexical less than
+* @code{LNBLNK}:        LNBLNK,    Index of the last non-blank character in a string
+* @code{LOC}:           LOC,       Returns the address of a variable
+* @code{LOG}:           LOG,       Logarithm function
+* @code{LOG10}:         LOG10,     Base 10 logarithm function 
+* @code{LOG_GAMMA}:     LOG_GAMMA, Logarithm of the Gamma function
+* @code{LOGICAL}:       LOGICAL,   Convert to logical type
+* @code{LONG}:          LONG,      Convert to integer type
+* @code{LSHIFT}:        LSHIFT,    Left shift bits
+* @code{LSTAT}:         LSTAT,     Get file status
+* @code{LTIME}:         LTIME,     Convert time to local time info
+* @code{MALLOC}:        MALLOC,    Dynamic memory allocation function
+* @code{MASKL}:         MASKL,     Left justified mask
+* @code{MASKR}:         MASKR,     Right justified mask
+* @code{MATMUL}:        MATMUL,    matrix multiplication
+* @code{MAX}:           MAX,       Maximum value of an argument list
+* @code{MAXEXPONENT}:   MAXEXPONENT, Maximum exponent of a real kind
+* @code{MAXLOC}:        MAXLOC,    Location of the maximum value within an array
+* @code{MAXVAL}:        MAXVAL,    Maximum value of an array
+* @code{MCLOCK}:        MCLOCK,    Time function
+* @code{MCLOCK8}:       MCLOCK8,   Time function (64-bit)
+* @code{MERGE}:         MERGE,     Merge arrays
+* @code{MERGE_BITS}:    MERGE_BITS, Merge of bits under mask
+* @code{MIN}:           MIN,       Minimum value of an argument list
+* @code{MINEXPONENT}:   MINEXPONENT, Minimum exponent of a real kind
+* @code{MINLOC}:        MINLOC,    Location of the minimum value within an array
+* @code{MINVAL}:        MINVAL,    Minimum value of an array
+* @code{MOD}:           MOD,       Remainder function
+* @code{MODULO}:        MODULO,    Modulo function
+* @code{MOVE_ALLOC}:    MOVE_ALLOC, Move allocation from one object to another
+* @code{MVBITS}:        MVBITS,    Move bits from one integer to another
+* @code{NEAREST}:       NEAREST,   Nearest representable number
+* @code{NEW_LINE}:      NEW_LINE,  New line character
+* @code{NINT}:          NINT,      Nearest whole number
+* @code{NORM2}:         NORM2,     Euclidean vector norm
+* @code{NOT}:           NOT,       Logical negation
+* @code{NULL}:          NULL,      Function that returns an disassociated pointer
+* @code{NUM_IMAGES}:    NUM_IMAGES, Number of images
+* @code{OR}:            OR,        Bitwise logical OR
+* @code{PACK}:          PACK,      Pack an array into an array of rank one
+* @code{PARITY}:        PARITY,    Reduction with exclusive OR
+* @code{PERROR}:        PERROR,    Print system error message
+* @code{POPCNT}:        POPCNT,    Number of bits set
+* @code{POPPAR}:        POPPAR,    Parity of the number of bits set
+* @code{PRECISION}:     PRECISION, Decimal precision of a real kind
+* @code{PRESENT}:       PRESENT,   Determine whether an optional dummy argument is specified
+* @code{PRODUCT}:       PRODUCT,   Product of array elements
+* @code{RADIX}:         RADIX,     Base of a data model
+* @code{RANDOM_NUMBER}: RANDOM_NUMBER, Pseudo-random number
+* @code{RANDOM_SEED}:   RANDOM_SEED, Initialize a pseudo-random number sequence
+* @code{RAND}:          RAND,      Real pseudo-random number
+* @code{RANGE}:         RANGE,     Decimal exponent range
+* @code{RAN}:           RAN,       Real pseudo-random number
+* @code{REAL}:          REAL,      Convert to real type 
+* @code{RENAME}:        RENAME,    Rename a file
+* @code{REPEAT}:        REPEAT,    Repeated string concatenation
+* @code{RESHAPE}:       RESHAPE,   Function to reshape an array
+* @code{RRSPACING}:     RRSPACING, Reciprocal of the relative spacing
+* @code{RSHIFT}:        RSHIFT,    Right shift bits
+* @code{SAME_TYPE_AS}:  SAME_TYPE_AS,  Query dynamic types for equality
+* @code{SCALE}:         SCALE,     Scale a real value
+* @code{SCAN}:          SCAN,      Scan a string for the presence of a set of characters
+* @code{SECNDS}:        SECNDS,    Time function
+* @code{SECOND}:        SECOND,    CPU time function
+* @code{SELECTED_CHAR_KIND}: SELECTED_CHAR_KIND,  Choose character kind
+* @code{SELECTED_INT_KIND}: SELECTED_INT_KIND,  Choose integer kind
+* @code{SELECTED_REAL_KIND}: SELECTED_REAL_KIND,  Choose real kind
+* @code{SET_EXPONENT}:  SET_EXPONENT, Set the exponent of the model
+* @code{SHAPE}:         SHAPE,     Determine the shape of an array
+* @code{SHIFTA}:        SHIFTA,    Right shift with fill
+* @code{SHIFTL}:        SHIFTL,    Left shift
+* @code{SHIFTR}:        SHIFTR,    Right shift
+* @code{SIGN}:          SIGN,      Sign copying function
+* @code{SIGNAL}:        SIGNAL,    Signal handling subroutine (or function)
+* @code{SIN}:           SIN,       Sine function
+* @code{SINH}:          SINH,      Hyperbolic sine function
+* @code{SIZE}:          SIZE,      Function to determine the size of an array
+* @code{SIZEOF}:        SIZEOF,    Determine the size in bytes of an expression
+* @code{SLEEP}:         SLEEP,     Sleep for the specified number of seconds
+* @code{SPACING}:       SPACING,   Smallest distance between two numbers of a given type
+* @code{SPREAD}:        SPREAD,    Add a dimension to an array 
+* @code{SQRT}:          SQRT,      Square-root function
+* @code{SRAND}:         SRAND,     Reinitialize the random number generator
+* @code{STAT}:          STAT,      Get file status
+* @code{STORAGE_SIZE}:  STORAGE_SIZE, Storage size in bits
+* @code{SUM}:           SUM,       Sum of array elements
+* @code{SYMLNK}:        SYMLNK,    Create a symbolic link
+* @code{SYSTEM}:        SYSTEM,    Execute a shell command
+* @code{SYSTEM_CLOCK}:  SYSTEM_CLOCK, Time function
+* @code{TAN}:           TAN,       Tangent function
+* @code{TANH}:          TANH,      Hyperbolic tangent function
+* @code{THIS_IMAGE}:    THIS_IMAGE, Cosubscript index of this image
+* @code{TIME}:          TIME,      Time function
+* @code{TIME8}:         TIME8,     Time function (64-bit)
+* @code{TINY}:          TINY,      Smallest positive number of a real kind
+* @code{TRAILZ}:        TRAILZ,    Number of trailing zero bits of an integer
+* @code{TRANSFER}:      TRANSFER,  Transfer bit patterns
+* @code{TRANSPOSE}:     TRANSPOSE, Transpose an array of rank two
+* @code{TRIM}:          TRIM,      Remove trailing blank characters of a string
+* @code{TTYNAM}:        TTYNAM,    Get the name of a terminal device.
+* @code{UBOUND}:        UBOUND,    Upper dimension bounds of an array
+* @code{UCOBOUND}:      UCOBOUND,  Upper codimension bounds of an array
+* @code{UMASK}:         UMASK,     Set the file creation mask
+* @code{UNLINK}:        UNLINK,    Remove a file from the file system
+* @code{UNPACK}:        UNPACK,    Unpack an array of rank one into an array
+* @code{VERIFY}:        VERIFY,    Scan a string for the absence of a set of characters
+* @code{XOR}:           XOR,       Bitwise logical exclusive or
+@end menu
+
+@node Introduction to Intrinsics
+@section Introduction to intrinsic procedures
+
+The intrinsic procedures provided by GNU Fortran include all of the
+intrinsic procedures required by the Fortran 95 standard, a set of
+intrinsic procedures for backwards compatibility with G77, and a
+selection of intrinsic procedures from the Fortran 2003 and Fortran 2008
+standards.  Any conflict between a description here and a description in
+either the Fortran 95 standard, the Fortran 2003 standard or the Fortran
+2008 standard is unintentional, and the standard(s) should be considered
+authoritative.
+
+The enumeration of the @code{KIND} type parameter is processor defined in
+the Fortran 95 standard.  GNU Fortran defines the default integer type and
+default real type by @code{INTEGER(KIND=4)} and @code{REAL(KIND=4)},
+respectively.  The standard mandates that both data types shall have
+another kind, which have more precision.  On typical target architectures
+supported by @command{gfortran}, this kind type parameter is @code{KIND=8}.
+Hence, @code{REAL(KIND=8)} and @code{DOUBLE PRECISION} are equivalent.
+In the description of generic intrinsic procedures, the kind type parameter
+will be specified by @code{KIND=*}, and in the description of specific
+names for an intrinsic procedure the kind type parameter will be explicitly
+given (e.g., @code{REAL(KIND=4)} or @code{REAL(KIND=8)}).  Finally, for
+brevity the optional @code{KIND=} syntax will be omitted.
+
+Many of the intrinsic procedures take one or more optional arguments.
+This document follows the convention used in the Fortran 95 standard,
+and denotes such arguments by square brackets.
+
+GNU Fortran offers the @option{-std=f95} and @option{-std=gnu} options,
+which can be used to restrict the set of intrinsic procedures to a 
+given standard.  By default, @command{gfortran} sets the @option{-std=gnu}
+option, and so all intrinsic procedures described here are accepted.  There
+is one caveat.  For a select group of intrinsic procedures, @command{g77}
+implemented both a function and a subroutine.  Both classes 
+have been implemented in @command{gfortran} for backwards compatibility
+with @command{g77}.  It is noted here that these functions and subroutines
+cannot be intermixed in a given subprogram.  In the descriptions that follow,
+the applicable standard for each intrinsic procedure is noted.
+
+
+
+@node ABORT
+@section @code{ABORT} --- Abort the program
+@fnindex ABORT
+@cindex program termination, with core dump
+@cindex terminate program, with core dump
+@cindex core, dump
+
+@table @asis
+@item @emph{Description}:
+@code{ABORT} causes immediate termination of the program.  On operating
+systems that support a core dump, @code{ABORT} will produce a core dump even if
+the option @option{-fno-dump-core} is in effect, which is suitable for debugging
+purposes.
+@c TODO: Check if this (with -fno-dump-core) is correct.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL ABORT}
+
+@item @emph{Return value}:
+Does not return.
+
+@item @emph{Example}:
+@smallexample
+program test_abort
+  integer :: i = 1, j = 2
+  if (i /= j) call abort
+end program test_abort
+@end smallexample
+
+@item @emph{See also}:
+@ref{EXIT}, @ref{KILL}
+
+@end table
+
+
+
+@node ABS
+@section @code{ABS} --- Absolute value
+@fnindex ABS
+@fnindex CABS
+@fnindex DABS
+@fnindex IABS
+@fnindex ZABS
+@fnindex CDABS
+@cindex absolute value
+
+@table @asis
+@item @emph{Description}:
+@code{ABS(A)} computes the absolute value of @code{A}.
+
+@item @emph{Standard}:
+Fortran 77 and later, has overloads that are GNU extensions
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ABS(A)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab The type of the argument shall be an @code{INTEGER},
+@code{REAL}, or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and
+kind as the argument except the return value is @code{REAL} for a
+@code{COMPLEX} argument.
+
+@item @emph{Example}:
+@smallexample
+program test_abs
+  integer :: i = -1
+  real :: x = -1.e0
+  complex :: z = (-1.e0,0.e0)
+  i = abs(i)
+  x = abs(x)
+  x = abs(z)
+end program test_abs
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument            @tab Return type       @tab Standard
+@item @code{ABS(A)}   @tab @code{REAL(4) A}    @tab @code{REAL(4)}    @tab Fortran 77 and later
+@item @code{CABS(A)}  @tab @code{COMPLEX(4) A} @tab @code{REAL(4)}    @tab Fortran 77 and later
+@item @code{DABS(A)}  @tab @code{REAL(8) A}    @tab @code{REAL(8)}    @tab Fortran 77 and later
+@item @code{IABS(A)}  @tab @code{INTEGER(4) A} @tab @code{INTEGER(4)} @tab Fortran 77 and later
+@item @code{ZABS(A)}  @tab @code{COMPLEX(8) A} @tab @code{COMPLEX(8)} @tab GNU extension
+@item @code{CDABS(A)} @tab @code{COMPLEX(8) A} @tab @code{COMPLEX(8)} @tab GNU extension
+@end multitable
+@end table
+
+
+
+@node ACCESS
+@section @code{ACCESS} --- Checks file access modes
+@fnindex ACCESS
+@cindex file system, access mode
+
+@table @asis
+@item @emph{Description}:
+@code{ACCESS(NAME, MODE)} checks whether the file @var{NAME} 
+exists, is readable, writable or executable. Except for the
+executable check, @code{ACCESS} can be replaced by
+Fortran 95's @code{INQUIRE}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = ACCESS(NAME, MODE)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{NAME} @tab Scalar @code{CHARACTER} of default kind with the
+file name. Tailing blank are ignored unless the character @code{achar(0)}
+is present, then all characters up to and excluding @code{achar(0)} are
+used as file name.
+@item @var{MODE} @tab Scalar @code{CHARACTER} of default kind with the
+file access mode, may be any concatenation of @code{"r"} (readable),
+@code{"w"} (writable) and @code{"x"} (executable), or @code{" "} to check
+for existence.
+@end multitable
+
+@item @emph{Return value}:
+Returns a scalar @code{INTEGER}, which is @code{0} if the file is
+accessible in the given mode; otherwise or if an invalid argument
+has been given for @code{MODE} the value @code{1} is returned.
+
+@item @emph{Example}:
+@smallexample
+program access_test
+  implicit none
+  character(len=*), parameter :: file  = 'test.dat'
+  character(len=*), parameter :: file2 = 'test.dat  '//achar(0)
+  if(access(file,' ') == 0) print *, trim(file),' is exists'
+  if(access(file,'r') == 0) print *, trim(file),' is readable'
+  if(access(file,'w') == 0) print *, trim(file),' is writable'
+  if(access(file,'x') == 0) print *, trim(file),' is executable'
+  if(access(file2,'rwx') == 0) &
+    print *, trim(file2),' is readable, writable and executable'
+end program access_test
+@end smallexample
+@item @emph{Specific names}:
+@item @emph{See also}:
+
+@end table
+
+
+
+@node ACHAR
+@section @code{ACHAR} --- Character in @acronym{ASCII} collating sequence 
+@fnindex ACHAR
+@cindex @acronym{ASCII} collating sequence
+@cindex collating sequence, @acronym{ASCII}
+
+@table @asis
+@item @emph{Description}:
+@code{ACHAR(I)} returns the character located at position @code{I}
+in the @acronym{ASCII} collating sequence.
+
+@item @emph{Standard}:
+Fortran 77 and later, with @var{KIND} argument Fortran 2003 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ACHAR(I [, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I}    @tab The type shall be @code{INTEGER}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{CHARACTER} with a length of one.
+If the @var{KIND} argument is present, the return value is of the
+specified kind and of the default kind otherwise.
+
+@item @emph{Example}:
+@smallexample
+program test_achar
+  character c
+  c = achar(32)
+end program test_achar
+@end smallexample
+
+@item @emph{Note}:
+See @ref{ICHAR} for a discussion of converting between numerical values
+and formatted string representations.
+
+@item @emph{See also}:
+@ref{CHAR}, @ref{IACHAR}, @ref{ICHAR}
+
+@end table
+
+
+
+@node ACOS
+@section @code{ACOS} --- Arccosine function 
+@fnindex ACOS
+@fnindex DACOS
+@cindex trigonometric function, cosine, inverse
+@cindex cosine, inverse
+
+@table @asis
+@item @emph{Description}:
+@code{ACOS(X)} computes the arccosine of @var{X} (inverse of @code{COS(X)}).
+
+@item @emph{Standard}:
+Fortran 77 and later, for a complex argument Fortran 2008 or later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ACOS(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall either be @code{REAL} with a magnitude that is
+less than or equal to one - or the type shall be @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as @var{X}.
+The real part of the result is in radians and lies in the range
+@math{0 \leq \Re \acos(x) \leq \pi}.
+
+@item @emph{Example}:
+@smallexample
+program test_acos
+  real(8) :: x = 0.866_8
+  x = acos(x)
+end program test_acos
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument         @tab Return type     @tab Standard
+@item @code{ACOS(X)}  @tab @code{REAL(4) X} @tab @code{REAL(4)}  @tab Fortran 77 and later
+@item @code{DACOS(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)}  @tab Fortran 77 and later
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{COS}
+
+@end table
+
+
+
+@node ACOSH
+@section @code{ACOSH} --- Inverse hyperbolic cosine function
+@fnindex ACOSH
+@fnindex DACOSH
+@cindex area hyperbolic cosine
+@cindex inverse hyperbolic cosine
+@cindex hyperbolic function, cosine, inverse
+@cindex cosine, hyperbolic, inverse
+
+@table @asis
+@item @emph{Description}:
+@code{ACOSH(X)} computes the inverse hyperbolic cosine of @var{X}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ACOSH(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has the same type and kind as @var{X}. If @var{X} is
+complex, the imaginary part of the result is in radians and lies between
+@math{ 0 \leq \Im \acosh(x) \leq \pi}.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_acosh
+  REAL(8), DIMENSION(3) :: x = (/ 1.0, 2.0, 3.0 /)
+  WRITE (*,*) ACOSH(x)
+END PROGRAM
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Argument          @tab Return type       @tab Standard
+@item @code{DACOSH(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{COSH}
+@end table
+
+
+
+@node ADJUSTL
+@section @code{ADJUSTL} --- Left adjust a string 
+@fnindex ADJUSTL
+@cindex string, adjust left
+@cindex adjust string
+
+@table @asis
+@item @emph{Description}:
+@code{ADJUSTL(STRING)} will left adjust a string by removing leading spaces.
+Spaces are inserted at the end of the string as needed.
+
+@item @emph{Standard}:
+Fortran 90 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ADJUSTL(STRING)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING} @tab The type shall be @code{CHARACTER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{CHARACTER} and of the same kind as
+@var{STRING} where leading spaces are removed and the same number of
+spaces are inserted on the end of @var{STRING}.
+
+@item @emph{Example}:
+@smallexample
+program test_adjustl
+  character(len=20) :: str = '   gfortran'
+  str = adjustl(str)
+  print *, str
+end program test_adjustl
+@end smallexample
+
+@item @emph{See also}:
+@ref{ADJUSTR}, @ref{TRIM}
+@end table
+
+
+
+@node ADJUSTR
+@section @code{ADJUSTR} --- Right adjust a string 
+@fnindex ADJUSTR
+@cindex string, adjust right
+@cindex adjust string
+
+@table @asis
+@item @emph{Description}:
+@code{ADJUSTR(STRING)} will right adjust a string by removing trailing spaces.
+Spaces are inserted at the start of the string as needed.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ADJUSTR(STRING)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STR} @tab The type shall be @code{CHARACTER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{CHARACTER} and of the same kind as
+@var{STRING} where trailing spaces are removed and the same number of
+spaces are inserted at the start of @var{STRING}.
+
+@item @emph{Example}:
+@smallexample
+program test_adjustr
+  character(len=20) :: str = 'gfortran'
+  str = adjustr(str)
+  print *, str
+end program test_adjustr
+@end smallexample
+
+@item @emph{See also}:
+@ref{ADJUSTL}, @ref{TRIM}
+@end table
+
+
+
+@node AIMAG
+@section @code{AIMAG} --- Imaginary part of complex number  
+@fnindex AIMAG
+@fnindex DIMAG
+@fnindex IMAG
+@fnindex IMAGPART
+@cindex complex numbers, imaginary part
+
+@table @asis
+@item @emph{Description}:
+@code{AIMAG(Z)} yields the imaginary part of complex argument @code{Z}.
+The @code{IMAG(Z)} and @code{IMAGPART(Z)} intrinsic functions are provided
+for compatibility with @command{g77}, and their use in new code is 
+strongly discouraged.
+
+@item @emph{Standard}:
+Fortran 77 and later, has overloads that are GNU extensions
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = AIMAG(Z)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{Z} @tab The type of the argument shall be @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL} with the
+kind type parameter of the argument.
+
+@item @emph{Example}:
+@smallexample
+program test_aimag
+  complex(4) z4
+  complex(8) z8
+  z4 = cmplx(1.e0_4, 0.e0_4)
+  z8 = cmplx(0.e0_8, 1.e0_8)
+  print *, aimag(z4), dimag(z8)
+end program test_aimag
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name               @tab Argument            @tab Return type     @tab Standard
+@item @code{AIMAG(Z)}    @tab @code{COMPLEX Z}    @tab @code{REAL}     @tab GNU extension
+@item @code{DIMAG(Z)}    @tab @code{COMPLEX(8) Z} @tab @code{REAL(8)}  @tab GNU extension
+@item @code{IMAG(Z)}     @tab @code{COMPLEX Z}    @tab @code{REAL}     @tab GNU extension
+@item @code{IMAGPART(Z)} @tab @code{COMPLEX Z}    @tab @code{REAL}     @tab GNU extension
+@end multitable
+@end table
+
+
+
+@node AINT
+@section @code{AINT} --- Truncate to a whole number
+@fnindex AINT
+@fnindex DINT
+@cindex floor
+@cindex rounding, floor
+
+@table @asis
+@item @emph{Description}:
+@code{AINT(A [, KIND])} truncates its argument to a whole number.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = AINT(A [, KIND])} 
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A}    @tab The type of the argument shall be @code{REAL}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL} with the kind type parameter of the
+argument if the optional @var{KIND} is absent; otherwise, the kind
+type parameter will be given by @var{KIND}.  If the magnitude of 
+@var{X} is less than one, @code{AINT(X)} returns zero.  If the
+magnitude is equal to or greater than one then it returns the largest
+whole number that does not exceed its magnitude.  The sign is the same
+as the sign of @var{X}. 
+
+@item @emph{Example}:
+@smallexample
+program test_aint
+  real(4) x4
+  real(8) x8
+  x4 = 1.234E0_4
+  x8 = 4.321_8
+  print *, aint(x4), dint(x8)
+  x8 = aint(x4,8)
+end program test_aint
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name           @tab Argument         @tab Return type      @tab Standard
+@item @code{AINT(A)} @tab @code{REAL(4) A} @tab @code{REAL(4)}   @tab Fortran 77 and later
+@item @code{DINT(A)} @tab @code{REAL(8) A} @tab @code{REAL(8)}   @tab Fortran 77 and later
+@end multitable
+@end table
+
+
+
+@node ALARM
+@section @code{ALARM} --- Execute a routine after a given delay
+@fnindex ALARM
+@cindex delayed execution
+
+@table @asis
+@item @emph{Description}:
+@code{ALARM(SECONDS, HANDLER [, STATUS])} causes external subroutine @var{HANDLER}
+to be executed after a delay of @var{SECONDS} by using @code{alarm(2)} to
+set up a signal and @code{signal(2)} to catch it. If @var{STATUS} is
+supplied, it will be returned with the number of seconds remaining until
+any previously scheduled alarm was due to be delivered, or zero if there
+was no previously scheduled alarm.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL ALARM(SECONDS, HANDLER [, STATUS])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{SECONDS} @tab The type of the argument shall be a scalar
+@code{INTEGER}. It is @code{INTENT(IN)}.
+@item @var{HANDLER} @tab Signal handler (@code{INTEGER FUNCTION} or
+@code{SUBROUTINE}) or dummy/global @code{INTEGER} scalar. The scalar 
+values may be either @code{SIG_IGN=1} to ignore the alarm generated 
+or @code{SIG_DFL=0} to set the default action. It is @code{INTENT(IN)}.
+@item @var{STATUS}  @tab (Optional) @var{STATUS} shall be a scalar
+variable of the default @code{INTEGER} kind. It is @code{INTENT(OUT)}.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program test_alarm
+  external handler_print
+  integer i
+  call alarm (3, handler_print, i)
+  print *, i
+  call sleep(10)
+end program test_alarm
+@end smallexample
+This will cause the external routine @var{handler_print} to be called
+after 3 seconds.
+@end table
+
+
+
+@node ALL
+@section @code{ALL} --- All values in @var{MASK} along @var{DIM} are true 
+@fnindex ALL
+@cindex array, apply condition
+@cindex array, condition testing
+
+@table @asis
+@item @emph{Description}:
+@code{ALL(MASK [, DIM])} determines if all the values are true in @var{MASK}
+in the array along dimension @var{DIM}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = ALL(MASK [, DIM])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{MASK} @tab The type of the argument shall be @code{LOGICAL} and
+it shall not be scalar.
+@item @var{DIM}  @tab (Optional) @var{DIM} shall be a scalar integer
+with a value that lies between one and the rank of @var{MASK}.
+@end multitable
+
+@item @emph{Return value}:
+@code{ALL(MASK)} returns a scalar value of type @code{LOGICAL} where
+the kind type parameter is the same as the kind type parameter of
+@var{MASK}.  If @var{DIM} is present, then @code{ALL(MASK, DIM)} returns
+an array with the rank of @var{MASK} minus 1.  The shape is determined from
+the shape of @var{MASK} where the @var{DIM} dimension is elided. 
+
+@table @asis
+@item (A)
+@code{ALL(MASK)} is true if all elements of @var{MASK} are true.
+It also is true if @var{MASK} has zero size; otherwise, it is false.
+@item (B)
+If the rank of @var{MASK} is one, then @code{ALL(MASK,DIM)} is equivalent
+to @code{ALL(MASK)}.  If the rank is greater than one, then @code{ALL(MASK,DIM)}
+is determined by applying @code{ALL} to the array sections.
+@end table
+
+@item @emph{Example}:
+@smallexample
+program test_all
+  logical l
+  l = all((/.true., .true., .true./))
+  print *, l
+  call section
+  contains
+    subroutine section
+      integer a(2,3), b(2,3)
+      a = 1
+      b = 1
+      b(2,2) = 2
+      print *, all(a .eq. b, 1)
+      print *, all(a .eq. b, 2)
+    end subroutine section
+end program test_all
+@end smallexample
+@end table
+
+
+
+@node ALLOCATED
+@section @code{ALLOCATED} --- Status of an allocatable entity
+@fnindex ALLOCATED
+@cindex allocation, status
+
+@table @asis
+@item @emph{Description}:
+@code{ALLOCATED(ARRAY)} and @code{ALLOCATED(SCALAR)} check the allocation
+status of @var{ARRAY} and @var{SCALAR}, respectively.
+
+@item @emph{Standard}:
+Fortran 95 and later.  Note, the @code{SCALAR=} keyword and allocatable
+scalar entities are available in Fortran 2003 and later.
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = ALLOCATED(ARRAY)}
+@item @code{RESULT = ALLOCATED(SCALAR)} 
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY}    @tab The argument shall be an @code{ALLOCATABLE} array.
+@item @var{SCALAR}   @tab The argument shall be an @code{ALLOCATABLE} scalar.
+@end multitable
+
+@item @emph{Return value}:
+The return value is a scalar @code{LOGICAL} with the default logical
+kind type parameter.  If the argument is allocated, then the result is
+@code{.TRUE.}; otherwise, it returns @code{.FALSE.} 
+
+@item @emph{Example}:
+@smallexample
+program test_allocated
+  integer :: i = 4
+  real(4), allocatable :: x(:)
+  if (.not. allocated(x)) allocate(x(i))
+end program test_allocated
+@end smallexample
+@end table
+
+
+
+@node AND
+@section @code{AND} --- Bitwise logical AND
+@fnindex AND
+@cindex bitwise logical and
+@cindex logical and, bitwise
+
+@table @asis
+@item @emph{Description}:
+Bitwise logical @code{AND}.
+
+This intrinsic routine is provided for backwards compatibility with 
+GNU Fortran 77.  For integer arguments, programmers should consider
+the use of the @ref{IAND} intrinsic defined by the Fortran standard.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = AND(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be either a scalar @code{INTEGER}
+type or a scalar @code{LOGICAL} type.
+@item @var{J} @tab The type shall be the same as the type of @var{I}.
+@end multitable
+
+@item @emph{Return value}:
+The return type is either a scalar @code{INTEGER} or a scalar
+@code{LOGICAL}.  If the kind type parameters differ, then the
+smaller kind type is implicitly converted to larger kind, and the 
+return has the larger kind.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_and
+  LOGICAL :: T = .TRUE., F = .FALSE.
+  INTEGER :: a, b
+  DATA a / Z'F' /, b / Z'3' /
+
+  WRITE (*,*) AND(T, T), AND(T, F), AND(F, T), AND(F, F)
+  WRITE (*,*) AND(a, b)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+Fortran 95 elemental function: @ref{IAND}
+@end table
+
+
+
+@node ANINT
+@section @code{ANINT} --- Nearest whole number
+@fnindex ANINT
+@fnindex DNINT
+@cindex ceiling
+@cindex rounding, ceiling
+
+@table @asis
+@item @emph{Description}:
+@code{ANINT(A [, KIND])} rounds its argument to the nearest whole number.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ANINT(A [, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A}    @tab The type of the argument shall be @code{REAL}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type real with the kind type parameter of the
+argument if the optional @var{KIND} is absent; otherwise, the kind
+type parameter will be given by @var{KIND}.  If @var{A} is greater than
+zero, @code{ANINT(A)} returns @code{AINT(X+0.5)}.  If @var{A} is
+less than or equal to zero then it returns @code{AINT(X-0.5)}.
+
+@item @emph{Example}:
+@smallexample
+program test_anint
+  real(4) x4
+  real(8) x8
+  x4 = 1.234E0_4
+  x8 = 4.321_8
+  print *, anint(x4), dnint(x8)
+  x8 = anint(x4,8)
+end program test_anint
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument         @tab Return type      @tab Standard
+@item @code{AINT(A)}  @tab @code{REAL(4) A} @tab @code{REAL(4)}   @tab Fortran 77 and later
+@item @code{DNINT(A)} @tab @code{REAL(8) A} @tab @code{REAL(8)}   @tab Fortran 77 and later
+@end multitable
+@end table
+
+
+
+@node ANY
+@section @code{ANY} --- Any value in @var{MASK} along @var{DIM} is true 
+@fnindex ANY
+@cindex array, apply condition
+@cindex array, condition testing
+
+@table @asis
+@item @emph{Description}:
+@code{ANY(MASK [, DIM])} determines if any of the values in the logical array
+@var{MASK} along dimension @var{DIM} are @code{.TRUE.}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = ANY(MASK [, DIM])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{MASK} @tab The type of the argument shall be @code{LOGICAL} and
+it shall not be scalar.
+@item @var{DIM}  @tab (Optional) @var{DIM} shall be a scalar integer
+with a value that lies between one and the rank of @var{MASK}.
+@end multitable
+
+@item @emph{Return value}:
+@code{ANY(MASK)} returns a scalar value of type @code{LOGICAL} where
+the kind type parameter is the same as the kind type parameter of
+@var{MASK}.  If @var{DIM} is present, then @code{ANY(MASK, DIM)} returns
+an array with the rank of @var{MASK} minus 1.  The shape is determined from
+the shape of @var{MASK} where the @var{DIM} dimension is elided. 
+
+@table @asis
+@item (A)
+@code{ANY(MASK)} is true if any element of @var{MASK} is true;
+otherwise, it is false.  It also is false if @var{MASK} has zero size.
+@item (B)
+If the rank of @var{MASK} is one, then @code{ANY(MASK,DIM)} is equivalent
+to @code{ANY(MASK)}.  If the rank is greater than one, then @code{ANY(MASK,DIM)}
+is determined by applying @code{ANY} to the array sections.
+@end table
+
+@item @emph{Example}:
+@smallexample
+program test_any
+  logical l
+  l = any((/.true., .true., .true./))
+  print *, l
+  call section
+  contains
+    subroutine section
+      integer a(2,3), b(2,3)
+      a = 1
+      b = 1
+      b(2,2) = 2
+      print *, any(a .eq. b, 1)
+      print *, any(a .eq. b, 2)
+    end subroutine section
+end program test_any
+@end smallexample
+@end table
+
+
+
+@node ASIN
+@section @code{ASIN} --- Arcsine function 
+@fnindex ASIN
+@fnindex DASIN
+@cindex trigonometric function, sine, inverse
+@cindex sine, inverse
+
+@table @asis
+@item @emph{Description}:
+@code{ASIN(X)} computes the arcsine of its @var{X} (inverse of @code{SIN(X)}).
+
+@item @emph{Standard}:
+Fortran 77 and later, for a complex argument Fortran 2008 or later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ASIN(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be either @code{REAL} and a magnitude that is
+less than or equal to one - or be @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as @var{X}.
+The real part of the result is in radians and lies in the range
+@math{-\pi/2 \leq \Re \asin(x) \leq \pi/2}.
+
+@item @emph{Example}:
+@smallexample
+program test_asin
+  real(8) :: x = 0.866_8
+  x = asin(x)
+end program test_asin
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type       @tab Standard
+@item @code{ASIN(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab Fortran 77 and later
+@item @code{DASIN(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab Fortran 77 and later
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{SIN}
+
+@end table
+
+
+
+@node ASINH
+@section @code{ASINH} --- Inverse hyperbolic sine function
+@fnindex ASINH
+@fnindex DASINH
+@cindex area hyperbolic sine
+@cindex inverse hyperbolic sine
+@cindex hyperbolic function, sine, inverse
+@cindex sine, hyperbolic, inverse
+
+@table @asis
+@item @emph{Description}:
+@code{ASINH(X)} computes the inverse hyperbolic sine of @var{X}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ASINH(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as  @var{X}. If @var{X} is
+complex, the imaginary part of the result is in radians and lies between
+@math{-\pi/2 \leq \Im \asinh(x) \leq \pi/2}.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_asinh
+  REAL(8), DIMENSION(3) :: x = (/ -1.0, 0.0, 1.0 /)
+  WRITE (*,*) ASINH(x)
+END PROGRAM
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Argument          @tab Return type       @tab Standard
+@item @code{DASINH(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension.
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{SINH}
+@end table
+
+
+
+@node ASSOCIATED
+@section @code{ASSOCIATED} --- Status of a pointer or pointer/target pair 
+@fnindex ASSOCIATED
+@cindex pointer, status
+@cindex association status
+
+@table @asis
+@item @emph{Description}:
+@code{ASSOCIATED(POINTER [, TARGET])} determines the status of the pointer
+@var{POINTER} or if @var{POINTER} is associated with the target @var{TARGET}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = ASSOCIATED(POINTER [, TARGET])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{POINTER} @tab @var{POINTER} shall have the @code{POINTER} attribute
+and it can be of any type.
+@item @var{TARGET} @tab (Optional) @var{TARGET} shall be a pointer or
+a target.  It must have the same type, kind type parameter, and
+array rank as @var{POINTER}.
+@end multitable
+The association status of neither @var{POINTER} nor @var{TARGET} shall be
+undefined.
+
+@item @emph{Return value}:
+@code{ASSOCIATED(POINTER)} returns a scalar value of type @code{LOGICAL(4)}.
+There are several cases:
+@table @asis
+@item (A) When the optional @var{TARGET} is not present then
+@code{ASSOCIATED(POINTER)} is true if @var{POINTER} is associated with a target; otherwise, it returns false.
+@item (B) If @var{TARGET} is present and a scalar target, the result is true if
+@var{TARGET} is not a zero-sized storage sequence and the target associated with @var{POINTER} occupies the same storage units.  If @var{POINTER} is
+disassociated, the result is false.
+@item (C) If @var{TARGET} is present and an array target, the result is true if
+@var{TARGET} and @var{POINTER} have the same shape, are not zero-sized arrays,
+are arrays whose elements are not zero-sized storage sequences, and
+@var{TARGET} and @var{POINTER} occupy the same storage units in array element
+order.
+As in case(B), the result is false, if @var{POINTER} is disassociated.
+@item (D) If @var{TARGET} is present and an scalar pointer, the result is true
+if @var{TARGET} is associated with @var{POINTER}, the target associated with
+@var{TARGET} are not zero-sized storage sequences and occupy the same storage
+units.
+The result is false, if either @var{TARGET} or @var{POINTER} is disassociated.
+@item (E) If @var{TARGET} is present and an array pointer, the result is true if
+target associated with @var{POINTER} and the target associated with @var{TARGET}
+have the same shape, are not zero-sized arrays, are arrays whose elements are
+not zero-sized storage sequences, and @var{TARGET} and @var{POINTER} occupy
+the same storage units in array element order.
+The result is false, if either @var{TARGET} or @var{POINTER} is disassociated.
+@end table
+
+@item @emph{Example}:
+@smallexample
+program test_associated
+   implicit none
+   real, target  :: tgt(2) = (/1., 2./)
+   real, pointer :: ptr(:)
+   ptr => tgt
+   if (associated(ptr)     .eqv. .false.) call abort
+   if (associated(ptr,tgt) .eqv. .false.) call abort
+end program test_associated
+@end smallexample
+
+@item @emph{See also}:
+@ref{NULL}
+@end table
+
+
+
+@node ATAN
+@section @code{ATAN} --- Arctangent function 
+@fnindex ATAN
+@fnindex DATAN
+@cindex trigonometric function, tangent, inverse
+@cindex tangent, inverse
+
+@table @asis
+@item @emph{Description}:
+@code{ATAN(X)} computes the arctangent of @var{X}.
+
+@item @emph{Standard}:
+Fortran 77 and later, for a complex argument and for two arguments
+Fortran 2008 or later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = ATAN(X)}
+@item @code{RESULT = ATAN(Y, X)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX};
+if @var{Y} is present, @var{X} shall be REAL.
+@item @var{Y} shall be of the same type and kind as @var{X}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as @var{X}.
+If @var{Y} is present, the result is identical to @code{ATAN2(Y,X)}.
+Otherwise, it the arcus tangent of @var{X}, where the real part of
+the result is in radians and lies in the range
+@math{-\pi/2 \leq \Re \atan(x) \leq \pi/2}.
+
+@item @emph{Example}:
+@smallexample
+program test_atan
+  real(8) :: x = 2.866_8
+  x = atan(x)
+end program test_atan
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type       @tab Standard
+@item @code{ATAN(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab Fortran 77 and later
+@item @code{DATAN(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab Fortran 77 and later
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{TAN}
+
+@end table
+
+
+
+@node ATAN2
+@section @code{ATAN2} --- Arctangent function 
+@fnindex ATAN2
+@fnindex DATAN2
+@cindex trigonometric function, tangent, inverse
+@cindex tangent, inverse
+
+@table @asis
+@item @emph{Description}:
+@code{ATAN2(Y, X)} computes the principal value of the argument
+function of the complex number @math{X + i Y}. This function can
+be used to transform from Cartesian into polar coordinates and
+allows to determine the angle in the correct quadrant.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ATAN2(Y, X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{Y} @tab The type shall be @code{REAL}.
+@item @var{X} @tab The type and kind type parameter shall be the same as @var{Y}.
+If @var{Y} is zero, then @var{X} must be nonzero.
+@end multitable
+
+@item @emph{Return value}:
+The return value has the same type and kind type parameter as @var{Y}.
+It is the principal value of the complex number @math{X + i Y}.  If
+@var{X} is nonzero, then it lies in the range @math{-\pi \le \atan (x) \leq \pi}.
+The sign is positive if @var{Y} is positive.  If @var{Y} is zero, then
+the return value is zero if @var{X} is positive and @math{\pi} if @var{X}
+is negative.  Finally, if @var{X} is zero, then the magnitude of the result
+is @math{\pi/2}.
+
+@item @emph{Example}:
+@smallexample
+program test_atan2
+  real(4) :: x = 1.e0_4, y = 0.5e0_4
+  x = atan2(y,x)
+end program test_atan2
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name                @tab Argument            @tab Return type    @tab Standard
+@item @code{ATAN2(X, Y)}  @tab @code{REAL(4) X, Y} @tab @code{REAL(4)} @tab Fortran 77 and later
+@item @code{DATAN2(X, Y)} @tab @code{REAL(8) X, Y} @tab @code{REAL(8)} @tab Fortran 77 and later
+@end multitable
+@end table
+
+
+
+@node ATANH
+@section @code{ATANH} --- Inverse hyperbolic tangent function
+@fnindex ATANH
+@fnindex DATANH
+@cindex area hyperbolic tangent
+@cindex inverse hyperbolic tangent
+@cindex hyperbolic function, tangent, inverse
+@cindex tangent, hyperbolic, inverse
+
+@table @asis
+@item @emph{Description}:
+@code{ATANH(X)} computes the inverse hyperbolic tangent of @var{X}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ATANH(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{X}. If @var{X} is
+complex, the imaginary part of the result is in radians and lies between
+@math{-\pi/2 \leq \Im \atanh(x) \leq \pi/2}.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_atanh
+  REAL, DIMENSION(3) :: x = (/ -1.0, 0.0, 1.0 /)
+  WRITE (*,*) ATANH(x)
+END PROGRAM
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Argument          @tab Return type       @tab Standard
+@item @code{DATANH(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{TANH}
+@end table
+
+
+
+@node BESSEL_J0
+@section @code{BESSEL_J0} --- Bessel function of the first kind of order 0
+@fnindex BESSEL_J0
+@fnindex BESJ0
+@fnindex DBESJ0
+@cindex Bessel function, first kind
+
+@table @asis
+@item @emph{Description}:
+@code{BESSEL_J0(X)} computes the Bessel function of the first kind of
+order 0 of @var{X}. This function is available under the name
+@code{BESJ0} as a GNU extension.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = BESSEL_J0(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL}, and it shall be scalar.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL} and lies in the
+range @math{ - 0.4027... \leq Bessel (0,x) \leq 1}. It has the same
+kind as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_besj0
+  real(8) :: x = 0.0_8
+  x = bessel_j0(x)
+end program test_besj0
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type       @tab Standard
+@item @code{DBESJ0(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}   @tab GNU extension
+@end multitable
+@end table
+
+
+
+@node BESSEL_J1
+@section @code{BESSEL_J1} --- Bessel function of the first kind of order 1
+@fnindex BESSEL_J1
+@fnindex BESJ1
+@fnindex DBESJ1
+@cindex Bessel function, first kind
+
+@table @asis
+@item @emph{Description}:
+@code{BESSEL_J1(X)} computes the Bessel function of the first kind of
+order 1 of @var{X}. This function is available under the name
+@code{BESJ1} as a GNU extension.
+
+@item @emph{Standard}:
+Fortran 2008
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = BESSEL_J1(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL}, and it shall be scalar.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL} and it lies in the
+range @math{ - 0.5818... \leq Bessel (0,x) \leq 0.5818 }. It has the same
+kind as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_besj1
+  real(8) :: x = 1.0_8
+  x = bessel_j1(x)
+end program test_besj1
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Argument          @tab Return type       @tab Standard
+@item @code{DBESJ1(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
+@end multitable
+@end table
+
+
+
+@node BESSEL_JN
+@section @code{BESSEL_JN} --- Bessel function of the first kind
+@fnindex BESSEL_JN
+@fnindex BESJN
+@fnindex DBESJN
+@cindex Bessel function, first kind
+
+@table @asis
+@item @emph{Description}:
+@code{BESSEL_JN(N, X)} computes the Bessel function of the first kind of
+order @var{N} of @var{X}. This function is available under the name
+@code{BESJN} as a GNU extension.  If @var{N} and @var{X} are arrays,
+their ranks and shapes shall conform.  
+
+@code{BESSEL_JN(N1, N2, X)} returns an array with the Bessel functions
+of the first kind of the orders @var{N1} to @var{N2}.
+
+@item @emph{Standard}:
+Fortran 2008 and later, negative @var{N} is allowed as GNU extension
+
+@item @emph{Class}:
+Elemental function, except for the transformational function
+@code{BESSEL_JN(N1, N2, X)}
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = BESSEL_JN(N, X)}
+@item @code{RESULT = BESSEL_JN(N1, N2, X)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{N} @tab Shall be a scalar or an array of type  @code{INTEGER}.
+@item @var{N1} @tab Shall be a non-negative scalar of type  @code{INTEGER}.
+@item @var{N2} @tab Shall be a non-negative scalar of type  @code{INTEGER}.
+@item @var{X} @tab Shall be a scalar or an array of type  @code{REAL};
+for @code{BESSEL_JN(N1, N2, X)} it shall be scalar.
+@end multitable
+
+@item @emph{Return value}:
+The return value is a scalar of type @code{REAL}. It has the same
+kind as @var{X}.
+
+@item @emph{Note}:
+The transformational function uses a recurrence algorithm which might,
+for some values of @var{X}, lead to different results than calls to
+the elemental function.
+
+@item @emph{Example}:
+@smallexample
+program test_besjn
+  real(8) :: x = 1.0_8
+  x = bessel_jn(5,x)
+end program test_besjn
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name                @tab Argument            @tab Return type       @tab Standard
+@item @code{DBESJN(N, X)} @tab @code{INTEGER N}    @tab @code{REAL(8)}    @tab GNU extension
+@item                     @tab @code{REAL(8) X}    @tab                   @tab
+@end multitable
+@end table
+
+
+
+@node BESSEL_Y0
+@section @code{BESSEL_Y0} --- Bessel function of the second kind of order 0
+@fnindex BESSEL_Y0
+@fnindex BESY0
+@fnindex DBESY0
+@cindex Bessel function, second kind
+
+@table @asis
+@item @emph{Description}:
+@code{BESSEL_Y0(X)} computes the Bessel function of the second kind of
+order 0 of @var{X}. This function is available under the name
+@code{BESY0} as a GNU extension.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = BESSEL_Y0(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL}, and it shall be scalar.
+@end multitable
+
+@item @emph{Return value}:
+The return value is a scalar of type @code{REAL}. It has the same
+kind as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_besy0
+  real(8) :: x = 0.0_8
+  x = bessel_y0(x)
+end program test_besy0
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type       @tab Standard
+@item @code{DBESY0(X)}@tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
+@end multitable
+@end table
+
+
+
+@node BESSEL_Y1
+@section @code{BESSEL_Y1} --- Bessel function of the second kind of order 1
+@fnindex BESSEL_Y1
+@fnindex BESY1
+@fnindex DBESY1
+@cindex Bessel function, second kind
+
+@table @asis
+@item @emph{Description}:
+@code{BESSEL_Y1(X)} computes the Bessel function of the second kind of
+order 1 of @var{X}. This function is available under the name
+@code{BESY1} as a GNU extension.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = BESSEL_Y1(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL}, and it shall be scalar.
+@end multitable
+
+@item @emph{Return value}:
+The return value is a scalar of type @code{REAL}. It has the same
+kind as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_besy1
+  real(8) :: x = 1.0_8
+  x = bessel_y1(x)
+end program test_besy1
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type       @tab Standard
+@item @code{DBESY1(X)}@tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
+@end multitable
+@end table
+
+
+
+@node BESSEL_YN
+@section @code{BESSEL_YN} --- Bessel function of the second kind
+@fnindex BESSEL_YN
+@fnindex BESYN
+@fnindex DBESYN
+@cindex Bessel function, second kind
+
+@table @asis
+@item @emph{Description}:
+@code{BESSEL_YN(N, X)} computes the Bessel function of the second kind of
+order @var{N} of @var{X}. This function is available under the name
+@code{BESYN} as a GNU extension.  If @var{N} and @var{X} are arrays,
+their ranks and shapes shall conform.  
+
+@code{BESSEL_YN(N1, N2, X)} returns an array with the Bessel functions
+of the first kind of the orders @var{N1} to @var{N2}.
+
+@item @emph{Standard}:
+Fortran 2008 and later, negative @var{N} is allowed as GNU extension
+
+@item @emph{Class}:
+Elemental function, except for the transformational function
+@code{BESSEL_YN(N1, N2, X)}
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = BESSEL_YN(N, X)}
+@item @code{RESULT = BESSEL_YN(N1, N2, X)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{N} @tab Shall be a scalar or an array of type  @code{INTEGER} .
+@item @var{N1} @tab Shall be a non-negative scalar of type  @code{INTEGER}.
+@item @var{N2} @tab Shall be a non-negative scalar of type  @code{INTEGER}.
+@item @var{X} @tab Shall be a scalar or an array of type  @code{REAL};
+for @code{BESSEL_YN(N1, N2, X)} it shall be scalar.
+@end multitable
+
+@item @emph{Return value}:
+The return value is a scalar of type @code{REAL}. It has the same
+kind as @var{X}.
+
+@item @emph{Note}:
+The transformational function uses a recurrence algorithm which might,
+for some values of @var{X}, lead to different results than calls to
+the elemental function.
+
+@item @emph{Example}:
+@smallexample
+program test_besyn
+  real(8) :: x = 1.0_8
+  x = bessel_yn(5,x)
+end program test_besyn
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name               @tab Argument            @tab Return type     @tab Standard
+@item @code{DBESYN(N,X)} @tab @code{INTEGER N} @tab @code{REAL(8)}  @tab GNU extension
+@item                    @tab @code{REAL(8) X} @tab                 @tab 
+@end multitable
+@end table
+
+
+
+@node BGE
+@section @code{BGE} --- Bitwise greater than or equal to
+@fnindex BGE
+@cindex bitwise comparison
+
+@table @asis
+@item @emph{Description}:
+Determines whether an integral is a bitwise greater than or equal to
+another.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = BGE(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of @code{INTEGER} type.
+@item @var{J} @tab Shall be of @code{INTEGER} type, and of the same kind
+as @var{I}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{LOGICAL} and of the default kind.
+
+@item @emph{See also}:
+@ref{BGT}, @ref{BLE}, @ref{BLT}
+@end table
+
+
+
+@node BGT
+@section @code{BGT} --- Bitwise greater than
+@fnindex BGT
+@cindex bitwise comparison
+
+@table @asis
+@item @emph{Description}:
+Determines whether an integral is a bitwise greater than another.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = BGT(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of @code{INTEGER} type.
+@item @var{J} @tab Shall be of @code{INTEGER} type, and of the same kind
+as @var{I}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{LOGICAL} and of the default kind.
+
+@item @emph{See also}:
+@ref{BGE}, @ref{BLE}, @ref{BLT}
+@end table
+
+
+
+@node BIT_SIZE
+@section @code{BIT_SIZE} --- Bit size inquiry function
+@fnindex BIT_SIZE
+@cindex bits, number of
+@cindex size of a variable, in bits
+
+@table @asis
+@item @emph{Description}:
+@code{BIT_SIZE(I)} returns the number of bits (integer precision plus sign bit)
+represented by the type of @var{I}.  The result of @code{BIT_SIZE(I)} is
+independent of the actual value of @var{I}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = BIT_SIZE(I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER}
+
+@item @emph{Example}:
+@smallexample
+program test_bit_size
+    integer :: i = 123
+    integer :: size
+    size = bit_size(i)
+    print *, size
+end program test_bit_size
+@end smallexample
+@end table
+
+
+
+@node BLE
+@section @code{BLE} --- Bitwise less than or equal to
+@fnindex BLE
+@cindex bitwise comparison
+
+@table @asis
+@item @emph{Description}:
+Determines whether an integral is a bitwise less than or equal to
+another.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = BLE(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of @code{INTEGER} type.
+@item @var{J} @tab Shall be of @code{INTEGER} type, and of the same kind
+as @var{I}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{LOGICAL} and of the default kind.
+
+@item @emph{See also}:
+@ref{BGT}, @ref{BGE}, @ref{BLT}
+@end table
+
+
+
+@node BLT
+@section @code{BLT} --- Bitwise less than
+@fnindex BLT
+@cindex bitwise comparison
+
+@table @asis
+@item @emph{Description}:
+Determines whether an integral is a bitwise less than another.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = BLT(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of @code{INTEGER} type.
+@item @var{J} @tab Shall be of @code{INTEGER} type, and of the same kind
+as @var{I}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{LOGICAL} and of the default kind.
+
+@item @emph{See also}:
+@ref{BGE}, @ref{BGT}, @ref{BLE}
+@end table
+
+
+
+@node BTEST
+@section @code{BTEST} --- Bit test function
+@fnindex BTEST
+@cindex bits, testing
+
+@table @asis
+@item @emph{Description}:
+@code{BTEST(I,POS)} returns logical @code{.TRUE.} if the bit at @var{POS}
+in @var{I} is set.  The counting of the bits starts at 0.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = BTEST(I, POS)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{POS} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{LOGICAL}
+
+@item @emph{Example}:
+@smallexample
+program test_btest
+    integer :: i = 32768 + 1024 + 64
+    integer :: pos
+    logical :: bool
+    do pos=0,16
+        bool = btest(i, pos) 
+        print *, pos, bool
+    end do
+end program test_btest
+@end smallexample
+@end table
+
+
+@node C_ASSOCIATED
+@section @code{C_ASSOCIATED} --- Status of a C pointer
+@fnindex C_ASSOCIATED
+@cindex association status, C pointer
+@cindex pointer, C association status
+
+@table @asis
+@item @emph{Description}:
+@code{C_ASSOCIATED(c_prt_1[, c_ptr_2])} determines the status of the C pointer
+@var{c_ptr_1} or if @var{c_ptr_1} is associated with the target @var{c_ptr_2}.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = C_ASSOCIATED(c_prt_1[, c_ptr_2])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{c_ptr_1} @tab Scalar of the type @code{C_PTR} or @code{C_FUNPTR}.
+@item @var{c_ptr_2} @tab (Optional) Scalar of the same type as @var{c_ptr_1}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{LOGICAL}; it is @code{.false.} if either
+@var{c_ptr_1} is a C NULL pointer or if @var{c_ptr1} and @var{c_ptr_2}
+point to different addresses.
+
+@item @emph{Example}:
+@smallexample
+subroutine association_test(a,b)
+  use iso_c_binding, only: c_associated, c_loc, c_ptr
+  implicit none
+  real, pointer :: a
+  type(c_ptr) :: b
+  if(c_associated(b, c_loc(a))) &
+     stop 'b and a do not point to same target'
+end subroutine association_test
+@end smallexample
+
+@item @emph{See also}:
+@ref{C_LOC}, @ref{C_FUNLOC}
+@end table
+
+
+@node C_FUNLOC
+@section @code{C_FUNLOC} --- Obtain the C address of a procedure
+@fnindex C_FUNLOC
+@cindex pointer, C address of procedures
+
+@table @asis
+@item @emph{Description}:
+@code{C_FUNLOC(x)} determines the C address of the argument.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = C_FUNLOC(x)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{x} @tab Interoperable function or pointer to such function.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{C_FUNPTR} and contains the C address
+of the argument.
+
+@item @emph{Example}:
+@smallexample
+module x
+  use iso_c_binding
+  implicit none
+contains
+  subroutine sub(a) bind(c)
+    real(c_float) :: a
+    a = sqrt(a)+5.0
+  end subroutine sub
+end module x
+program main
+  use iso_c_binding
+  use x
+  implicit none
+  interface
+    subroutine my_routine(p) bind(c,name='myC_func')
+      import :: c_funptr
+      type(c_funptr), intent(in) :: p
+    end subroutine
+  end interface
+  call my_routine(c_funloc(sub))
+end program main
+@end smallexample
+
+@item @emph{See also}:
+@ref{C_ASSOCIATED}, @ref{C_LOC}, @ref{C_F_POINTER}, @ref{C_F_PROCPOINTER}
+@end table
+
+
+@node C_F_PROCPOINTER
+@section @code{C_F_PROCPOINTER} --- Convert C into Fortran procedure pointer
+@fnindex C_F_PROCPOINTER
+@cindex pointer, C address of pointers
+
+@table @asis
+@item @emph{Description}:
+@code{C_F_PROCPOINTER(CPTR, FPTR)} Assign the target of the C function pointer
+@var{CPTR} to the Fortran procedure pointer @var{FPTR}.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL C_F_PROCPOINTER(cptr, fptr)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{CPTR}  @tab scalar of the type @code{C_FUNPTR}. It is
+@code{INTENT(IN)}.
+@item @var{FPTR}  @tab procedure pointer interoperable with @var{cptr}. It is
+@code{INTENT(OUT)}.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program main
+  use iso_c_binding
+  implicit none
+  abstract interface
+    function func(a)
+      import :: c_float
+      real(c_float), intent(in) :: a
+      real(c_float) :: func
+    end function
+  end interface
+  interface
+     function getIterFunc() bind(c,name="getIterFunc")
+       import :: c_funptr
+       type(c_funptr) :: getIterFunc
+     end function
+  end interface
+  type(c_funptr) :: cfunptr
+  procedure(func), pointer :: myFunc
+  cfunptr = getIterFunc()
+  call c_f_procpointer(cfunptr, myFunc)
+end program main
+@end smallexample
+
+@item @emph{See also}:
+@ref{C_LOC}, @ref{C_F_POINTER}
+@end table
+
+
+@node C_F_POINTER
+@section @code{C_F_POINTER} --- Convert C into Fortran pointer
+@fnindex C_F_POINTER
+@cindex pointer, convert C to Fortran
+
+@table @asis
+@item @emph{Description}:
+@code{C_F_POINTER(CPTR, FPTR[, SHAPE])} Assign the target the C pointer
+@var{CPTR} to the Fortran pointer @var{FPTR} and specify its
+shape.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL C_F_POINTER(CPTR, FPTR[, SHAPE])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{CPTR}  @tab scalar of the type @code{C_PTR}. It is
+@code{INTENT(IN)}.
+@item @var{FPTR}  @tab pointer interoperable with @var{cptr}. It is
+@code{INTENT(OUT)}.
+@item @var{SHAPE} @tab (Optional) Rank-one array of type @code{INTEGER}
+with @code{INTENT(IN)}. It shall be present
+if and only if @var{fptr} is an array. The size
+must be equal to the rank of @var{fptr}.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program main
+  use iso_c_binding
+  implicit none
+  interface
+    subroutine my_routine(p) bind(c,name='myC_func')
+      import :: c_ptr
+      type(c_ptr), intent(out) :: p
+    end subroutine
+  end interface
+  type(c_ptr) :: cptr
+  real,pointer :: a(:)
+  call my_routine(cptr)
+  call c_f_pointer(cptr, a, [12])
+end program main
+@end smallexample
+
+@item @emph{See also}:
+@ref{C_LOC}, @ref{C_F_PROCPOINTER}
+@end table
+
+
+@node C_LOC
+@section @code{C_LOC} --- Obtain the C address of an object
+@fnindex C_LOC
+@cindex procedure pointer, convert C to Fortran
+
+@table @asis
+@item @emph{Description}:
+@code{C_LOC(X)} determines the C address of the argument.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = C_LOC(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .10 .75
+@item @var{X} @tab  Shall have either the POINTER or TARGET attribute. It shall not be a coindexed object. It shall either be a variable with interoperable type and kind type parameters, or be a scalar, nonpolymorphic variable with no length type parameters.
+
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{C_PTR} and contains the C address
+of the argument.
+
+@item @emph{Example}:
+@smallexample
+subroutine association_test(a,b)
+  use iso_c_binding, only: c_associated, c_loc, c_ptr
+  implicit none
+  real, pointer :: a
+  type(c_ptr) :: b
+  if(c_associated(b, c_loc(a))) &
+     stop 'b and a do not point to same target'
+end subroutine association_test
+@end smallexample
+
+@item @emph{See also}:
+@ref{C_ASSOCIATED}, @ref{C_FUNLOC}, @ref{C_F_POINTER}, @ref{C_F_PROCPOINTER}
+@end table
+
+
+@node C_SIZEOF
+@section @code{C_SIZEOF} --- Size in bytes of an expression
+@fnindex C_SIZEOF
+@cindex expression size
+@cindex size of an expression
+
+@table @asis
+@item @emph{Description}:
+@code{C_SIZEOF(X)} calculates the number of bytes of storage the
+expression @code{X} occupies.
+
+@item @emph{Standard}:
+Fortran 2008
+
+@item @emph{Class}:
+Inquiry function of the module @code{ISO_C_BINDING}
+
+@item @emph{Syntax}:
+@code{N = C_SIZEOF(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The argument shall be an interoperable data entity.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type integer and of the system-dependent kind
+@code{C_SIZE_T} (from the @code{ISO_C_BINDING} module). Its value is the
+number of bytes occupied by the argument.  If the argument has the
+@code{POINTER} attribute, the number of bytes of the storage area pointed
+to is returned.  If the argument is of a derived type with @code{POINTER}
+or @code{ALLOCATABLE} components, the return value doesn't account for
+the sizes of the data pointed to by these components.
+
+@item @emph{Example}:
+@smallexample
+   use iso_c_binding
+   integer(c_int) :: i
+   real(c_float) :: r, s(5)
+   print *, (c_sizeof(s)/c_sizeof(r) == 5)
+   end
+@end smallexample
+The example will print @code{.TRUE.} unless you are using a platform
+where default @code{REAL} variables are unusually padded.
+
+@item @emph{See also}:
+@ref{SIZEOF}, @ref{STORAGE_SIZE}
+@end table
+
+
+@node CEILING
+@section @code{CEILING} --- Integer ceiling function
+@fnindex CEILING
+@cindex ceiling
+@cindex rounding, ceiling
+
+@table @asis
+@item @emph{Description}:
+@code{CEILING(A)} returns the least integer greater than or equal to @var{A}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = CEILING(A [, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab The type shall be @code{REAL}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER(KIND)} if @var{KIND} is present
+and a default-kind @code{INTEGER} otherwise.
+
+@item @emph{Example}:
+@smallexample
+program test_ceiling
+    real :: x = 63.29
+    real :: y = -63.59
+    print *, ceiling(x) ! returns 64
+    print *, ceiling(y) ! returns -63
+end program test_ceiling
+@end smallexample
+
+@item @emph{See also}:
+@ref{FLOOR}, @ref{NINT}
+
+@end table
+
+
+
+@node CHAR
+@section @code{CHAR} --- Character conversion function
+@fnindex CHAR
+@cindex conversion, to character
+
+@table @asis
+@item @emph{Description}:
+@code{CHAR(I [, KIND])} returns the character represented by the integer @var{I}.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = CHAR(I [, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{CHARACTER(1)}
+
+@item @emph{Example}:
+@smallexample
+program test_char
+    integer :: i = 74
+    character(1) :: c
+    c = char(i)
+    print *, i, c ! returns 'J'
+end program test_char
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name           @tab Argument         @tab Return type             @tab Standard
+@item @code{CHAR(I)} @tab @code{INTEGER I} @tab @code{CHARACTER(LEN=1)} @tab F77 and later
+@end multitable
+
+@item @emph{Note}:
+See @ref{ICHAR} for a discussion of converting between numerical values
+and formatted string representations.
+
+@item @emph{See also}:
+@ref{ACHAR}, @ref{IACHAR}, @ref{ICHAR}
+
+@end table
+
+
+
+@node CHDIR
+@section @code{CHDIR} --- Change working directory
+@fnindex CHDIR
+@cindex system, working directory
+
+@table @asis
+@item @emph{Description}:
+Change current working directory to a specified path.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL CHDIR(NAME [, STATUS])}
+@item @code{STATUS = CHDIR(NAME)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{NAME}   @tab The type shall be @code{CHARACTER} of default
+kind and shall specify a valid path within the file system.
+@item @var{STATUS} @tab (Optional) @code{INTEGER} status flag of the default
+kind.  Returns 0 on success, and a system specific and nonzero error code
+otherwise.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_chdir
+  CHARACTER(len=255) :: path
+  CALL getcwd(path)
+  WRITE(*,*) TRIM(path)
+  CALL chdir("/tmp")
+  CALL getcwd(path)
+  WRITE(*,*) TRIM(path)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{GETCWD}
+@end table
+
+
+
+@node CHMOD
+@section @code{CHMOD} --- Change access permissions of files
+@fnindex CHMOD
+@cindex file system, change access mode
+
+@table @asis
+@item @emph{Description}:
+@code{CHMOD} changes the permissions of a file. This function invokes
+@code{/bin/chmod} and might therefore not work on all platforms.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL CHMOD(NAME, MODE[, STATUS])}
+@item @code{STATUS = CHMOD(NAME, MODE)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+
+@item @var{NAME} @tab Scalar @code{CHARACTER} of default kind with the
+file name. Trailing blanks are ignored unless the character
+@code{achar(0)} is present, then all characters up to and excluding
+@code{achar(0)} are used as the file name.
+
+@item @var{MODE} @tab Scalar @code{CHARACTER} of default kind giving the
+file permission. @var{MODE} uses the same syntax as the @var{MODE}
+argument of @code{/bin/chmod}.
+
+@item @var{STATUS} @tab (optional) scalar @code{INTEGER}, which is
+@code{0} on success and nonzero otherwise.
+@end multitable
+
+@item @emph{Return value}:
+In either syntax, @var{STATUS} is set to @code{0} on success and nonzero
+otherwise.
+
+@item @emph{Example}:
+@code{CHMOD} as subroutine
+@smallexample
+program chmod_test
+  implicit none
+  integer :: status
+  call chmod('test.dat','u+x',status)
+  print *, 'Status: ', status
+end program chmod_test
+@end smallexample
+@code{CHMOD} as function:
+@smallexample
+program chmod_test
+  implicit none
+  integer :: status
+  status = chmod('test.dat','u+x')
+  print *, 'Status: ', status
+end program chmod_test
+@end smallexample
+
+@end table
+
+
+
+@node CMPLX
+@section @code{CMPLX} --- Complex conversion function
+@fnindex CMPLX
+@cindex complex numbers, conversion to
+@cindex conversion, to complex
+
+@table @asis
+@item @emph{Description}:
+@code{CMPLX(X [, Y [, KIND]])} returns a complex number where @var{X} is converted to
+the real component.  If @var{Y} is present it is converted to the imaginary
+component.  If @var{Y} is not present then the imaginary component is set to
+0.0.  If @var{X} is complex then @var{Y} must not be present.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = CMPLX(X [, Y [, KIND]])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type may be @code{INTEGER}, @code{REAL},
+or @code{COMPLEX}.
+@item @var{Y} @tab (Optional; only allowed if @var{X} is not
+@code{COMPLEX}.)  May be @code{INTEGER} or @code{REAL}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of @code{COMPLEX} type, with a kind equal to
+@var{KIND} if it is specified.  If @var{KIND} is not specified, the
+result is of the default @code{COMPLEX} kind, regardless of the kinds of
+@var{X} and @var{Y}. 
+
+@item @emph{Example}:
+@smallexample
+program test_cmplx
+    integer :: i = 42
+    real :: x = 3.14
+    complex :: z
+    z = cmplx(i, x)
+    print *, z, cmplx(x)
+end program test_cmplx
+@end smallexample
+
+@item @emph{See also}:
+@ref{COMPLEX}
+@end table
+
+
+
+@node COMMAND_ARGUMENT_COUNT
+@section @code{COMMAND_ARGUMENT_COUNT} --- Get number of command line arguments
+@fnindex COMMAND_ARGUMENT_COUNT
+@cindex command-line arguments
+@cindex command-line arguments, number of
+@cindex arguments, to program
+
+@table @asis
+@item @emph{Description}:
+@code{COMMAND_ARGUMENT_COUNT} returns the number of arguments passed on the
+command line when the containing program was invoked.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = COMMAND_ARGUMENT_COUNT()}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item None
+@end multitable
+
+@item @emph{Return value}:
+The return value is an @code{INTEGER} of default kind.
+
+@item @emph{Example}:
+@smallexample
+program test_command_argument_count
+    integer :: count
+    count = command_argument_count()
+    print *, count
+end program test_command_argument_count
+@end smallexample
+
+@item @emph{See also}:
+@ref{GET_COMMAND}, @ref{GET_COMMAND_ARGUMENT}
+@end table
+
+
+
+@node COMPILER_OPTIONS
+@section @code{COMPILER_OPTIONS} --- Options passed to the compiler
+@fnindex COMPILER_OPTIONS
+@cindex flags inquiry function
+@cindex options inquiry function
+@cindex compiler flags inquiry function
+
+@table @asis
+@item @emph{Description}:
+@code{COMPILER_OPTIONS} returns a string with the options used for
+compiling.
+
+@item @emph{Standard}:
+Fortran 2008
+
+@item @emph{Class}:
+Inquiry function of the module @code{ISO_FORTRAN_ENV}
+
+@item @emph{Syntax}:
+@code{STR = COMPILER_OPTIONS()}
+
+@item @emph{Arguments}:
+None.
+
+@item @emph{Return value}:
+The return value is a default-kind string with system-dependent length.
+It contains the compiler flags used to compile the file, which called
+the @code{COMPILER_OPTIONS} intrinsic.
+
+@item @emph{Example}:
+@smallexample
+   use iso_fortran_env
+   print '(4a)', 'This file was compiled by ', &
+                 compiler_version(), ' using the the options ', &
+                 compiler_options()
+   end
+@end smallexample
+
+@item @emph{See also}:
+@ref{COMPILER_VERSION}, @ref{ISO_FORTRAN_ENV}
+@end table
+
+
+
+@node COMPILER_VERSION
+@section @code{COMPILER_VERSION} --- Compiler version string
+@fnindex COMPILER_VERSION
+@cindex compiler, name and version
+@cindex version of the compiler
+
+@table @asis
+@item @emph{Description}:
+@code{COMPILER_VERSION} returns a string with the name and the
+version of the compiler.
+
+@item @emph{Standard}:
+Fortran 2008
+
+@item @emph{Class}:
+Inquiry function of the module @code{ISO_FORTRAN_ENV}
+
+@item @emph{Syntax}:
+@code{STR = COMPILER_VERSION()}
+
+@item @emph{Arguments}:
+None.
+
+@item @emph{Return value}:
+The return value is a default-kind string with system-dependent length.
+It contains the name of the compiler and its version number.
+
+@item @emph{Example}:
+@smallexample
+   use iso_fortran_env
+   print '(4a)', 'This file was compiled by ', &
+                 compiler_version(), ' using the the options ', &
+                 compiler_options()
+   end
+@end smallexample
+
+@item @emph{See also}:
+@ref{COMPILER_OPTIONS}, @ref{ISO_FORTRAN_ENV}
+@end table
+
+
+
+@node COMPLEX
+@section @code{COMPLEX} --- Complex conversion function
+@fnindex COMPLEX
+@cindex complex numbers, conversion to
+@cindex conversion, to complex
+
+@table @asis
+@item @emph{Description}:
+@code{COMPLEX(X, Y)} returns a complex number where @var{X} is converted
+to the real component and @var{Y} is converted to the imaginary
+component.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = COMPLEX(X, Y)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type may be @code{INTEGER} or @code{REAL}.
+@item @var{Y} @tab The type may be @code{INTEGER} or @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+If @var{X} and @var{Y} are both of @code{INTEGER} type, then the return
+value is of default @code{COMPLEX} type.
+
+If @var{X} and @var{Y} are of @code{REAL} type, or one is of @code{REAL}
+type and one is of @code{INTEGER} type, then the return value is of
+@code{COMPLEX} type with a kind equal to that of the @code{REAL}
+argument with the highest precision.  
+
+@item @emph{Example}:
+@smallexample
+program test_complex
+    integer :: i = 42
+    real :: x = 3.14
+    print *, complex(i, x)
+end program test_complex
+@end smallexample
+
+@item @emph{See also}:
+@ref{CMPLX}
+@end table
+
+
+
+@node CONJG
+@section @code{CONJG} --- Complex conjugate function 
+@fnindex CONJG
+@fnindex DCONJG
+@cindex complex conjugate
+
+@table @asis
+@item @emph{Description}:
+@code{CONJG(Z)} returns the conjugate of @var{Z}.  If @var{Z} is @code{(x, y)}
+then the result is @code{(x, -y)}
+
+@item @emph{Standard}:
+Fortran 77 and later, has overloads that are GNU extensions
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{Z = CONJG(Z)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{Z} @tab The type shall be @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{COMPLEX}.
+
+@item @emph{Example}:
+@smallexample
+program test_conjg
+    complex :: z = (2.0, 3.0)
+    complex(8) :: dz = (2.71_8, -3.14_8)
+    z= conjg(z)
+    print *, z
+    dz = dconjg(dz)
+    print *, dz
+end program test_conjg
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Argument             @tab Return type       @tab Standard
+@item @code{CONJG(Z)}  @tab @code{COMPLEX Z}     @tab @code{COMPLEX}    @tab GNU extension
+@item @code{DCONJG(Z)} @tab @code{COMPLEX(8) Z}  @tab @code{COMPLEX(8)} @tab GNU extension
+@end multitable
+@end table
+
+
+
+@node COS
+@section @code{COS} --- Cosine function 
+@fnindex COS
+@fnindex DCOS
+@fnindex CCOS
+@fnindex ZCOS
+@fnindex CDCOS
+@cindex trigonometric function, cosine
+@cindex cosine
+
+@table @asis
+@item @emph{Description}:
+@code{COS(X)} computes the cosine of @var{X}.
+
+@item @emph{Standard}:
+Fortran 77 and later, has overloads that are GNU extensions
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = COS(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or
+@code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as @var{X}. The real part
+of the result is in radians. If @var{X} is of the type @code{REAL},
+the return value lies in the range @math{ -1 \leq \cos (x) \leq 1}.
+
+@item @emph{Example}:
+@smallexample
+program test_cos
+  real :: x = 0.0
+  x = cos(x)
+end program test_cos
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument            @tab Return type       @tab Standard
+@item @code{COS(X)}   @tab @code{REAL(4) X}    @tab @code{REAL(4)}    @tab Fortran 77 and later
+@item @code{DCOS(X)}  @tab @code{REAL(8) X}    @tab @code{REAL(8)}    @tab Fortran 77 and later
+@item @code{CCOS(X)}  @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab Fortran 77 and later
+@item @code{ZCOS(X)}  @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension
+@item @code{CDCOS(X)} @tab @code{COMPLEX(8) X} @tab @code{COMPLEX(8)} @tab GNU extension
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{ACOS}
+
+@end table
+
+
+
+@node COSH
+@section @code{COSH} --- Hyperbolic cosine function 
+@fnindex COSH
+@fnindex DCOSH
+@cindex hyperbolic cosine
+@cindex hyperbolic function, cosine
+@cindex cosine, hyperbolic
+
+@table @asis
+@item @emph{Description}:
+@code{COSH(X)} computes the hyperbolic cosine of @var{X}.
+
+@item @emph{Standard}:
+Fortran 77 and later, for a complex argument Fortran 2008 or later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{X = COSH(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{X}. If @var{X} is
+complex, the imaginary part of the result is in radians. If @var{X}
+is @code{REAL}, the return value has a lower bound of one,
+@math{\cosh (x) \geq 1}.
+
+@item @emph{Example}:
+@smallexample
+program test_cosh
+  real(8) :: x = 1.0_8
+  x = cosh(x)
+end program test_cosh
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type       @tab Standard
+@item @code{COSH(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab Fortran 77 and later
+@item @code{DCOSH(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab Fortran 77 and later
+@end multitable
+
+@item @emph{See also}:
+Inverse function: @ref{ACOSH}
+
+@end table
+
+
+
+@node COUNT
+@section @code{COUNT} --- Count function
+@fnindex COUNT
+@cindex array, conditionally count elements
+@cindex array, element counting
+@cindex array, number of elements
+
+@table @asis
+@item @emph{Description}:
+
+Counts the number of @code{.TRUE.} elements in a logical @var{MASK},
+or, if the @var{DIM} argument is supplied, counts the number of
+elements along each row of the array in the @var{DIM} direction.
+If the array has zero size, or all of the elements of @var{MASK} are
+@code{.FALSE.}, then the result is @code{0}.
+
+@item @emph{Standard}:
+Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = COUNT(MASK [, DIM, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{MASK} @tab The type shall be @code{LOGICAL}.
+@item @var{DIM}  @tab (Optional) The type shall be @code{INTEGER}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+If @var{DIM} is present, the result is an array with a rank one less
+than the rank of @var{ARRAY}, and a size corresponding to the shape
+of @var{ARRAY} with the @var{DIM} dimension removed.
+
+@item @emph{Example}:
+@smallexample
+program test_count
+    integer, dimension(2,3) :: a, b
+    logical, dimension(2,3) :: mask
+    a = reshape( (/ 1, 2, 3, 4, 5, 6 /), (/ 2, 3 /))
+    b = reshape( (/ 0, 7, 3, 4, 5, 8 /), (/ 2, 3 /))
+    print '(3i3)', a(1,:)
+    print '(3i3)', a(2,:)
+    print *
+    print '(3i3)', b(1,:)
+    print '(3i3)', b(2,:)
+    print *
+    mask = a.ne.b
+    print '(3l3)', mask(1,:)
+    print '(3l3)', mask(2,:)
+    print *
+    print '(3i3)', count(mask)
+    print *
+    print '(3i3)', count(mask, 1)
+    print *
+    print '(3i3)', count(mask, 2)
+end program test_count
+@end smallexample
+@end table
+
+
+
+@node CPU_TIME
+@section @code{CPU_TIME} --- CPU elapsed time in seconds
+@fnindex CPU_TIME
+@cindex time, elapsed
+
+@table @asis
+@item @emph{Description}:
+Returns a @code{REAL} value representing the elapsed CPU time in
+seconds.  This is useful for testing segments of code to determine
+execution time.
+
+If a time source is available, time will be reported with microsecond
+resolution. If no time source is available, @var{TIME} is set to
+@code{-1.0}.
+
+Note that @var{TIME} may contain a, system dependent, arbitrary offset
+and may not start with @code{0.0}. For @code{CPU_TIME}, the absolute
+value is meaningless, only differences between subsequent calls to
+this subroutine, as shown in the example below, should be used.
+
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL CPU_TIME(TIME)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{TIME} @tab The type shall be @code{REAL} with @code{INTENT(OUT)}.
+@end multitable
+
+@item @emph{Return value}:
+None
+
+@item @emph{Example}:
+@smallexample
+program test_cpu_time
+    real :: start, finish
+    call cpu_time(start)
+        ! put code to test here
+    call cpu_time(finish)
+    print '("Time = ",f6.3," seconds.")',finish-start
+end program test_cpu_time
+@end smallexample
+
+@item @emph{See also}:
+@ref{SYSTEM_CLOCK}, @ref{DATE_AND_TIME}
+@end table
+
+
+
+@node CSHIFT
+@section @code{CSHIFT} --- Circular shift elements of an array
+@fnindex CSHIFT
+@cindex array, shift circularly
+@cindex array, permutation
+@cindex array, rotate
+
+@table @asis
+@item @emph{Description}:
+@code{CSHIFT(ARRAY, SHIFT [, DIM])} performs a circular shift on elements of
+@var{ARRAY} along the dimension of @var{DIM}.  If @var{DIM} is omitted it is
+taken to be @code{1}.  @var{DIM} is a scalar of type @code{INTEGER} in the
+range of @math{1 \leq DIM \leq n)} where @math{n} is the rank of @var{ARRAY}.
+If the rank of @var{ARRAY} is one, then all elements of @var{ARRAY} are shifted
+by @var{SHIFT} places.  If rank is greater than one, then all complete rank one
+sections of @var{ARRAY} along the given dimension are shifted.  Elements
+shifted out one end of each rank one section are shifted back in the other end.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = CSHIFT(ARRAY, SHIFT [, DIM])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY}  @tab Shall be an array of any type.
+@item @var{SHIFT}  @tab The type shall be @code{INTEGER}.
+@item @var{DIM}    @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+Returns an array of same type and rank as the @var{ARRAY} argument.
+
+@item @emph{Example}:
+@smallexample
+program test_cshift
+    integer, dimension(3,3) :: a
+    a = reshape( (/ 1, 2, 3, 4, 5, 6, 7, 8, 9 /), (/ 3, 3 /))
+    print '(3i3)', a(1,:)
+    print '(3i3)', a(2,:)
+    print '(3i3)', a(3,:)    
+    a = cshift(a, SHIFT=(/1, 2, -1/), DIM=2)
+    print *
+    print '(3i3)', a(1,:)
+    print '(3i3)', a(2,:)
+    print '(3i3)', a(3,:)
+end program test_cshift
+@end smallexample
+@end table
+
+
+
+@node CTIME
+@section @code{CTIME} --- Convert a time into a string
+@fnindex CTIME
+@cindex time, conversion to string
+@cindex conversion, to string
+
+@table @asis
+@item @emph{Description}:
+@code{CTIME} converts a system time value, such as returned by
+@code{TIME8}, to a string. Unless the application has called
+@code{setlocale}, the output will be in the default locale, of length
+24 and of the form @samp{Sat Aug 19 18:13:14 1995}. In other locales,
+a longer string may result.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL CTIME(TIME, RESULT)}.
+@item @code{RESULT = CTIME(TIME)}.
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{TIME}    @tab The type shall be of type @code{INTEGER}.
+@item @var{RESULT}  @tab The type shall be of type @code{CHARACTER} and
+of default kind. It is an @code{INTENT(OUT)} argument. If the length
+of this variable is too short for the time and date string to fit
+completely, it will be blank on procedure return.
+@end multitable
+
+@item @emph{Return value}:
+The converted date and time as a string. 
+
+@item @emph{Example}:
+@smallexample
+program test_ctime
+    integer(8) :: i
+    character(len=30) :: date
+    i = time8()
+
+    ! Do something, main part of the program
+    
+    call ctime(i,date)
+    print *, 'Program was started on ', date
+end program test_ctime
+@end smallexample
+
+@item @emph{See Also}:
+@ref{DATE_AND_TIME}, @ref{GMTIME}, @ref{LTIME}, @ref{TIME}, @ref{TIME8}
+@end table
+
+
+
+@node DATE_AND_TIME
+@section @code{DATE_AND_TIME} --- Date and time subroutine
+@fnindex DATE_AND_TIME
+@cindex date, current
+@cindex current date
+@cindex time, current
+@cindex current time
+
+@table @asis
+@item @emph{Description}:
+@code{DATE_AND_TIME(DATE, TIME, ZONE, VALUES)} gets the corresponding date and
+time information from the real-time system clock.  @var{DATE} is
+@code{INTENT(OUT)} and has form ccyymmdd.  @var{TIME} is @code{INTENT(OUT)} and
+has form hhmmss.sss.  @var{ZONE} is @code{INTENT(OUT)} and has form (+-)hhmm,
+representing the difference with respect to Coordinated Universal Time (UTC).
+Unavailable time and date parameters return blanks.
+
+@var{VALUES} is @code{INTENT(OUT)} and provides the following:
+
+@multitable @columnfractions .15 .30 .40
+@item @tab @code{VALUE(1)}: @tab The year
+@item @tab @code{VALUE(2)}: @tab The month
+@item @tab @code{VALUE(3)}: @tab The day of the month
+@item @tab @code{VALUE(4)}: @tab Time difference with UTC in minutes
+@item @tab @code{VALUE(5)}: @tab The hour of the day
+@item @tab @code{VALUE(6)}: @tab The minutes of the hour
+@item @tab @code{VALUE(7)}: @tab The seconds of the minute
+@item @tab @code{VALUE(8)}: @tab The milliseconds of the second
+@end multitable
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL DATE_AND_TIME([DATE, TIME, ZONE, VALUES])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{DATE}  @tab (Optional) The type shall be @code{CHARACTER(LEN=8)}
+or larger, and of default kind.
+@item @var{TIME}  @tab (Optional) The type shall be @code{CHARACTER(LEN=10)}
+or larger, and of default kind.
+@item @var{ZONE}  @tab (Optional) The type shall be @code{CHARACTER(LEN=5)}
+or larger, and of default kind.
+@item @var{VALUES}@tab (Optional) The type shall be @code{INTEGER(8)}.
+@end multitable
+
+@item @emph{Return value}:
+None
+
+@item @emph{Example}:
+@smallexample
+program test_time_and_date
+    character(8)  :: date
+    character(10) :: time
+    character(5)  :: zone
+    integer,dimension(8) :: values
+    ! using keyword arguments
+    call date_and_time(date,time,zone,values)
+    call date_and_time(DATE=date,ZONE=zone)
+    call date_and_time(TIME=time)
+    call date_and_time(VALUES=values)
+    print '(a,2x,a,2x,a)', date, time, zone
+    print '(8i5))', values
+end program test_time_and_date
+@end smallexample
+
+@item @emph{See also}:
+@ref{CPU_TIME}, @ref{SYSTEM_CLOCK}
+@end table
+
+
+
+@node DBLE
+@section @code{DBLE} --- Double conversion function 
+@fnindex DBLE
+@cindex conversion, to real
+
+@table @asis
+@item @emph{Description}:
+@code{DBLE(A)} Converts @var{A} to double precision real type.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = DBLE(A)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab The type shall be @code{INTEGER}, @code{REAL},
+or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type double precision real.
+
+@item @emph{Example}:
+@smallexample
+program test_dble
+    real    :: x = 2.18
+    integer :: i = 5
+    complex :: z = (2.3,1.14)
+    print *, dble(x), dble(i), dble(z)
+end program test_dble
+@end smallexample
+
+@item @emph{See also}:
+@ref{REAL}
+@end table
+
+
+
+@node DCMPLX
+@section @code{DCMPLX} --- Double complex conversion function
+@fnindex DCMPLX
+@cindex complex numbers, conversion to
+@cindex conversion, to complex
+
+@table @asis
+@item @emph{Description}:
+@code{DCMPLX(X [,Y])} returns a double complex number where @var{X} is
+converted to the real component.  If @var{Y} is present it is converted to the
+imaginary component.  If @var{Y} is not present then the imaginary component is
+set to 0.0.  If @var{X} is complex then @var{Y} must not be present.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = DCMPLX(X [, Y])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type may be @code{INTEGER}, @code{REAL},
+or @code{COMPLEX}.
+@item @var{Y} @tab (Optional if @var{X} is not @code{COMPLEX}.) May be
+@code{INTEGER} or @code{REAL}. 
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{COMPLEX(8)}
+
+@item @emph{Example}:
+@smallexample
+program test_dcmplx
+    integer :: i = 42
+    real :: x = 3.14
+    complex :: z
+    z = cmplx(i, x)
+    print *, dcmplx(i)
+    print *, dcmplx(x)
+    print *, dcmplx(z)
+    print *, dcmplx(x,i)
+end program test_dcmplx
+@end smallexample
+@end table
+
+
+@node DIGITS
+@section @code{DIGITS} --- Significant binary digits function
+@fnindex DIGITS
+@cindex model representation, significant digits
+
+@table @asis
+@item @emph{Description}:
+@code{DIGITS(X)} returns the number of significant binary digits of the internal
+model representation of @var{X}.  For example, on a system using a 32-bit
+floating point representation, a default real number would likely return 24.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = DIGITS(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type may be @code{INTEGER} or @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER}.
+
+@item @emph{Example}:
+@smallexample
+program test_digits
+    integer :: i = 12345
+    real :: x = 3.143
+    real(8) :: y = 2.33
+    print *, digits(i)
+    print *, digits(x)
+    print *, digits(y)
+end program test_digits
+@end smallexample
+@end table
+
+
+
+@node DIM
+@section @code{DIM} --- Positive difference
+@fnindex DIM
+@fnindex IDIM
+@fnindex DDIM
+@cindex positive difference
+
+@table @asis
+@item @emph{Description}:
+@code{DIM(X,Y)} returns the difference @code{X-Y} if the result is positive;
+otherwise returns zero.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = DIM(X, Y)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{INTEGER} or @code{REAL}
+@item @var{Y} @tab The type shall be the same type and kind as @var{X}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} or @code{REAL}.
+
+@item @emph{Example}:
+@smallexample
+program test_dim
+    integer :: i
+    real(8) :: x
+    i = dim(4, 15)
+    x = dim(4.345_8, 2.111_8)
+    print *, i
+    print *, x
+end program test_dim
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Argument               @tab Return type       @tab Standard
+@item @code{DIM(X,Y)}  @tab @code{REAL(4) X, Y}    @tab @code{REAL(4)}    @tab Fortran 77 and later
+@item @code{IDIM(X,Y)} @tab @code{INTEGER(4) X, Y} @tab @code{INTEGER(4)} @tab Fortran 77 and later
+@item @code{DDIM(X,Y)} @tab @code{REAL(8) X, Y}    @tab @code{REAL(8)}    @tab Fortran 77 and later
+@end multitable
+@end table
+
+
+
+@node DOT_PRODUCT
+@section @code{DOT_PRODUCT} --- Dot product function
+@fnindex DOT_PRODUCT
+@cindex dot product
+@cindex vector product
+@cindex product, vector
+
+@table @asis
+@item @emph{Description}:
+@code{DOT_PRODUCT(VECTOR_A, VECTOR_B)} computes the dot product multiplication
+of two vectors @var{VECTOR_A} and @var{VECTOR_B}.  The two vectors may be
+either numeric or logical and must be arrays of rank one and of equal size. If
+the vectors are @code{INTEGER} or @code{REAL}, the result is
+@code{SUM(VECTOR_A*VECTOR_B)}. If the vectors are @code{COMPLEX}, the result
+is @code{SUM(CONJG(VECTOR_A)*VECTOR_B)}. If the vectors are @code{LOGICAL},
+the result is @code{ANY(VECTOR_A .AND. VECTOR_B)}.  
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = DOT_PRODUCT(VECTOR_A, VECTOR_B)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{VECTOR_A} @tab The type shall be numeric or @code{LOGICAL}, rank 1.
+@item @var{VECTOR_B} @tab The type shall be numeric if @var{VECTOR_A} is of numeric type or @code{LOGICAL} if @var{VECTOR_A} is of type @code{LOGICAL}. @var{VECTOR_B} shall be a rank-one array.
+@end multitable
+
+@item @emph{Return value}:
+If the arguments are numeric, the return value is a scalar of numeric type,
+@code{INTEGER}, @code{REAL}, or @code{COMPLEX}.  If the arguments are
+@code{LOGICAL}, the return value is @code{.TRUE.} or @code{.FALSE.}.
+
+@item @emph{Example}:
+@smallexample
+program test_dot_prod
+    integer, dimension(3) :: a, b
+    a = (/ 1, 2, 3 /)
+    b = (/ 4, 5, 6 /)
+    print '(3i3)', a
+    print *
+    print '(3i3)', b
+    print *
+    print *, dot_product(a,b)
+end program test_dot_prod
+@end smallexample
+@end table
+
+
+
+@node DPROD
+@section @code{DPROD} --- Double product function
+@fnindex DPROD
+@cindex product, double-precision
+
+@table @asis
+@item @emph{Description}:
+@code{DPROD(X,Y)} returns the product @code{X*Y}.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = DPROD(X, Y)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL}.
+@item @var{Y} @tab The type shall be @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL(8)}.
+
+@item @emph{Example}:
+@smallexample
+program test_dprod
+    real :: x = 5.2
+    real :: y = 2.3
+    real(8) :: d
+    d = dprod(x,y)
+    print *, d
+end program test_dprod
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name              @tab Argument               @tab Return type       @tab Standard
+@item @code{DPROD(X,Y)} @tab @code{REAL(4) X, Y}    @tab @code{REAL(4)}    @tab Fortran 77 and later
+@end multitable
+
+@end table
+
+
+@node DREAL
+@section @code{DREAL} --- Double real part function
+@fnindex DREAL
+@cindex complex numbers, real part
+
+@table @asis
+@item @emph{Description}:
+@code{DREAL(Z)} returns the real part of complex variable @var{Z}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = DREAL(A)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab The type shall be @code{COMPLEX(8)}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL(8)}.
+
+@item @emph{Example}:
+@smallexample
+program test_dreal
+    complex(8) :: z = (1.3_8,7.2_8)
+    print *, dreal(z)
+end program test_dreal
+@end smallexample
+
+@item @emph{See also}:
+@ref{AIMAG}
+
+@end table
+
+
+
+@node DSHIFTL
+@section @code{DSHIFTL} --- Combined left shift
+@fnindex DSHIFTL
+@cindex left shift, combined
+@cindex shift, left
+
+@table @asis
+@item @emph{Description}:
+@code{DSHIFTL(I, J, SHIFT)} combines bits of @var{I} and @var{J}. The
+rightmost @var{SHIFT} bits of the result are the leftmost @var{SHIFT}
+bits of @var{J}, and the remaining bits are the rightmost bits of
+@var{I}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = DSHIFTL(I, J, SHIFT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@item @var{J} @tab Shall be of type @code{INTEGER}, and of the same kind
+as @var{I}.
+@item @var{SHIFT} @tab Shall be of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{I}.
+
+@item @emph{See also}:
+@ref{DSHIFTR}
+
+@end table
+
+
+
+@node DSHIFTR
+@section @code{DSHIFTR} --- Combined right shift
+@fnindex DSHIFTR
+@cindex right shift, combined
+@cindex shift, right
+
+@table @asis
+@item @emph{Description}:
+@code{DSHIFTR(I, J, SHIFT)} combines bits of @var{I} and @var{J}. The
+leftmost @var{SHIFT} bits of the result are the rightmost @var{SHIFT}
+bits of @var{I}, and the remaining bits are the leftmost bits of
+@var{J}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = DSHIFTR(I, J, SHIFT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@item @var{J} @tab Shall be of type @code{INTEGER}, and of the same kind
+as @var{I}.
+@item @var{SHIFT} @tab Shall be of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{I}.
+
+@item @emph{See also}:
+@ref{DSHIFTL}
+
+@end table
+
+
+
+@node DTIME
+@section @code{DTIME} --- Execution time subroutine (or function)
+@fnindex DTIME
+@cindex time, elapsed
+@cindex elapsed time
+
+@table @asis
+@item @emph{Description}:
+@code{DTIME(VALUES, TIME)} initially returns the number of seconds of runtime
+since the start of the process's execution in @var{TIME}.  @var{VALUES}
+returns the user and system components of this time in @code{VALUES(1)} and
+@code{VALUES(2)} respectively. @var{TIME} is equal to @code{VALUES(1) +
+VALUES(2)}.
+
+Subsequent invocations of @code{DTIME} return values accumulated since the
+previous invocation.
+
+On some systems, the underlying timings are represented using types with
+sufficiently small limits that overflows (wrap around) are possible, such as
+32-bit types. Therefore, the values returned by this intrinsic might be, or
+become, negative, or numerically less than previous values, during a single
+run of the compiled program.
+
+Please note, that this implementation is thread safe if used within OpenMP
+directives, i.e., its state will be consistent while called from multiple
+threads. However, if @code{DTIME} is called from multiple threads, the result
+is still the time since the last invocation. This may not give the intended
+results. If possible, use @code{CPU_TIME} instead.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+@var{VALUES} and @var{TIME} are @code{INTENT(OUT)} and provide the following:
+
+@multitable @columnfractions .15 .30 .40
+@item @tab @code{VALUES(1)}: @tab User time in seconds.
+@item @tab @code{VALUES(2)}: @tab System time in seconds.
+@item @tab @code{TIME}: @tab Run time since start in seconds.
+@end multitable
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL DTIME(VALUES, TIME)}.
+@item @code{TIME = DTIME(VALUES)}, (not recommended).
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{VALUES}@tab The type shall be @code{REAL(4), DIMENSION(2)}.
+@item @var{TIME}@tab The type shall be @code{REAL(4)}.
+@end multitable
+
+@item @emph{Return value}:
+Elapsed time in seconds since the last invocation or since the start of program
+execution if not called before.
+
+@item @emph{Example}:
+@smallexample
+program test_dtime
+    integer(8) :: i, j
+    real, dimension(2) :: tarray
+    real :: result
+    call dtime(tarray, result)
+    print *, result
+    print *, tarray(1)
+    print *, tarray(2)   
+    do i=1,100000000    ! Just a delay
+        j = i * i - i
+    end do
+    call dtime(tarray, result)
+    print *, result
+    print *, tarray(1)
+    print *, tarray(2)
+end program test_dtime
+@end smallexample
+
+@item @emph{See also}:
+@ref{CPU_TIME}
+
+@end table
+
+
+
+@node EOSHIFT
+@section @code{EOSHIFT} --- End-off shift elements of an array
+@fnindex EOSHIFT
+@cindex array, shift
+
+@table @asis
+@item @emph{Description}:
+@code{EOSHIFT(ARRAY, SHIFT[, BOUNDARY, DIM])} performs an end-off shift on
+elements of @var{ARRAY} along the dimension of @var{DIM}.  If @var{DIM} is
+omitted it is taken to be @code{1}.  @var{DIM} is a scalar of type
+@code{INTEGER} in the range of @math{1 \leq DIM \leq n)} where @math{n} is the
+rank of @var{ARRAY}.  If the rank of @var{ARRAY} is one, then all elements of
+@var{ARRAY} are shifted by @var{SHIFT} places.  If rank is greater than one,
+then all complete rank one sections of @var{ARRAY} along the given dimension are
+shifted.  Elements shifted out one end of each rank one section are dropped.  If
+@var{BOUNDARY} is present then the corresponding value of from @var{BOUNDARY}
+is copied back in the other end.  If @var{BOUNDARY} is not present then the
+following are copied in depending on the type of @var{ARRAY}.
+
+@multitable @columnfractions .15 .80
+@item @emph{Array Type} @tab @emph{Boundary Value}
+@item Numeric  @tab 0 of the type and kind of @var{ARRAY}.
+@item Logical  @tab @code{.FALSE.}.
+@item Character(@var{len}) @tab @var{len} blanks.
+@end multitable
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = EOSHIFT(ARRAY, SHIFT [, BOUNDARY, DIM])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY}  @tab May be any type, not scalar.
+@item @var{SHIFT}  @tab The type shall be @code{INTEGER}.
+@item @var{BOUNDARY} @tab Same type as @var{ARRAY}. 
+@item @var{DIM}    @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+Returns an array of same type and rank as the @var{ARRAY} argument.
+
+@item @emph{Example}:
+@smallexample
+program test_eoshift
+    integer, dimension(3,3) :: a
+    a = reshape( (/ 1, 2, 3, 4, 5, 6, 7, 8, 9 /), (/ 3, 3 /))
+    print '(3i3)', a(1,:)
+    print '(3i3)', a(2,:)
+    print '(3i3)', a(3,:)    
+    a = EOSHIFT(a, SHIFT=(/1, 2, 1/), BOUNDARY=-5, DIM=2)
+    print *
+    print '(3i3)', a(1,:)
+    print '(3i3)', a(2,:)
+    print '(3i3)', a(3,:)
+end program test_eoshift
+@end smallexample
+@end table
+
+
+
+@node EPSILON
+@section @code{EPSILON} --- Epsilon function
+@fnindex EPSILON
+@cindex model representation, epsilon
+
+@table @asis
+@item @emph{Description}:
+@code{EPSILON(X)} returns the smallest number @var{E} of the same kind
+as @var{X} such that @math{1 + E > 1}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = EPSILON(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of same type as the argument.
+
+@item @emph{Example}:
+@smallexample
+program test_epsilon
+    real :: x = 3.143
+    real(8) :: y = 2.33
+    print *, EPSILON(x)
+    print *, EPSILON(y)
+end program test_epsilon
+@end smallexample
+@end table
+
+
+
+@node ERF
+@section @code{ERF} --- Error function 
+@fnindex ERF
+@cindex error function
+
+@table @asis
+@item @emph{Description}:
+@code{ERF(X)} computes the error function of @var{X}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ERF(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL}, of the same kind as
+@var{X} and lies in the range @math{-1 \leq erf (x) \leq 1 }.
+
+@item @emph{Example}:
+@smallexample
+program test_erf
+  real(8) :: x = 0.17_8
+  x = erf(x)
+end program test_erf
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type       @tab Standard
+@item @code{DERF(X)}  @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
+@end multitable
+@end table
+
+
+
+@node ERFC
+@section @code{ERFC} --- Error function 
+@fnindex ERFC
+@cindex error function, complementary
+
+@table @asis
+@item @emph{Description}:
+@code{ERFC(X)} computes the complementary error function of @var{X}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ERFC(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL} and of the same kind as @var{X}.
+It lies in the range @math{ 0 \leq erfc (x) \leq 2 }.
+
+@item @emph{Example}:
+@smallexample
+program test_erfc
+  real(8) :: x = 0.17_8
+  x = erfc(x)
+end program test_erfc
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type       @tab Standard
+@item @code{DERFC(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
+@end multitable
+@end table
+
+
+
+@node ERFC_SCALED
+@section @code{ERFC_SCALED} --- Error function 
+@fnindex ERFC_SCALED
+@cindex error function, complementary, exponentially-scaled
+
+@table @asis
+@item @emph{Description}:
+@code{ERFC_SCALED(X)} computes the exponentially-scaled complementary
+error function of @var{X}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ERFC_SCALED(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL} and of the same kind as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_erfc_scaled
+  real(8) :: x = 0.17_8
+  x = erfc_scaled(x)
+end program test_erfc_scaled
+@end smallexample
+@end table
+
+
+
+@node ETIME
+@section @code{ETIME} --- Execution time subroutine (or function)
+@fnindex ETIME
+@cindex time, elapsed
+
+@table @asis
+@item @emph{Description}:
+@code{ETIME(VALUES, TIME)} returns the number of seconds of runtime
+since the start of the process's execution in @var{TIME}.  @var{VALUES}
+returns the user and system components of this time in @code{VALUES(1)} and
+@code{VALUES(2)} respectively. @var{TIME} is equal to @code{VALUES(1) + VALUES(2)}.
+
+On some systems, the underlying timings are represented using types with
+sufficiently small limits that overflows (wrap around) are possible, such as
+32-bit types. Therefore, the values returned by this intrinsic might be, or
+become, negative, or numerically less than previous values, during a single
+run of the compiled program.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+@var{VALUES} and @var{TIME} are @code{INTENT(OUT)} and provide the following:
+
+@multitable @columnfractions .15 .30 .60
+@item @tab @code{VALUES(1)}: @tab User time in seconds.
+@item @tab @code{VALUES(2)}: @tab System time in seconds.
+@item @tab @code{TIME}: @tab Run time since start in seconds.
+@end multitable
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL ETIME(VALUES, TIME)}.
+@item @code{TIME = ETIME(VALUES)}, (not recommended).
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{VALUES}@tab The type shall be @code{REAL(4), DIMENSION(2)}.
+@item @var{TIME}@tab The type shall be @code{REAL(4)}.
+@end multitable
+
+@item @emph{Return value}:
+Elapsed time in seconds since the start of program execution.
+
+@item @emph{Example}:
+@smallexample
+program test_etime
+    integer(8) :: i, j
+    real, dimension(2) :: tarray
+    real :: result
+    call ETIME(tarray, result)
+    print *, result
+    print *, tarray(1)
+    print *, tarray(2)   
+    do i=1,100000000    ! Just a delay
+        j = i * i - i
+    end do
+    call ETIME(tarray, result)
+    print *, result
+    print *, tarray(1)
+    print *, tarray(2)
+end program test_etime
+@end smallexample
+
+@item @emph{See also}:
+@ref{CPU_TIME}
+
+@end table
+
+
+
+@node EXECUTE_COMMAND_LINE
+@section @code{EXECUTE_COMMAND_LINE} --- Execute a shell command
+@fnindex EXECUTE_COMMAND_LINE
+@cindex system, system call
+@cindex command line
+
+@table @asis
+@item @emph{Description}:
+@code{EXECUTE_COMMAND_LINE} runs a shell command, synchronously or
+asynchronously.
+
+The @code{COMMAND} argument is passed to the shell and executed, using
+the C library's @code{system} call.  (The shell is @code{sh} on Unix
+systems, and @code{cmd.exe} on Windows.)  If @code{WAIT} is present
+and has the value false, the execution of the command is asynchronous
+if the system supports it; otherwise, the command is executed
+synchronously.
+
+The three last arguments allow the user to get status information.  After
+synchronous execution, @code{EXITSTAT} contains the integer exit code of
+the command, as returned by @code{system}.  @code{CMDSTAT} is set to zero
+if the command line was executed (whatever its exit status was).
+@code{CMDMSG} is assigned an error message if an error has occurred.
+
+Note that the @code{system} function need not be thread-safe. It is
+the responsibility of the user to ensure that @code{system} is not
+called concurrently.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL EXECUTE_COMMAND_LINE(COMMAND [, WAIT, EXITSTAT, CMDSTAT, CMDMSG ])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{COMMAND} @tab Shall be a default @code{CHARACTER} scalar.
+@item @var{WAIT} @tab (Optional) Shall be a default @code{LOGICAL} scalar.
+@item @var{EXITSTAT} @tab (Optional) Shall be an @code{INTEGER} of the
+default kind.
+@item @var{CMDSTAT} @tab (Optional) Shall be an @code{INTEGER} of the
+default kind.
+@item @var{CMDMSG} @tab (Optional) Shall be an @code{CHARACTER} scalar of the
+default kind.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program test_exec
+  integer :: i
+
+  call execute_command_line ("external_prog.exe", exitstat=i)
+  print *, "Exit status of external_prog.exe was ", i
+
+  call execute_command_line ("reindex_files.exe", wait=.false.)
+  print *, "Now reindexing files in the background"
+
+end program test_exec
+@end smallexample
+
+
+@item @emph{Note}:
+
+Because this intrinsic is implemented in terms of the @code{system}
+function call, its behavior with respect to signaling is processor
+dependent. In particular, on POSIX-compliant systems, the SIGINT and
+SIGQUIT signals will be ignored, and the SIGCHLD will be blocked. As
+such, if the parent process is terminated, the child process might not be
+terminated alongside.
+
+
+@item @emph{See also}:
+@ref{SYSTEM}
+@end table
+
+
+
+@node EXIT
+@section @code{EXIT} --- Exit the program with status. 
+@fnindex EXIT
+@cindex program termination
+@cindex terminate program
+
+@table @asis
+@item @emph{Description}:
+@code{EXIT} causes immediate termination of the program with status.  If status
+is omitted it returns the canonical @emph{success} for the system.  All Fortran
+I/O units are closed. 
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL EXIT([STATUS])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STATUS} @tab Shall be an @code{INTEGER} of the default kind.
+@end multitable
+
+@item @emph{Return value}:
+@code{STATUS} is passed to the parent process on exit.
+
+@item @emph{Example}:
+@smallexample
+program test_exit
+  integer :: STATUS = 0
+  print *, 'This program is going to exit.'
+  call EXIT(STATUS)
+end program test_exit
+@end smallexample
+
+@item @emph{See also}:
+@ref{ABORT}, @ref{KILL}
+@end table
+
+
+
+@node EXP
+@section @code{EXP} --- Exponential function 
+@fnindex EXP
+@fnindex DEXP
+@fnindex CEXP
+@fnindex ZEXP
+@fnindex CDEXP
+@cindex exponential function
+@cindex logarithm function, inverse
+
+@table @asis
+@item @emph{Description}:
+@code{EXP(X)} computes the base @math{e} exponential of @var{X}.
+
+@item @emph{Standard}:
+Fortran 77 and later, has overloads that are GNU extensions
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = EXP(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or
+@code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_exp
+  real :: x = 1.0
+  x = exp(x)
+end program test_exp
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument             @tab Return type         @tab Standard
+@item @code{EXP(X)}   @tab @code{REAL(4) X}     @tab @code{REAL(4)}      @tab Fortran 77 and later
+@item @code{DEXP(X)}  @tab @code{REAL(8) X}     @tab @code{REAL(8)}      @tab Fortran 77 and later
+@item @code{CEXP(X)}  @tab @code{COMPLEX(4) X}  @tab @code{COMPLEX(4)}   @tab Fortran 77 and later
+@item @code{ZEXP(X)}  @tab @code{COMPLEX(8) X}  @tab @code{COMPLEX(8)}   @tab GNU extension
+@item @code{CDEXP(X)} @tab @code{COMPLEX(8) X}  @tab @code{COMPLEX(8)}   @tab GNU extension
+@end multitable
+@end table
+
+
+
+@node EXPONENT
+@section @code{EXPONENT} --- Exponent function 
+@fnindex EXPONENT
+@cindex real number, exponent
+@cindex floating point, exponent
+
+@table @asis
+@item @emph{Description}:
+@code{EXPONENT(X)} returns the value of the exponent part of @var{X}. If @var{X}
+is zero the value returned is zero. 
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = EXPONENT(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type default @code{INTEGER}.
+
+@item @emph{Example}:
+@smallexample
+program test_exponent
+  real :: x = 1.0
+  integer :: i
+  i = exponent(x)
+  print *, i
+  print *, exponent(0.0)
+end program test_exponent
+@end smallexample
+@end table
+
+
+
+@node EXTENDS_TYPE_OF
+@section @code{EXTENDS_TYPE_OF} ---  Query dynamic type for extension
+@fnindex EXTENDS_TYPE_OF
+
+@table @asis
+@item @emph{Description}:
+Query dynamic type for extension.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = EXTENDS_TYPE_OF(A, MOLD)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab Shall be an object of extensible declared type or
+unlimited polymorphic. 
+@item @var{MOLD} @tab Shall be an object of extensible declared type or
+unlimited polymorphic. 
+@end multitable
+
+@item @emph{Return value}:
+The return value is a scalar of type default logical. It is true if and only if
+the dynamic type of A is an extension type of the dynamic type of MOLD.
+
+
+@item @emph{See also}:
+@ref{SAME_TYPE_AS}
+@end table
+
+
+
+@node FDATE
+@section @code{FDATE} --- Get the current time as a string
+@fnindex FDATE
+@cindex time, current
+@cindex current time
+@cindex date, current
+@cindex current date
+
+@table @asis
+@item @emph{Description}:
+@code{FDATE(DATE)} returns the current date (using the same format as
+@code{CTIME}) in @var{DATE}. It is equivalent to @code{CALL CTIME(DATE,
+TIME())}.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL FDATE(DATE)}.
+@item @code{DATE = FDATE()}.
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{DATE}@tab The type shall be of type @code{CHARACTER} of the
+default kind. It is an @code{INTENT(OUT)} argument.  If the length of
+this variable is too short for the date and time string to fit
+completely, it will be blank on procedure return.
+@end multitable
+
+@item @emph{Return value}:
+The current date and time as a string.
+
+@item @emph{Example}:
+@smallexample
+program test_fdate
+    integer(8) :: i, j
+    character(len=30) :: date
+    call fdate(date)
+    print *, 'Program started on ', date
+    do i = 1, 100000000 ! Just a delay
+        j = i * i - i
+    end do
+    call fdate(date)
+    print *, 'Program ended on ', date
+end program test_fdate
+@end smallexample
+
+@item @emph{See also}:
+@ref{DATE_AND_TIME}, @ref{CTIME}
+@end table
+
+
+@node FGET
+@section @code{FGET} --- Read a single character in stream mode from stdin 
+@fnindex FGET
+@cindex read character, stream mode
+@cindex stream mode, read character
+@cindex file operation, read character
+
+@table @asis
+@item @emph{Description}:
+Read a single character in stream mode from stdin by bypassing normal 
+formatted output. Stream I/O should not be mixed with normal record-oriented 
+(formatted or unformatted) I/O on the same unit; the results are unpredictable.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+Note that the @code{FGET} intrinsic is provided for backwards compatibility with 
+@command{g77}.  GNU Fortran provides the Fortran 2003 Stream facility.
+Programmers should consider the use of new stream IO feature in new code 
+for future portability. See also @ref{Fortran 2003 status}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL FGET(C [, STATUS])}
+@item @code{STATUS = FGET(C)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{C}      @tab The type shall be @code{CHARACTER} and of default
+kind.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}.
+Returns 0 on success, -1 on end-of-file, and a system specific positive
+error code otherwise.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_fget
+  INTEGER, PARAMETER :: strlen = 100
+  INTEGER :: status, i = 1
+  CHARACTER(len=strlen) :: str = ""
+
+  WRITE (*,*) 'Enter text:'
+  DO
+    CALL fget(str(i:i), status)
+    if (status /= 0 .OR. i > strlen) exit
+    i = i + 1
+  END DO
+  WRITE (*,*) TRIM(str)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{FGETC}, @ref{FPUT}, @ref{FPUTC}
+@end table
+
+
+
+@node FGETC
+@section @code{FGETC} --- Read a single character in stream mode
+@fnindex FGETC
+@cindex read character, stream mode
+@cindex stream mode, read character
+@cindex file operation, read character
+
+@table @asis
+@item @emph{Description}:
+Read a single character in stream mode by bypassing normal formatted output. 
+Stream I/O should not be mixed with normal record-oriented (formatted or 
+unformatted) I/O on the same unit; the results are unpredictable.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+Note that the @code{FGET} intrinsic is provided for backwards compatibility
+with @command{g77}.  GNU Fortran provides the Fortran 2003 Stream facility.
+Programmers should consider the use of new stream IO feature in new code 
+for future portability. See also @ref{Fortran 2003 status}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL FGETC(UNIT, C [, STATUS])}
+@item @code{STATUS = FGETC(UNIT, C)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{UNIT}   @tab The type shall be @code{INTEGER}.
+@item @var{C}      @tab The type shall be @code{CHARACTER} and of default
+kind.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}.
+Returns 0 on success, -1 on end-of-file and a system specific positive
+error code otherwise.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_fgetc
+  INTEGER :: fd = 42, status
+  CHARACTER :: c
+
+  OPEN(UNIT=fd, FILE="/etc/passwd", ACTION="READ", STATUS = "OLD")
+  DO
+    CALL fgetc(fd, c, status)
+    IF (status /= 0) EXIT
+    call fput(c)
+  END DO
+  CLOSE(UNIT=fd)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{FGET}, @ref{FPUT}, @ref{FPUTC}
+@end table
+
+
+
+@node FLOOR
+@section @code{FLOOR} --- Integer floor function
+@fnindex FLOOR
+@cindex floor
+@cindex rounding, floor
+
+@table @asis
+@item @emph{Description}:
+@code{FLOOR(A)} returns the greatest integer less than or equal to @var{X}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = FLOOR(A [, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab The type shall be @code{REAL}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER(KIND)} if @var{KIND} is present
+and of default-kind @code{INTEGER} otherwise.
+
+@item @emph{Example}:
+@smallexample
+program test_floor
+    real :: x = 63.29
+    real :: y = -63.59
+    print *, floor(x) ! returns 63
+    print *, floor(y) ! returns -64
+end program test_floor
+@end smallexample
+
+@item @emph{See also}:
+@ref{CEILING}, @ref{NINT}
+
+@end table
+
+
+
+@node FLUSH
+@section @code{FLUSH} --- Flush I/O unit(s)
+@fnindex FLUSH
+@cindex file operation, flush
+
+@table @asis
+@item @emph{Description}:
+Flushes Fortran unit(s) currently open for output. Without the optional
+argument, all units are flushed, otherwise just the unit specified.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL FLUSH(UNIT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{UNIT} @tab (Optional) The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Note}:
+Beginning with the Fortran 2003 standard, there is a @code{FLUSH}
+statement that should be preferred over the @code{FLUSH} intrinsic.
+
+The @code{FLUSH} intrinsic and the Fortran 2003 @code{FLUSH} statement
+have identical effect: they flush the runtime library's I/O buffer so
+that the data becomes visible to other processes. This does not guarantee
+that the data is committed to disk.
+
+On POSIX systems, you can request that all data is transferred  to  the
+storage device by calling the @code{fsync} function, with the POSIX file
+descriptor of the I/O unit as argument (retrieved with GNU intrinsic
+@code{FNUM}). The following example shows how:
+
+@smallexample
+  ! Declare the interface for POSIX fsync function
+  interface
+    function fsync (fd) bind(c,name="fsync")
+    use iso_c_binding, only: c_int
+      integer(c_int), value :: fd
+      integer(c_int) :: fsync
+    end function fsync
+  end interface
+
+  ! Variable declaration
+  integer :: ret
+
+  ! Opening unit 10
+  open (10,file="foo")
+
+  ! ...
+  ! Perform I/O on unit 10
+  ! ...
+
+  ! Flush and sync
+  flush(10)
+  ret = fsync(fnum(10))
+
+  ! Handle possible error
+  if (ret /= 0) stop "Error calling FSYNC"
+@end smallexample
+
+@end table
+
+
+
+@node FNUM
+@section @code{FNUM} --- File number function
+@fnindex FNUM
+@cindex file operation, file number
+
+@table @asis
+@item @emph{Description}:
+@code{FNUM(UNIT)} returns the POSIX file descriptor number corresponding to the
+open Fortran I/O unit @code{UNIT}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = FNUM(UNIT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{UNIT} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER}
+
+@item @emph{Example}:
+@smallexample
+program test_fnum
+  integer :: i
+  open (unit=10, status = "scratch")
+  i = fnum(10)
+  print *, i
+  close (10)
+end program test_fnum
+@end smallexample
+@end table
+
+
+
+@node FPUT
+@section @code{FPUT} --- Write a single character in stream mode to stdout 
+@fnindex FPUT
+@cindex write character, stream mode
+@cindex stream mode, write character
+@cindex file operation, write character
+
+@table @asis
+@item @emph{Description}:
+Write a single character in stream mode to stdout by bypassing normal 
+formatted output. Stream I/O should not be mixed with normal record-oriented 
+(formatted or unformatted) I/O on the same unit; the results are unpredictable.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+Note that the @code{FGET} intrinsic is provided for backwards compatibility with 
+@command{g77}.  GNU Fortran provides the Fortran 2003 Stream facility.
+Programmers should consider the use of new stream IO feature in new code 
+for future portability. See also @ref{Fortran 2003 status}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL FPUT(C [, STATUS])}
+@item @code{STATUS = FPUT(C)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{C}      @tab The type shall be @code{CHARACTER} and of default
+kind.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}.
+Returns 0 on success, -1 on end-of-file and a system specific positive
+error code otherwise.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_fput
+  CHARACTER(len=10) :: str = "gfortran"
+  INTEGER :: i
+  DO i = 1, len_trim(str)
+    CALL fput(str(i:i))
+  END DO
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{FPUTC}, @ref{FGET}, @ref{FGETC}
+@end table
+
+
+
+@node FPUTC
+@section @code{FPUTC} --- Write a single character in stream mode
+@fnindex FPUTC
+@cindex write character, stream mode
+@cindex stream mode, write character
+@cindex file operation, write character
+
+@table @asis
+@item @emph{Description}:
+Write a single character in stream mode by bypassing normal formatted 
+output. Stream I/O should not be mixed with normal record-oriented 
+(formatted or unformatted) I/O on the same unit; the results are unpredictable.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+Note that the @code{FGET} intrinsic is provided for backwards compatibility with 
+@command{g77}.  GNU Fortran provides the Fortran 2003 Stream facility.
+Programmers should consider the use of new stream IO feature in new code 
+for future portability. See also @ref{Fortran 2003 status}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL FPUTC(UNIT, C [, STATUS])}
+@item @code{STATUS = FPUTC(UNIT, C)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{UNIT}   @tab The type shall be @code{INTEGER}.
+@item @var{C}      @tab The type shall be @code{CHARACTER} and of default
+kind.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}.
+Returns 0 on success, -1 on end-of-file and a system specific positive
+error code otherwise.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_fputc
+  CHARACTER(len=10) :: str = "gfortran"
+  INTEGER :: fd = 42, i
+
+  OPEN(UNIT = fd, FILE = "out", ACTION = "WRITE", STATUS="NEW")
+  DO i = 1, len_trim(str)
+    CALL fputc(fd, str(i:i))
+  END DO
+  CLOSE(fd)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{FPUT}, @ref{FGET}, @ref{FGETC}
+@end table
+
+
+
+@node FRACTION
+@section @code{FRACTION} --- Fractional part of the model representation
+@fnindex FRACTION
+@cindex real number, fraction
+@cindex floating point, fraction
+
+@table @asis
+@item @emph{Description}:
+@code{FRACTION(X)} returns the fractional part of the model
+representation of @code{X}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{Y = FRACTION(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type of the argument shall be a @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as the argument.
+The fractional part of the model representation of @code{X} is returned;
+it is @code{X * RADIX(X)**(-EXPONENT(X))}.
+
+@item @emph{Example}:
+@smallexample
+program test_fraction
+  real :: x
+  x = 178.1387e-4
+  print *, fraction(x), x * radix(x)**(-exponent(x))
+end program test_fraction
+@end smallexample
+
+@end table
+
+
+
+@node FREE
+@section @code{FREE} --- Frees memory
+@fnindex FREE
+@cindex pointer, cray
+
+@table @asis
+@item @emph{Description}:
+Frees memory previously allocated by @code{MALLOC}. The @code{FREE}
+intrinsic is an extension intended to be used with Cray pointers, and is
+provided in GNU Fortran to allow user to compile legacy code. For
+new code using Fortran 95 pointers, the memory de-allocation intrinsic is
+@code{DEALLOCATE}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL FREE(PTR)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{PTR} @tab The type shall be @code{INTEGER}. It represents the
+location of the memory that should be de-allocated.
+@end multitable
+
+@item @emph{Return value}:
+None
+
+@item @emph{Example}:
+See @code{MALLOC} for an example.
+
+@item @emph{See also}:
+@ref{MALLOC}
+@end table
+
+
+
+@node FSEEK
+@section @code{FSEEK} --- Low level file positioning subroutine
+@fnindex FSEEK
+@cindex file operation, seek
+@cindex file operation, position
+
+@table @asis
+@item @emph{Description}:
+Moves @var{UNIT} to the specified @var{OFFSET}. If @var{WHENCE} 
+is set to 0, the @var{OFFSET} is taken as an absolute value @code{SEEK_SET},
+if set to 1, @var{OFFSET} is taken to be relative to the current position 
+@code{SEEK_CUR}, and if set to 2 relative to the end of the file @code{SEEK_END}.
+On error, @var{STATUS} is set to a nonzero value. If @var{STATUS} the seek 
+fails silently.
+
+This intrinsic routine is not fully backwards compatible with @command{g77}. 
+In @command{g77}, the @code{FSEEK} takes a statement label instead of a 
+@var{STATUS} variable. If FSEEK is used in old code, change
+@smallexample
+  CALL FSEEK(UNIT, OFFSET, WHENCE, *label)
+@end smallexample 
+to
+@smallexample
+  INTEGER :: status
+  CALL FSEEK(UNIT, OFFSET, WHENCE, status)
+  IF (status /= 0) GOTO label
+@end smallexample 
+
+Please note that GNU Fortran provides the Fortran 2003 Stream facility.
+Programmers should consider the use of new stream IO feature in new code 
+for future portability. See also @ref{Fortran 2003 status}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL FSEEK(UNIT, OFFSET, WHENCE[, STATUS])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{UNIT}   @tab Shall be a scalar of type @code{INTEGER}.
+@item @var{OFFSET} @tab Shall be a scalar of type @code{INTEGER}.
+@item @var{WHENCE} @tab Shall be a scalar of type @code{INTEGER}.
+Its value shall be either 0, 1 or 2.
+@item @var{STATUS} @tab (Optional) shall be a scalar of type 
+@code{INTEGER(4)}.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_fseek
+  INTEGER, PARAMETER :: SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2
+  INTEGER :: fd, offset, ierr
+
+  ierr   = 0
+  offset = 5
+  fd     = 10
+
+  OPEN(UNIT=fd, FILE="fseek.test")
+  CALL FSEEK(fd, offset, SEEK_SET, ierr)  ! move to OFFSET
+  print *, FTELL(fd), ierr
+
+  CALL FSEEK(fd, 0, SEEK_END, ierr)       ! move to end
+  print *, FTELL(fd), ierr
+
+  CALL FSEEK(fd, 0, SEEK_SET, ierr)       ! move to beginning
+  print *, FTELL(fd), ierr
+
+  CLOSE(UNIT=fd)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{FTELL}
+@end table
+
+
+
+@node FSTAT
+@section @code{FSTAT} --- Get file status
+@fnindex FSTAT
+@cindex file system, file status
+
+@table @asis
+@item @emph{Description}:
+@code{FSTAT} is identical to @ref{STAT}, except that information about an 
+already opened file is obtained.
+
+The elements in @code{VALUES} are the same as described by @ref{STAT}.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL FSTAT(UNIT, VALUES [, STATUS])}
+@item @code{STATUS = FSTAT(UNIT, VALUES)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{UNIT}   @tab An open I/O unit number of type @code{INTEGER}.
+@item @var{VALUES} @tab The type shall be @code{INTEGER(4), DIMENSION(13)}.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}. Returns 0 
+on success and a system specific error code otherwise.
+@end multitable
+
+@item @emph{Example}:
+See @ref{STAT} for an example.
+
+@item @emph{See also}:
+To stat a link: @ref{LSTAT}, to stat a file: @ref{STAT}
+@end table
+
+
+
+@node FTELL
+@section @code{FTELL} --- Current stream position
+@fnindex FTELL
+@cindex file operation, position
+
+@table @asis
+@item @emph{Description}:
+Retrieves the current position within an open file.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL FTELL(UNIT, OFFSET)}
+@item @code{OFFSET = FTELL(UNIT)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{OFFSET}  @tab Shall of type @code{INTEGER}.
+@item @var{UNIT}    @tab Shall of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+In either syntax, @var{OFFSET} is set to the current offset of unit
+number @var{UNIT}, or to @math{-1} if the unit is not currently open.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_ftell
+  INTEGER :: i
+  OPEN(10, FILE="temp.dat")
+  CALL ftell(10,i)
+  WRITE(*,*) i
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{FSEEK}
+@end table
+
+
+
+@node GAMMA
+@section @code{GAMMA} --- Gamma function
+@fnindex GAMMA
+@fnindex DGAMMA
+@cindex Gamma function
+@cindex Factorial function
+
+@table @asis
+@item @emph{Description}:
+@code{GAMMA(X)} computes Gamma (@math{\Gamma}) of @var{X}. For positive,
+integer values of @var{X} the Gamma function simplifies to the factorial
+function @math{\Gamma(x)=(x-1)!}.
+
+@tex
+$$
+\Gamma(x) = \int_0^\infty t^{x-1}{\rm e}^{-t}\,{\rm d}t
+$$
+@end tex
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{X = GAMMA(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{REAL} and neither zero
+nor a negative integer.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL} of the same kind as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_gamma
+  real :: x = 1.0
+  x = gamma(x) ! returns 1.0
+end program test_gamma
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Argument         @tab Return type       @tab Standard
+@item @code{GAMMA(X)}  @tab @code{REAL(4) X} @tab @code{REAL(4)}    @tab GNU Extension
+@item @code{DGAMMA(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)}    @tab GNU Extension
+@end multitable
+
+@item @emph{See also}:
+Logarithm of the Gamma function: @ref{LOG_GAMMA}
+
+@end table
+
+
+
+@node GERROR
+@section @code{GERROR} --- Get last system error message
+@fnindex GERROR
+@cindex system, error handling
+
+@table @asis
+@item @emph{Description}:
+Returns the system error message corresponding to the last system error.
+This resembles the functionality of @code{strerror(3)} in C.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL GERROR(RESULT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{RESULT}  @tab Shall of type @code{CHARACTER} and of default
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_gerror
+  CHARACTER(len=100) :: msg
+  CALL gerror(msg)
+  WRITE(*,*) msg
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{IERRNO}, @ref{PERROR}
+@end table
+
+
+
+@node GETARG
+@section @code{GETARG} --- Get command line arguments
+@fnindex GETARG
+@cindex command-line arguments
+@cindex arguments, to program
+
+@table @asis
+@item @emph{Description}:
+Retrieve the @var{POS}-th argument that was passed on the
+command line when the containing program was invoked.
+
+This intrinsic routine is provided for backwards compatibility with 
+GNU Fortran 77.  In new code, programmers should consider the use of 
+the @ref{GET_COMMAND_ARGUMENT} intrinsic defined by the Fortran 2003 
+standard.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL GETARG(POS, VALUE)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{POS}   @tab Shall be of type @code{INTEGER} and not wider than
+the default integer kind; @math{@var{POS} \geq 0}
+@item @var{VALUE} @tab Shall be of type @code{CHARACTER} and of default
+kind.
+@item @var{VALUE} @tab Shall be of type @code{CHARACTER}. 
+@end multitable
+
+@item @emph{Return value}:
+After @code{GETARG} returns, the @var{VALUE} argument holds the
+@var{POS}th command line argument. If @var{VALUE} can not hold the
+argument, it is truncated to fit the length of @var{VALUE}. If there are
+less than @var{POS} arguments specified at the command line, @var{VALUE}
+will be filled with blanks. If @math{@var{POS} = 0}, @var{VALUE} is set
+to the name of the program (on systems that support this feature).
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_getarg
+  INTEGER :: i
+  CHARACTER(len=32) :: arg
+
+  DO i = 1, iargc()
+    CALL getarg(i, arg)
+    WRITE (*,*) arg
+  END DO
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+GNU Fortran 77 compatibility function: @ref{IARGC}
+
+Fortran 2003 functions and subroutines: @ref{GET_COMMAND},
+@ref{GET_COMMAND_ARGUMENT}, @ref{COMMAND_ARGUMENT_COUNT}
+@end table
+
+
+
+@node GET_COMMAND
+@section @code{GET_COMMAND} --- Get the entire command line
+@fnindex GET_COMMAND
+@cindex command-line arguments
+@cindex arguments, to program
+
+@table @asis
+@item @emph{Description}:
+Retrieve the entire command line that was used to invoke the program.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL GET_COMMAND([COMMAND, LENGTH, STATUS])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{COMMAND} @tab (Optional) shall be of type @code{CHARACTER} and
+of default kind.
+@item @var{LENGTH} @tab (Optional) Shall be of type @code{INTEGER} and of
+default kind.
+@item @var{STATUS} @tab (Optional) Shall be of type @code{INTEGER} and of
+default kind.
+@end multitable
+
+@item @emph{Return value}:
+If @var{COMMAND} is present, stores the entire command line that was used
+to invoke the program in @var{COMMAND}. If @var{LENGTH} is present, it is
+assigned the length of the command line. If @var{STATUS} is present, it
+is assigned 0 upon success of the command, -1 if @var{COMMAND} is too
+short to store the command line, or a positive value in case of an error.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_get_command
+  CHARACTER(len=255) :: cmd
+  CALL get_command(cmd)
+  WRITE (*,*) TRIM(cmd)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{GET_COMMAND_ARGUMENT}, @ref{COMMAND_ARGUMENT_COUNT}
+@end table
+
+
+
+@node GET_COMMAND_ARGUMENT
+@section @code{GET_COMMAND_ARGUMENT} --- Get command line arguments
+@fnindex GET_COMMAND_ARGUMENT
+@cindex command-line arguments
+@cindex arguments, to program
+
+@table @asis
+@item @emph{Description}:
+Retrieve the @var{NUMBER}-th argument that was passed on the
+command line when the containing program was invoked.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL GET_COMMAND_ARGUMENT(NUMBER [, VALUE, LENGTH, STATUS])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{NUMBER} @tab Shall be a scalar of type @code{INTEGER} and of
+default kind, @math{@var{NUMBER} \geq 0}
+@item @var{VALUE}  @tab (Optional) Shall be a scalar of type @code{CHARACTER}
+and of default kind.
+@item @var{LENGTH} @tab (Optional) Shall be a scalar of type @code{INTEGER}
+and of default kind.
+@item @var{STATUS} @tab (Optional) Shall be a scalar of type @code{INTEGER}
+and of default kind.
+@end multitable
+
+@item @emph{Return value}:
+After @code{GET_COMMAND_ARGUMENT} returns, the @var{VALUE} argument holds the 
+@var{NUMBER}-th command line argument. If @var{VALUE} can not hold the argument, it is 
+truncated to fit the length of @var{VALUE}. If there are less than @var{NUMBER}
+arguments specified at the command line, @var{VALUE} will be filled with blanks. 
+If @math{@var{NUMBER} = 0}, @var{VALUE} is set to the name of the program (on
+systems that support this feature). The @var{LENGTH} argument contains the
+length of the @var{NUMBER}-th command line argument. If the argument retrieval
+fails, @var{STATUS} is a positive number; if @var{VALUE} contains a truncated
+command line argument, @var{STATUS} is -1; and otherwise the @var{STATUS} is
+zero.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_get_command_argument
+  INTEGER :: i
+  CHARACTER(len=32) :: arg
+
+  i = 0
+  DO
+    CALL get_command_argument(i, arg)
+    IF (LEN_TRIM(arg) == 0) EXIT
+
+    WRITE (*,*) TRIM(arg)
+    i = i+1
+  END DO
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{GET_COMMAND}, @ref{COMMAND_ARGUMENT_COUNT}
+@end table
+
+
+
+@node GETCWD
+@section @code{GETCWD} --- Get current working directory
+@fnindex GETCWD
+@cindex system, working directory
+
+@table @asis
+@item @emph{Description}:
+Get current working directory.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL GETCWD(C [, STATUS])}
+@item @code{STATUS = GETCWD(C)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{C} @tab The type shall be @code{CHARACTER} and of default kind.
+@item @var{STATUS} @tab (Optional) status flag. Returns 0 on success, 
+a system specific and nonzero error code otherwise.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_getcwd
+  CHARACTER(len=255) :: cwd
+  CALL getcwd(cwd)
+  WRITE(*,*) TRIM(cwd)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{CHDIR}
+@end table
+
+
+
+@node GETENV
+@section @code{GETENV} --- Get an environmental variable
+@fnindex GETENV
+@cindex environment variable
+
+@table @asis
+@item @emph{Description}:
+Get the @var{VALUE} of the environmental variable @var{NAME}.
+
+This intrinsic routine is provided for backwards compatibility with
+GNU Fortran 77.  In new code, programmers should consider the use of
+the @ref{GET_ENVIRONMENT_VARIABLE} intrinsic defined by the Fortran
+2003 standard.
+
+Note that @code{GETENV} need not be thread-safe. It is the
+responsibility of the user to ensure that the environment is not being
+updated concurrently with a call to the @code{GETENV} intrinsic.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL GETENV(NAME, VALUE)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{NAME}  @tab Shall be of type @code{CHARACTER} and of default kind.
+@item @var{VALUE} @tab Shall be of type @code{CHARACTER} and of default kind.
+@end multitable
+
+@item @emph{Return value}:
+Stores the value of @var{NAME} in @var{VALUE}. If @var{VALUE} is 
+not large enough to hold the data, it is truncated. If @var{NAME}
+is not set, @var{VALUE} will be filled with blanks.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_getenv
+  CHARACTER(len=255) :: homedir
+  CALL getenv("HOME", homedir)
+  WRITE (*,*) TRIM(homedir)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{GET_ENVIRONMENT_VARIABLE}
+@end table
+
+
+
+@node GET_ENVIRONMENT_VARIABLE
+@section @code{GET_ENVIRONMENT_VARIABLE} --- Get an environmental variable
+@fnindex GET_ENVIRONMENT_VARIABLE
+@cindex environment variable
+
+@table @asis
+@item @emph{Description}:
+Get the @var{VALUE} of the environmental variable @var{NAME}.
+
+Note that @code{GET_ENVIRONMENT_VARIABLE} need not be thread-safe. It
+is the responsibility of the user to ensure that the environment is
+not being updated concurrently with a call to the
+@code{GET_ENVIRONMENT_VARIABLE} intrinsic.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL GET_ENVIRONMENT_VARIABLE(NAME[, VALUE, LENGTH, STATUS, TRIM_NAME)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{NAME}      @tab Shall be a scalar of type @code{CHARACTER}
+and of default kind.
+@item @var{VALUE}     @tab (Optional) Shall be a scalar of type @code{CHARACTER}
+and of default kind.
+@item @var{LENGTH}    @tab (Optional) Shall be a scalar of type @code{INTEGER}
+and of default kind.
+@item @var{STATUS}    @tab (Optional) Shall be a scalar of type @code{INTEGER}
+and of default kind.
+@item @var{TRIM_NAME} @tab (Optional) Shall be a scalar of type @code{LOGICAL}
+and of default kind.
+@end multitable
+
+@item @emph{Return value}:
+Stores the value of @var{NAME} in @var{VALUE}. If @var{VALUE} is 
+not large enough to hold the data, it is truncated. If @var{NAME}
+is not set, @var{VALUE} will be filled with blanks. Argument @var{LENGTH}
+contains the length needed for storing the environment variable @var{NAME}
+or zero if it is not present. @var{STATUS} is -1 if @var{VALUE} is present
+but too short for the environment variable; it is 1 if the environment
+variable does not exist and 2 if the processor does not support environment
+variables; in all other cases @var{STATUS} is zero. If @var{TRIM_NAME} is
+present with the value @code{.FALSE.}, the trailing blanks in @var{NAME}
+are significant; otherwise they are not part of the environment variable
+name.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_getenv
+  CHARACTER(len=255) :: homedir
+  CALL get_environment_variable("HOME", homedir)
+  WRITE (*,*) TRIM(homedir)
+END PROGRAM
+@end smallexample
+@end table
+
+
+
+@node GETGID
+@section @code{GETGID} --- Group ID function
+@fnindex GETGID
+@cindex system, group ID
+
+@table @asis
+@item @emph{Description}:
+Returns the numerical group ID of the current process.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = GETGID()}
+
+@item @emph{Return value}:
+The return value of @code{GETGID} is an @code{INTEGER} of the default
+kind.
+
+
+@item @emph{Example}:
+See @code{GETPID} for an example.
+
+@item @emph{See also}:
+@ref{GETPID}, @ref{GETUID}
+@end table
+
+
+
+@node GETLOG
+@section @code{GETLOG} --- Get login name
+@fnindex GETLOG
+@cindex system, login name
+@cindex login name
+
+@table @asis
+@item @emph{Description}:
+Gets the username under which the program is running.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL GETLOG(C)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{C} @tab Shall be of type @code{CHARACTER} and of default kind.
+@end multitable
+
+@item @emph{Return value}:
+Stores the current user name in @var{LOGIN}.  (On systems where POSIX
+functions @code{geteuid} and @code{getpwuid} are not available, and 
+the @code{getlogin} function is not implemented either, this will
+return a blank string.)
+
+@item @emph{Example}:
+@smallexample
+PROGRAM TEST_GETLOG
+  CHARACTER(32) :: login
+  CALL GETLOG(login)
+  WRITE(*,*) login
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{GETUID}
+@end table
+
+
+
+@node GETPID
+@section @code{GETPID} --- Process ID function
+@fnindex GETPID
+@cindex system, process ID
+@cindex process ID
+
+@table @asis
+@item @emph{Description}:
+Returns the numerical process identifier of the current process.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = GETPID()}
+
+@item @emph{Return value}:
+The return value of @code{GETPID} is an @code{INTEGER} of the default
+kind.
+
+
+@item @emph{Example}:
+@smallexample
+program info
+  print *, "The current process ID is ", getpid()
+  print *, "Your numerical user ID is ", getuid()
+  print *, "Your numerical group ID is ", getgid()
+end program info
+@end smallexample
+
+@item @emph{See also}:
+@ref{GETGID}, @ref{GETUID}
+@end table
+
+
+
+@node GETUID
+@section @code{GETUID} --- User ID function
+@fnindex GETUID
+@cindex system, user ID
+@cindex user id
+
+@table @asis
+@item @emph{Description}:
+Returns the numerical user ID of the current process.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = GETUID()}
+
+@item @emph{Return value}:
+The return value of @code{GETUID} is an @code{INTEGER} of the default
+kind.
+
+
+@item @emph{Example}:
+See @code{GETPID} for an example.
+
+@item @emph{See also}:
+@ref{GETPID}, @ref{GETLOG}
+@end table
+
+
+
+@node GMTIME
+@section @code{GMTIME} --- Convert time to GMT info
+@fnindex GMTIME
+@cindex time, conversion to GMT info
+
+@table @asis
+@item @emph{Description}:
+Given a system time value @var{TIME} (as provided by the @code{TIME8}
+intrinsic), fills @var{VALUES} with values extracted from it appropriate
+to the UTC time zone (Universal Coordinated Time, also known in some
+countries as GMT, Greenwich Mean Time), using @code{gmtime(3)}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL GMTIME(TIME, VALUES)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{TIME}   @tab An @code{INTEGER} scalar expression
+corresponding to a system time, with @code{INTENT(IN)}.
+@item @var{VALUES} @tab A default @code{INTEGER} array with 9 elements,
+with @code{INTENT(OUT)}.
+@end multitable
+
+@item @emph{Return value}:
+The elements of @var{VALUES} are assigned as follows:
+@enumerate
+@item Seconds after the minute, range 0--59 or 0--61 to allow for leap
+seconds
+@item Minutes after the hour, range 0--59
+@item Hours past midnight, range 0--23
+@item Day of month, range 0--31
+@item Number of months since January, range 0--12
+@item Years since 1900
+@item Number of days since Sunday, range 0--6
+@item Days since January 1
+@item Daylight savings indicator: positive if daylight savings is in
+effect, zero if not, and negative if the information is not available.
+@end enumerate
+
+@item @emph{See also}:
+@ref{CTIME}, @ref{LTIME}, @ref{TIME}, @ref{TIME8}
+
+@end table
+
+
+
+@node HOSTNM
+@section @code{HOSTNM} --- Get system host name
+@fnindex HOSTNM
+@cindex system, host name
+
+@table @asis
+@item @emph{Description}:
+Retrieves the host name of the system on which the program is running.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL HOSTNM(C [, STATUS])}
+@item @code{STATUS = HOSTNM(NAME)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{C}    @tab Shall of type @code{CHARACTER} and of default kind.
+@item @var{STATUS}  @tab (Optional) status flag of type @code{INTEGER}.
+Returns 0 on success, or a system specific error code otherwise.
+@end multitable
+
+@item @emph{Return value}:
+In either syntax, @var{NAME} is set to the current hostname if it can
+be obtained, or to a blank string otherwise.
+
+@end table
+
+
+
+@node HUGE
+@section @code{HUGE} --- Largest number of a kind
+@fnindex HUGE
+@cindex limits, largest number
+@cindex model representation, largest number
+
+@table @asis
+@item @emph{Description}:
+@code{HUGE(X)} returns the largest number that is not an infinity in
+the model of the type of @code{X}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = HUGE(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{REAL} or @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as @var{X}
+
+@item @emph{Example}:
+@smallexample
+program test_huge_tiny
+  print *, huge(0), huge(0.0), huge(0.0d0)
+  print *, tiny(0.0), tiny(0.0d0)
+end program test_huge_tiny
+@end smallexample
+@end table
+
+
+
+@node HYPOT
+@section @code{HYPOT} --- Euclidean distance function
+@fnindex HYPOT
+@cindex Euclidean distance
+
+@table @asis
+@item @emph{Description}:
+@code{HYPOT(X,Y)} is the Euclidean distance function. It is equal to
+@math{\sqrt{X^2 + Y^2}}, without undue underflow or overflow.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = HYPOT(X, Y)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL}.
+@item @var{Y} @tab The type and kind type parameter shall be the same as
+@var{X}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has the same type and kind type parameter as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_hypot
+  real(4) :: x = 1.e0_4, y = 0.5e0_4
+  x = hypot(x,y)
+end program test_hypot
+@end smallexample
+@end table
+
+
+
+@node IACHAR
+@section @code{IACHAR} --- Code in @acronym{ASCII} collating sequence 
+@fnindex IACHAR
+@cindex @acronym{ASCII} collating sequence
+@cindex collating sequence, @acronym{ASCII}
+@cindex conversion, to integer
+
+@table @asis
+@item @emph{Description}:
+@code{IACHAR(C)} returns the code for the @acronym{ASCII} character
+in the first character position of @code{C}.
+
+@item @emph{Standard}:
+Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = IACHAR(C [, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{C}    @tab Shall be a scalar @code{CHARACTER}, with @code{INTENT(IN)}
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+
+@item @emph{Example}:
+@smallexample
+program test_iachar
+  integer i
+  i = iachar(' ')
+end program test_iachar
+@end smallexample
+
+@item @emph{Note}:
+See @ref{ICHAR} for a discussion of converting between numerical values
+and formatted string representations.
+
+@item @emph{See also}:
+@ref{ACHAR}, @ref{CHAR}, @ref{ICHAR}
+
+@end table
+
+
+
+@node IALL
+@section @code{IALL} --- Bitwise AND of array elements
+@fnindex IALL
+@cindex array, AND
+@cindex bits, AND of array elements
+
+@table @asis
+@item @emph{Description}:
+Reduces with bitwise AND the elements of @var{ARRAY} along dimension @var{DIM}
+if the corresponding element in @var{MASK} is @code{TRUE}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = IALL(ARRAY[, MASK])}
+@item @code{RESULT = IALL(ARRAY, DIM[, MASK])}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}
+@item @var{DIM}   @tab (Optional) shall be a scalar of type 
+@code{INTEGER} with a value in the range from 1 to n, where n 
+equals the rank of @var{ARRAY}.
+@item @var{MASK}  @tab (Optional) shall be of type @code{LOGICAL} 
+and either be a scalar or an array of the same shape as @var{ARRAY}.
+@end multitable
+
+@item @emph{Return value}:
+The result is of the same type as @var{ARRAY}.
+
+If @var{DIM} is absent, a scalar with the bitwise ALL of all elements in
+@var{ARRAY} is returned. Otherwise, an array of rank n-1, where n equals
+the rank of @var{ARRAY}, and a shape similar to that of @var{ARRAY} with
+dimension @var{DIM} dropped is returned.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_iall
+  INTEGER(1) :: a(2)
+
+  a(1) = b'00100100'
+  a(2) = b'01101010'
+
+  ! prints 00100000
+  PRINT '(b8.8)', IALL(a)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{IANY}, @ref{IPARITY}, @ref{IAND}
+@end table
+
+
+
+@node IAND
+@section @code{IAND} --- Bitwise logical and
+@fnindex IAND
+@cindex bitwise logical and
+@cindex logical and, bitwise
+
+@table @asis
+@item @emph{Description}:
+Bitwise logical @code{AND}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = IAND(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{J} @tab The type shall be @code{INTEGER}, of the same
+kind as @var{I}.  (As a GNU extension, different kinds are also 
+permitted.)
+@end multitable
+
+@item @emph{Return value}:
+The return type is @code{INTEGER}, of the same kind as the
+arguments.  (If the argument kinds differ, it is of the same kind as
+the larger argument.)
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_iand
+  INTEGER :: a, b
+  DATA a / Z'F' /, b / Z'3' /
+  WRITE (*,*) IAND(a, b)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{IOR}, @ref{IEOR}, @ref{IBITS}, @ref{IBSET}, @ref{IBCLR}, @ref{NOT}
+
+@end table
+
+
+
+@node IANY
+@section @code{IANY} --- Bitwise OR of array elements
+@fnindex IANY
+@cindex array, OR
+@cindex bits, OR of array elements
+
+@table @asis
+@item @emph{Description}:
+Reduces with bitwise OR (inclusive or) the elements of @var{ARRAY} along
+dimension @var{DIM} if the corresponding element in @var{MASK} is @code{TRUE}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = IANY(ARRAY[, MASK])}
+@item @code{RESULT = IANY(ARRAY, DIM[, MASK])}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}
+@item @var{DIM}   @tab (Optional) shall be a scalar of type 
+@code{INTEGER} with a value in the range from 1 to n, where n 
+equals the rank of @var{ARRAY}.
+@item @var{MASK}  @tab (Optional) shall be of type @code{LOGICAL} 
+and either be a scalar or an array of the same shape as @var{ARRAY}.
+@end multitable
+
+@item @emph{Return value}:
+The result is of the same type as @var{ARRAY}.
+
+If @var{DIM} is absent, a scalar with the bitwise OR of all elements in
+@var{ARRAY} is returned. Otherwise, an array of rank n-1, where n equals
+the rank of @var{ARRAY}, and a shape similar to that of @var{ARRAY} with
+dimension @var{DIM} dropped is returned.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_iany
+  INTEGER(1) :: a(2)
+
+  a(1) = b'00100100'
+  a(2) = b'01101010'
+
+  ! prints 01101110
+  PRINT '(b8.8)', IANY(a)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{IPARITY}, @ref{IALL}, @ref{IOR}
+@end table
+
+
+
+@node IARGC
+@section @code{IARGC} --- Get the number of command line arguments
+@fnindex IARGC
+@cindex command-line arguments
+@cindex command-line arguments, number of
+@cindex arguments, to program
+
+@table @asis
+@item @emph{Description}:
+@code{IARGC} returns the number of arguments passed on the
+command line when the containing program was invoked.
+
+This intrinsic routine is provided for backwards compatibility with 
+GNU Fortran 77.  In new code, programmers should consider the use of 
+the @ref{COMMAND_ARGUMENT_COUNT} intrinsic defined by the Fortran 2003 
+standard.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = IARGC()}
+
+@item @emph{Arguments}:
+None.
+
+@item @emph{Return value}:
+The number of command line arguments, type @code{INTEGER(4)}.
+
+@item @emph{Example}:
+See @ref{GETARG}
+
+@item @emph{See also}:
+GNU Fortran 77 compatibility subroutine: @ref{GETARG}
+
+Fortran 2003 functions and subroutines: @ref{GET_COMMAND},
+@ref{GET_COMMAND_ARGUMENT}, @ref{COMMAND_ARGUMENT_COUNT}
+@end table
+
+
+
+@node IBCLR
+@section @code{IBCLR} --- Clear bit
+@fnindex IBCLR
+@cindex bits, unset
+@cindex bits, clear
+
+@table @asis
+@item @emph{Description}:
+@code{IBCLR} returns the value of @var{I} with the bit at position
+@var{POS} set to zero.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = IBCLR(I, POS)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{POS} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the same kind as
+@var{I}.
+
+@item @emph{See also}:
+@ref{IBITS}, @ref{IBSET}, @ref{IAND}, @ref{IOR}, @ref{IEOR}, @ref{MVBITS}
+
+@end table
+
+
+
+@node IBITS
+@section @code{IBITS} --- Bit extraction
+@fnindex IBITS
+@cindex bits, get
+@cindex bits, extract
+
+@table @asis
+@item @emph{Description}:
+@code{IBITS} extracts a field of length @var{LEN} from @var{I},
+starting from bit position @var{POS} and extending left for @var{LEN}
+bits.  The result is right-justified and the remaining bits are
+zeroed.  The value of @code{POS+LEN} must be less than or equal to the
+value @code{BIT_SIZE(I)}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = IBITS(I, POS, LEN)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I}   @tab The type shall be @code{INTEGER}.
+@item @var{POS} @tab The type shall be @code{INTEGER}.
+@item @var{LEN} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the same kind as
+@var{I}.
+
+@item @emph{See also}:
+@ref{BIT_SIZE}, @ref{IBCLR}, @ref{IBSET}, @ref{IAND}, @ref{IOR}, @ref{IEOR}
+@end table
+
+
+
+@node IBSET
+@section @code{IBSET} --- Set bit
+@fnindex IBSET
+@cindex bits, set
+
+@table @asis
+@item @emph{Description}:
+@code{IBSET} returns the value of @var{I} with the bit at position
+@var{POS} set to one.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = IBSET(I, POS)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{POS} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the same kind as
+@var{I}.
+
+@item @emph{See also}:
+@ref{IBCLR}, @ref{IBITS}, @ref{IAND}, @ref{IOR}, @ref{IEOR}, @ref{MVBITS}
+
+@end table
+
+
+
+@node ICHAR
+@section @code{ICHAR} --- Character-to-integer conversion function
+@fnindex ICHAR
+@cindex conversion, to integer
+
+@table @asis
+@item @emph{Description}:
+@code{ICHAR(C)} returns the code for the character in the first character
+position of @code{C} in the system's native character set.
+The correspondence between characters and their codes is not necessarily
+the same across different GNU Fortran implementations.
+
+@item @emph{Standard}:
+Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ICHAR(C [, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{C}    @tab Shall be a scalar @code{CHARACTER}, with @code{INTENT(IN)}
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+
+@item @emph{Example}:
+@smallexample
+program test_ichar
+  integer i
+  i = ichar(' ')
+end program test_ichar
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Argument             @tab Return type       @tab Standard
+@item @code{ICHAR(C)}  @tab @code{CHARACTER C}   @tab @code{INTEGER(4)}    @tab Fortran 77 and later
+@end multitable
+
+@item @emph{Note}:
+No intrinsic exists to convert between a numeric value and a formatted
+character string representation -- for instance, given the
+@code{CHARACTER} value @code{'154'}, obtaining an @code{INTEGER} or
+@code{REAL} value with the value 154, or vice versa. Instead, this
+functionality is provided by internal-file I/O, as in the following
+example:
+@smallexample
+program read_val
+  integer value
+  character(len=10) string, string2
+  string = '154'
+  
+  ! Convert a string to a numeric value
+  read (string,'(I10)') value
+  print *, value
+  
+  ! Convert a value to a formatted string
+  write (string2,'(I10)') value
+  print *, string2
+end program read_val
+@end smallexample
+
+@item @emph{See also}:
+@ref{ACHAR}, @ref{CHAR}, @ref{IACHAR}
+
+@end table
+
+
+
+@node IDATE
+@section @code{IDATE} --- Get current local time subroutine (day/month/year) 
+@fnindex IDATE
+@cindex date, current
+@cindex current date
+
+@table @asis
+@item @emph{Description}:
+@code{IDATE(VALUES)} Fills @var{VALUES} with the numerical values at the  
+current local time. The day (in the range 1-31), month (in the range 1-12), 
+and year appear in elements 1, 2, and 3 of @var{VALUES}, respectively. 
+The year has four significant digits.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL IDATE(VALUES)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{VALUES} @tab The type shall be @code{INTEGER, DIMENSION(3)} and
+the kind shall be the default integer kind.
+@end multitable
+
+@item @emph{Return value}:
+Does not return anything.
+
+@item @emph{Example}:
+@smallexample
+program test_idate
+  integer, dimension(3) :: tarray
+  call idate(tarray)
+  print *, tarray(1)
+  print *, tarray(2)
+  print *, tarray(3)
+end program test_idate
+@end smallexample
+@end table
+
+
+
+@node IEOR
+@section @code{IEOR} --- Bitwise logical exclusive or
+@fnindex IEOR
+@cindex bitwise logical exclusive or
+@cindex logical exclusive or, bitwise
+
+@table @asis
+@item @emph{Description}:
+@code{IEOR} returns the bitwise Boolean exclusive-OR of @var{I} and
+@var{J}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = IEOR(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{J} @tab The type shall be @code{INTEGER}, of the same
+kind as @var{I}.  (As a GNU extension, different kinds are also 
+permitted.)
+@end multitable
+
+@item @emph{Return value}:
+The return type is @code{INTEGER}, of the same kind as the
+arguments.  (If the argument kinds differ, it is of the same kind as
+the larger argument.)
+
+@item @emph{See also}:
+@ref{IOR}, @ref{IAND}, @ref{IBITS}, @ref{IBSET}, @ref{IBCLR}, @ref{NOT}
+@end table
+
+
+
+@node IERRNO
+@section @code{IERRNO} --- Get the last system error number
+@fnindex IERRNO
+@cindex system, error handling
+
+@table @asis
+@item @emph{Description}:
+Returns the last system error number, as given by the C @code{errno}
+variable.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = IERRNO()}
+
+@item @emph{Arguments}:
+None.
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the default integer
+kind.
+
+@item @emph{See also}:
+@ref{PERROR}
+@end table
+
+
+
+@node IMAGE_INDEX
+@section @code{IMAGE_INDEX} --- Function that converts a cosubscript to an image index
+@fnindex IMAGE_INDEX
+@cindex coarray, @code{IMAGE_INDEX}
+@cindex images, cosubscript to image index conversion
+
+@table @asis
+@item @emph{Description}:
+Returns the image index belonging to a cosubscript.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Inquiry function.
+
+@item @emph{Syntax}:
+@code{RESULT = IMAGE_INDEX(COARRAY, SUB)}
+
+@item @emph{Arguments}: None.
+@multitable @columnfractions .15 .70
+@item @var{COARRAY} @tab Coarray of any type.
+@item @var{SUB}     @tab default integer rank-1 array of a size equal to
+the corank of @var{COARRAY}.
+@end multitable
+
+
+@item @emph{Return value}:
+Scalar default integer with the value of the image index which corresponds
+to the cosubscripts. For invalid cosubscripts the result is zero.
+
+@item @emph{Example}:
+@smallexample
+INTEGER :: array[2,-1:4,8,*]
+! Writes  28 (or 0 if there are fewer than 28 images)
+WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1])
+@end smallexample
+
+@item @emph{See also}:
+@ref{THIS_IMAGE}, @ref{NUM_IMAGES}
+@end table
+
+
+
+@node INDEX intrinsic
+@section @code{INDEX} --- Position of a substring within a string
+@fnindex INDEX
+@cindex substring position
+@cindex string, find substring
+
+@table @asis
+@item @emph{Description}:
+Returns the position of the start of the first occurrence of string
+@var{SUBSTRING} as a substring in @var{STRING}, counting from one.  If
+@var{SUBSTRING} is not present in @var{STRING}, zero is returned.  If 
+the @var{BACK} argument is present and true, the return value is the
+start of the last occurrence rather than the first.
+
+@item @emph{Standard}:
+Fortran 77 and later, with @var{KIND} argument Fortran 2003 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = INDEX(STRING, SUBSTRING [, BACK [, KIND]])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING} @tab Shall be a scalar @code{CHARACTER}, with
+@code{INTENT(IN)}
+@item @var{SUBSTRING} @tab Shall be a scalar @code{CHARACTER}, with
+@code{INTENT(IN)}
+@item @var{BACK} @tab (Optional) Shall be a scalar @code{LOGICAL}, with
+@code{INTENT(IN)}
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name                            @tab Argument           @tab Return type       @tab Standard
+@item @code{INDEX(STRING, SUBSTRING)} @tab @code{CHARACTER}   @tab @code{INTEGER(4)} @tab Fortran 77 and later
+@end multitable
+
+@item @emph{See also}:
+@ref{SCAN}, @ref{VERIFY}
+@end table
+
+
+
+@node INT
+@section @code{INT} --- Convert to integer type
+@fnindex INT
+@fnindex IFIX
+@fnindex IDINT
+@cindex conversion, to integer
+
+@table @asis
+@item @emph{Description}:
+Convert to integer type
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = INT(A [, KIND))}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A}    @tab Shall be of type @code{INTEGER},
+@code{REAL}, or @code{COMPLEX}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+These functions return a @code{INTEGER} variable or array under 
+the following rules: 
+
+@table @asis
+@item (A)
+If @var{A} is of type @code{INTEGER}, @code{INT(A) = A} 
+@item (B)
+If @var{A} is of type @code{REAL} and @math{|A| < 1}, @code{INT(A)} equals @code{0}. 
+If @math{|A| \geq 1}, then @code{INT(A)} equals the largest integer that does not exceed 
+the range of @var{A} and whose sign is the same as the sign of @var{A}.
+@item (C)
+If @var{A} is of type @code{COMPLEX}, rule B is applied to the real part of @var{A}.
+@end table
+
+@item @emph{Example}:
+@smallexample
+program test_int
+  integer :: i = 42
+  complex :: z = (-3.7, 1.0)
+  print *, int(i)
+  print *, int(z), int(z,8)
+end program
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type       @tab Standard
+@item @code{INT(A)}   @tab @code{REAL(4) A}  @tab @code{INTEGER}    @tab Fortran 77 and later
+@item @code{IFIX(A)}  @tab @code{REAL(4) A}  @tab @code{INTEGER}    @tab Fortran 77 and later
+@item @code{IDINT(A)} @tab @code{REAL(8) A}  @tab @code{INTEGER}    @tab Fortran 77 and later
+@end multitable
+
+@end table
+
+
+@node INT2
+@section @code{INT2} --- Convert to 16-bit integer type
+@fnindex INT2
+@fnindex SHORT
+@cindex conversion, to integer
+
+@table @asis
+@item @emph{Description}:
+Convert to a @code{KIND=2} integer type. This is equivalent to the
+standard @code{INT} intrinsic with an optional argument of
+@code{KIND=2}, and is only included for backwards compatibility.
+
+The @code{SHORT} intrinsic is equivalent to @code{INT2}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = INT2(A)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A}    @tab Shall be of type @code{INTEGER},
+@code{REAL}, or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is a @code{INTEGER(2)} variable.
+
+@item @emph{See also}:
+@ref{INT}, @ref{INT8}, @ref{LONG}
+@end table
+
+
+
+@node INT8
+@section @code{INT8} --- Convert to 64-bit integer type
+@fnindex INT8
+@cindex conversion, to integer
+
+@table @asis
+@item @emph{Description}:
+Convert to a @code{KIND=8} integer type. This is equivalent to the
+standard @code{INT} intrinsic with an optional argument of
+@code{KIND=8}, and is only included for backwards compatibility.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = INT8(A)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A}    @tab Shall be of type @code{INTEGER},
+@code{REAL}, or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is a @code{INTEGER(8)} variable.
+
+@item @emph{See also}:
+@ref{INT}, @ref{INT2}, @ref{LONG}
+@end table
+
+
+
+@node IOR
+@section @code{IOR} --- Bitwise logical or
+@fnindex IOR
+@cindex bitwise logical or
+@cindex logical or, bitwise
+
+@table @asis
+@item @emph{Description}:
+@code{IOR} returns the bitwise Boolean inclusive-OR of @var{I} and
+@var{J}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = IOR(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{J} @tab The type shall be @code{INTEGER}, of the same
+kind as @var{I}.  (As a GNU extension, different kinds are also 
+permitted.)
+@end multitable
+
+@item @emph{Return value}:
+The return type is @code{INTEGER}, of the same kind as the
+arguments.  (If the argument kinds differ, it is of the same kind as
+the larger argument.)
+
+@item @emph{See also}:
+@ref{IEOR}, @ref{IAND}, @ref{IBITS}, @ref{IBSET}, @ref{IBCLR}, @ref{NOT}
+@end table
+
+
+
+@node IPARITY
+@section @code{IPARITY} --- Bitwise XOR of array elements
+@fnindex IPARITY
+@cindex array, parity
+@cindex array, XOR
+@cindex bits, XOR of array elements
+
+@table @asis
+@item @emph{Description}:
+Reduces with bitwise XOR (exclusive or) the elements of @var{ARRAY} along
+dimension @var{DIM} if the corresponding element in @var{MASK} is @code{TRUE}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = IPARITY(ARRAY[, MASK])}
+@item @code{RESULT = IPARITY(ARRAY, DIM[, MASK])}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}
+@item @var{DIM}   @tab (Optional) shall be a scalar of type 
+@code{INTEGER} with a value in the range from 1 to n, where n 
+equals the rank of @var{ARRAY}.
+@item @var{MASK}  @tab (Optional) shall be of type @code{LOGICAL} 
+and either be a scalar or an array of the same shape as @var{ARRAY}.
+@end multitable
+
+@item @emph{Return value}:
+The result is of the same type as @var{ARRAY}.
+
+If @var{DIM} is absent, a scalar with the bitwise XOR of all elements in
+@var{ARRAY} is returned. Otherwise, an array of rank n-1, where n equals
+the rank of @var{ARRAY}, and a shape similar to that of @var{ARRAY} with
+dimension @var{DIM} dropped is returned.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_iparity
+  INTEGER(1) :: a(2)
+
+  a(1) = b'00100100'
+  a(2) = b'01101010'
+
+  ! prints 01001110
+  PRINT '(b8.8)', IPARITY(a)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{IANY}, @ref{IALL}, @ref{IEOR}, @ref{PARITY}
+@end table
+
+
+
+@node IRAND
+@section @code{IRAND} --- Integer pseudo-random number
+@fnindex IRAND
+@cindex random number generation
+
+@table @asis
+@item @emph{Description}:
+@code{IRAND(FLAG)} returns a pseudo-random number from a uniform
+distribution between 0 and a system-dependent limit (which is in most
+cases 2147483647). If @var{FLAG} is 0, the next number
+in the current sequence is returned; if @var{FLAG} is 1, the generator
+is restarted by @code{CALL SRAND(0)}; if @var{FLAG} has any other value,
+it is used as a new seed with @code{SRAND}.
+
+This intrinsic routine is provided for backwards compatibility with
+GNU Fortran 77. It implements a simple modulo generator as provided 
+by @command{g77}. For new code, one should consider the use of 
+@ref{RANDOM_NUMBER} as it implements a superior algorithm.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = IRAND(I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be a scalar @code{INTEGER} of kind 4.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of @code{INTEGER(kind=4)} type.
+
+@item @emph{Example}:
+@smallexample
+program test_irand
+  integer,parameter :: seed = 86456
+  
+  call srand(seed)
+  print *, irand(), irand(), irand(), irand()
+  print *, irand(seed), irand(), irand(), irand()
+end program test_irand
+@end smallexample
+
+@end table
+
+
+
+@node IS_IOSTAT_END
+@section @code{IS_IOSTAT_END} --- Test for end-of-file value
+@fnindex IS_IOSTAT_END
+@cindex @code{IOSTAT}, end of file
+
+@table @asis
+@item @emph{Description}:
+@code{IS_IOSTAT_END} tests whether an variable has the value of the I/O
+status ``end of file''. The function is equivalent to comparing the variable
+with the @code{IOSTAT_END} parameter of the intrinsic module
+@code{ISO_FORTRAN_ENV}.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = IS_IOSTAT_END(I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of the type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+Returns a @code{LOGICAL} of the default kind, which @code{.TRUE.} if
+@var{I} has the value which indicates an end of file condition for
+@code{IOSTAT=} specifiers, and is @code{.FALSE.} otherwise.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM iostat
+  IMPLICIT NONE
+  INTEGER :: stat, i
+  OPEN(88, FILE='test.dat')
+  READ(88, *, IOSTAT=stat) i
+  IF(IS_IOSTAT_END(stat)) STOP 'END OF FILE'
+END PROGRAM
+@end smallexample
+@end table
+
+
+
+@node IS_IOSTAT_EOR
+@section @code{IS_IOSTAT_EOR} --- Test for end-of-record value
+@fnindex IS_IOSTAT_EOR
+@cindex @code{IOSTAT}, end of record
+
+@table @asis
+@item @emph{Description}:
+@code{IS_IOSTAT_EOR} tests whether an variable has the value of the I/O
+status ``end of record''. The function is equivalent to comparing the
+variable with the @code{IOSTAT_EOR} parameter of the intrinsic module
+@code{ISO_FORTRAN_ENV}.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = IS_IOSTAT_EOR(I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of the type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+Returns a @code{LOGICAL} of the default kind, which @code{.TRUE.} if
+@var{I} has the value which indicates an end of file condition for
+@code{IOSTAT=} specifiers, and is @code{.FALSE.} otherwise.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM iostat
+  IMPLICIT NONE
+  INTEGER :: stat, i(50)
+  OPEN(88, FILE='test.dat', FORM='UNFORMATTED')
+  READ(88, IOSTAT=stat) i
+  IF(IS_IOSTAT_EOR(stat)) STOP 'END OF RECORD'
+END PROGRAM
+@end smallexample
+@end table
+
+
+
+@node ISATTY
+@section @code{ISATTY} --- Whether a unit is a terminal device.
+@fnindex ISATTY
+@cindex system, terminal
+
+@table @asis
+@item @emph{Description}:
+Determine whether a unit is connected to a terminal device.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = ISATTY(UNIT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{UNIT} @tab Shall be a scalar @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+Returns @code{.TRUE.} if the @var{UNIT} is connected to a terminal 
+device, @code{.FALSE.} otherwise.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_isatty
+  INTEGER(kind=1) :: unit
+  DO unit = 1, 10
+    write(*,*) isatty(unit=unit)
+  END DO
+END PROGRAM
+@end smallexample
+@item @emph{See also}:
+@ref{TTYNAM}
+@end table
+
+
+
+@node ISHFT
+@section @code{ISHFT} --- Shift bits
+@fnindex ISHFT
+@cindex bits, shift
+
+@table @asis
+@item @emph{Description}:
+@code{ISHFT} returns a value corresponding to @var{I} with all of the
+bits shifted @var{SHIFT} places.  A value of @var{SHIFT} greater than
+zero corresponds to a left shift, a value of zero corresponds to no
+shift, and a value less than zero corresponds to a right shift.  If the
+absolute value of @var{SHIFT} is greater than @code{BIT_SIZE(I)}, the
+value is undefined.  Bits shifted out from the left end or right end are
+lost; zeros are shifted in from the opposite end.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ISHFT(I, SHIFT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{SHIFT} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the same kind as
+@var{I}.
+
+@item @emph{See also}:
+@ref{ISHFTC}
+@end table
+
+
+
+@node ISHFTC
+@section @code{ISHFTC} --- Shift bits circularly
+@fnindex ISHFTC
+@cindex bits, shift circular
+
+@table @asis
+@item @emph{Description}:
+@code{ISHFTC} returns a value corresponding to @var{I} with the
+rightmost @var{SIZE} bits shifted circularly @var{SHIFT} places; that
+is, bits shifted out one end are shifted into the opposite end.  A value
+of @var{SHIFT} greater than zero corresponds to a left shift, a value of
+zero corresponds to no shift, and a value less than zero corresponds to
+a right shift.  The absolute value of @var{SHIFT} must be less than
+@var{SIZE}.  If the @var{SIZE} argument is omitted, it is taken to be
+equivalent to @code{BIT_SIZE(I)}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = ISHFTC(I, SHIFT [, SIZE])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{SHIFT} @tab The type shall be @code{INTEGER}.
+@item @var{SIZE} @tab (Optional) The type shall be @code{INTEGER};
+the value must be greater than zero and less than or equal to
+@code{BIT_SIZE(I)}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the same kind as
+@var{I}.
+
+@item @emph{See also}:
+@ref{ISHFT}
+@end table
+
+
+
+@node ISNAN
+@section @code{ISNAN} --- Test for a NaN
+@fnindex ISNAN
+@cindex IEEE, ISNAN
+
+@table @asis
+@item @emph{Description}:
+@code{ISNAN} tests whether a floating-point value is an IEEE
+Not-a-Number (NaN).
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{ISNAN(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Variable of the type @code{REAL}.
+
+@end multitable
+
+@item @emph{Return value}:
+Returns a default-kind @code{LOGICAL}. The returned value is @code{TRUE}
+if @var{X} is a NaN and @code{FALSE} otherwise.
+
+@item @emph{Example}:
+@smallexample
+program test_nan
+  implicit none
+  real :: x
+  x = -1.0
+  x = sqrt(x)
+  if (isnan(x)) stop '"x" is a NaN'
+end program test_nan
+@end smallexample
+@end table
+
+
+
+@node ITIME
+@section @code{ITIME} --- Get current local time subroutine (hour/minutes/seconds) 
+@fnindex ITIME
+@cindex time, current
+@cindex current time
+
+@table @asis
+@item @emph{Description}:
+@code{IDATE(VALUES)} Fills @var{VALUES} with the numerical values at the  
+current local time. The hour (in the range 1-24), minute (in the range 1-60), 
+and seconds (in the range 1-60) appear in elements 1, 2, and 3 of @var{VALUES}, 
+respectively.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL ITIME(VALUES)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{VALUES} @tab The type shall be @code{INTEGER, DIMENSION(3)}
+and the kind shall be the default integer kind.
+@end multitable
+
+@item @emph{Return value}:
+Does not return anything.
+
+
+@item @emph{Example}:
+@smallexample
+program test_itime
+  integer, dimension(3) :: tarray
+  call itime(tarray)
+  print *, tarray(1)
+  print *, tarray(2)
+  print *, tarray(3)
+end program test_itime
+@end smallexample
+@end table
+
+
+
+@node KILL
+@section @code{KILL} --- Send a signal to a process
+@fnindex KILL
+
+@table @asis
+@item @emph{Description}:
+@item @emph{Standard}:
+Sends the signal specified by @var{SIGNAL} to the process @var{PID}.
+See @code{kill(2)}.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL KILL(C, VALUE [, STATUS])}
+@item @code{STATUS = KILL(C, VALUE)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{C} @tab Shall be a scalar @code{INTEGER}, with
+@code{INTENT(IN)}
+@item @var{VALUE} @tab Shall be a scalar @code{INTEGER}, with
+@code{INTENT(IN)}
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)} or
+@code{INTEGER(8)}. Returns 0 on success, or a system-specific error code
+otherwise.
+@end multitable
+
+@item @emph{See also}:
+@ref{ABORT}, @ref{EXIT}
+@end table
+
+
+
+@node KIND
+@section @code{KIND} --- Kind of an entity
+@fnindex KIND
+@cindex kind
+
+@table @asis
+@item @emph{Description}:
+@code{KIND(X)} returns the kind value of the entity @var{X}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{K = KIND(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{LOGICAL}, @code{INTEGER},
+@code{REAL}, @code{COMPLEX} or @code{CHARACTER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is a scalar of type @code{INTEGER} and of the default
+integer kind.
+
+@item @emph{Example}:
+@smallexample
+program test_kind
+  integer,parameter :: kc = kind(' ')
+  integer,parameter :: kl = kind(.true.)
+
+  print *, "The default character kind is ", kc
+  print *, "The default logical kind is ", kl
+end program test_kind
+@end smallexample
+
+@end table
+
+
+
+@node LBOUND
+@section @code{LBOUND} --- Lower dimension bounds of an array
+@fnindex LBOUND
+@cindex array, lower bound
+
+@table @asis
+@item @emph{Description}:
+Returns the lower bounds of an array, or a single lower bound
+along the @var{DIM} dimension.
+@item @emph{Standard}:
+Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = LBOUND(ARRAY [, DIM [, KIND]])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array, of any type.
+@item @var{DIM} @tab (Optional) Shall be a scalar @code{INTEGER}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+If @var{DIM} is absent, the result is an array of the lower bounds of
+@var{ARRAY}.  If @var{DIM} is present, the result is a scalar
+corresponding to the lower bound of the array along that dimension.  If
+@var{ARRAY} is an expression rather than a whole array or array
+structure component, or if it has a zero extent along the relevant
+dimension, the lower bound is taken to be 1.
+
+@item @emph{See also}:
+@ref{UBOUND}, @ref{LCOBOUND}
+@end table
+
+
+
+@node LCOBOUND
+@section @code{LCOBOUND} --- Lower codimension bounds of an array
+@fnindex LCOBOUND
+@cindex coarray, lower bound
+
+@table @asis
+@item @emph{Description}:
+Returns the lower bounds of a coarray, or a single lower cobound
+along the @var{DIM} codimension.
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = LCOBOUND(COARRAY [, DIM [, KIND]])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an coarray, of any type.
+@item @var{DIM} @tab (Optional) Shall be a scalar @code{INTEGER}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+If @var{DIM} is absent, the result is an array of the lower cobounds of
+@var{COARRAY}.  If @var{DIM} is present, the result is a scalar
+corresponding to the lower cobound of the array along that codimension.
+
+@item @emph{See also}:
+@ref{UCOBOUND}, @ref{LBOUND}
+@end table
+
+
+
+@node LEADZ
+@section @code{LEADZ} --- Number of leading zero bits of an integer
+@fnindex LEADZ
+@cindex zero bits
+
+@table @asis
+@item @emph{Description}:
+@code{LEADZ} returns the number of leading zero bits of an integer.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = LEADZ(I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The type of the return value is the default @code{INTEGER}.
+If all the bits of @code{I} are zero, the result value is @code{BIT_SIZE(I)}.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_leadz
+  WRITE (*,*) BIT_SIZE(1)  ! prints 32
+  WRITE (*,*) LEADZ(1)     ! prints 31
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{BIT_SIZE}, @ref{TRAILZ}, @ref{POPCNT}, @ref{POPPAR}
+@end table
+
+
+
+@node LEN
+@section @code{LEN} --- Length of a character entity
+@fnindex LEN
+@cindex string, length
+
+@table @asis
+@item @emph{Description}:
+Returns the length of a character string.  If @var{STRING} is an array,
+the length of an element of @var{STRING} is returned.  Note that
+@var{STRING} need not be defined when this intrinsic is invoked, since
+only the length, not the content, of @var{STRING} is needed.
+
+@item @emph{Standard}:
+Fortran 77 and later, with @var{KIND} argument Fortran 2003 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{L = LEN(STRING [, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING} @tab Shall be a scalar or array of type
+@code{CHARACTER}, with @code{INTENT(IN)}
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name               @tab Argument          @tab Return type       @tab Standard
+@item @code{LEN(STRING)} @tab @code{CHARACTER}  @tab @code{INTEGER}    @tab Fortran 77 and later
+@end multitable
+
+
+@item @emph{See also}:
+@ref{LEN_TRIM}, @ref{ADJUSTL}, @ref{ADJUSTR}
+@end table
+
+
+
+@node LEN_TRIM
+@section @code{LEN_TRIM} --- Length of a character entity without trailing blank characters
+@fnindex LEN_TRIM
+@cindex string, length, without trailing whitespace
+
+@table @asis
+@item @emph{Description}:
+Returns the length of a character string, ignoring any trailing blanks.
+
+@item @emph{Standard}:
+Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = LEN_TRIM(STRING [, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING} @tab Shall be a scalar of type @code{CHARACTER},
+with @code{INTENT(IN)}
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+
+@item @emph{See also}:
+@ref{LEN}, @ref{ADJUSTL}, @ref{ADJUSTR}
+@end table
+
+
+
+@node LGE
+@section @code{LGE} --- Lexical greater than or equal
+@fnindex LGE
+@cindex lexical comparison of strings
+@cindex string, comparison
+
+@table @asis
+@item @emph{Description}:
+Determines whether one string is lexically greater than or equal to
+another string, where the two strings are interpreted as containing
+ASCII character codes.  If the String A and String B are not the same
+length, the shorter is compared as if spaces were appended to it to form
+a value that has the same length as the longer.
+
+In general, the lexical comparison intrinsics @code{LGE}, @code{LGT},
+@code{LLE}, and @code{LLT} differ from the corresponding intrinsic
+operators @code{.GE.}, @code{.GT.}, @code{.LE.}, and @code{.LT.}, in
+that the latter use the processor's character ordering (which is not
+ASCII on some targets), whereas the former always use the ASCII
+ordering.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = LGE(STRING_A, STRING_B)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING_A} @tab Shall be of default @code{CHARACTER} type.
+@item @var{STRING_B} @tab Shall be of default @code{CHARACTER} type.
+@end multitable
+
+@item @emph{Return value}:
+Returns @code{.TRUE.} if @code{STRING_A >= STRING_B}, and @code{.FALSE.}
+otherwise, based on the ASCII ordering.
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name                           @tab Argument          @tab Return type       @tab Standard
+@item @code{LGE(STRING_A, STRING_B)} @tab @code{CHARACTER}  @tab @code{LOGICAL}    @tab Fortran 77 and later
+@end multitable
+
+@item @emph{See also}:
+@ref{LGT}, @ref{LLE}, @ref{LLT}
+@end table
+
+
+
+@node LGT
+@section @code{LGT} --- Lexical greater than
+@fnindex LGT
+@cindex lexical comparison of strings
+@cindex string, comparison
+
+@table @asis
+@item @emph{Description}:
+Determines whether one string is lexically greater than another string,
+where the two strings are interpreted as containing ASCII character
+codes.  If the String A and String B are not the same length, the
+shorter is compared as if spaces were appended to it to form a value
+that has the same length as the longer.
+
+In general, the lexical comparison intrinsics @code{LGE}, @code{LGT},
+@code{LLE}, and @code{LLT} differ from the corresponding intrinsic
+operators @code{.GE.}, @code{.GT.}, @code{.LE.}, and @code{.LT.}, in
+that the latter use the processor's character ordering (which is not
+ASCII on some targets), whereas the former always use the ASCII
+ordering.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = LGT(STRING_A, STRING_B)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING_A} @tab Shall be of default @code{CHARACTER} type.
+@item @var{STRING_B} @tab Shall be of default @code{CHARACTER} type.
+@end multitable
+
+@item @emph{Return value}:
+Returns @code{.TRUE.} if @code{STRING_A > STRING_B}, and @code{.FALSE.}
+otherwise, based on the ASCII ordering.
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name                           @tab Argument          @tab Return type       @tab Standard
+@item @code{LGT(STRING_A, STRING_B)} @tab @code{CHARACTER}  @tab @code{LOGICAL}    @tab Fortran 77 and later
+@end multitable
+
+@item @emph{See also}:
+@ref{LGE}, @ref{LLE}, @ref{LLT}
+@end table
+
+
+
+@node LINK
+@section @code{LINK} --- Create a hard link
+@fnindex LINK
+@cindex file system, create link
+@cindex file system, hard link
+
+@table @asis
+@item @emph{Description}:
+Makes a (hard) link from file @var{PATH1} to @var{PATH2}. A null
+character (@code{CHAR(0)}) can be used to mark the end of the names in
+@var{PATH1} and @var{PATH2}; otherwise, trailing blanks in the file
+names are ignored.  If the @var{STATUS} argument is supplied, it
+contains 0 on success or a nonzero error code upon return; see
+@code{link(2)}.
+
+This intrinsic is provided in both subroutine and function forms;
+however, only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL LINK(PATH1, PATH2 [, STATUS])}
+@item @code{STATUS = LINK(PATH1, PATH2)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{PATH1} @tab Shall be of default @code{CHARACTER} type.
+@item @var{PATH2} @tab Shall be of default @code{CHARACTER} type.
+@item @var{STATUS} @tab (Optional) Shall be of default @code{INTEGER} type.
+@end multitable
+
+@item @emph{See also}:
+@ref{SYMLNK}, @ref{UNLINK}
+@end table
+
+
+
+@node LLE
+@section @code{LLE} --- Lexical less than or equal
+@fnindex LLE
+@cindex lexical comparison of strings
+@cindex string, comparison
+
+@table @asis
+@item @emph{Description}:
+Determines whether one string is lexically less than or equal to another
+string, where the two strings are interpreted as containing ASCII
+character codes.  If the String A and String B are not the same length,
+the shorter is compared as if spaces were appended to it to form a value
+that has the same length as the longer.
+
+In general, the lexical comparison intrinsics @code{LGE}, @code{LGT},
+@code{LLE}, and @code{LLT} differ from the corresponding intrinsic
+operators @code{.GE.}, @code{.GT.}, @code{.LE.}, and @code{.LT.}, in
+that the latter use the processor's character ordering (which is not
+ASCII on some targets), whereas the former always use the ASCII
+ordering.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = LLE(STRING_A, STRING_B)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING_A} @tab Shall be of default @code{CHARACTER} type.
+@item @var{STRING_B} @tab Shall be of default @code{CHARACTER} type.
+@end multitable
+
+@item @emph{Return value}:
+Returns @code{.TRUE.} if @code{STRING_A <= STRING_B}, and @code{.FALSE.}
+otherwise, based on the ASCII ordering.
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name                           @tab Argument          @tab Return type       @tab Standard
+@item @code{LLE(STRING_A, STRING_B)} @tab @code{CHARACTER}  @tab @code{LOGICAL}    @tab Fortran 77 and later
+@end multitable
+
+@item @emph{See also}:
+@ref{LGE}, @ref{LGT}, @ref{LLT}
+@end table
+
+
+
+@node LLT
+@section @code{LLT} --- Lexical less than
+@fnindex LLT
+@cindex lexical comparison of strings
+@cindex string, comparison
+
+@table @asis
+@item @emph{Description}:
+Determines whether one string is lexically less than another string,
+where the two strings are interpreted as containing ASCII character
+codes.  If the String A and String B are not the same length, the
+shorter is compared as if spaces were appended to it to form a value
+that has the same length as the longer.
+
+In general, the lexical comparison intrinsics @code{LGE}, @code{LGT},
+@code{LLE}, and @code{LLT} differ from the corresponding intrinsic
+operators @code{.GE.}, @code{.GT.}, @code{.LE.}, and @code{.LT.}, in
+that the latter use the processor's character ordering (which is not
+ASCII on some targets), whereas the former always use the ASCII
+ordering.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = LLT(STRING_A, STRING_B)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING_A} @tab Shall be of default @code{CHARACTER} type.
+@item @var{STRING_B} @tab Shall be of default @code{CHARACTER} type.
+@end multitable
+
+@item @emph{Return value}:
+Returns @code{.TRUE.} if @code{STRING_A < STRING_B}, and @code{.FALSE.}
+otherwise, based on the ASCII ordering.
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name                           @tab Argument          @tab Return type       @tab Standard
+@item @code{LLT(STRING_A, STRING_B)} @tab @code{CHARACTER}  @tab @code{LOGICAL}    @tab Fortran 77 and later
+@end multitable
+
+@item @emph{See also}:
+@ref{LGE}, @ref{LGT}, @ref{LLE}
+@end table
+
+
+
+@node LNBLNK
+@section @code{LNBLNK} --- Index of the last non-blank character in a string
+@fnindex LNBLNK
+@cindex string, find non-blank character
+
+@table @asis
+@item @emph{Description}:
+Returns the length of a character string, ignoring any trailing blanks.
+This is identical to the standard @code{LEN_TRIM} intrinsic, and is only
+included for backwards compatibility.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = LNBLNK(STRING)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING} @tab Shall be a scalar of type @code{CHARACTER},
+with @code{INTENT(IN)}
+@end multitable
+
+@item @emph{Return value}:
+The return value is of @code{INTEGER(kind=4)} type.
+
+@item @emph{See also}:
+@ref{INDEX intrinsic}, @ref{LEN_TRIM}
+@end table
+
+
+
+@node LOC
+@section @code{LOC} --- Returns the address of a variable
+@fnindex LOC
+@cindex location of a variable in memory
+
+@table @asis
+@item @emph{Description}:
+@code{LOC(X)} returns the address of @var{X} as an integer.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = LOC(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Variable of any type.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER}, with a @code{KIND}
+corresponding to 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} --- Natural logarithm function
+@fnindex LOG
+@fnindex ALOG
+@fnindex DLOG
+@fnindex CLOG
+@fnindex ZLOG
+@fnindex CDLOG
+@cindex exponential function, inverse
+@cindex logarithm function
+@cindex natural logarithm function
+
+@table @asis
+@item @emph{Description}:
+@code{LOG(X)} computes the natural logarithm of @var{X}, i.e. the
+logarithm to the base @math{e}.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = LOG(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or
+@code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL} or @code{COMPLEX}.
+The kind type parameter is the same as @var{X}.
+If @var{X} is @code{COMPLEX}, the imaginary part @math{\omega} is in the range
+@math{-\pi \leq \omega \leq \pi}.
+
+@item @emph{Example}:
+@smallexample
+program test_log
+  real(8) :: x = 2.7182818284590451_8
+  complex :: z = (1.0, 2.0)
+  x = log(x)    ! will yield (approximately) 1
+  z = log(z)
+end program test_log
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type       @tab Standard
+@item @code{ALOG(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab f95, gnu
+@item @code{DLOG(X)}  @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab f95, gnu
+@item @code{CLOG(X)}  @tab @code{COMPLEX(4) X}  @tab @code{COMPLEX(4)}    @tab f95, gnu
+@item @code{ZLOG(X)}  @tab @code{COMPLEX(8) X}  @tab @code{COMPLEX(8)}    @tab f95, gnu
+@item @code{CDLOG(X)} @tab @code{COMPLEX(8) X}  @tab @code{COMPLEX(8)}    @tab f95, gnu
+@end multitable
+@end table
+
+
+
+@node LOG10
+@section @code{LOG10} --- Base 10 logarithm function
+@fnindex LOG10
+@fnindex ALOG10
+@fnindex DLOG10
+@cindex exponential function, inverse
+@cindex logarithm function with base 10
+@cindex base 10 logarithm function
+
+@table @asis
+@item @emph{Description}:
+@code{LOG10(X)} computes the base 10 logarithm of @var{X}.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = LOG10(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL} or @code{COMPLEX}.
+The kind type parameter is the same as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_log10
+  real(8) :: x = 10.0_8
+  x = log10(x)
+end program test_log10
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type       @tab Standard
+@item @code{ALOG10(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab Fortran 95 and later
+@item @code{DLOG10(X)}  @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab Fortran 95 and later
+@end multitable
+@end table
+
+
+
+@node LOG_GAMMA
+@section @code{LOG_GAMMA} --- Logarithm of the Gamma function
+@fnindex LOG_GAMMA
+@fnindex LGAMMA
+@fnindex ALGAMA
+@fnindex DLGAMA
+@cindex Gamma function, logarithm of
+
+@table @asis
+@item @emph{Description}:
+@code{LOG_GAMMA(X)} computes the natural logarithm of the absolute value
+of the Gamma (@math{\Gamma}) function.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{X = LOG_GAMMA(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{REAL} and neither zero
+nor a negative integer.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL} of the same kind as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_log_gamma
+  real :: x = 1.0
+  x = lgamma(x) ! returns 0.0
+end program test_log_gamma
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Argument         @tab Return type       @tab Standard
+@item @code{LGAMMA(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)}    @tab GNU Extension
+@item @code{ALGAMA(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)}    @tab GNU Extension
+@item @code{DLGAMA(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)}    @tab GNU Extension
+@end multitable
+
+@item @emph{See also}:
+Gamma function: @ref{GAMMA}
+
+@end table
+
+
+
+@node LOGICAL
+@section @code{LOGICAL} --- Convert to logical type
+@fnindex LOGICAL
+@cindex conversion, to logical
+
+@table @asis
+@item @emph{Description}:
+Converts one kind of @code{LOGICAL} variable to another.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = LOGICAL(L [, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{L}    @tab The type shall be @code{LOGICAL}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is a @code{LOGICAL} value equal to @var{L}, with a
+kind corresponding to @var{KIND}, or of the default logical kind if
+@var{KIND} is not given.
+
+@item @emph{See also}:
+@ref{INT}, @ref{REAL}, @ref{CMPLX}
+@end table
+
+
+
+@node LONG
+@section @code{LONG} --- Convert to integer type
+@fnindex LONG
+@cindex conversion, to integer
+
+@table @asis
+@item @emph{Description}:
+Convert to a @code{KIND=4} integer type, which is the same size as a C
+@code{long} integer.  This is equivalent to the standard @code{INT}
+intrinsic with an optional argument of @code{KIND=4}, and is only
+included for backwards compatibility.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = LONG(A)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A}    @tab Shall be of type @code{INTEGER},
+@code{REAL}, or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is a @code{INTEGER(4)} variable.
+
+@item @emph{See also}:
+@ref{INT}, @ref{INT2}, @ref{INT8}
+@end table
+
+
+
+@node LSHIFT
+@section @code{LSHIFT} --- Left shift bits
+@fnindex LSHIFT
+@cindex bits, shift left
+
+@table @asis
+@item @emph{Description}:
+@code{LSHIFT} returns a value corresponding to @var{I} with all of the
+bits shifted left by @var{SHIFT} places.  If the absolute value of
+@var{SHIFT} is greater than @code{BIT_SIZE(I)}, the value is undefined. 
+Bits shifted out from the left end are lost; zeros are shifted in from
+the opposite end.
+
+This function has been superseded by the @code{ISHFT} intrinsic, which
+is standard in Fortran 95 and later, and the @code{SHIFTL} intrinsic,
+which is standard in Fortran 2008 and later.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = LSHIFT(I, SHIFT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{SHIFT} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the same kind as
+@var{I}.
+
+@item @emph{See also}:
+@ref{ISHFT}, @ref{ISHFTC}, @ref{RSHIFT}, @ref{SHIFTA}, @ref{SHIFTL},
+@ref{SHIFTR}
+
+@end table
+
+
+
+@node LSTAT
+@section @code{LSTAT} --- Get file status
+@fnindex LSTAT
+@cindex file system, file status
+
+@table @asis
+@item @emph{Description}:
+@code{LSTAT} is identical to @ref{STAT}, except that if path is a
+symbolic link, then the link itself is statted, not the file that it
+refers to.
+
+The elements in @code{VALUES} are the same as described by @ref{STAT}.
+
+This intrinsic is provided in both subroutine and function forms;
+however, only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL LSTAT(NAME, VALUES [, STATUS])}
+@item @code{STATUS = LSTAT(NAME, VALUES)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{NAME}   @tab The type shall be @code{CHARACTER} of the default
+kind, a valid path within the file system.
+@item @var{VALUES} @tab The type shall be @code{INTEGER(4), DIMENSION(13)}.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}.
+Returns 0 on success and a system specific error code otherwise.
+@end multitable
+
+@item @emph{Example}:
+See @ref{STAT} for an example.
+
+@item @emph{See also}:
+To stat an open file: @ref{FSTAT}, to stat a file: @ref{STAT}
+@end table
+
+
+
+@node LTIME
+@section @code{LTIME} --- Convert time to local time info
+@fnindex LTIME
+@cindex time, conversion to local time info
+
+@table @asis
+@item @emph{Description}:
+Given a system time value @var{TIME} (as provided by the @code{TIME8}
+intrinsic), fills @var{VALUES} with values extracted from it appropriate
+to the local time zone using @code{localtime(3)}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL LTIME(TIME, VALUES)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{TIME}  @tab An @code{INTEGER} scalar expression
+corresponding to a system time, with @code{INTENT(IN)}.
+@item @var{VALUES} @tab A default @code{INTEGER} array with 9 elements,
+with @code{INTENT(OUT)}.
+@end multitable
+
+@item @emph{Return value}:
+The elements of @var{VALUES} are assigned as follows:
+@enumerate
+@item Seconds after the minute, range 0--59 or 0--61 to allow for leap
+seconds
+@item Minutes after the hour, range 0--59
+@item Hours past midnight, range 0--23
+@item Day of month, range 0--31
+@item Number of months since January, range 0--12
+@item Years since 1900
+@item Number of days since Sunday, range 0--6
+@item Days since January 1
+@item Daylight savings indicator: positive if daylight savings is in
+effect, zero if not, and negative if the information is not available.
+@end enumerate
+
+@item @emph{See also}:
+@ref{CTIME}, @ref{GMTIME}, @ref{TIME}, @ref{TIME8}
+
+@end table
+
+
+
+@node MALLOC
+@section @code{MALLOC} --- Allocate dynamic memory
+@fnindex MALLOC
+@cindex pointer, cray
+
+@table @asis
+@item @emph{Description}:
+@code{MALLOC(SIZE)} allocates @var{SIZE} bytes of dynamic memory and
+returns the address of the allocated memory. The @code{MALLOC} intrinsic
+is an extension intended to be used with Cray pointers, and is provided
+in GNU Fortran to allow the user to compile legacy code. For new code
+using Fortran 95 pointers, the memory allocation intrinsic is
+@code{ALLOCATE}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{PTR = MALLOC(SIZE)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{SIZE} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER(K)}, with @var{K} such that
+variables of type @code{INTEGER(K)} have the same size as
+C pointers (@code{sizeof(void *)}).
+
+@item @emph{Example}:
+The following example demonstrates the use of @code{MALLOC} and
+@code{FREE} with Cray pointers.
+
+@smallexample
+program test_malloc
+  implicit none
+  integer i
+  real*8 x(*), z
+  pointer(ptr_x,x)
+
+  ptr_x = malloc(20*8)
+  do i = 1, 20
+    x(i) = sqrt(1.0d0 / i)
+  end do
+  z = 0
+  do i = 1, 20
+    z = z + x(i)
+    print *, z
+  end do
+  call free(ptr_x)
+end program test_malloc
+@end smallexample
+
+@item @emph{See also}:
+@ref{FREE}
+@end table
+
+
+
+@node MASKL
+@section @code{MASKL} --- Left justified mask
+@fnindex MASKL
+@cindex mask, left justified
+
+@table @asis
+@item @emph{Description}:
+@code{MASKL(I[, KIND])} has its leftmost @var{I} bits set to 1, and the
+remaining bits set to 0.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = MASKL(I[, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@item @var{KIND} @tab Shall be a scalar constant expression of type
+@code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER}. If @var{KIND} is present, it
+specifies the kind value of the return type; otherwise, it is of the
+default integer kind.
+
+@item @emph{See also}:
+@ref{MASKR}
+@end table
+
+
+
+@node MASKR
+@section @code{MASKR} --- Right justified mask
+@fnindex MASKR
+@cindex mask, right justified
+
+@table @asis
+@item @emph{Description}:
+@code{MASKL(I[, KIND])} has its rightmost @var{I} bits set to 1, and the
+remaining bits set to 0.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = MASKR(I[, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@item @var{KIND} @tab Shall be a scalar constant expression of type
+@code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER}. If @var{KIND} is present, it
+specifies the kind value of the return type; otherwise, it is of the
+default integer kind.
+
+@item @emph{See also}:
+@ref{MASKL}
+@end table
+
+
+
+@node MATMUL
+@section @code{MATMUL} --- matrix multiplication
+@fnindex MATMUL
+@cindex matrix multiplication
+@cindex product, matrix
+
+@table @asis
+@item @emph{Description}:
+Performs a matrix multiplication on numeric or logical arguments.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = MATMUL(MATRIX_A, MATRIX_B)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{MATRIX_A} @tab An array of @code{INTEGER},
+@code{REAL}, @code{COMPLEX}, or @code{LOGICAL} type, with a rank of
+one or two.
+@item @var{MATRIX_B} @tab An array of @code{INTEGER},
+@code{REAL}, or @code{COMPLEX} type if @var{MATRIX_A} is of a numeric
+type; otherwise, an array of @code{LOGICAL} type. The rank shall be one
+or two, and the first (or only) dimension of @var{MATRIX_B} shall be
+equal to the last (or only) dimension of @var{MATRIX_A}.
+@end multitable
+
+@item @emph{Return value}:
+The matrix product of @var{MATRIX_A} and @var{MATRIX_B}.  The type and
+kind of the result follow the usual type and kind promotion rules, as
+for the @code{*} or @code{.AND.} operators.
+
+@item @emph{See also}:
+@end table
+
+
+
+@node MAX
+@section @code{MAX} --- Maximum value of an argument list
+@fnindex MAX
+@fnindex MAX0
+@fnindex AMAX0
+@fnindex MAX1
+@fnindex AMAX1
+@fnindex DMAX1
+@cindex maximum value
+
+@table @asis
+@item @emph{Description}:
+Returns the argument with the largest (most positive) value.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = MAX(A1, A2 [, A3 [, ...]])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A1}          @tab The type shall be @code{INTEGER} or
+@code{REAL}.
+@item @var{A2}, @var{A3}, ... @tab An expression of the same type and kind
+as @var{A1}.  (As a GNU extension, arguments of different kinds are
+permitted.)
+@end multitable
+
+@item @emph{Return value}:
+The return value corresponds to the maximum value among the arguments,
+and has the same type and kind as the first argument.
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Argument             @tab Return type         @tab Standard
+@item @code{MAX0(A1)}  @tab @code{INTEGER(4) A1} @tab @code{INTEGER(4)}   @tab Fortran 77 and later
+@item @code{AMAX0(A1)} @tab @code{INTEGER(4) A1} @tab @code{REAL(MAX(X))} @tab Fortran 77 and later
+@item @code{MAX1(A1)}  @tab @code{REAL A1}       @tab @code{INT(MAX(X))}  @tab Fortran 77 and later
+@item @code{AMAX1(A1)} @tab @code{REAL(4) A1}    @tab @code{REAL(4)}      @tab Fortran 77 and later
+@item @code{DMAX1(A1)} @tab @code{REAL(8) A1}    @tab @code{REAL(8)}      @tab Fortran 77 and later
+@end multitable
+
+@item @emph{See also}:
+@ref{MAXLOC} @ref{MAXVAL}, @ref{MIN}
+
+@end table
+
+
+
+@node MAXEXPONENT
+@section @code{MAXEXPONENT} --- Maximum exponent of a real kind
+@fnindex MAXEXPONENT
+@cindex model representation, maximum exponent
+
+@table @asis
+@item @emph{Description}:
+@code{MAXEXPONENT(X)} returns the maximum exponent in the model of the
+type of @code{X}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = MAXEXPONENT(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the default integer
+kind.
+
+@item @emph{Example}:
+@smallexample
+program exponents
+  real(kind=4) :: x
+  real(kind=8) :: y
+
+  print *, minexponent(x), maxexponent(x)
+  print *, minexponent(y), maxexponent(y)
+end program exponents
+@end smallexample
+@end table
+
+
+
+@node MAXLOC
+@section @code{MAXLOC} --- Location of the maximum value within an array
+@fnindex MAXLOC
+@cindex array, location of maximum element
+
+@table @asis
+@item @emph{Description}:
+Determines the location of the element in the array with the maximum
+value, or, if the @var{DIM} argument is supplied, determines the
+locations of the maximum element along each row of the array in the
+@var{DIM} direction.  If @var{MASK} is present, only the elements for
+which @var{MASK} is @code{.TRUE.} are considered.  If more than one
+element in the array has the maximum value, the location returned is
+that of the first such element in array element order.  If the array has
+zero size, or all of the elements of @var{MASK} are @code{.FALSE.}, then
+the result is an array of zeroes.  Similarly, if @var{DIM} is supplied
+and all of the elements of @var{MASK} along a given row are zero, the
+result value for that row is zero.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = MAXLOC(ARRAY, DIM [, MASK])}
+@item @code{RESULT = MAXLOC(ARRAY [, MASK])}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array of type @code{INTEGER} or
+@code{REAL}.
+@item @var{DIM}   @tab (Optional) Shall be a scalar of type
+@code{INTEGER}, with a value between one and the rank of @var{ARRAY},
+inclusive.  It may not be an optional dummy argument.
+@item @var{MASK}  @tab Shall be an array of type @code{LOGICAL},
+and conformable with @var{ARRAY}.
+@end multitable
+
+@item @emph{Return value}:
+If @var{DIM} is absent, the result is a rank-one array with a length
+equal to the rank of @var{ARRAY}.  If @var{DIM} is present, the result
+is an array with a rank one less than the rank of @var{ARRAY}, and a
+size corresponding to the size of @var{ARRAY} with the @var{DIM}
+dimension removed.  If @var{DIM} is present and @var{ARRAY} has a rank
+of one, the result is a scalar.  In all cases, the result is of default
+@code{INTEGER} type.
+
+@item @emph{See also}:
+@ref{MAX}, @ref{MAXVAL}
+
+@end table
+
+
+
+@node MAXVAL
+@section @code{MAXVAL} --- Maximum value of an array
+@fnindex MAXVAL
+@cindex array, maximum value
+@cindex maximum value
+
+@table @asis
+@item @emph{Description}:
+Determines the maximum value of the elements in an array value, or, if
+the @var{DIM} argument is supplied, determines the maximum value along
+each row of the array in the @var{DIM} direction.  If @var{MASK} is
+present, only the elements for which @var{MASK} is @code{.TRUE.} are
+considered.  If the array has zero size, or all of the elements of
+@var{MASK} are @code{.FALSE.}, then the result is @code{-HUGE(ARRAY)}
+if @var{ARRAY} is numeric, or a string of nulls if @var{ARRAY} is of character
+type.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = MAXVAL(ARRAY, DIM [, MASK])}
+@item @code{RESULT = MAXVAL(ARRAY [, MASK])}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array of type @code{INTEGER} or
+@code{REAL}.
+@item @var{DIM}   @tab (Optional) Shall be a scalar of type
+@code{INTEGER}, with a value between one and the rank of @var{ARRAY},
+inclusive.  It may not be an optional dummy argument.
+@item @var{MASK}  @tab Shall be an array of type @code{LOGICAL},
+and conformable with @var{ARRAY}.
+@end multitable
+
+@item @emph{Return value}:
+If @var{DIM} is absent, or if @var{ARRAY} has a rank of one, the result
+is a scalar.  If @var{DIM} is present, the result is an array with a
+rank one less than the rank of @var{ARRAY}, and a size corresponding to
+the size of @var{ARRAY} with the @var{DIM} dimension removed.  In all
+cases, the result is of the same type and kind as @var{ARRAY}.
+
+@item @emph{See also}:
+@ref{MAX}, @ref{MAXLOC}
+@end table
+
+
+
+@node MCLOCK
+@section @code{MCLOCK} --- Time function
+@fnindex MCLOCK
+@cindex time, clock ticks
+@cindex clock ticks
+
+@table @asis
+@item @emph{Description}:
+Returns the number of clock ticks since the start of the process, based
+on the UNIX function @code{clock(3)}.
+
+This intrinsic is not fully portable, such as to systems with 32-bit
+@code{INTEGER} types but supporting times wider than 32 bits. Therefore,
+the values returned by this intrinsic might be, or become, negative, or
+numerically less than previous values, during a single run of the
+compiled program.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = MCLOCK()}
+
+@item @emph{Return value}:
+The return value is a scalar of type @code{INTEGER(4)}, equal to the
+number of clock ticks since the start of the process, or @code{-1} if
+the system does not support @code{clock(3)}.
+
+@item @emph{See also}:
+@ref{CTIME}, @ref{GMTIME}, @ref{LTIME}, @ref{MCLOCK}, @ref{TIME}
+
+@end table
+
+
+
+@node MCLOCK8
+@section @code{MCLOCK8} --- Time function (64-bit)
+@fnindex MCLOCK8
+@cindex time, clock ticks
+@cindex clock ticks
+
+@table @asis
+@item @emph{Description}:
+Returns the number of clock ticks since the start of the process, based
+on the UNIX function @code{clock(3)}.
+
+@emph{Warning:} this intrinsic does not increase the range of the timing
+values over that returned by @code{clock(3)}. On a system with a 32-bit
+@code{clock(3)}, @code{MCLOCK8} will return a 32-bit value, even though
+it is converted to a 64-bit @code{INTEGER(8)} value. That means
+overflows of the 32-bit value can still occur. Therefore, the values
+returned by this intrinsic might be or become negative or numerically
+less than previous values during a single run of the compiled program.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = MCLOCK8()}
+
+@item @emph{Return value}:
+The return value is a scalar of type @code{INTEGER(8)}, equal to the
+number of clock ticks since the start of the process, or @code{-1} if
+the system does not support @code{clock(3)}.
+
+@item @emph{See also}:
+@ref{CTIME}, @ref{GMTIME}, @ref{LTIME}, @ref{MCLOCK}, @ref{TIME8}
+
+@end table
+
+
+
+@node MERGE
+@section @code{MERGE} --- Merge variables
+@fnindex MERGE
+@cindex array, merge arrays
+@cindex array, combine arrays
+
+@table @asis
+@item @emph{Description}:
+Select values from two arrays according to a logical mask.  The result
+is equal to @var{TSOURCE} if @var{MASK} is @code{.TRUE.}, or equal to
+@var{FSOURCE} if it is @code{.FALSE.}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = MERGE(TSOURCE, FSOURCE, MASK)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{TSOURCE} @tab May be of any type.
+@item @var{FSOURCE} @tab Shall be of the same type and type parameters
+as @var{TSOURCE}.
+@item @var{MASK}    @tab Shall be of type @code{LOGICAL}.
+@end multitable
+
+@item @emph{Return value}:
+The result is of the same type and type parameters as @var{TSOURCE}.
+
+@end table
+
+
+
+@node MERGE_BITS
+@section @code{MERGE_BITS} --- Merge of bits under mask
+@fnindex MERGE_BITS
+@cindex bits, merge
+
+@table @asis
+@item @emph{Description}:
+@code{MERGE_BITS(I, J, MASK)} merges the bits of @var{I} and @var{J}
+as determined by the mask.  The i-th bit of the result is equal to the 
+i-th bit of @var{I} if the i-th bit of @var{MASK} is 1; it is equal to
+the i-th bit of @var{J} otherwise.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = MERGE_BITS(I, J, MASK)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I}    @tab Shall be of type @code{INTEGER}.
+@item @var{J}    @tab Shall be of type @code{INTEGER} and of the same
+kind as @var{I}.
+@item @var{MASK} @tab Shall be of type @code{INTEGER} and of the same
+kind as @var{I}.
+@end multitable
+
+@item @emph{Return value}:
+The result is of the same type and kind as @var{I}.
+
+@end table
+
+
+
+@node MIN
+@section @code{MIN} --- Minimum value of an argument list
+@fnindex MIN
+@fnindex MIN0
+@fnindex AMIN0
+@fnindex MIN1
+@fnindex AMIN1
+@fnindex DMIN1
+@cindex minimum value
+
+@table @asis
+@item @emph{Description}:
+Returns the argument with the smallest (most negative) value.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = MIN(A1, A2 [, A3, ...])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A1}          @tab The type shall be @code{INTEGER} or
+@code{REAL}.
+@item @var{A2}, @var{A3}, ... @tab An expression of the same type and kind
+as @var{A1}.  (As a GNU extension, arguments of different kinds are
+permitted.)
+@end multitable
+
+@item @emph{Return value}:
+The return value corresponds to the maximum value among the arguments,
+and has the same type and kind as the first argument.
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name              @tab Argument             @tab Return type        @tab Standard
+@item @code{MIN0(A1)}   @tab @code{INTEGER(4) A1} @tab @code{INTEGER(4)}  @tab Fortran 77 and later
+@item @code{AMIN0(A1)}  @tab @code{INTEGER(4) A1} @tab @code{REAL(4)}     @tab Fortran 77 and later
+@item @code{MIN1(A1)}   @tab @code{REAL A1}       @tab @code{INTEGER(4)}  @tab Fortran 77 and later
+@item @code{AMIN1(A1)}  @tab @code{REAL(4) A1}    @tab @code{REAL(4)}     @tab Fortran 77 and later
+@item @code{DMIN1(A1)}  @tab @code{REAL(8) A1}    @tab @code{REAL(8)}     @tab Fortran 77 and later
+@end multitable
+
+@item @emph{See also}:
+@ref{MAX}, @ref{MINLOC}, @ref{MINVAL}
+@end table
+
+
+
+@node MINEXPONENT
+@section @code{MINEXPONENT} --- Minimum exponent of a real kind
+@fnindex MINEXPONENT
+@cindex model representation, minimum exponent
+
+@table @asis
+@item @emph{Description}:
+@code{MINEXPONENT(X)} returns the minimum exponent in the model of the
+type of @code{X}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = MINEXPONENT(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the default integer
+kind.
+
+@item @emph{Example}:
+See @code{MAXEXPONENT} for an example.
+@end table
+
+
+
+@node MINLOC
+@section @code{MINLOC} --- Location of the minimum value within an array
+@fnindex MINLOC
+@cindex array, location of minimum element
+
+@table @asis
+@item @emph{Description}:
+Determines the location of the element in the array with the minimum
+value, or, if the @var{DIM} argument is supplied, determines the
+locations of the minimum element along each row of the array in the
+@var{DIM} direction.  If @var{MASK} is present, only the elements for
+which @var{MASK} is @code{.TRUE.} are considered.  If more than one
+element in the array has the minimum value, the location returned is
+that of the first such element in array element order.  If the array has
+zero size, or all of the elements of @var{MASK} are @code{.FALSE.}, then
+the result is an array of zeroes.  Similarly, if @var{DIM} is supplied
+and all of the elements of @var{MASK} along a given row are zero, the
+result value for that row is zero.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = MINLOC(ARRAY, DIM [, MASK])}
+@item @code{RESULT = MINLOC(ARRAY [, MASK])}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array of type @code{INTEGER} or
+@code{REAL}.
+@item @var{DIM}   @tab (Optional) Shall be a scalar of type
+@code{INTEGER}, with a value between one and the rank of @var{ARRAY},
+inclusive.  It may not be an optional dummy argument.
+@item @var{MASK}  @tab Shall be an array of type @code{LOGICAL},
+and conformable with @var{ARRAY}.
+@end multitable
+
+@item @emph{Return value}:
+If @var{DIM} is absent, the result is a rank-one array with a length
+equal to the rank of @var{ARRAY}.  If @var{DIM} is present, the result
+is an array with a rank one less than the rank of @var{ARRAY}, and a
+size corresponding to the size of @var{ARRAY} with the @var{DIM}
+dimension removed.  If @var{DIM} is present and @var{ARRAY} has a rank
+of one, the result is a scalar.  In all cases, the result is of default
+@code{INTEGER} type.
+
+@item @emph{See also}:
+@ref{MIN}, @ref{MINVAL}
+
+@end table
+
+
+
+@node MINVAL
+@section @code{MINVAL} --- Minimum value of an array
+@fnindex MINVAL
+@cindex array, minimum value
+@cindex minimum value
+
+@table @asis
+@item @emph{Description}:
+Determines the minimum value of the elements in an array value, or, if
+the @var{DIM} argument is supplied, determines the minimum value along
+each row of the array in the @var{DIM} direction.  If @var{MASK} is
+present, only the elements for which @var{MASK} is @code{.TRUE.} are
+considered.  If the array has zero size, or all of the elements of
+@var{MASK} are @code{.FALSE.}, then the result is @code{HUGE(ARRAY)} if
+@var{ARRAY} is numeric, or a string of @code{CHAR(255)} characters if
+@var{ARRAY} is of character type.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = MINVAL(ARRAY, DIM [, MASK])}
+@item @code{RESULT = MINVAL(ARRAY [, MASK])}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array of type @code{INTEGER} or
+@code{REAL}.
+@item @var{DIM}   @tab (Optional) Shall be a scalar of type
+@code{INTEGER}, with a value between one and the rank of @var{ARRAY},
+inclusive.  It may not be an optional dummy argument.
+@item @var{MASK}  @tab Shall be an array of type @code{LOGICAL},
+and conformable with @var{ARRAY}.
+@end multitable
+
+@item @emph{Return value}:
+If @var{DIM} is absent, or if @var{ARRAY} has a rank of one, the result
+is a scalar.  If @var{DIM} is present, the result is an array with a
+rank one less than the rank of @var{ARRAY}, and a size corresponding to
+the size of @var{ARRAY} with the @var{DIM} dimension removed.  In all
+cases, the result is of the same type and kind as @var{ARRAY}.
+
+@item @emph{See also}:
+@ref{MIN}, @ref{MINLOC}
+
+@end table
+
+
+
+@node MOD
+@section @code{MOD} --- Remainder function
+@fnindex MOD
+@fnindex AMOD
+@fnindex DMOD
+@cindex remainder
+@cindex division, remainder
+
+@table @asis
+@item @emph{Description}:
+@code{MOD(A,P)} computes the remainder of the division of A by P@. It is
+calculated as @code{A - (INT(A/P) * P)}.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = MOD(A, P)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab Shall be a scalar of type @code{INTEGER} or @code{REAL}
+@item @var{P} @tab Shall be a scalar of the same type as @var{A} and not
+equal to zero
+@end multitable
+
+@item @emph{Return value}:
+The kind of the return value is the result of cross-promoting
+the kinds of the arguments.
+
+@item @emph{Example}:
+@smallexample
+program test_mod
+  print *, mod(17,3)
+  print *, mod(17.5,5.5)
+  print *, mod(17.5d0,5.5)
+  print *, mod(17.5,5.5d0)
+
+  print *, mod(-17,3)
+  print *, mod(-17.5,5.5)
+  print *, mod(-17.5d0,5.5)
+  print *, mod(-17.5,5.5d0)
+
+  print *, mod(17,-3)
+  print *, mod(17.5,-5.5)
+  print *, mod(17.5d0,-5.5)
+  print *, mod(17.5,-5.5d0)
+end program test_mod
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Arguments          @tab Return type    @tab Standard
+@item @code{MOD(A,P)}  @tab @code{INTEGER A,P} @tab @code{INTEGER} @tab Fortran 95 and later
+@item @code{AMOD(A,P)} @tab @code{REAL(4) A,P} @tab @code{REAL(4)} @tab Fortran 95 and later
+@item @code{DMOD(A,P)} @tab @code{REAL(8) A,P} @tab @code{REAL(8)} @tab Fortran 95 and later
+@end multitable
+@end table
+
+
+
+@node MODULO
+@section @code{MODULO} --- Modulo function
+@fnindex MODULO
+@cindex modulo
+@cindex division, modulo
+
+@table @asis
+@item @emph{Description}:
+@code{MODULO(A,P)} computes the @var{A} modulo @var{P}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = MODULO(A, P)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab Shall be a scalar of type @code{INTEGER} or @code{REAL}
+@item @var{P} @tab Shall be a scalar of the same type and kind as @var{A}
+@end multitable
+
+@item @emph{Return value}:
+The type and kind of the result are those of the arguments.
+@table @asis
+@item If @var{A} and @var{P} are of type @code{INTEGER}:
+@code{MODULO(A,P)} has the value @var{R} such that @code{A=Q*P+R}, where
+@var{Q} is an integer and @var{R} is between 0 (inclusive) and @var{P}
+(exclusive).
+@item If @var{A} and @var{P} are of type @code{REAL}:
+@code{MODULO(A,P)} has the value of @code{A - FLOOR (A / P) * P}.
+@end table
+In all cases, if @var{P} is zero the result is processor-dependent.
+
+@item @emph{Example}:
+@smallexample
+program test_modulo
+  print *, modulo(17,3)
+  print *, modulo(17.5,5.5)
+
+  print *, modulo(-17,3)
+  print *, modulo(-17.5,5.5)
+
+  print *, modulo(17,-3)
+  print *, modulo(17.5,-5.5)
+end program
+@end smallexample
+
+@end table
+
+
+
+@node MOVE_ALLOC
+@section @code{MOVE_ALLOC} --- Move allocation from one object to another
+@fnindex MOVE_ALLOC
+@cindex moving allocation
+@cindex allocation, moving
+
+@table @asis
+@item @emph{Description}:
+@code{MOVE_ALLOC(FROM, TO)} moves the allocation from @var{FROM} to
+@var{TO}.  @var{FROM} will become deallocated in the process.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Pure subroutine
+
+@item @emph{Syntax}:
+@code{CALL MOVE_ALLOC(FROM, TO)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{FROM}  @tab @code{ALLOCATABLE}, @code{INTENT(INOUT)}, may be
+of any type and kind.
+@item @var{TO} @tab @code{ALLOCATABLE}, @code{INTENT(OUT)}, shall be
+of the same type, kind and rank as @var{FROM}.
+@end multitable
+
+@item @emph{Return value}:
+None
+
+@item @emph{Example}:
+@smallexample
+program test_move_alloc
+    integer, allocatable :: a(:), b(:)
+
+    allocate(a(3))
+    a = [ 1, 2, 3 ]
+    call move_alloc(a, b)
+    print *, allocated(a), allocated(b)
+    print *, b
+end program test_move_alloc
+@end smallexample
+@end table
+
+
+
+@node MVBITS
+@section @code{MVBITS} --- Move bits from one integer to another
+@fnindex MVBITS
+@cindex bits, move
+
+@table @asis
+@item @emph{Description}:
+Moves @var{LEN} bits from positions @var{FROMPOS} through
+@code{FROMPOS+LEN-1} of @var{FROM} to positions @var{TOPOS} through
+@code{TOPOS+LEN-1} of @var{TO}. The portion of argument @var{TO} not
+affected by the movement of bits is unchanged. The values of
+@code{FROMPOS+LEN-1} and @code{TOPOS+LEN-1} must be less than
+@code{BIT_SIZE(FROM)}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental subroutine
+
+@item @emph{Syntax}:
+@code{CALL MVBITS(FROM, FROMPOS, LEN, TO, TOPOS)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{FROM}    @tab The type shall be @code{INTEGER}.
+@item @var{FROMPOS} @tab The type shall be @code{INTEGER}.
+@item @var{LEN}     @tab The type shall be @code{INTEGER}.
+@item @var{TO}      @tab The type shall be @code{INTEGER}, of the
+same kind as @var{FROM}.
+@item @var{TOPOS}   @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{See also}:
+@ref{IBCLR}, @ref{IBSET}, @ref{IBITS}, @ref{IAND}, @ref{IOR}, @ref{IEOR}
+@end table
+
+
+
+@node NEAREST
+@section @code{NEAREST} --- Nearest representable number
+@fnindex NEAREST
+@cindex real number, nearest different
+@cindex floating point, nearest different
+
+@table @asis
+@item @emph{Description}:
+@code{NEAREST(X, S)} returns the processor-representable number nearest
+to @code{X} in the direction indicated by the sign of @code{S}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = NEAREST(X, S)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{REAL}.
+@item @var{S} @tab (Optional) shall be of type @code{REAL} and
+not equal to zero.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type as @code{X}. If @code{S} is
+positive, @code{NEAREST} returns the processor-representable number
+greater than @code{X} and nearest to it. If @code{S} is negative,
+@code{NEAREST} returns the processor-representable number smaller than
+@code{X} and nearest to it.
+
+@item @emph{Example}:
+@smallexample
+program test_nearest
+  real :: x, y
+  x = nearest(42.0, 1.0)
+  y = nearest(42.0, -1.0)
+  write (*,"(3(G20.15))") x, y, x - y
+end program test_nearest
+@end smallexample
+@end table
+
+
+
+@node NEW_LINE
+@section @code{NEW_LINE} --- New line character
+@fnindex NEW_LINE
+@cindex newline
+@cindex output, newline
+
+@table @asis
+@item @emph{Description}:
+@code{NEW_LINE(C)} returns the new-line character.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = NEW_LINE(C)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{C}    @tab The argument shall be a scalar or array of the
+type @code{CHARACTER}.
+@end multitable
+
+@item @emph{Return value}:
+Returns a @var{CHARACTER} scalar of length one with the new-line character of
+the same kind as parameter @var{C}.
+
+@item @emph{Example}:
+@smallexample
+program newline
+  implicit none
+  write(*,'(A)') 'This is record 1.'//NEW_LINE('A')//'This is record 2.'
+end program newline
+@end smallexample
+@end table
+
+
+
+@node NINT
+@section @code{NINT} --- Nearest whole number
+@fnindex NINT
+@fnindex IDNINT
+@cindex rounding, nearest whole number
+
+@table @asis
+@item @emph{Description}:
+@code{NINT(A)} rounds its argument to the nearest whole number.
+
+@item @emph{Standard}:
+Fortran 77 and later, with @var{KIND} argument Fortran 90 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = NINT(A [, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A}    @tab The type of the argument shall be @code{REAL}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+Returns @var{A} with the fractional portion of its magnitude eliminated by
+rounding to the nearest whole number and with its sign preserved,
+converted to an @code{INTEGER} of the default kind.
+
+@item @emph{Example}:
+@smallexample
+program test_nint
+  real(4) x4
+  real(8) x8
+  x4 = 1.234E0_4
+  x8 = 4.321_8
+  print *, nint(x4), idnint(x8)
+end program test_nint
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Argument           @tab Return Type     @tab Standard
+@item @code{NINT(A)}   @tab @code{REAL(4) A}   @tab  @code{INTEGER} @tab Fortran 95 and later
+@item @code{IDNINT(A)} @tab @code{REAL(8) A}   @tab  @code{INTEGER} @tab Fortran 95 and later
+@end multitable
+
+@item @emph{See also}:
+@ref{CEILING}, @ref{FLOOR}
+
+@end table
+
+
+
+@node NORM2
+@section @code{NORM2} --- Euclidean vector norms
+@fnindex NORM2
+@cindex Euclidean vector norm
+@cindex L2 vector norm
+@cindex norm, Euclidean
+
+@table @asis
+@item @emph{Description}:
+Calculates the Euclidean vector norm (@math{L_2} norm) of
+of @var{ARRAY} along dimension @var{DIM}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = NORM2(ARRAY[, DIM])}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array of type @code{REAL}
+@item @var{DIM}   @tab (Optional) shall be a scalar of type 
+@code{INTEGER} with a value in the range from 1 to n, where n 
+equals the rank of @var{ARRAY}.
+@end multitable
+
+@item @emph{Return value}:
+The result is of the same type as @var{ARRAY}.
+
+If @var{DIM} is absent, a scalar with the square root of the sum of all
+elements in @var{ARRAY} squared  is returned. Otherwise, an array of
+rank @math{n-1}, where @math{n} equals the rank of @var{ARRAY}, and a
+shape similar to that of @var{ARRAY} with dimension @var{DIM} dropped
+is returned.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_sum
+  REAL :: x(5) = [ real :: 1, 2, 3, 4, 5 ]
+  print *, NORM2(x)  ! = sqrt(55.) ~ 7.416
+END PROGRAM
+@end smallexample
+@end table
+
+
+
+@node NOT
+@section @code{NOT} --- Logical negation
+@fnindex NOT
+@cindex bits, negate
+@cindex bitwise logical not
+@cindex logical not, bitwise
+
+@table @asis
+@item @emph{Description}:
+@code{NOT} returns the bitwise Boolean inverse of @var{I}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = NOT(I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return type is @code{INTEGER}, of the same kind as the
+argument.
+
+@item @emph{See also}:
+@ref{IAND}, @ref{IEOR}, @ref{IOR}, @ref{IBITS}, @ref{IBSET}, @ref{IBCLR}
+
+@end table
+
+
+
+@node NULL
+@section @code{NULL} --- Function that returns an disassociated pointer
+@fnindex NULL
+@cindex pointer, status
+@cindex pointer, disassociated
+
+@table @asis
+@item @emph{Description}:
+Returns a disassociated pointer.
+
+If @var{MOLD} is present, a disassociated pointer of the same type is
+returned, otherwise the type is determined by context.
+
+In Fortran 95, @var{MOLD} is optional. Please note that Fortran 2003
+includes cases where it is required.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{PTR => NULL([MOLD])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{MOLD} @tab (Optional) shall be a pointer of any association
+status and of any type.
+@end multitable
+
+@item @emph{Return value}:
+A disassociated pointer.
+
+@item @emph{Example}:
+@smallexample
+REAL, POINTER, DIMENSION(:) :: VEC => NULL ()
+@end smallexample
+
+@item @emph{See also}:
+@ref{ASSOCIATED}
+@end table
+
+
+
+@node NUM_IMAGES
+@section @code{NUM_IMAGES} --- Function that returns the number of images
+@fnindex NUM_IMAGES
+@cindex coarray, @code{NUM_IMAGES}
+@cindex images, number of
+
+@table @asis
+@item @emph{Description}:
+Returns the number of images.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = NUM_IMAGES()}
+
+@item @emph{Arguments}: None.
+
+@item @emph{Return value}:
+Scalar default-kind integer.
+
+@item @emph{Example}:
+@smallexample
+INTEGER :: value[*]
+INTEGER :: i
+value = THIS_IMAGE()
+SYNC ALL
+IF (THIS_IMAGE() == 1) THEN
+  DO i = 1, NUM_IMAGES()
+    WRITE(*,'(2(a,i0))') 'value[', i, '] is ', value[i]
+  END DO
+END IF
+@end smallexample
+
+@item @emph{See also}:
+@ref{THIS_IMAGE}, @ref{IMAGE_INDEX}
+@end table
+
+
+
+@node OR
+@section @code{OR} --- Bitwise logical OR
+@fnindex OR
+@cindex bitwise logical or
+@cindex logical or, bitwise
+
+@table @asis
+@item @emph{Description}:
+Bitwise logical @code{OR}.
+
+This intrinsic routine is provided for backwards compatibility with 
+GNU Fortran 77.  For integer arguments, programmers should consider
+the use of the @ref{IOR} intrinsic defined by the Fortran standard.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = OR(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be either a scalar @code{INTEGER}
+type or a scalar @code{LOGICAL} type.
+@item @var{J} @tab The type shall be the same as the type of @var{J}.
+@end multitable
+
+@item @emph{Return value}:
+The return type is either a scalar @code{INTEGER} or a scalar
+@code{LOGICAL}.  If the kind type parameters differ, then the
+smaller kind type is implicitly converted to larger kind, and the 
+return has the larger kind.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_or
+  LOGICAL :: T = .TRUE., F = .FALSE.
+  INTEGER :: a, b
+  DATA a / Z'F' /, b / Z'3' /
+
+  WRITE (*,*) OR(T, T), OR(T, F), OR(F, T), OR(F, F)
+  WRITE (*,*) OR(a, b)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+Fortran 95 elemental function: @ref{IOR}
+@end table
+
+
+
+@node PACK
+@section @code{PACK} --- Pack an array into an array of rank one
+@fnindex PACK
+@cindex array, packing
+@cindex array, reduce dimension
+@cindex array, gather elements
+
+@table @asis
+@item @emph{Description}:
+Stores the elements of @var{ARRAY} in an array of rank one.
+
+The beginning of the resulting array is made up of elements whose @var{MASK} 
+equals @code{TRUE}. Afterwards, positions are filled with elements taken from
+@var{VECTOR}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = PACK(ARRAY, MASK[,VECTOR]}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY}  @tab Shall be an array of any type.
+@item @var{MASK}   @tab Shall be an array of type @code{LOGICAL} and 
+of the same size as @var{ARRAY}. Alternatively, it may be a @code{LOGICAL} 
+scalar.
+@item @var{VECTOR} @tab (Optional) shall be an array of the same type 
+as @var{ARRAY} and of rank one. If present, the number of elements in 
+@var{VECTOR} shall be equal to or greater than the number of true elements 
+in @var{MASK}. If @var{MASK} is scalar, the number of elements in 
+@var{VECTOR} shall be equal to or greater than the number of elements in
+@var{ARRAY}.
+@end multitable
+
+@item @emph{Return value}:
+The result is an array of rank one and the same type as that of @var{ARRAY}.
+If @var{VECTOR} is present, the result size is that of @var{VECTOR}, the
+number of @code{TRUE} values in @var{MASK} otherwise.
+
+@item @emph{Example}:
+Gathering nonzero elements from an array:
+@smallexample
+PROGRAM test_pack_1
+  INTEGER :: m(6)
+  m = (/ 1, 0, 0, 0, 5, 0 /)
+  WRITE(*, FMT="(6(I0, ' '))") pack(m, m /= 0)  ! "1 5"
+END PROGRAM
+@end smallexample
+
+Gathering nonzero elements from an array and appending elements from @var{VECTOR}:
+@smallexample
+PROGRAM test_pack_2
+  INTEGER :: m(4)
+  m = (/ 1, 0, 0, 2 /)
+  WRITE(*, FMT="(4(I0, ' '))") pack(m, m /= 0, (/ 0, 0, 3, 4 /))  ! "1 2 3 4"
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{UNPACK}
+@end table
+
+
+
+@node PARITY
+@section @code{PARITY} --- Reduction with exclusive OR
+@fnindex PARITY
+@cindex Parity
+@cindex Reduction, XOR
+@cindex XOR reduction
+
+@table @asis
+@item @emph{Description}:
+Calculates the parity, i.e. the reduction using @code{.XOR.},
+of @var{MASK} along dimension @var{DIM}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = PARITY(MASK[, DIM])}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{LOGICAL} @tab Shall be an array of type @code{LOGICAL}
+@item @var{DIM}   @tab (Optional) shall be a scalar of type 
+@code{INTEGER} with a value in the range from 1 to n, where n 
+equals the rank of @var{MASK}.
+@end multitable
+
+@item @emph{Return value}:
+The result is of the same type as @var{MASK}.
+
+If @var{DIM} is absent, a scalar with the parity of all elements in
+@var{MASK} is returned, i.e. true if an odd number of elements is
+@code{.true.} and false otherwise.  If @var{DIM} is present, an array
+of rank @math{n-1}, where @math{n} equals the rank of @var{ARRAY},
+and a shape similar to that of @var{MASK} with dimension @var{DIM}
+dropped is returned.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_sum
+  LOGICAL :: x(2) = [ .true., .false. ]
+  print *, PARITY(x) ! prints "T" (true).
+END PROGRAM
+@end smallexample
+@end table
+
+
+
+@node PERROR
+@section @code{PERROR} --- Print system error message
+@fnindex PERROR
+@cindex system, error handling
+
+@table @asis
+@item @emph{Description}:
+Prints (on the C @code{stderr} stream) a newline-terminated error
+message corresponding to the last system error. This is prefixed by
+@var{STRING}, a colon and a space. See @code{perror(3)}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL PERROR(STRING)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING} @tab A scalar of type @code{CHARACTER} and of the
+default kind.
+@end multitable
+
+@item @emph{See also}:
+@ref{IERRNO}
+@end table
+
+
+
+@node PRECISION
+@section @code{PRECISION} --- Decimal precision of a real kind
+@fnindex PRECISION
+@cindex model representation, precision
+
+@table @asis
+@item @emph{Description}:
+@code{PRECISION(X)} returns the decimal precision in the model of the
+type of @code{X}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = PRECISION(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{REAL} or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the default integer
+kind.
+
+@item @emph{See also}:
+@ref{SELECTED_REAL_KIND}, @ref{RANGE}
+
+@item @emph{Example}:
+@smallexample
+program prec_and_range
+  real(kind=4) :: x(2)
+  complex(kind=8) :: y
+
+  print *, precision(x), range(x)
+  print *, precision(y), range(y)
+end program prec_and_range
+@end smallexample
+@end table
+
+
+
+@node POPCNT
+@section @code{POPCNT} --- Number of bits set
+@fnindex POPCNT
+@cindex binary representation
+@cindex bits set
+
+@table @asis
+@item @emph{Description}:
+@code{POPCNT(I)} returns the number of bits set ('1' bits) in the binary
+representation of @code{I}.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = POPCNT(I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the default integer
+kind.
+
+@item @emph{See also}:
+@ref{POPPAR}, @ref{LEADZ}, @ref{TRAILZ}
+
+@item @emph{Example}:
+@smallexample
+program test_population
+  print *, popcnt(127),       poppar(127)
+  print *, popcnt(huge(0_4)), poppar(huge(0_4))
+  print *, popcnt(huge(0_8)), poppar(huge(0_8))
+end program test_population
+@end smallexample
+@end table
+
+
+@node POPPAR
+@section @code{POPPAR} --- Parity of the number of bits set
+@fnindex POPPAR
+@cindex binary representation
+@cindex parity
+
+@table @asis
+@item @emph{Description}:
+@code{POPPAR(I)} returns parity of the integer @code{I}, i.e. the parity
+of the number of bits set ('1' bits) in the binary representation of
+@code{I}. It is equal to 0 if @code{I} has an even number of bits set,
+and 1 for an odd number of '1' bits.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = POPPAR(I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the default integer
+kind.
+
+@item @emph{See also}:
+@ref{POPCNT}, @ref{LEADZ}, @ref{TRAILZ}
+
+@item @emph{Example}:
+@smallexample
+program test_population
+  print *, popcnt(127),       poppar(127)
+  print *, popcnt(huge(0_4)), poppar(huge(0_4))
+  print *, popcnt(huge(0_8)), poppar(huge(0_8))
+end program test_population
+@end smallexample
+@end table
+
+
+
+@node PRESENT
+@section @code{PRESENT} --- Determine whether an optional dummy argument is specified
+@fnindex PRESENT
+
+@table @asis
+@item @emph{Description}:
+Determines whether an optional dummy argument is present.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = PRESENT(A)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab May be of any type and may be a pointer, scalar or array
+value, or a dummy procedure. It shall be the name of an optional dummy argument
+accessible within the current subroutine or function.
+@end multitable
+
+@item @emph{Return value}:
+Returns either @code{TRUE} if the optional argument @var{A} is present, or
+@code{FALSE} otherwise.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_present
+  WRITE(*,*) f(), f(42)      ! "F T"
+CONTAINS
+  LOGICAL FUNCTION f(x)
+    INTEGER, INTENT(IN), OPTIONAL :: x
+    f = PRESENT(x)
+  END FUNCTION
+END PROGRAM
+@end smallexample
+@end table
+
+
+
+@node PRODUCT
+@section @code{PRODUCT} --- Product of array elements
+@fnindex PRODUCT
+@cindex array, product
+@cindex array, multiply elements
+@cindex array, conditionally multiply elements
+@cindex multiply array elements
+
+@table @asis
+@item @emph{Description}:
+Multiplies the elements of @var{ARRAY} along dimension @var{DIM} if
+the corresponding element in @var{MASK} is @code{TRUE}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = PRODUCT(ARRAY[, MASK])}
+@item @code{RESULT = PRODUCT(ARRAY, DIM[, MASK])}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}, 
+@code{REAL} or @code{COMPLEX}.
+@item @var{DIM}   @tab (Optional) shall be a scalar of type 
+@code{INTEGER} with a value in the range from 1 to n, where n 
+equals the rank of @var{ARRAY}.
+@item @var{MASK}  @tab (Optional) shall be of type @code{LOGICAL} 
+and either be a scalar or an array of the same shape as @var{ARRAY}.
+@end multitable
+
+@item @emph{Return value}:
+The result is of the same type as @var{ARRAY}.
+
+If @var{DIM} is absent, a scalar with the product of all elements in 
+@var{ARRAY} is returned. Otherwise, an array of rank n-1, where n equals 
+the rank of @var{ARRAY}, and a shape similar to that of @var{ARRAY} with 
+dimension @var{DIM} dropped is returned.
+
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_product
+  INTEGER :: x(5) = (/ 1, 2, 3, 4 ,5 /)
+  print *, PRODUCT(x)                    ! all elements, product = 120
+  print *, PRODUCT(x, MASK=MOD(x, 2)==1) ! odd elements, product = 15
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{SUM}
+@end table
+
+
+
+@node RADIX
+@section @code{RADIX} --- Base of a model number
+@fnindex RADIX
+@cindex model representation, base
+@cindex model representation, radix
+
+@table @asis
+@item @emph{Description}:
+@code{RADIX(X)} returns the base of the model representing the entity @var{X}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = RADIX(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{INTEGER} or @code{REAL}
+@end multitable
+
+@item @emph{Return value}:
+The return value is a scalar of type @code{INTEGER} and of the default
+integer kind.
+
+@item @emph{See also}:
+@ref{SELECTED_REAL_KIND}
+
+@item @emph{Example}:
+@smallexample
+program test_radix
+  print *, "The radix for the default integer kind is", radix(0)
+  print *, "The radix for the default real kind is", radix(0.0)
+end program test_radix
+@end smallexample
+
+@end table
+
+
+
+@node RAN
+@section @code{RAN} --- Real pseudo-random number
+@fnindex RAN
+@cindex random number generation
+
+@table @asis
+@item @emph{Description}:
+For compatibility with HP FORTRAN 77/iX, the @code{RAN} intrinsic is
+provided as an alias for @code{RAND}.  See @ref{RAND} for complete
+documentation.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{See also}:
+@ref{RAND}, @ref{RANDOM_NUMBER}
+@end table
+
+
+
+@node RAND
+@section @code{RAND} --- Real pseudo-random number
+@fnindex RAND
+@cindex random number generation
+
+@table @asis
+@item @emph{Description}:
+@code{RAND(FLAG)} returns a pseudo-random number from a uniform
+distribution between 0 and 1. If @var{FLAG} is 0, the next number
+in the current sequence is returned; if @var{FLAG} is 1, the generator
+is restarted by @code{CALL SRAND(0)}; if @var{FLAG} has any other value,
+it is used as a new seed with @code{SRAND}.
+
+This intrinsic routine is provided for backwards compatibility with
+GNU Fortran 77. It implements a simple modulo generator as provided 
+by @command{g77}. For new code, one should consider the use of 
+@ref{RANDOM_NUMBER} as it implements a superior algorithm.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = RAND(I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be a scalar @code{INTEGER} of kind 4.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of @code{REAL} type and the default kind.
+
+@item @emph{Example}:
+@smallexample
+program test_rand
+  integer,parameter :: seed = 86456
+  
+  call srand(seed)
+  print *, rand(), rand(), rand(), rand()
+  print *, rand(seed), rand(), rand(), rand()
+end program test_rand
+@end smallexample
+
+@item @emph{See also}:
+@ref{SRAND}, @ref{RANDOM_NUMBER}
+
+@end table
+
+
+
+@node RANDOM_NUMBER
+@section @code{RANDOM_NUMBER} --- Pseudo-random number
+@fnindex RANDOM_NUMBER
+@cindex random number generation
+
+@table @asis
+@item @emph{Description}:
+Returns a single pseudorandom number or an array of pseudorandom numbers
+from the uniform distribution over the range @math{ 0 \leq x < 1}.
+
+The runtime-library implements George Marsaglia's KISS (Keep It Simple 
+Stupid) random number generator (RNG). This RNG combines:
+@enumerate
+@item The congruential generator @math{x(n) = 69069 \cdot x(n-1) + 1327217885}
+with a period of @math{2^{32}},
+@item A 3-shift shift-register generator with a period of @math{2^{32} - 1},
+@item  Two 16-bit multiply-with-carry generators with a period of
+@math{597273182964842497 > 2^{59}}.
+@end enumerate
+The overall period exceeds @math{2^{123}}.
+
+Please note, this RNG is thread safe if used within OpenMP directives,
+i.e., its state will be consistent while called from multiple threads.
+However, the KISS generator does not create random numbers in parallel 
+from multiple sources, but in sequence from a single source. If an
+OpenMP-enabled application heavily relies on random numbers, one should 
+consider employing a dedicated parallel random number generator instead.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{RANDOM_NUMBER(HARVEST)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{HARVEST} @tab Shall be a scalar or an array of type @code{REAL}.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program test_random_number
+  REAL :: r(5,5)
+  CALL init_random_seed()         ! see example of RANDOM_SEED
+  CALL RANDOM_NUMBER(r)
+end program
+@end smallexample
+
+@item @emph{See also}:
+@ref{RANDOM_SEED}
+@end table
+
+
+
+@node RANDOM_SEED
+@section @code{RANDOM_SEED} --- Initialize a pseudo-random number sequence
+@fnindex RANDOM_SEED
+@cindex random number generation, seeding
+@cindex seeding a random number generator
+
+@table @asis
+@item @emph{Description}:
+Restarts or queries the state of the pseudorandom number generator used by 
+@code{RANDOM_NUMBER}.
+
+If @code{RANDOM_SEED} is called without arguments, it is initialized to
+a default state. The example below shows how to initialize the random 
+seed based on the system's time.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL RANDOM_SEED([SIZE, PUT, GET])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{SIZE} @tab (Optional) Shall be a scalar and of type default 
+@code{INTEGER}, with @code{INTENT(OUT)}. It specifies the minimum size 
+of the arrays used with the @var{PUT} and @var{GET} arguments.
+@item @var{PUT}  @tab (Optional) Shall be an array of type default 
+@code{INTEGER} and rank one. It is @code{INTENT(IN)} and the size of 
+the array must be larger than or equal to the number returned by the 
+@var{SIZE} argument.
+@item @var{GET}  @tab (Optional) Shall be an array of type default 
+@code{INTEGER} and rank one. It is @code{INTENT(OUT)} and the size 
+of the array must be larger than or equal to the number returned by 
+the @var{SIZE} argument.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+SUBROUTINE init_random_seed()
+  INTEGER :: i, n, clock
+  INTEGER, DIMENSION(:), ALLOCATABLE :: seed
+
+  CALL RANDOM_SEED(size = n)
+  ALLOCATE(seed(n))
+
+  CALL SYSTEM_CLOCK(COUNT=clock)
+
+  seed = clock + 37 * (/ (i - 1, i = 1, n) /)
+  CALL RANDOM_SEED(PUT = seed)
+
+  DEALLOCATE(seed)
+END SUBROUTINE
+@end smallexample
+
+@item @emph{See also}:
+@ref{RANDOM_NUMBER}
+@end table
+
+
+
+@node RANGE
+@section @code{RANGE} --- Decimal exponent range
+@fnindex RANGE
+@cindex model representation, range
+
+@table @asis
+@item @emph{Description}:
+@code{RANGE(X)} returns the decimal exponent range in the model of the
+type of @code{X}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = RANGE(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{INTEGER}, @code{REAL}
+or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the default integer
+kind.
+
+@item @emph{See also}:
+@ref{SELECTED_REAL_KIND}, @ref{PRECISION}
+
+@item @emph{Example}:
+See @code{PRECISION} for an example.
+@end table
+
+
+
+@node REAL
+@section @code{REAL} --- Convert to real type 
+@fnindex REAL
+@fnindex REALPART
+@fnindex FLOAT
+@fnindex DFLOAT
+@fnindex SNGL
+@cindex conversion, to real
+@cindex complex numbers, real part
+
+@table @asis
+@item @emph{Description}:
+@code{REAL(A [, KIND])} converts its argument @var{A} to a real type.  The
+@code{REALPART} function is provided for compatibility with @command{g77},
+and its use is strongly discouraged.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = REAL(A [, KIND])}
+@item @code{RESULT = REALPART(Z)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A}    @tab Shall be @code{INTEGER}, @code{REAL}, or
+@code{COMPLEX}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+These functions return a @code{REAL} variable or array under
+the following rules: 
+
+@table @asis
+@item (A)
+@code{REAL(A)} is converted to a default real type if @var{A} is an 
+integer or real variable.
+@item (B)
+@code{REAL(A)} is converted to a real type with the kind type parameter
+of @var{A} if @var{A} is a complex variable.
+@item (C)
+@code{REAL(A, KIND)} is converted to a real type with kind type
+parameter @var{KIND} if @var{A} is a complex, integer, or real
+variable.
+@end table
+
+@item @emph{Example}:
+@smallexample
+program test_real
+  complex :: x = (1.0, 2.0)
+  print *, real(x), real(x,8), realpart(x)
+end program test_real
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Argument           @tab Return type     @tab Standard
+@item @code{FLOAT(A)}  @tab @code{INTEGER(4)}  @tab @code{REAL(4)}  @tab Fortran 77 and later
+@item @code{DFLOAT(A)} @tab @code{INTEGER(4)}  @tab @code{REAL(8)}  @tab GNU extension
+@item @code{SNGL(A)}   @tab @code{INTEGER(8)}  @tab @code{REAL(4)}  @tab Fortran 77 and later
+@end multitable
+
+
+@item @emph{See also}:
+@ref{DBLE}
+
+@end table
+
+
+
+@node RENAME
+@section @code{RENAME} --- Rename a file
+@fnindex RENAME
+@cindex file system, rename file
+
+@table @asis
+@item @emph{Description}:
+Renames a file from file @var{PATH1} to @var{PATH2}. A null
+character (@code{CHAR(0)}) can be used to mark the end of the names in
+@var{PATH1} and @var{PATH2}; otherwise, trailing blanks in the file
+names are ignored.  If the @var{STATUS} argument is supplied, it
+contains 0 on success or a nonzero error code upon return; see
+@code{rename(2)}.
+
+This intrinsic is provided in both subroutine and function forms;
+however, only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL RENAME(PATH1, PATH2 [, STATUS])}
+@item @code{STATUS = RENAME(PATH1, PATH2)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{PATH1} @tab Shall be of default @code{CHARACTER} type.
+@item @var{PATH2} @tab Shall be of default @code{CHARACTER} type.
+@item @var{STATUS} @tab (Optional) Shall be of default @code{INTEGER} type.
+@end multitable
+
+@item @emph{See also}:
+@ref{LINK}
+
+@end table
+
+
+
+@node REPEAT
+@section @code{REPEAT} --- Repeated string concatenation 
+@fnindex REPEAT
+@cindex string, repeat
+@cindex string, concatenate
+
+@table @asis
+@item @emph{Description}:
+Concatenates @var{NCOPIES} copies of a string.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = REPEAT(STRING, NCOPIES)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING}  @tab Shall be scalar and of type @code{CHARACTER}.
+@item @var{NCOPIES} @tab Shall be scalar and of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+A new scalar of type @code{CHARACTER} built up from @var{NCOPIES} copies 
+of @var{STRING}.
+
+@item @emph{Example}:
+@smallexample
+program test_repeat
+  write(*,*) repeat("x", 5)   ! "xxxxx"
+end program
+@end smallexample
+@end table
+
+
+
+@node RESHAPE
+@section @code{RESHAPE} --- Function to reshape an array
+@fnindex RESHAPE
+@cindex array, change dimensions
+@cindex array, transmogrify
+
+@table @asis
+@item @emph{Description}:
+Reshapes @var{SOURCE} to correspond to @var{SHAPE}. If necessary,
+the new array may be padded with elements from @var{PAD} or permuted
+as defined by @var{ORDER}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = RESHAPE(SOURCE, SHAPE[, PAD, ORDER])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{SOURCE} @tab Shall be an array of any type.
+@item @var{SHAPE}  @tab Shall be of type @code{INTEGER} and an 
+array of rank one. Its values must be positive or zero.
+@item @var{PAD}    @tab (Optional) shall be an array of the same 
+type as @var{SOURCE}.
+@item @var{ORDER}  @tab (Optional) shall be of type @code{INTEGER}
+and an array of the same shape as @var{SHAPE}. Its values shall
+be a permutation of the numbers from 1 to n, where n is the size of 
+@var{SHAPE}. If @var{ORDER} is absent, the natural ordering shall
+be assumed.
+@end multitable
+
+@item @emph{Return value}:
+The result is an array of shape @var{SHAPE} with the same type as 
+@var{SOURCE}. 
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_reshape
+  INTEGER, DIMENSION(4) :: x
+  WRITE(*,*) SHAPE(x)                       ! prints "4"
+  WRITE(*,*) SHAPE(RESHAPE(x, (/2, 2/)))    ! prints "2 2"
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{SHAPE}
+@end table
+
+
+
+@node RRSPACING
+@section @code{RRSPACING} --- Reciprocal of the relative spacing
+@fnindex RRSPACING
+@cindex real number, relative spacing
+@cindex floating point, relative spacing
+
+
+@table @asis
+@item @emph{Description}:
+@code{RRSPACING(X)} returns the  reciprocal of the relative spacing of
+model numbers near @var{X}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = RRSPACING(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as @var{X}.
+The value returned is equal to
+@code{ABS(FRACTION(X)) * FLOAT(RADIX(X))**DIGITS(X)}.
+
+@item @emph{See also}:
+@ref{SPACING}
+@end table
+
+
+
+@node RSHIFT
+@section @code{RSHIFT} --- Right shift bits
+@fnindex RSHIFT
+@cindex bits, shift right
+
+@table @asis
+@item @emph{Description}:
+@code{RSHIFT} returns a value corresponding to @var{I} with all of the
+bits shifted right by @var{SHIFT} places.  If the absolute value of
+@var{SHIFT} is greater than @code{BIT_SIZE(I)}, the value is undefined.
+Bits shifted out from the right end are lost. The fill is arithmetic: the
+bits shifted in from the left end are equal to the leftmost bit, which in
+two's complement representation is the sign bit.
+
+This function has been superseded by the @code{SHIFTA} intrinsic, which
+is standard in Fortran 2008 and later.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = RSHIFT(I, SHIFT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{SHIFT} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the same kind as
+@var{I}.
+
+@item @emph{See also}:
+@ref{ISHFT}, @ref{ISHFTC}, @ref{LSHIFT}, @ref{SHIFTA}, @ref{SHIFTR},
+@ref{SHIFTL}
+
+@end table
+
+
+
+@node SAME_TYPE_AS
+@section @code{SAME_TYPE_AS} ---  Query dynamic types for equality
+@fnindex SAME_TYPE_AS
+
+@table @asis
+@item @emph{Description}:
+Query dynamic types for equality.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = SAME_TYPE_AS(A, B)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab Shall be an object of extensible declared type or
+unlimited polymorphic.
+@item @var{B} @tab Shall be an object of extensible declared type or
+unlimited polymorphic.
+@end multitable
+
+@item @emph{Return value}:
+The return value is a scalar of type default logical. It is true if and
+only if the dynamic type of A is the same as the dynamic type of B.
+
+@item @emph{See also}:
+@ref{EXTENDS_TYPE_OF}
+
+@end table
+
+
+
+@node SCALE
+@section @code{SCALE} --- Scale a real value
+@fnindex SCALE
+@cindex real number, scale
+@cindex floating point, scale
+
+@table @asis
+@item @emph{Description}:
+@code{SCALE(X,I)} returns @code{X * RADIX(X)**I}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SCALE(X, I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type of the argument shall be a @code{REAL}.
+@item @var{I} @tab The type of the argument shall be a @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as @var{X}.
+Its value is @code{X * RADIX(X)**I}.
+
+@item @emph{Example}:
+@smallexample
+program test_scale
+  real :: x = 178.1387e-4
+  integer :: i = 5
+  print *, scale(x,i), x*radix(x)**i
+end program test_scale
+@end smallexample
+
+@end table
+
+
+
+@node SCAN
+@section @code{SCAN} --- Scan a string for the presence of a set of characters
+@fnindex SCAN
+@cindex string, find subset
+
+@table @asis
+@item @emph{Description}:
+Scans a @var{STRING} for any of the characters in a @var{SET} 
+of characters.
+
+If @var{BACK} is either absent or equals @code{FALSE}, this function
+returns the position of the leftmost character of @var{STRING} that is
+in @var{SET}. If @var{BACK} equals @code{TRUE}, the rightmost position
+is returned. If no character of @var{SET} is found in @var{STRING}, the 
+result is zero.
+
+@item @emph{Standard}:
+Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SCAN(STRING, SET[, BACK [, KIND]])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING} @tab Shall be of type @code{CHARACTER}.
+@item @var{SET}    @tab Shall be of type @code{CHARACTER}.
+@item @var{BACK}   @tab (Optional) shall be of type @code{LOGICAL}.
+@item @var{KIND}   @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_scan
+  WRITE(*,*) SCAN("FORTRAN", "AO")          ! 2, found 'O'
+  WRITE(*,*) SCAN("FORTRAN", "AO", .TRUE.)  ! 6, found 'A'
+  WRITE(*,*) SCAN("FORTRAN", "C++")         ! 0, found none
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{INDEX intrinsic}, @ref{VERIFY}
+@end table
+
+
+
+@node SECNDS
+@section @code{SECNDS} --- Time function
+@fnindex SECNDS
+@cindex time, elapsed
+@cindex elapsed time
+
+@table @asis
+@item @emph{Description}:
+@code{SECNDS(X)} gets the time in seconds from the real-time system clock.
+@var{X} is a reference time, also in seconds. If this is zero, the time in
+seconds from midnight is returned. This function is non-standard and its
+use is discouraged.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = SECNDS (X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{T}     @tab Shall be of type @code{REAL(4)}.
+@item @var{X}     @tab Shall be of type @code{REAL(4)}.
+@end multitable
+
+@item @emph{Return value}:
+None
+
+@item @emph{Example}:
+@smallexample
+program test_secnds
+    integer :: i
+    real(4) :: t1, t2
+    print *, secnds (0.0)   ! seconds since midnight
+    t1 = secnds (0.0)       ! reference time
+    do i = 1, 10000000      ! do something
+    end do
+    t2 = secnds (t1)        ! elapsed time
+    print *, "Something took ", t2, " seconds."
+end program test_secnds
+@end smallexample
+@end table
+
+
+
+@node SECOND
+@section @code{SECOND} --- CPU time function
+@fnindex SECOND
+@cindex time, elapsed
+@cindex elapsed time
+
+@table @asis
+@item @emph{Description}:
+Returns a @code{REAL(4)} value representing the elapsed CPU time in
+seconds.  This provides the same functionality as the standard
+@code{CPU_TIME} intrinsic, and is only included for backwards
+compatibility.
+
+This intrinsic is provided in both subroutine and function forms;
+however, only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL SECOND(TIME)}
+@item @code{TIME = SECOND()}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{TIME}  @tab Shall be of type @code{REAL(4)}.
+@end multitable
+
+@item @emph{Return value}:
+In either syntax, @var{TIME} is set to the process's current runtime in
+seconds.
+
+@item @emph{See also}:
+@ref{CPU_TIME}
+
+@end table
+
+
+
+@node SELECTED_CHAR_KIND
+@section @code{SELECTED_CHAR_KIND} --- Choose character kind
+@fnindex SELECTED_CHAR_KIND
+@cindex character kind
+@cindex kind, character
+
+@table @asis
+@item @emph{Description}:
+
+@code{SELECTED_CHAR_KIND(NAME)} returns the kind value for the character
+set named @var{NAME}, if a character set with such a name is supported,
+or @math{-1} otherwise. Currently, supported character sets include
+``ASCII'' and ``DEFAULT'', which are equivalent, and ``ISO_10646''
+(Universal Character Set, UCS-4) which is commonly known as Unicode.
+
+@item @emph{Standard}:
+Fortran 2003 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = SELECTED_CHAR_KIND(NAME)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{NAME} @tab Shall be a scalar and of the default character type.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program character_kind
+  use iso_fortran_env
+  implicit none
+  integer, parameter :: ascii = selected_char_kind ("ascii")
+  integer, parameter :: ucs4  = selected_char_kind ('ISO_10646')
+
+  character(kind=ascii, len=26) :: alphabet
+  character(kind=ucs4,  len=30) :: hello_world
+
+  alphabet = ascii_"abcdefghijklmnopqrstuvwxyz"
+  hello_world = ucs4_'Hello World and Ni Hao -- ' &
+                // char (int (z'4F60'), ucs4)     &
+                // char (int (z'597D'), ucs4)
+
+  write (*,*) alphabet
+
+  open (output_unit, encoding='UTF-8')
+  write (*,*) trim (hello_world)
+end program character_kind
+@end smallexample
+@end table
+
+
+
+@node SELECTED_INT_KIND
+@section @code{SELECTED_INT_KIND} --- Choose integer kind
+@fnindex SELECTED_INT_KIND
+@cindex integer kind
+@cindex kind, integer
+
+@table @asis
+@item @emph{Description}:
+@code{SELECTED_INT_KIND(R)} return the kind value of the smallest integer
+type that can represent all values ranging from @math{-10^R} (exclusive)
+to @math{10^R} (exclusive). If there is no integer kind that accommodates
+this range, @code{SELECTED_INT_KIND} returns @math{-1}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = SELECTED_INT_KIND(R)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{R} @tab Shall be a scalar and of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program large_integers
+  integer,parameter :: k5 = selected_int_kind(5)
+  integer,parameter :: k15 = selected_int_kind(15)
+  integer(kind=k5) :: i5
+  integer(kind=k15) :: i15
+
+  print *, huge(i5), huge(i15)
+
+  ! The following inequalities are always true
+  print *, huge(i5) >= 10_k5**5-1
+  print *, huge(i15) >= 10_k15**15-1
+end program large_integers
+@end smallexample
+@end table
+
+
+
+@node SELECTED_REAL_KIND
+@section @code{SELECTED_REAL_KIND} --- Choose real kind
+@fnindex SELECTED_REAL_KIND
+@cindex real kind
+@cindex kind, real
+@cindex radix, real
+
+@table @asis
+@item @emph{Description}:
+@code{SELECTED_REAL_KIND(P,R)} returns the kind value of a real data type
+with decimal precision of at least @code{P} digits, exponent range of
+at least @code{R}, and with a radix of @code{RADIX}.
+
+@item @emph{Standard}:
+Fortran 95 and later, with @code{RADIX} Fortran 2008 or later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = SELECTED_REAL_KIND([P, R, RADIX])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{P} @tab (Optional) shall be a scalar and of type @code{INTEGER}.
+@item @var{R} @tab (Optional) shall be a scalar and of type @code{INTEGER}.
+@item @var{RADIX} @tab (Optional) shall be a scalar and of type @code{INTEGER}.
+@end multitable
+Before Fortran 2008, at least one of the arguments @var{R} or @var{P} shall
+be present; since Fortran 2008, they are assumed to be zero if absent.
+
+@item @emph{Return value}:
+
+@code{SELECTED_REAL_KIND} returns the value of the kind type parameter of
+a real data type with decimal precision of at least @code{P} digits, a
+decimal exponent range of at least @code{R}, and with the requested
+@code{RADIX}. If the @code{RADIX} parameter is absent, real kinds with
+any radix can be returned. If more than one real data type meet the
+criteria, the kind of the data type with the smallest decimal precision
+is returned. If no real data type matches the criteria, the result is
+@table @asis
+@item -1 if the processor does not support a real data type with a
+precision greater than or equal to @code{P}, but the @code{R} and
+@code{RADIX} requirements can be fulfilled
+@item -2 if the processor does not support a real type with an exponent
+range greater than or equal to @code{R}, but @code{P} and @code{RADIX}
+are fulfillable
+@item -3 if @code{RADIX} but not @code{P} and @code{R} requirements
+are fulfillable
+@item -4 if @code{RADIX} and either @code{P} or @code{R} requirements
+are fulfillable
+@item -5 if there is no real type with the given @code{RADIX}
+@end table
+
+@item @emph{See also}:
+@ref{PRECISION}, @ref{RANGE}, @ref{RADIX}
+
+@item @emph{Example}:
+@smallexample
+program real_kinds
+  integer,parameter :: p6 = selected_real_kind(6)
+  integer,parameter :: p10r100 = selected_real_kind(10,100)
+  integer,parameter :: r400 = selected_real_kind(r=400)
+  real(kind=p6) :: x
+  real(kind=p10r100) :: y
+  real(kind=r400) :: z
+
+  print *, precision(x), range(x)
+  print *, precision(y), range(y)
+  print *, precision(z), range(z)
+end program real_kinds
+@end smallexample
+@end table
+
+
+
+@node SET_EXPONENT
+@section @code{SET_EXPONENT} --- Set the exponent of the model
+@fnindex SET_EXPONENT
+@cindex real number, set exponent
+@cindex floating point, set exponent
+
+@table @asis
+@item @emph{Description}:
+@code{SET_EXPONENT(X, I)} returns the real number whose fractional part
+is that that of @var{X} and whose exponent part is @var{I}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SET_EXPONENT(X, I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{REAL}.
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as @var{X}.
+The real number whose fractional part
+is that that of @var{X} and whose exponent part if @var{I} is returned;
+it is @code{FRACTION(X) * RADIX(X)**I}.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_setexp
+  REAL :: x = 178.1387e-4
+  INTEGER :: i = 17
+  PRINT *, SET_EXPONENT(x, i), FRACTION(x) * RADIX(x)**i
+END PROGRAM
+@end smallexample
+
+@end table
+
+
+
+@node SHAPE
+@section @code{SHAPE} --- Determine the shape of an array
+@fnindex SHAPE
+@cindex array, shape
+
+@table @asis
+@item @emph{Description}:
+Determines the shape of an array.
+
+@item @emph{Standard}:
+Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = SHAPE(SOURCE [, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{SOURCE} @tab Shall be an array or scalar of any type. 
+If @var{SOURCE} is a pointer it must be associated and allocatable 
+arrays must be allocated.
+@item @var{KIND}   @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+An @code{INTEGER} array of rank one with as many elements as @var{SOURCE} 
+has dimensions. The elements of the resulting array correspond to the extend
+of @var{SOURCE} along the respective dimensions. If @var{SOURCE} is a scalar,
+the result is the rank one array of size zero. If @var{KIND} is absent, the
+return value has the default integer kind otherwise the specified kind.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_shape
+  INTEGER, DIMENSION(-1:1, -1:2) :: A
+  WRITE(*,*) SHAPE(A)             ! (/ 3, 4 /)
+  WRITE(*,*) SIZE(SHAPE(42))      ! (/ /)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{RESHAPE}, @ref{SIZE}
+@end table
+
+
+
+@node SHIFTA
+@section @code{SHIFTA} --- Right shift with fill
+@fnindex SHIFTA
+@cindex bits, shift right
+@cindex shift, right with fill
+
+@table @asis
+@item @emph{Description}:
+@code{SHIFTA} returns a value corresponding to @var{I} with all of the
+bits shifted right by @var{SHIFT} places.  If the absolute value of
+@var{SHIFT} is greater than @code{BIT_SIZE(I)}, the value is undefined.
+Bits shifted out from the right end are lost. The fill is arithmetic: the
+bits shifted in from the left end are equal to the leftmost bit, which in
+two's complement representation is the sign bit.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SHIFTA(I, SHIFT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{SHIFT} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the same kind as
+@var{I}.
+
+@item @emph{See also}:
+@ref{SHIFTL}, @ref{SHIFTR}
+@end table
+
+
+
+@node SHIFTL
+@section @code{SHIFTL} --- Left shift
+@fnindex SHIFTL
+@cindex bits, shift left
+@cindex shift, left
+
+@table @asis
+@item @emph{Description}:
+@code{SHIFTL} returns a value corresponding to @var{I} with all of the
+bits shifted left by @var{SHIFT} places.  If the absolute value of
+@var{SHIFT} is greater than @code{BIT_SIZE(I)}, the value is undefined.
+Bits shifted out from the left end are lost, and bits shifted in from
+the right end are set to 0.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SHIFTL(I, SHIFT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{SHIFT} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the same kind as
+@var{I}.
+
+@item @emph{See also}:
+@ref{SHIFTA}, @ref{SHIFTR}
+@end table
+
+
+
+@node SHIFTR
+@section @code{SHIFTR} --- Right shift
+@fnindex SHIFTR
+@cindex bits, shift right
+@cindex shift, right
+
+@table @asis
+@item @emph{Description}:
+@code{SHIFTR} returns a value corresponding to @var{I} with all of the
+bits shifted right by @var{SHIFT} places.  If the absolute value of
+@var{SHIFT} is greater than @code{BIT_SIZE(I)}, the value is undefined.
+Bits shifted out from the right end are lost, and bits shifted in from
+the left end are set to 0.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SHIFTR(I, SHIFT)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be @code{INTEGER}.
+@item @var{SHIFT} @tab The type shall be @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of the same kind as
+@var{I}.
+
+@item @emph{See also}:
+@ref{SHIFTA}, @ref{SHIFTL}
+@end table
+
+
+
+@node SIGN
+@section @code{SIGN} --- Sign copying function
+@fnindex SIGN
+@fnindex ISIGN
+@fnindex DSIGN
+@cindex sign copying
+
+@table @asis
+@item @emph{Description}:
+@code{SIGN(A,B)} returns the value of @var{A} with the sign of @var{B}.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SIGN(A, B)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab Shall be of type @code{INTEGER} or @code{REAL}
+@item @var{B} @tab Shall be of the same type and kind as @var{A}
+@end multitable
+
+@item @emph{Return value}:
+The kind of the return value is that of @var{A} and @var{B}.
+If @math{B\ge 0} then the result is @code{ABS(A)}, else
+it is @code{-ABS(A)}.
+
+@item @emph{Example}:
+@smallexample
+program test_sign
+  print *, sign(-12,1)
+  print *, sign(-12,0)
+  print *, sign(-12,-1)
+
+  print *, sign(-12.,1.)
+  print *, sign(-12.,0.)
+  print *, sign(-12.,-1.)
+end program test_sign
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name              @tab Arguments              @tab Return type       @tab Standard
+@item @code{SIGN(A,B)}  @tab @code{REAL(4) A, B}    @tab @code{REAL(4)}    @tab f77, gnu
+@item @code{ISIGN(A,B)} @tab @code{INTEGER(4) A, B} @tab @code{INTEGER(4)} @tab f77, gnu
+@item @code{DSIGN(A,B)} @tab @code{REAL(8) A, B}    @tab @code{REAL(8)}    @tab f77, gnu
+@end multitable
+@end table
+
+
+
+@node SIGNAL
+@section @code{SIGNAL} --- Signal handling subroutine (or function)
+@fnindex SIGNAL
+@cindex system, signal handling
+
+@table @asis
+@item @emph{Description}:
+@code{SIGNAL(NUMBER, HANDLER [, STATUS])} causes external subroutine
+@var{HANDLER} to be executed with a single integer argument when signal
+@var{NUMBER} occurs.  If @var{HANDLER} is an integer, it can be used to
+turn off handling of signal @var{NUMBER} or revert to its default
+action.  See @code{signal(2)}.
+
+If @code{SIGNAL} is called as a subroutine and the @var{STATUS} argument
+is supplied, it is set to the value returned by @code{signal(2)}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL SIGNAL(NUMBER, HANDLER [, STATUS])}
+@item @code{STATUS = SIGNAL(NUMBER, HANDLER)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{NUMBER} @tab Shall be a scalar integer, with @code{INTENT(IN)}
+@item @var{HANDLER}@tab Signal handler (@code{INTEGER FUNCTION} or
+@code{SUBROUTINE}) or dummy/global @code{INTEGER} scalar.
+@code{INTEGER}. It is @code{INTENT(IN)}.
+@item @var{STATUS} @tab (Optional) @var{STATUS} shall be a scalar
+integer. It has @code{INTENT(OUT)}.
+@end multitable
+@c TODO: What should the interface of the handler be?  Does it take arguments?
+
+@item @emph{Return value}:
+The @code{SIGNAL} function returns the value returned by @code{signal(2)}.
+
+@item @emph{Example}:
+@smallexample
+program test_signal
+  intrinsic signal
+  external handler_print
+
+  call signal (12, handler_print)
+  call signal (10, 1)
+
+  call sleep (30)
+end program test_signal
+@end smallexample
+@end table
+
+
+
+@node SIN
+@section @code{SIN} --- Sine function 
+@fnindex SIN
+@fnindex DSIN
+@fnindex CSIN
+@fnindex ZSIN
+@fnindex CDSIN
+@cindex trigonometric function, sine
+@cindex sine
+
+@table @asis
+@item @emph{Description}:
+@code{SIN(X)} computes the sine of @var{X}.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SIN(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or
+@code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_sin
+  real :: x = 0.0
+  x = sin(x)
+end program test_sin
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument             @tab Return type       @tab Standard
+@item @code{SIN(X)}   @tab @code{REAL(4) X}     @tab @code{REAL(4)}    @tab f77, gnu
+@item @code{DSIN(X)}  @tab @code{REAL(8) X}     @tab @code{REAL(8)}    @tab f95, gnu
+@item @code{CSIN(X)}  @tab @code{COMPLEX(4) X}  @tab @code{COMPLEX(4)} @tab f95, gnu
+@item @code{ZSIN(X)}  @tab @code{COMPLEX(8) X}  @tab @code{COMPLEX(8)} @tab f95, gnu
+@item @code{CDSIN(X)} @tab @code{COMPLEX(8) X}  @tab @code{COMPLEX(8)} @tab f95, gnu
+@end multitable
+
+@item @emph{See also}:
+@ref{ASIN}
+@end table
+
+
+
+@node SINH
+@section @code{SINH} --- Hyperbolic sine function 
+@fnindex SINH
+@fnindex DSINH
+@cindex hyperbolic sine
+@cindex hyperbolic function, sine
+@cindex sine, hyperbolic
+
+@table @asis
+@item @emph{Description}:
+@code{SINH(X)} computes the hyperbolic sine of @var{X}.
+
+@item @emph{Standard}:
+Fortran 95 and later, for a complex argument Fortran 2008 or later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SINH(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_sinh
+  real(8) :: x = - 1.0_8
+  x = sinh(x)
+end program test_sinh
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type       @tab Standard
+@item @code{SINH(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab Fortran 95 and later
+@item @code{DSINH(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab Fortran 95 and later
+@end multitable
+
+@item @emph{See also}:
+@ref{ASINH}
+@end table
+
+
+
+@node SIZE
+@section @code{SIZE} --- Determine the size of an array
+@fnindex SIZE
+@cindex array, size
+@cindex array, number of elements
+@cindex array, count elements
+
+@table @asis
+@item @emph{Description}:
+Determine the extent of @var{ARRAY} along a specified dimension @var{DIM},
+or the total number of elements in @var{ARRAY} if @var{DIM} is absent.
+
+@item @emph{Standard}:
+Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = SIZE(ARRAY[, DIM [, KIND]])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array of any type. If @var{ARRAY} is
+a pointer it must be associated and allocatable arrays must be allocated.
+@item @var{DIM}   @tab (Optional) shall be a scalar of type @code{INTEGER} 
+and its value shall be in the range from 1 to n, where n equals the rank 
+of @var{ARRAY}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_size
+  WRITE(*,*) SIZE((/ 1, 2 /))    ! 2
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{SHAPE}, @ref{RESHAPE}
+@end table
+
+
+@node SIZEOF
+@section @code{SIZEOF} --- Size in bytes of an expression
+@fnindex SIZEOF
+@cindex expression size
+@cindex size of an expression
+
+@table @asis
+@item @emph{Description}:
+@code{SIZEOF(X)} calculates the number of bytes of storage the
+expression @code{X} occupies.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Intrinsic function
+
+@item @emph{Syntax}:
+@code{N = SIZEOF(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The argument shall be of any type, rank or shape.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type integer and of the system-dependent kind
+@var{C_SIZE_T} (from the @var{ISO_C_BINDING} module). Its value is the
+number of bytes occupied by the argument.  If the argument has the
+@code{POINTER} attribute, the number of bytes of the storage area pointed
+to is returned.  If the argument is of a derived type with @code{POINTER}
+or @code{ALLOCATABLE} components, the return value doesn't account for
+the sizes of the data pointed to by these components. If the argument is
+polymorphic, the size according to the declared type is returned.
+
+@item @emph{Example}:
+@smallexample
+   integer :: i
+   real :: r, s(5)
+   print *, (sizeof(s)/sizeof(r) == 5)
+   end
+@end smallexample
+The example will print @code{.TRUE.} unless you are using a platform
+where default @code{REAL} variables are unusually padded.
+
+@item @emph{See also}:
+@ref{C_SIZEOF}, @ref{STORAGE_SIZE}
+@end table
+
+
+@node SLEEP
+@section @code{SLEEP} --- Sleep for the specified number of seconds
+@fnindex SLEEP
+@cindex delayed execution
+
+@table @asis
+@item @emph{Description}:
+Calling this subroutine causes the process to pause for @var{SECONDS} seconds.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL SLEEP(SECONDS)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{SECONDS} @tab The type shall be of default @code{INTEGER}.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program test_sleep
+  call sleep(5)
+end
+@end smallexample
+@end table
+
+
+
+@node SPACING
+@section @code{SPACING} --- Smallest distance between two numbers of a given type
+@fnindex SPACING
+@cindex real number, relative spacing
+@cindex floating point, relative spacing
+
+@table @asis
+@item @emph{Description}:
+Determines the distance between the argument @var{X} and the nearest 
+adjacent number of the same type.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SPACING(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The result is of the same type as the input argument @var{X}.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_spacing
+  INTEGER, PARAMETER :: SGL = SELECTED_REAL_KIND(p=6, r=37)
+  INTEGER, PARAMETER :: DBL = SELECTED_REAL_KIND(p=13, r=200)
+
+  WRITE(*,*) spacing(1.0_SGL)      ! "1.1920929E-07"          on i686
+  WRITE(*,*) spacing(1.0_DBL)      ! "2.220446049250313E-016" on i686
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{RRSPACING}
+@end table
+
+
+
+@node SPREAD
+@section @code{SPREAD} --- Add a dimension to an array
+@fnindex SPREAD
+@cindex array, increase dimension
+@cindex array, duplicate elements
+@cindex array, duplicate dimensions
+
+@table @asis
+@item @emph{Description}:
+Replicates a @var{SOURCE} array @var{NCOPIES} times along a specified 
+dimension @var{DIM}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = SPREAD(SOURCE, DIM, NCOPIES)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{SOURCE}  @tab Shall be a scalar or an array of any type and 
+a rank less than seven.
+@item @var{DIM}     @tab Shall be a scalar of type @code{INTEGER} with a 
+value in the range from 1 to n+1, where n equals the rank of @var{SOURCE}.
+@item @var{NCOPIES} @tab Shall be a scalar of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The result is an array of the same type as @var{SOURCE} and has rank n+1
+where n equals the rank of @var{SOURCE}.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_spread
+  INTEGER :: a = 1, b(2) = (/ 1, 2 /)
+  WRITE(*,*) SPREAD(A, 1, 2)            ! "1 1"
+  WRITE(*,*) SPREAD(B, 1, 2)            ! "1 1 2 2"
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{UNPACK}
+@end table
+
+
+
+@node SQRT
+@section @code{SQRT} --- Square-root function
+@fnindex SQRT
+@fnindex DSQRT
+@fnindex CSQRT
+@fnindex ZSQRT
+@fnindex CDSQRT
+@cindex root
+@cindex square-root
+
+@table @asis
+@item @emph{Description}:
+@code{SQRT(X)} computes the square root of @var{X}.
+
+@item @emph{Standard}:
+Fortran 77 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = SQRT(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or
+@code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{REAL} or @code{COMPLEX}.
+The kind type parameter is the same as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_sqrt
+  real(8) :: x = 2.0_8
+  complex :: z = (1.0, 2.0)
+  x = sqrt(x)
+  z = sqrt(z)
+end program test_sqrt
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name             @tab Argument             @tab Return type          @tab Standard
+@item @code{SQRT(X)}   @tab @code{REAL(4) X}     @tab @code{REAL(4)}       @tab Fortran 95 and later
+@item @code{DSQRT(X)}  @tab @code{REAL(8) X}     @tab @code{REAL(8)}       @tab Fortran 95 and later
+@item @code{CSQRT(X)}  @tab @code{COMPLEX(4) X}  @tab @code{COMPLEX(4)}    @tab Fortran 95 and later
+@item @code{ZSQRT(X)}  @tab @code{COMPLEX(8) X}  @tab @code{COMPLEX(8)}    @tab GNU extension
+@item @code{CDSQRT(X)} @tab @code{COMPLEX(8) X}  @tab @code{COMPLEX(8)}    @tab GNU extension
+@end multitable
+@end table
+
+
+
+@node SRAND
+@section @code{SRAND} --- Reinitialize the random number generator
+@fnindex SRAND
+@cindex random number generation, seeding
+@cindex seeding a random number generator
+
+@table @asis
+@item @emph{Description}:
+@code{SRAND} reinitializes the pseudo-random number generator
+called by @code{RAND} and @code{IRAND}. The new seed used by the
+generator is specified by the required argument @var{SEED}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL SRAND(SEED)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{SEED} @tab Shall be a scalar @code{INTEGER(kind=4)}.
+@end multitable
+
+@item @emph{Return value}:
+Does not return anything.
+
+@item @emph{Example}:
+See @code{RAND} and @code{IRAND} for examples.
+
+@item @emph{Notes}:
+The Fortran 2003 standard specifies the intrinsic @code{RANDOM_SEED} to
+initialize the pseudo-random numbers generator and @code{RANDOM_NUMBER}
+to generate pseudo-random numbers. Please note that in
+GNU Fortran, these two sets of intrinsics (@code{RAND},
+@code{IRAND} and @code{SRAND} on the one hand, @code{RANDOM_NUMBER} and
+@code{RANDOM_SEED} on the other hand) access two independent
+pseudo-random number generators.
+
+@item @emph{See also}:
+@ref{RAND}, @ref{RANDOM_SEED}, @ref{RANDOM_NUMBER}
+
+@end table
+
+
+
+@node STAT
+@section @code{STAT} --- Get file status
+@fnindex STAT
+@cindex file system, file status
+
+@table @asis
+@item @emph{Description}:
+This function returns information about a file. No permissions are required on 
+the file itself, but execute (search) permission is required on all of the 
+directories in path that lead to the file.
+
+The elements that are obtained and stored in the array @code{VALUES}:
+@multitable @columnfractions .15 .70
+@item @code{VALUES(1)}   @tab  Device ID 
+@item @code{VALUES(2)}   @tab  Inode number 
+@item @code{VALUES(3)}   @tab  File mode 
+@item @code{VALUES(4)}   @tab  Number of links 
+@item @code{VALUES(5)}   @tab  Owner's uid 
+@item @code{VALUES(6)}   @tab  Owner's gid 
+@item @code{VALUES(7)}   @tab  ID of device containing directory entry for file (0 if not available) 
+@item @code{VALUES(8)}   @tab  File size (bytes) 
+@item @code{VALUES(9)}   @tab  Last access time 
+@item @code{VALUES(10)}  @tab  Last modification time 
+@item @code{VALUES(11)}  @tab  Last file status change time 
+@item @code{VALUES(12)}  @tab  Preferred I/O block size (-1 if not available) 
+@item @code{VALUES(13)}  @tab  Number of blocks allocated (-1 if not available)
+@end multitable
+
+Not all these elements are relevant on all systems. 
+If an element is not relevant, it is returned as 0.
+
+This intrinsic is provided in both subroutine and function forms; however,
+only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL STAT(NAME, VALUES [, STATUS])}
+@item @code{STATUS = STAT(NAME, VALUES)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{NAME}   @tab The type shall be @code{CHARACTER}, of the
+default kind and a valid path within the file system.
+@item @var{VALUES} @tab The type shall be @code{INTEGER(4), DIMENSION(13)}.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}. Returns 0 
+on success and a system specific error code otherwise.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_stat
+  INTEGER, DIMENSION(13) :: buff
+  INTEGER :: status
+
+  CALL STAT("/etc/passwd", buff, status)
+
+  IF (status == 0) THEN
+    WRITE (*, FMT="('Device ID:',               T30, I19)") buff(1)
+    WRITE (*, FMT="('Inode number:',            T30, I19)") buff(2)
+    WRITE (*, FMT="('File mode (octal):',       T30, O19)") buff(3)
+    WRITE (*, FMT="('Number of links:',         T30, I19)") buff(4)
+    WRITE (*, FMT="('Owner''s uid:',            T30, I19)") buff(5)
+    WRITE (*, FMT="('Owner''s gid:',            T30, I19)") buff(6)
+    WRITE (*, FMT="('Device where located:',    T30, I19)") buff(7)
+    WRITE (*, FMT="('File size:',               T30, I19)") buff(8)
+    WRITE (*, FMT="('Last access time:',        T30, A19)") CTIME(buff(9))
+    WRITE (*, FMT="('Last modification time',   T30, A19)") CTIME(buff(10))
+    WRITE (*, FMT="('Last status change time:', T30, A19)") CTIME(buff(11))
+    WRITE (*, FMT="('Preferred block size:',    T30, I19)") buff(12)
+    WRITE (*, FMT="('No. of blocks allocated:', T30, I19)") buff(13)
+  END IF
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+To stat an open file: @ref{FSTAT}, to stat a link: @ref{LSTAT}
+@end table
+
+
+
+@node STORAGE_SIZE
+@section @code{STORAGE_SIZE} --- Storage size in bits
+@fnindex STORAGE_SIZE
+@cindex storage size
+
+@table @asis
+@item @emph{Description}:
+Returns the storage size of argument @var{A} in bits.
+@item @emph{Standard}:
+Fortran 2008 and later
+@item @emph{Class}:
+Inquiry function
+@item @emph{Syntax}:
+@code{RESULT = STORAGE_SIZE(A [, KIND])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{A} @tab Shall be a scalar or array of any type.
+@item @var{KIND} @tab (Optional) shall be a scalar integer constant expression.
+@end multitable
+
+@item @emph{Return Value}:
+The result is a scalar integer with the kind type parameter specified by KIND (or default integer type if KIND is missing). The result value is the size expressed in bits for an element of an array that
+has the dynamic type and type parameters of A.
+
+@item @emph{See also}:
+@ref{C_SIZEOF}, @ref{SIZEOF}
+@end table
+
+
+
+@node SUM
+@section @code{SUM} --- Sum of array elements
+@fnindex SUM
+@cindex array, sum
+@cindex array, add elements
+@cindex array, conditionally add elements
+@cindex sum array elements
+
+@table @asis
+@item @emph{Description}:
+Adds the elements of @var{ARRAY} along dimension @var{DIM} if
+the corresponding element in @var{MASK} is @code{TRUE}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = SUM(ARRAY[, MASK])}
+@item @code{RESULT = SUM(ARRAY, DIM[, MASK])}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array of type @code{INTEGER}, 
+@code{REAL} or @code{COMPLEX}.
+@item @var{DIM}   @tab (Optional) shall be a scalar of type 
+@code{INTEGER} with a value in the range from 1 to n, where n 
+equals the rank of @var{ARRAY}.
+@item @var{MASK}  @tab (Optional) shall be of type @code{LOGICAL} 
+and either be a scalar or an array of the same shape as @var{ARRAY}.
+@end multitable
+
+@item @emph{Return value}:
+The result is of the same type as @var{ARRAY}.
+
+If @var{DIM} is absent, a scalar with the sum of all elements in @var{ARRAY}
+is returned. Otherwise, an array of rank n-1, where n equals the rank of 
+@var{ARRAY}, and a shape similar to that of @var{ARRAY} with dimension @var{DIM} 
+dropped is returned.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_sum
+  INTEGER :: x(5) = (/ 1, 2, 3, 4 ,5 /)
+  print *, SUM(x)                        ! all elements, sum = 15
+  print *, SUM(x, MASK=MOD(x, 2)==1)     ! odd elements, sum = 9
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{PRODUCT}
+@end table
+
+
+
+@node SYMLNK
+@section @code{SYMLNK} --- Create a symbolic link
+@fnindex SYMLNK
+@cindex file system, create link
+@cindex file system, soft link
+
+@table @asis
+@item @emph{Description}:
+Makes a symbolic link from file @var{PATH1} to @var{PATH2}. A null
+character (@code{CHAR(0)}) can be used to mark the end of the names in
+@var{PATH1} and @var{PATH2}; otherwise, trailing blanks in the file
+names are ignored.  If the @var{STATUS} argument is supplied, it
+contains 0 on success or a nonzero error code upon return; see
+@code{symlink(2)}.  If the system does not supply @code{symlink(2)}, 
+@code{ENOSYS} is returned.
+
+This intrinsic is provided in both subroutine and function forms;
+however, only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL SYMLNK(PATH1, PATH2 [, STATUS])}
+@item @code{STATUS = SYMLNK(PATH1, PATH2)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{PATH1} @tab Shall be of default @code{CHARACTER} type.
+@item @var{PATH2} @tab Shall be of default @code{CHARACTER} type.
+@item @var{STATUS} @tab (Optional) Shall be of default @code{INTEGER} type.
+@end multitable
+
+@item @emph{See also}:
+@ref{LINK}, @ref{UNLINK}
+
+@end table
+
+
+
+@node SYSTEM
+@section @code{SYSTEM} --- Execute a shell command
+@fnindex SYSTEM
+@cindex system, system call
+
+@table @asis
+@item @emph{Description}:
+Passes the command @var{COMMAND} to a shell (see @code{system(3)}). If
+argument @var{STATUS} is present, it contains the value returned by
+@code{system(3)}, which is presumably 0 if the shell command succeeded.
+Note that which shell is used to invoke the command is system-dependent
+and environment-dependent.
+
+This intrinsic is provided in both subroutine and function forms;
+however, only one form can be used in any given program unit.
+
+Note that the @code{system} function need not be thread-safe. It is
+the responsibility of the user to ensure that @code{system} is not
+called concurrently.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL SYSTEM(COMMAND [, STATUS])}
+@item @code{STATUS = SYSTEM(COMMAND)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{COMMAND} @tab Shall be of default @code{CHARACTER} type.
+@item @var{STATUS}  @tab (Optional) Shall be of default @code{INTEGER} type.
+@end multitable
+
+@item @emph{See also}:
+@ref{EXECUTE_COMMAND_LINE}, which is part of the Fortran 2008 standard
+and should considered in new code for future portability.
+@end table
+
+
+
+@node SYSTEM_CLOCK
+@section @code{SYSTEM_CLOCK} --- Time function
+@fnindex SYSTEM_CLOCK
+@cindex time, clock ticks
+@cindex clock ticks
+
+@table @asis
+@item @emph{Description}:
+Determines the @var{COUNT} of a processor clock since an unspecified
+time in the past modulo @var{COUNT_MAX}, @var{COUNT_RATE} determines
+the number of clock ticks per second.  If the platform supports a high
+resolution monotonic clock, that clock is used and can provide up to
+nanosecond resolution.  If a high resolution monotonic clock is not
+available, the implementation falls back to a potentially lower
+resolution realtime clock.
+
+@var{COUNT_RATE} and @var{COUNT_MAX} vary depending on the kind of the
+arguments.  For @var{kind=8} arguments, @var{COUNT} represents
+nanoseconds, and for @var{kind=4} arguments, @var{COUNT} represents
+milliseconds. Other than the kind dependency, @var{COUNT_RATE} and
+@var{COUNT_MAX} are constant, however the particular values are
+specific to @command{gfortran}.
+
+If there is no clock, @var{COUNT} is set to @code{-HUGE(COUNT)}, and
+@var{COUNT_RATE} and @var{COUNT_MAX} are set to zero.
+
+When running on a platform using the GNU C library (glibc), or a
+derivative thereof, the high resolution monotonic clock is available
+only when linking with the @var{rt} library.  This can be done
+explicitly by adding the @code{-lrt} flag when linking the
+application, but is also done implicitly when using OpenMP.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Subroutine
+
+@item @emph{Syntax}:
+@code{CALL SYSTEM_CLOCK([COUNT, COUNT_RATE, COUNT_MAX])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{COUNT}      @tab (Optional) shall be a scalar of type 
+@code{INTEGER} with @code{INTENT(OUT)}.
+@item @var{COUNT_RATE} @tab (Optional) shall be a scalar of type 
+@code{INTEGER} with @code{INTENT(OUT)}.
+@item @var{COUNT_MAX}  @tab (Optional) shall be a scalar of type 
+@code{INTEGER} with @code{INTENT(OUT)}.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_system_clock
+  INTEGER :: count, count_rate, count_max
+  CALL SYSTEM_CLOCK(count, count_rate, count_max)
+  WRITE(*,*) count, count_rate, count_max
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{DATE_AND_TIME}, @ref{CPU_TIME}
+@end table
+
+
+
+@node TAN
+@section @code{TAN} --- Tangent function
+@fnindex TAN
+@fnindex DTAN
+@cindex trigonometric function, tangent
+@cindex tangent
+
+@table @asis
+@item @emph{Description}:
+@code{TAN(X)} computes the tangent of @var{X}.
+
+@item @emph{Standard}:
+Fortran 77 and later, for a complex argument Fortran 2008 or later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = TAN(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{X}.
+
+@item @emph{Example}:
+@smallexample
+program test_tan
+  real(8) :: x = 0.165_8
+  x = tan(x)
+end program test_tan
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type     @tab Standard
+@item @code{TAN(X)}   @tab @code{REAL(4) X}  @tab @code{REAL(4)}  @tab Fortran 95 and later
+@item @code{DTAN(X)}  @tab @code{REAL(8) X}  @tab @code{REAL(8)}  @tab Fortran 95 and later
+@end multitable
+
+@item @emph{See also}:
+@ref{ATAN}
+@end table
+
+
+
+@node TANH
+@section @code{TANH} --- Hyperbolic tangent function 
+@fnindex TANH
+@fnindex DTANH
+@cindex hyperbolic tangent
+@cindex hyperbolic function, tangent
+@cindex tangent, hyperbolic
+
+@table @asis
+@item @emph{Description}:
+@code{TANH(X)} computes the hyperbolic tangent of @var{X}.
+
+@item @emph{Standard}:
+Fortran 77 and later, for a complex argument Fortran 2008 or later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{X = TANH(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab The type shall be @code{REAL} or @code{COMPLEX}.
+@end multitable
+
+@item @emph{Return value}:
+The return value has same type and kind as @var{X}. If @var{X} is
+complex, the imaginary part of the result is in radians. If @var{X}
+is @code{REAL}, the return value lies in the range
+@math{ - 1 \leq tanh(x) \leq 1 }.
+
+@item @emph{Example}:
+@smallexample
+program test_tanh
+  real(8) :: x = 2.1_8
+  x = tanh(x)
+end program test_tanh
+@end smallexample
+
+@item @emph{Specific names}:
+@multitable @columnfractions .20 .20 .20 .25
+@item Name            @tab Argument          @tab Return type       @tab Standard
+@item @code{TANH(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab Fortran 95 and later
+@item @code{DTANH(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab Fortran 95 and later
+@end multitable
+
+@item @emph{See also}:
+@ref{ATANH}
+@end table
+
+
+
+@node THIS_IMAGE
+@section @code{THIS_IMAGE} --- Function that returns the cosubscript index of this image
+@fnindex THIS_IMAGE
+@cindex coarray, @code{THIS_IMAGE}
+@cindex images, index of this image
+
+@table @asis
+@item @emph{Description}:
+Returns the cosubscript for this image.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{RESULT = THIS_IMAGE()}
+@item @code{RESULT = THIS_IMAGE(COARRAY [, DIM])}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{COARRAY} @tab Coarray of any type  (optional; if @var{DIM}
+present, required).
+@item @var{DIM}     @tab default integer scalar (optional). If present,
+@var{DIM} shall be between one and the corank of @var{COARRAY}.
+@end multitable
+
+
+@item @emph{Return value}:
+Default integer. If @var{COARRAY} is not present, it is scalar and its value
+is the index of the invoking image. Otherwise, if @var{DIM} is not present,
+a rank-1 array with corank elements is returned, containing the cosubscripts
+for @var{COARRAY} specifying the invoking image. If @var{DIM} is present,
+a scalar is returned, with the value of the @var{DIM} element of
+@code{THIS_IMAGE(COARRAY)}.
+
+@item @emph{Example}:
+@smallexample
+INTEGER :: value[*]
+INTEGER :: i
+value = THIS_IMAGE()
+SYNC ALL
+IF (THIS_IMAGE() == 1) THEN
+  DO i = 1, NUM_IMAGES()
+    WRITE(*,'(2(a,i0))') 'value[', i, '] is ', value[i]
+  END DO
+END IF
+@end smallexample
+
+@item @emph{See also}:
+@ref{NUM_IMAGES}, @ref{IMAGE_INDEX}
+@end table
+
+
+
+@node TIME
+@section @code{TIME} --- Time function
+@fnindex TIME
+@cindex time, current
+@cindex current time
+
+@table @asis
+@item @emph{Description}:
+Returns the current time encoded as an integer (in the manner of the
+UNIX function @code{time(3)}). This value is suitable for passing to
+@code{CTIME}, @code{GMTIME}, and @code{LTIME}.
+
+This intrinsic is not fully portable, such as to systems with 32-bit
+@code{INTEGER} types but supporting times wider than 32 bits. Therefore,
+the values returned by this intrinsic might be, or become, negative, or
+numerically less than previous values, during a single run of the
+compiled program.
+
+See @ref{TIME8}, for information on a similar intrinsic that might be
+portable to more GNU Fortran implementations, though to fewer Fortran
+compilers.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = TIME()}
+
+@item @emph{Return value}:
+The return value is a scalar of type @code{INTEGER(4)}.
+
+@item @emph{See also}:
+@ref{CTIME}, @ref{GMTIME}, @ref{LTIME}, @ref{MCLOCK}, @ref{TIME8}
+
+@end table
+
+
+
+@node TIME8
+@section @code{TIME8} --- Time function (64-bit)
+@fnindex TIME8
+@cindex time, current
+@cindex current time
+
+@table @asis
+@item @emph{Description}:
+Returns the current time encoded as an integer (in the manner of the
+UNIX function @code{time(3)}). This value is suitable for passing to
+@code{CTIME}, @code{GMTIME}, and @code{LTIME}.
+
+@emph{Warning:} this intrinsic does not increase the range of the timing
+values over that returned by @code{time(3)}. On a system with a 32-bit
+@code{time(3)}, @code{TIME8} will return a 32-bit value, even though
+it is converted to a 64-bit @code{INTEGER(8)} value. That means
+overflows of the 32-bit value can still occur. Therefore, the values
+returned by this intrinsic might be or become negative or numerically
+less than previous values during a single run of the compiled program.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = TIME8()}
+
+@item @emph{Return value}:
+The return value is a scalar of type @code{INTEGER(8)}.
+
+@item @emph{See also}:
+@ref{CTIME}, @ref{GMTIME}, @ref{LTIME}, @ref{MCLOCK8}, @ref{TIME}
+
+@end table
+
+
+
+@node TINY
+@section @code{TINY} --- Smallest positive number of a real kind
+@fnindex TINY
+@cindex limits, smallest number
+@cindex model representation, smallest number
+
+@table @asis
+@item @emph{Description}:
+@code{TINY(X)} returns the smallest positive (non zero) number
+in the model of the type of @code{X}.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = TINY(X)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{X} @tab Shall be of type @code{REAL}.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of the same type and kind as @var{X}
+
+@item @emph{Example}:
+See @code{HUGE} for an example.
+@end table
+
+
+
+@node TRAILZ
+@section @code{TRAILZ} --- Number of trailing zero bits of an integer
+@fnindex TRAILZ
+@cindex zero bits
+
+@table @asis
+@item @emph{Description}:
+@code{TRAILZ} returns the number of trailing zero bits of an integer.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = TRAILZ(I)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab Shall be of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The type of the return value is the default @code{INTEGER}.
+If all the bits of @code{I} are zero, the result value is @code{BIT_SIZE(I)}.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_trailz
+  WRITE (*,*) TRAILZ(8)  ! prints 3
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{BIT_SIZE}, @ref{LEADZ}, @ref{POPPAR}, @ref{POPCNT}
+@end table
+
+
+
+@node TRANSFER
+@section @code{TRANSFER} --- Transfer bit patterns
+@fnindex TRANSFER
+@cindex bits, move
+@cindex type cast
+
+@table @asis
+@item @emph{Description}:
+Interprets the bitwise representation of @var{SOURCE} in memory as if it
+is the representation of a variable or array of the same type and type
+parameters as @var{MOLD}.
+
+This is approximately equivalent to the C concept of @emph{casting} one
+type to another.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = TRANSFER(SOURCE, MOLD[, SIZE])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{SOURCE} @tab Shall be a scalar or an array of any type.
+@item @var{MOLD}   @tab Shall be a scalar or an array of any type.
+@item @var{SIZE}   @tab (Optional) shall be a scalar of type 
+@code{INTEGER}.
+@end multitable
+
+@item @emph{Return value}:
+The result has the same type as @var{MOLD}, with the bit level
+representation of @var{SOURCE}.  If @var{SIZE} is present, the result is
+a one-dimensional array of length @var{SIZE}.  If @var{SIZE} is absent
+but @var{MOLD} is an array (of any size or shape), the result is a one-
+dimensional array of the minimum length needed to contain the entirety
+of the bitwise representation of @var{SOURCE}.   If @var{SIZE} is absent
+and @var{MOLD} is a scalar, the result is a scalar.
+
+If the bitwise representation of the result is longer than that of
+@var{SOURCE}, then the leading bits of the result correspond to those of
+@var{SOURCE} and any trailing bits are filled arbitrarily.
+
+When the resulting bit representation does not correspond to a valid
+representation of a variable of the same type as @var{MOLD}, the results
+are undefined, and subsequent operations on the result cannot be
+guaranteed to produce sensible behavior.  For example, it is possible to
+create @code{LOGICAL} variables for which @code{@var{VAR}} and
+@code{.NOT.@var{VAR}} both appear to be true.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_transfer
+  integer :: x = 2143289344
+  print *, transfer(x, 1.0)    ! prints "NaN" on i686
+END PROGRAM
+@end smallexample
+@end table
+
+
+
+@node TRANSPOSE
+@section @code{TRANSPOSE} --- Transpose an array of rank two
+@fnindex TRANSPOSE
+@cindex array, transpose
+@cindex matrix, transpose
+@cindex transpose
+
+@table @asis
+@item @emph{Description}:
+Transpose an array of rank two. Element (i, j) of the result has the value 
+@code{MATRIX(j, i)}, for all i, j.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = TRANSPOSE(MATRIX)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{MATRIX} @tab Shall be an array of any type and have a rank of two.
+@end multitable
+
+@item @emph{Return value}:
+The result has the same type as @var{MATRIX}, and has shape 
+@code{(/ m, n /)} if @var{MATRIX} has shape @code{(/ n, m /)}.
+@end table
+
+
+
+@node TRIM
+@section @code{TRIM} --- Remove trailing blank characters of a string
+@fnindex TRIM
+@cindex string, remove trailing whitespace
+
+@table @asis
+@item @emph{Description}:
+Removes trailing blank characters of a string.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = TRIM(STRING)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING} @tab Shall be a scalar of type @code{CHARACTER}.
+@end multitable
+
+@item @emph{Return value}:
+A scalar of type @code{CHARACTER} which length is that of @var{STRING}
+less the number of trailing blanks.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_trim
+  CHARACTER(len=10), PARAMETER :: s = "GFORTRAN  "
+  WRITE(*,*) LEN(s), LEN(TRIM(s))  ! "10 8", with/without trailing blanks
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{ADJUSTL}, @ref{ADJUSTR}
+@end table
+
+
+
+@node TTYNAM
+@section @code{TTYNAM} --- Get the name of a terminal device.
+@fnindex TTYNAM
+@cindex system, terminal
+
+@table @asis
+@item @emph{Description}:
+Get the name of a terminal device. For more information, 
+see @code{ttyname(3)}.
+
+This intrinsic is provided in both subroutine and function forms; 
+however, only one form can be used in any given program unit. 
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL TTYNAM(UNIT, NAME)}
+@item @code{NAME = TTYNAM(UNIT)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{UNIT} @tab Shall be a scalar @code{INTEGER}.
+@item @var{NAME} @tab Shall be of type @code{CHARACTER}.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_ttynam
+  INTEGER :: unit
+  DO unit = 1, 10
+    IF (isatty(unit=unit)) write(*,*) ttynam(unit)
+  END DO
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{ISATTY}
+@end table
+
+
+
+@node UBOUND
+@section @code{UBOUND} --- Upper dimension bounds of an array
+@fnindex UBOUND
+@cindex array, upper bound
+
+@table @asis
+@item @emph{Description}:
+Returns the upper bounds of an array, or a single upper bound
+along the @var{DIM} dimension.
+@item @emph{Standard}:
+Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = UBOUND(ARRAY [, DIM [, KIND]])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an array, of any type.
+@item @var{DIM} @tab (Optional) Shall be a scalar @code{INTEGER}.
+@item @var{KIND}@tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+If @var{DIM} is absent, the result is an array of the upper bounds of
+@var{ARRAY}.  If @var{DIM} is present, the result is a scalar
+corresponding to the upper bound of the array along that dimension.  If
+@var{ARRAY} is an expression rather than a whole array or array
+structure component, or if it has a zero extent along the relevant
+dimension, the upper bound is taken to be the number of elements along
+the relevant dimension.
+
+@item @emph{See also}:
+@ref{LBOUND}, @ref{LCOBOUND}
+@end table
+
+
+
+@node UCOBOUND
+@section @code{UCOBOUND} --- Upper codimension bounds of an array
+@fnindex UCOBOUND
+@cindex coarray, upper bound
+
+@table @asis
+@item @emph{Description}:
+Returns the upper cobounds of a coarray, or a single upper cobound
+along the @var{DIM} codimension.
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Inquiry function
+
+@item @emph{Syntax}:
+@code{RESULT = UCOBOUND(COARRAY [, DIM [, KIND]])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{ARRAY} @tab Shall be an coarray, of any type.
+@item @var{DIM} @tab (Optional) Shall be a scalar @code{INTEGER}.
+@item @var{KIND} @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+If @var{DIM} is absent, the result is an array of the lower cobounds of
+@var{COARRAY}.  If @var{DIM} is present, the result is a scalar
+corresponding to the lower cobound of the array along that codimension.
+
+@item @emph{See also}:
+@ref{LCOBOUND}, @ref{LBOUND}
+@end table
+
+
+
+@node UMASK
+@section @code{UMASK} --- Set the file creation mask
+@fnindex UMASK
+@cindex file system, file creation mask
+
+@table @asis
+@item @emph{Description}:
+Sets the file creation mask to @var{MASK}. If called as a function, it
+returns the old value. If called as a subroutine and argument @var{OLD}
+if it is supplied, it is set to the old value. See @code{umask(2)}.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL UMASK(MASK [, OLD])}
+@item @code{OLD = UMASK(MASK)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{MASK} @tab Shall be a scalar of type @code{INTEGER}.
+@item @var{OLD} @tab (Optional) Shall be a scalar of type
+@code{INTEGER}.
+@end multitable
+
+@end table
+
+
+
+@node UNLINK
+@section @code{UNLINK} --- Remove a file from the file system
+@fnindex UNLINK
+@cindex file system, remove file
+
+@table @asis
+@item @emph{Description}:
+Unlinks the file @var{PATH}. A null character (@code{CHAR(0)}) can be
+used to mark the end of the name in @var{PATH}; otherwise, trailing
+blanks in the file name are ignored.  If the @var{STATUS} argument is
+supplied, it contains 0 on success or a nonzero error code upon return;
+see @code{unlink(2)}.
+
+This intrinsic is provided in both subroutine and function forms;
+however, only one form can be used in any given program unit.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Subroutine, function
+
+@item @emph{Syntax}:
+@multitable @columnfractions .80
+@item @code{CALL UNLINK(PATH [, STATUS])}
+@item @code{STATUS = UNLINK(PATH)}
+@end multitable
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{PATH} @tab Shall be of default @code{CHARACTER} type.
+@item @var{STATUS} @tab (Optional) Shall be of default @code{INTEGER} type.
+@end multitable
+
+@item @emph{See also}:
+@ref{LINK}, @ref{SYMLNK}
+@end table
+
+
+
+@node UNPACK
+@section @code{UNPACK} --- Unpack an array of rank one into an array
+@fnindex UNPACK
+@cindex array, unpacking
+@cindex array, increase dimension
+@cindex array, scatter elements
+
+@table @asis
+@item @emph{Description}:
+Store the elements of @var{VECTOR} in an array of higher rank.
+
+@item @emph{Standard}:
+Fortran 95 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = UNPACK(VECTOR, MASK, FIELD)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{VECTOR} @tab Shall be an array of any type and rank one. It 
+shall have at least as many elements as @var{MASK} has @code{TRUE} values.
+@item @var{MASK}   @tab Shall be an array of type @code{LOGICAL}.
+@item @var{FIELD}  @tab Shall be of the same type as @var{VECTOR} and have
+the same shape as @var{MASK}.
+@end multitable
+
+@item @emph{Return value}:
+The resulting array corresponds to @var{FIELD} with @code{TRUE} elements
+of @var{MASK} replaced by values from @var{VECTOR} in array element order.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_unpack
+  integer :: vector(2)  = (/1,1/)
+  logical :: mask(4)  = (/ .TRUE., .FALSE., .FALSE., .TRUE. /)
+  integer :: field(2,2) = 0, unity(2,2)
+
+  ! result: unity matrix
+  unity = unpack(vector, reshape(mask, (/2,2/)), field)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{PACK}, @ref{SPREAD}
+@end table
+
+
+
+@node VERIFY
+@section @code{VERIFY} --- Scan a string for characters not a given set
+@fnindex VERIFY
+@cindex string, find missing set
+
+@table @asis
+@item @emph{Description}:
+Verifies that all the characters in @var{STRING} belong to the set of
+characters in @var{SET}.
+
+If @var{BACK} is either absent or equals @code{FALSE}, this function
+returns the position of the leftmost character of @var{STRING} that is
+not in @var{SET}. If @var{BACK} equals @code{TRUE}, the rightmost
+position is returned. If all characters of @var{STRING} are found in
+@var{SET}, the result is zero.
+
+@item @emph{Standard}:
+Fortran 95 and later, with @var{KIND} argument Fortran 2003 and later
+
+@item @emph{Class}:
+Elemental function
+
+@item @emph{Syntax}:
+@code{RESULT = VERIFY(STRING, SET[, BACK [, KIND]])}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{STRING} @tab Shall be of type @code{CHARACTER}.
+@item @var{SET}    @tab Shall be of type @code{CHARACTER}.
+@item @var{BACK}   @tab (Optional) shall be of type @code{LOGICAL}.
+@item @var{KIND}   @tab (Optional) An @code{INTEGER} initialization
+expression indicating the kind parameter of the result.
+@end multitable
+
+@item @emph{Return value}:
+The return value is of type @code{INTEGER} and of kind @var{KIND}. If
+@var{KIND} is absent, the return value is of default integer kind.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_verify
+  WRITE(*,*) VERIFY("FORTRAN", "AO")           ! 1, found 'F'
+  WRITE(*,*) VERIFY("FORTRAN", "FOO")          ! 3, found 'R'
+  WRITE(*,*) VERIFY("FORTRAN", "C++")          ! 1, found 'F'
+  WRITE(*,*) VERIFY("FORTRAN", "C++", .TRUE.)  ! 7, found 'N'
+  WRITE(*,*) VERIFY("FORTRAN", "FORTRAN")      ! 0' found none
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+@ref{SCAN}, @ref{INDEX intrinsic}
+@end table
+
+
+
+@node XOR
+@section @code{XOR} --- Bitwise logical exclusive OR
+@fnindex XOR
+@cindex bitwise logical exclusive or
+@cindex logical exclusive or, bitwise
+
+@table @asis
+@item @emph{Description}:
+Bitwise logical exclusive or. 
+
+This intrinsic routine is provided for backwards compatibility with 
+GNU Fortran 77.  For integer arguments, programmers should consider
+the use of the @ref{IEOR} intrinsic and for logical arguments the
+@code{.NEQV.} operator, which are both defined by the Fortran standard.
+
+@item @emph{Standard}:
+GNU extension
+
+@item @emph{Class}:
+Function
+
+@item @emph{Syntax}:
+@code{RESULT = XOR(I, J)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{I} @tab The type shall be either  a scalar @code{INTEGER}
+type or a scalar @code{LOGICAL} type.
+@item @var{J} @tab The type shall be the same as the type of @var{I}.
+@end multitable
+
+@item @emph{Return value}:
+The return type is either a scalar @code{INTEGER} or a scalar
+@code{LOGICAL}.  If the kind type parameters differ, then the
+smaller kind type is implicitly converted to larger kind, and the 
+return has the larger kind.
+
+@item @emph{Example}:
+@smallexample
+PROGRAM test_xor
+  LOGICAL :: T = .TRUE., F = .FALSE.
+  INTEGER :: a, b
+  DATA a / Z'F' /, b / Z'3' /
+
+  WRITE (*,*) XOR(T, T), XOR(T, F), XOR(F, T), XOR(F, F)
+  WRITE (*,*) XOR(a, b)
+END PROGRAM
+@end smallexample
+
+@item @emph{See also}:
+Fortran 95 elemental function: @ref{IEOR}
+@end table
+
+
+
+@node Intrinsic Modules
+@chapter Intrinsic Modules
+@cindex intrinsic Modules
+
+@menu
+* ISO_FORTRAN_ENV::
+* ISO_C_BINDING::
+* OpenMP Modules OMP_LIB and OMP_LIB_KINDS::
+@end menu
+
+@node ISO_FORTRAN_ENV
+@section @code{ISO_FORTRAN_ENV}
+@table @asis
+@item @emph{Standard}:
+Fortran 2003 and later, except when otherwise noted
+@end table
+
+The @code{ISO_FORTRAN_ENV} module provides the following scalar default-integer
+named constants:
+
+@table @asis
+@item @code{ATOMIC_INT_KIND}:
+Default-kind integer constant to be used as kind parameter when defining
+integer variables used in atomic operations. (Fortran 2008 or later.)
+
+@item @code{ATOMIC_LOGICAL_KIND}:
+Default-kind integer constant to be used as kind parameter when defining
+logical variables used in atomic operations. (Fortran 2008 or later.)
+
+@item @code{CHARACTER_KINDS}:
+Default-kind integer constant array of rank one containing the supported kind
+parameters of the @code{CHARACTER} type. (Fortran 2008 or later.)
+
+@item @code{CHARACTER_STORAGE_SIZE}:
+Size in bits of the character storage unit.
+
+@item @code{ERROR_UNIT}:
+Identifies the preconnected unit used for error reporting.
+
+@item @code{FILE_STORAGE_SIZE}:
+Size in bits of the file-storage unit.
+
+@item @code{INPUT_UNIT}:
+Identifies the preconnected unit identified by the asterisk
+(@code{*}) in @code{READ} statement.
+
+@item @code{INT8}, @code{INT16}, @code{INT32}, @code{INT64}:
+Kind type parameters to specify an INTEGER type with a storage
+size of 16, 32, and 64 bits. It is negative if a target platform
+does not support the particular kind. (Fortran 2008 or later.)
+
+@item @code{INTEGER_KINDS}:
+Default-kind integer constant array of rank one containing the supported kind
+parameters of the @code{INTEGER} type. (Fortran 2008 or later.)
+
+@item @code{IOSTAT_END}:
+The value assigned to the variable passed to the @code{IOSTAT=} specifier of
+an input/output statement if an end-of-file condition occurred.
+
+@item @code{IOSTAT_EOR}:
+The value assigned to the variable passed to the @code{IOSTAT=} specifier of
+an input/output statement if an end-of-record condition occurred.
+
+@item @code{IOSTAT_INQUIRE_INTERNAL_UNIT}:
+Scalar default-integer constant, used by @code{INQUIRE} for the
+@code{IOSTAT=} specifier to denote an that a unit number identifies an
+internal unit. (Fortran 2008 or later.)
+
+@item @code{NUMERIC_STORAGE_SIZE}:
+The size in bits of the numeric storage unit.
+
+@item @code{LOGICAL_KINDS}:
+Default-kind integer constant array of rank one containing the supported kind
+parameters of the @code{LOGICAL} type. (Fortran 2008 or later.)
+
+@item @code{OUTPUT_UNIT}:
+Identifies the preconnected unit identified by the asterisk
+(@code{*}) in @code{WRITE} statement.
+
+@item @code{REAL32}, @code{REAL64}, @code{REAL128}:
+Kind type parameters to specify a REAL type with a storage
+size of 32, 64, and 128 bits. It is negative if a target platform
+does not support the particular kind. (Fortran 2008 or later.)
+
+@item @code{REAL_KINDS}:
+Default-kind integer constant array of rank one containing the supported kind
+parameters of the @code{REAL} type. (Fortran 2008 or later.)
+
+@item @code{STAT_LOCKED}:
+Scalar default-integer constant used as STAT= return value by @code{LOCK} to
+denote that the lock variable is locked by the executing image. (Fortran 2008
+or later.)
+
+@item @code{STAT_LOCKED_OTHER_IMAGE}:
+Scalar default-integer constant used as STAT= return value by @code{UNLOCK} to
+denote that the lock variable is locked by another image. (Fortran 2008 or
+later.)
+
+@item @code{STAT_STOPPED_IMAGE}:
+Positive, scalar default-integer constant used as STAT= return value if the
+argument in the statement requires synchronisation with an image, which has
+initiated the termination of the execution. (Fortran 2008 or later.)
+
+@item @code{STAT_UNLOCKED}:
+Scalar default-integer constant used as STAT= return value by @code{UNLOCK} to
+denote that the lock variable is unlocked. (Fortran 2008 or later.)
+@end table
+
+The module also provides the following intrinsic procedures:
+@ref{COMPILER_OPTIONS} and @ref{COMPILER_VERSION}.
+
+
+
+@node ISO_C_BINDING
+@section @code{ISO_C_BINDING}
+@table @asis
+@item @emph{Standard}:
+Fortran 2003 and later, GNU extensions
+@end table
+
+The following intrinsic procedures are provided by the module; their
+definition can be found in the section Intrinsic Procedures of this
+manual.
+
+@table @asis
+@item @code{C_ASSOCIATED}
+@item @code{C_F_POINTER}
+@item @code{C_F_PROCPOINTER}
+@item @code{C_FUNLOC}
+@item @code{C_LOC}
+@item @code{C_SIZEOF}
+@end table
+@c TODO: Vertical spacing between C_FUNLOC and C_LOC wrong in PDF,
+@c don't really know why.
+
+The @code{ISO_C_BINDING} module provides the following named constants of
+type default integer, which can be used as KIND type parameters.
+
+In addition to the integer named constants required by the Fortran 2003 
+standard, GNU Fortran provides as an extension named constants for the 
+128-bit integer types supported by the C compiler: @code{C_INT128_T, 
+C_INT_LEAST128_T, C_INT_FAST128_T}.
+
+@multitable @columnfractions .15 .35 .35 .35
+@item Fortran Type  @tab Named constant         @tab C type                                @tab Extension
+@item @code{INTEGER}@tab @code{C_INT}           @tab @code{int}
+@item @code{INTEGER}@tab @code{C_SHORT}         @tab @code{short int}
+@item @code{INTEGER}@tab @code{C_LONG}          @tab @code{long int}
+@item @code{INTEGER}@tab @code{C_LONG_LONG}     @tab @code{long long int}
+@item @code{INTEGER}@tab @code{C_SIGNED_CHAR}   @tab @code{signed char}/@code{unsigned char}
+@item @code{INTEGER}@tab @code{C_SIZE_T}        @tab @code{size_t}
+@item @code{INTEGER}@tab @code{C_INT8_T}        @tab @code{int8_t}
+@item @code{INTEGER}@tab @code{C_INT16_T}       @tab @code{int16_t}
+@item @code{INTEGER}@tab @code{C_INT32_T}       @tab @code{int32_t}
+@item @code{INTEGER}@tab @code{C_INT64_T}       @tab @code{int64_t}
+@item @code{INTEGER}@tab @code{C_INT128_T}      @tab @code{int128_t}                      @tab Ext.
+@item @code{INTEGER}@tab @code{C_INT_LEAST8_T}  @tab @code{int_least8_t}
+@item @code{INTEGER}@tab @code{C_INT_LEAST16_T} @tab @code{int_least16_t}
+@item @code{INTEGER}@tab @code{C_INT_LEAST32_T} @tab @code{int_least32_t}
+@item @code{INTEGER}@tab @code{C_INT_LEAST64_T} @tab @code{int_least64_t}
+@item @code{INTEGER}@tab @code{C_INT_LEAST128_T}@tab @code{int_least128_t}                @tab Ext.
+@item @code{INTEGER}@tab @code{C_INT_FAST8_T}   @tab @code{int_fast8_t}
+@item @code{INTEGER}@tab @code{C_INT_FAST16_T}  @tab @code{int_fast16_t}
+@item @code{INTEGER}@tab @code{C_INT_FAST32_T}  @tab @code{int_fast32_t}
+@item @code{INTEGER}@tab @code{C_INT_FAST64_T}  @tab @code{int_fast64_t}
+@item @code{INTEGER}@tab @code{C_INT_FAST128_T} @tab @code{int_fast128_t}                 @tab Ext.
+@item @code{INTEGER}@tab @code{C_INTMAX_T}      @tab @code{intmax_t}
+@item @code{INTEGER}@tab @code{C_INTPTR_T}      @tab @code{intptr_t}
+@item @code{REAL}   @tab @code{C_FLOAT}         @tab @code{float}
+@item @code{REAL}   @tab @code{C_DOUBLE}        @tab @code{double}
+@item @code{REAL}   @tab @code{C_LONG_DOUBLE}   @tab @code{long double}
+@item @code{COMPLEX}@tab @code{C_FLOAT_COMPLEX} @tab @code{float _Complex}
+@item @code{COMPLEX}@tab @code{C_DOUBLE_COMPLEX}@tab @code{double _Complex}
+@item @code{COMPLEX}@tab @code{C_LONG_DOUBLE_COMPLEX}@tab @code{long double _Complex}
+@item @code{LOGICAL}@tab @code{C_BOOL}          @tab @code{_Bool}
+@item @code{CHARACTER}@tab @code{C_CHAR}        @tab @code{char}
+@end multitable
+
+Additionally, the following parameters of type @code{CHARACTER(KIND=C_CHAR)}
+are defined.
+
+@multitable @columnfractions .20 .45 .15
+@item Name                     @tab C definition    @tab Value
+@item @code{C_NULL_CHAR}       @tab null character  @tab @code{'\0'}
+@item @code{C_ALERT}           @tab alert           @tab @code{'\a'}
+@item @code{C_BACKSPACE}       @tab backspace       @tab @code{'\b'}
+@item @code{C_FORM_FEED}       @tab form feed       @tab @code{'\f'}
+@item @code{C_NEW_LINE}        @tab new line        @tab @code{'\n'}
+@item @code{C_CARRIAGE_RETURN} @tab carriage return @tab @code{'\r'}
+@item @code{C_HORIZONTAL_TAB}  @tab horizontal tab  @tab @code{'\t'}
+@item @code{C_VERTICAL_TAB}    @tab vertical tab    @tab @code{'\v'}
+@end multitable
+
+Moreover, the following two named constants are defined:
+
+@multitable @columnfractions .20 .80
+@item Name                 @tab Type
+@item @code{C_NULL_PTR}    @tab @code{C_PTR}
+@item @code{C_NULL_FUNPTR} @tab @code{C_FUNPTR}
+@end multitable
+
+Both are equivalent to the value @code{NULL} in C.
+
+@node OpenMP Modules OMP_LIB and OMP_LIB_KINDS
+@section OpenMP Modules @code{OMP_LIB} and @code{OMP_LIB_KINDS}
+@table @asis
+@item @emph{Standard}:
+OpenMP Application Program Interface v3.0
+@end table
+
+
+The OpenMP Fortran runtime library routines are provided both in
+a form of two Fortran 90 modules, named @code{OMP_LIB} and 
+@code{OMP_LIB_KINDS}, and in a form of a Fortran @code{include} file named
+@file{omp_lib.h}. The procedures provided by @code{OMP_LIB} can be found
+in the @ref{Top,,Introduction,libgomp,GNU OpenMP runtime library} manual,
+the named constants defined in the modules are listed
+below.
+
+For details refer to the actual
+@uref{http://www.openmp.org/mp-documents/spec30.pdf,
+OpenMP Application Program Interface v3.0}.
+
+@code{OMP_LIB_KINDS} provides the following scalar default-integer
+named constants:
+
+@table @asis
+@item @code{omp_integer_kind}
+@item @code{omp_logical_kind}
+@item @code{omp_lock_kind}
+@item @code{omp_nest_lock_kind}
+@item @code{omp_sched_kind}
+@end table
+
+@code{OMP_LIB} provides the scalar default-integer
+named constant @code{openmp_version} with a value of the form
+@var{yyyymm}, where @code{yyyy} is the year and @var{mm} the month
+of the OpenMP version; for OpenMP v3.0 the value is @code{200805}.
+
+And the following scalar integer named constants of the
+kind @code{omp_sched_kind}:
+
+@table @asis
+@item @code{omp_sched_static}
+@item @code{omp_sched_dynamic}
+@item @code{omp_sched_guided}
+@item @code{omp_sched_auto}
+@end table
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
new file mode 100644
index 000000000..9b5396234
--- /dev/null
+++ b/gcc/fortran/invoke.texi
@@ -0,0 +1,1512 @@
+@c Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+@c Free Software Foundation, Inc.
+@c This is part of the GNU Fortran manual.   
+@c For copying conditions, see the file gfortran.texi.
+
+@ignore
+@c man begin COPYRIGHT
+Copyright @copyright{} 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+Free Software Foundation, Inc.
+
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with the
+Invariant Sections being ``Funding Free Software'', the Front-Cover
+Texts being (a) (see below), and with the Back-Cover Texts being (b)
+(see below).  A copy of the license is included in the gfdl(7) man page.
+
+(a) The FSF's Front-Cover Text is:
+
+     A GNU Manual
+
+(b) The FSF's Back-Cover Text is:
+
+     You have freedom to copy and modify this GNU Manual, like GNU
+     software.  Copies published by the Free Software Foundation raise
+     funds for GNU development.
+@c man end
+@c Set file name and title for the man page.
+@setfilename gfortran
+@settitle GNU Fortran compiler.
+@c man begin SYNOPSIS
+gfortran [@option{-c}|@option{-S}|@option{-E}]
+         [@option{-g}] [@option{-pg}] [@option{-O}@var{level}]
+         [@option{-W}@var{warn}@dots{}] [@option{-pedantic}]
+         [@option{-I}@var{dir}@dots{}] [@option{-L}@var{dir}@dots{}]
+         [@option{-D}@var{macro}[=@var{defn}]@dots{}] [@option{-U}@var{macro}]
+         [@option{-f}@var{option}@dots{}]
+         [@option{-m}@var{machine-option}@dots{}]
+         [@option{-o} @var{outfile}] @var{infile}@dots{}
+
+Only the most useful options are listed here; see below for the
+remainder.
+@c man end
+@c man begin SEEALSO
+gpl(7), gfdl(7), fsf-funding(7),
+cpp(1), gcov(1), gcc(1), as(1), ld(1), gdb(1), adb(1), dbx(1), sdb(1)
+and the Info entries for @file{gcc}, @file{cpp}, @file{gfortran}, @file{as},
+@file{ld}, @file{binutils} and @file{gdb}.
+@c man end
+@c man begin BUGS
+For instructions on reporting bugs, see
+@w{@value{BUGURL}}.
+@c man end
+@c man begin AUTHOR
+See the Info entry for @command{gfortran} for contributors to GCC and
+GNU Fortran.
+@c man end
+@end ignore
+
+@node Invoking GNU Fortran
+@chapter GNU Fortran Command Options
+@cindex GNU Fortran command options
+@cindex command options
+@cindex options, @command{gfortran} command
+
+@c man begin DESCRIPTION
+
+The @command{gfortran} command supports all the options supported by the
+@command{gcc} command.  Only options specific to GNU Fortran are documented here.
+
+@xref{Invoking GCC,,GCC Command Options,gcc,Using the GNU Compiler
+Collection (GCC)}, for information
+on the non-Fortran-specific aspects of the @command{gcc} command (and,
+therefore, the @command{gfortran} command).
+
+@cindex options, negative forms
+All GCC and GNU Fortran options
+are accepted both by @command{gfortran} and by @command{gcc}
+(as well as any other drivers built at the same time,
+such as @command{g++}),
+since adding GNU Fortran to the GCC distribution
+enables acceptance of GNU Fortran options
+by all of the relevant drivers.
+
+In some cases, options have positive and negative forms;
+the negative form of @option{-ffoo} would be @option{-fno-foo}.
+This manual documents only one of these two forms, whichever
+one is not the default.
+@c man end
+
+@menu
+* Option Summary::      Brief list of all @command{gfortran} options,
+                        without explanations.
+* Fortran Dialect Options::  Controlling the variant of Fortran language
+                             compiled.
+* Preprocessing Options::  Enable and customize preprocessing.
+* Error and Warning Options::     How picky should the compiler be?
+* Debugging Options::   Symbol tables, measurements, and debugging dumps.
+* Directory Options::   Where to find module files
+* Link Options ::       Influencing the linking step
+* Runtime Options::     Influencing runtime behavior
+* Code Gen Options::    Specifying conventions for function calls, data layout
+                        and register usage.
+* Environment Variables:: Environment variables that affect @command{gfortran}.
+@end menu
+
+@node Option Summary
+@section Option summary
+
+@c man begin OPTIONS
+
+Here is a summary of all the options specific to GNU Fortran, grouped
+by type.  Explanations are in the following sections.
+
+@table @emph
+@item Fortran Language Options
+@xref{Fortran Dialect Options,,Options controlling Fortran dialect}.
+@gccoptlist{-fall-intrinsics  -ffree-form  -fno-fixed-form @gol
+-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
+-ffree-line-length-@var{n}  -ffree-line-length-none @gol
+-fdefault-double-8  -fdefault-integer-8  -fdefault-real-8 @gol
+-fcray-pointer  -fopenmp  -fno-range-check -fbackslash -fmodule-private}
+
+@item Preprocessing Options
+@xref{Preprocessing Options,,Enable and customize preprocessing}.
+@gccoptlist{-cpp -dD -dI -dM -dN -dU -fworking-directory @gol
+-imultilib @var{dir} -iprefix @var{file} -isysroot @var{dir} @gol
+-iquote -isystem @var{dir} -nocpp -nostdinc -undef @gol
+-A@var{question}=@var{answer} -A-@var{question}@r{[}=@var{answer}@r{]} @gol
+-C -CC -D@var{macro}@r{[}=@var{defn}@r{]} -U@var{macro} -H -P}
+
+@item Error and Warning Options
+@xref{Error and Warning Options,,Options to request or suppress errors
+and warnings}.
+@gccoptlist{-fmax-errors=@var{n} @gol
+-fsyntax-only  -pedantic  -pedantic-errors @gol
+-Wall  -Waliasing  -Wampersand  -Warray-bounds -Wcharacter-truncation @gol
+-Wconversion -Wimplicit-interface  -Wimplicit-procedure  -Wline-truncation @gol
+-Wintrinsics-std  -Wsurprising  -Wno-tabs  -Wunderflow  -Wunused-parameter @gol
+-Wintrinsic-shadow  -Wno-align-commons}
+
+@item Debugging Options
+@xref{Debugging Options,,Options for debugging your program or GNU Fortran}.
+@gccoptlist{-fdump-fortran-original  -fdump-fortran-optimized @gol
+-ffpe-trap=@var{list}  -fdump-core -fbacktrace -fdump-parse-tree}
+
+@item Directory Options
+@xref{Directory Options,,Options for directory search}.
+@gccoptlist{-I@var{dir}  -J@var{dir} -fintrinsic-modules-path @var{dir}}
+
+@item Link Options
+@xref{Link Options,,Options for influencing the linking step}.
+@gccoptlist{-static-libgfortran}
+
+@item Runtime Options
+@xref{Runtime Options,,Options for influencing runtime behavior}.
+@gccoptlist{-fconvert=@var{conversion}  -fno-range-check
+-frecord-marker=@var{length} @gol  -fmax-subrecord-length=@var{length}
+-fsign-zero}
+
+@item Code Generation Options
+@xref{Code Gen Options,,Options for code generation conventions}.
+@gccoptlist{-fno-automatic  -ff2c  -fno-underscoring @gol
+-fno-whole-file -fsecond-underscore @gol
+-fbounds-check -fcheck-array-temporaries  -fmax-array-constructor =@var{n} @gol
+-fcheck=@var{<all|array-temps|bounds|do|mem|pointer|recursion>} @gol
+-fcoarray=@var{<none|single>} -fmax-stack-var-size=@var{n} @gol
+-fpack-derived  -frepack-arrays  -fshort-enums  -fexternal-blas @gol
+-fblas-matmul-limit=@var{n} -frecursive -finit-local-zero @gol
+-finit-integer=@var{n} -finit-real=@var{<zero|inf|-inf|nan|snan>} @gol
+-finit-logical=@var{<true|false>} -finit-character=@var{n} @gol
+-fno-align-commons -fno-protect-parens -frealloc-lhs}
+@end table
+
+@menu
+* Fortran Dialect Options::  Controlling the variant of Fortran language
+                             compiled.
+* Preprocessing Options::  Enable and customize preprocessing.
+* Error and Warning Options::     How picky should the compiler be?
+* Debugging Options::   Symbol tables, measurements, and debugging dumps.
+* Directory Options::   Where to find module files
+* Link Options ::       Influencing the linking step
+* Runtime Options::     Influencing runtime behavior
+* Code Gen Options::    Specifying conventions for function calls, data layout
+                        and register usage.
+@end menu
+
+@node Fortran Dialect Options
+@section Options controlling Fortran dialect
+@cindex dialect options
+@cindex language, dialect options
+@cindex options, dialect
+
+The following options control the details of the Fortran dialect
+accepted by the compiler:
+
+@table @gcctabopt
+@item -ffree-form
+@itemx -ffixed-form
+@opindex @code{ffree-form}
+@opindex @code{fno-fixed-form}
+@cindex options, fortran dialect
+@cindex file format, free
+@cindex file format, fixed
+Specify the layout used by the source file.  The free form layout
+was introduced in Fortran 90.  Fixed form was traditionally used in
+older Fortran programs.  When neither option is specified, the source
+form is determined by the file extension.
+
+@item -fall-intrinsics
+@opindex @code{fall-intrinsics}
+This option causes all intrinsic procedures (including the GNU-specific
+extensions) to be accepted.  This can be useful with @option{-std=f95} to
+force standard-compliance but get access to the full range of intrinsics
+available with @command{gfortran}.  As a consequence, @option{-Wintrinsics-std}
+will be ignored and no user-defined procedure with the same name as any
+intrinsic will be called except when it is explicitly declared @code{EXTERNAL}.
+
+@item -fd-lines-as-code
+@itemx -fd-lines-as-comments
+@opindex @code{fd-lines-as-code}
+@opindex @code{fd-lines-as-comments}
+Enable special treatment for lines beginning with @code{d} or @code{D}
+in fixed form sources.  If the @option{-fd-lines-as-code} option is
+given they are treated as if the first column contained a blank.  If the
+@option{-fd-lines-as-comments} option is given, they are treated as
+comment lines.
+
+@item -fdefault-double-8
+@opindex @code{fdefault-double-8}
+Set the @code{DOUBLE PRECISION} type to an 8 byte wide type.  If
+@option{-fdefault-real-8} is given, @code{DOUBLE PRECISION} would
+instead be promoted to 16 bytes if possible, and @option{-fdefault-double-8}
+can be used to prevent this.  The kind of real constants like @code{1.d0} will
+not be changed by @option{-fdefault-real-8} though, so also
+@option{-fdefault-double-8} does not affect it.
+
+@item -fdefault-integer-8
+@opindex @code{fdefault-integer-8}
+Set the default integer and logical types to an 8 byte wide type.
+Do nothing if this is already the default.  This option also affects
+the kind of integer constants like @code{42}.
+
+@item -fdefault-real-8
+@opindex @code{fdefault-real-8}
+Set the default real type to an 8 byte wide type.
+Do nothing if this is already the default.  This option also affects
+the kind of non-double real constants like @code{1.0}, and does promote
+the default width of @code{DOUBLE PRECISION} to 16 bytes if possible, unless
+@code{-fdefault-double-8} is given, too.
+
+@item -fdollar-ok
+@opindex @code{fdollar-ok}
+@cindex @code{$}
+@cindex symbol names
+@cindex character set
+Allow @samp{$} as a valid non-first character in a symbol name. Symbols 
+that start with @samp{$} are rejected since it is unclear which rules to
+apply to implicit typing as different vendors implement different rules.
+Using @samp{$} in @code{IMPLICIT} statements is also rejected.
+
+@item -fbackslash
+@opindex @code{backslash}
+@cindex backslash
+@cindex escape characters
+Change the interpretation of backslashes in string literals from a single
+backslash character to ``C-style'' escape characters. The following
+combinations are expanded @code{\a}, @code{\b}, @code{\f}, @code{\n},
+@code{\r}, @code{\t}, @code{\v}, @code{\\}, and @code{\0} to the ASCII
+characters alert, backspace, form feed, newline, carriage return,
+horizontal tab, vertical tab, backslash, and NUL, respectively.
+Additionally, @code{\x}@var{nn}, @code{\u}@var{nnnn} and
+@code{\U}@var{nnnnnnnn} (where each @var{n} is a hexadecimal digit) are
+translated into the Unicode characters corresponding to the specified code
+points. All other combinations of a character preceded by \ are
+unexpanded.
+
+@item -fmodule-private
+@opindex @code{fmodule-private}
+@cindex module entities
+@cindex private
+Set the default accessibility of module entities to @code{PRIVATE}.
+Use-associated entities will not be accessible unless they are explicitly
+declared as @code{PUBLIC}.
+
+@item -ffixed-line-length-@var{n}
+@opindex @code{ffixed-line-length-}@var{n}
+@cindex file format, fixed
+Set column after which characters are ignored in typical fixed-form
+lines in the source file, and through which spaces are assumed (as
+if padded to that length) after the ends of short fixed-form lines.
+
+Popular values for @var{n} include 72 (the
+standard and the default), 80 (card image), and 132 (corresponding
+to ``extended-source'' options in some popular compilers).
+@var{n} may also be @samp{none}, meaning that the entire line is meaningful
+and that continued character constants never have implicit spaces appended
+to them to fill out the line.
+@option{-ffixed-line-length-0} means the same thing as
+@option{-ffixed-line-length-none}.
+
+@item -ffree-line-length-@var{n}
+@opindex @code{ffree-line-length-}@var{n}
+@cindex file format, free
+Set column after which characters are ignored in typical free-form
+lines in the source file. The default value is 132.
+@var{n} may be @samp{none}, meaning that the entire line is meaningful.
+@option{-ffree-line-length-0} means the same thing as
+@option{-ffree-line-length-none}.
+
+@item -fmax-identifier-length=@var{n}
+@opindex @code{fmax-identifier-length=}@var{n}
+Specify the maximum allowed identifier length. Typical values are
+31 (Fortran 95) and 63 (Fortran 2003 and Fortran 2008).
+
+@item -fimplicit-none
+@opindex @code{fimplicit-none}
+Specify that no implicit typing is allowed, unless overridden by explicit
+@code{IMPLICIT} statements.  This is the equivalent of adding
+@code{implicit none} to the start of every procedure.
+
+@item -fcray-pointer
+@opindex @code{fcray-pointer}
+Enable the Cray pointer extension, which provides C-like pointer
+functionality.
+
+@item -fopenmp
+@opindex @code{fopenmp}
+@cindex OpenMP
+Enable the OpenMP extensions.  This includes OpenMP @code{!$omp} directives
+in free form
+and @code{c$omp}, @code{*$omp} and @code{!$omp} directives in fixed form,
+@code{!$} conditional compilation sentinels in free form
+and @code{c$}, @code{*$} and @code{!$} sentinels in fixed form, 
+and when linking arranges for the OpenMP runtime library to be linked
+in.  The option @option{-fopenmp} implies @option{-frecursive}.
+
+@item -fno-range-check
+@opindex @code{frange-check}
+Disable range checking on results of simplification of constant
+expressions during compilation.  For example, GNU Fortran will give
+an error at compile time when simplifying @code{a = 1. / 0}.
+With this option, no error will be given and @code{a} will be assigned
+the value @code{+Infinity}.  If an expression evaluates to a value
+outside of the relevant range of [@code{-HUGE()}:@code{HUGE()}],
+then the expression will be replaced by @code{-Inf} or @code{+Inf}
+as appropriate.
+Similarly, @code{DATA i/Z'FFFFFFFF'/} will result in an integer overflow
+on most systems, but with @option{-fno-range-check} the value will
+``wrap around'' and @code{i} will be initialized to @math{-1} instead.
+
+@item -std=@var{std}
+@opindex @code{std=}@var{std} option
+Specify the standard to which the program is expected to conform, which
+may be one of @samp{f95}, @samp{f2003}, @samp{f2008}, @samp{gnu}, or
+@samp{legacy}.  The default value for @var{std} is @samp{gnu}, which
+specifies a superset of the Fortran 95 standard that includes all of the
+extensions supported by GNU Fortran, although warnings will be given for
+obsolete extensions not recommended for use in new code.  The
+@samp{legacy} value is equivalent but without the warnings for obsolete
+extensions, and may be useful for old non-standard programs.  The
+@samp{f95}, @samp{f2003} and @samp{f2008} values specify strict
+conformance to the Fortran 95, Fortran 2003 and Fortran 2008 standards,
+respectively; errors are given for all extensions beyond the relevant
+language standard, and warnings are given for the Fortran 77 features
+that are permitted but obsolescent in later standards.
+
+@end table
+
+@node Preprocessing Options
+@section Enable and customize preprocessing
+@cindex preprocessor
+@cindex options, preprocessor
+@cindex CPP
+
+Preprocessor related options. See section 
+@ref{Preprocessing and conditional compilation} for more detailed
+information on preprocessing in @command{gfortran}.
+
+@table @gcctabopt
+@item -cpp
+@itemx -nocpp
+@opindex @code{cpp}
+@opindex @code{fpp}
+@cindex preprocessor, enable
+@cindex preprocessor, disable
+Enable preprocessing. The preprocessor is automatically invoked if
+the file extension is @file{.fpp}, @file{.FPP},  @file{.F}, @file{.FOR},
+@file{.FTN}, @file{.F90}, @file{.F95}, @file{.F03} or @file{.F08}. Use
+this option to manually enable preprocessing of any kind of Fortran file.
+
+To disable preprocessing of files with any of the above listed extensions,
+use the negative form: @option{-nocpp}.
+
+The preprocessor is run in traditional mode. Any restrictions of the
+file-format, especially the limits on line length, apply for
+preprocessed output as well, so it might be advisable to use the
+@option{-ffree-line-length-none} or @option{-ffixed-line-length-none}
+options.
+
+@item -dM
+@opindex @code{dM}
+@cindex preprocessor, debugging
+@cindex debugging, preprocessor
+Instead of the normal output, generate a list of @code{'#define'}
+directives for all the macros defined during the execution of the
+preprocessor, including predefined macros. This gives you a way
+of finding out what is predefined in your version of the preprocessor.
+Assuming you have no file @file{foo.f90}, the command
+@smallexample
+  touch foo.f90; gfortran -cpp -E -dM foo.f90
+@end smallexample
+will show all the predefined macros.
+
+@item -dD
+@opindex @code{dD}
+@cindex preprocessor, debugging
+@cindex debugging, preprocessor
+Like @option{-dM} except in two respects: it does not include the
+predefined macros, and it outputs both the @code{#define} directives
+and the result of preprocessing. Both kinds of output go to the
+standard output file.
+
+@item -dN
+@opindex @code{dN}
+@cindex preprocessor, debugging
+@cindex debugging, preprocessor
+Like @option{-dD}, but emit only the macro names, not their expansions.
+
+@item -dU
+@opindex @code{dU}
+@cindex preprocessor, debugging
+@cindex debugging, preprocessor
+Like @option{dD} except that only macros that are expanded, or whose
+definedness is tested in preprocessor directives, are output; the 
+output is delayed until the use or test of the macro; and @code{'#undef'}
+directives are also output for macros tested but undefined at the time.
+
+@item -dI
+@opindex @code{dI}
+@cindex preprocessor, debugging
+@cindex debugging, preprocessor
+Output @code{'#include'} directives in addition to the result
+of preprocessing.
+
+@item -fworking-directory
+@opindex @code{fworking-directory}
+@cindex preprocessor, working directory
+Enable generation of linemarkers in the preprocessor output that will
+let the compiler know the current working directory at the time of
+preprocessing. When this option is enabled, the preprocessor will emit,
+after the initial linemarker, a second linemarker with the current
+working directory followed by two slashes. GCC will use this directory,
+when it's present in the preprocessed input, as the directory emitted
+as the current working directory in some debugging information formats.
+This option is implicitly enabled if debugging information is enabled,
+but this can be inhibited with the negated form
+@option{-fno-working-directory}. If the @option{-P} flag is present
+in the command line, this option has no effect, since no @code{#line}
+directives are emitted whatsoever.
+
+@item -idirafter @var{dir}
+@opindex @code{idirafter @var{dir}}
+@cindex preprocessing, include path
+Search @var{dir} for include files, but do it after all directories
+specified with @option{-I} and the standard system directories have
+been exhausted. @var{dir} is treated as a system include directory.
+If dir begins with @code{=}, then the @code{=} will be replaced by
+the sysroot prefix; see @option{--sysroot} and @option{-isysroot}.
+
+@item -imultilib @var{dir}
+@opindex @code{imultilib @var{dir}}
+@cindex preprocessing, include path
+Use @var{dir} as a subdirectory of the directory containing target-specific
+C++ headers.
+
+@item -iprefix @var{prefix}
+@opindex @code{iprefix @var{prefix}}
+@cindex preprocessing, include path
+Specify @var{prefix} as the prefix for subsequent @option{-iwithprefix}
+options. If the @var{prefix} represents a directory, you should include
+the final @code{'/'}.
+
+@item -isysroot @var{dir}
+@opindex @code{isysroot @var{dir}}
+@cindex preprocessing, include path
+This option is like the @option{--sysroot} option, but applies only to
+header files. See the @option{--sysroot} option for more information.
+
+@item -iquote @var{dir}
+@opindex @code{iquote @var{dir}}
+@cindex preprocessing, include path
+Search @var{dir} only for header files requested with @code{#include "file"};
+they are not searched for @code{#include <file>}, before all directories
+specified by @option{-I} and before the standard system directories. If
+@var{dir} begins with @code{=}, then the @code{=} will be replaced by the
+sysroot prefix; see @option{--sysroot} and @option{-isysroot}.
+
+@item -isystem @var{dir}
+@opindex @code{isystem @var{dir}}
+@cindex preprocessing, include path
+Search @var{dir} for header files, after all directories specified by
+@option{-I} but before the standard system directories. Mark it as a
+system directory, so that it gets the same special treatment as is
+applied to the standard system directories. If @var{dir} begins with
+@code{=}, then the @code{=} will be replaced by the sysroot prefix;
+see @option{--sysroot} and @option{-isysroot}.
+
+@item -nostdinc
+@opindex @code{nostdinc}
+Do not search the standard system directories for header files. Only
+the directories you have specified with @option{-I} options (and the
+directory of the current file, if appropriate) are searched.
+
+@item -undef
+@opindex @code{undef}
+Do not predefine any system-specific or GCC-specific macros.
+The standard predefined macros remain defined.
+
+@item -A@var{predicate}=@var{answer}
+@opindex @code{A@var{predicate}=@var{answer}}
+@cindex preprocessing, assertion
+Make an assertion with the predicate @var{predicate} and answer @var{answer}.
+This form is preferred to the older form -A predicate(answer), which is still
+supported, because it does not use shell special characters.
+
+@item -A-@var{predicate}=@var{answer}
+@opindex @code{A-@var{predicate}=@var{answer}}
+@cindex preprocessing, assertion
+Cancel an assertion with the predicate @var{predicate} and answer @var{answer}.
+
+@item -C
+@opindex @code{C}
+@cindex preprocessing, keep comments
+Do not discard comments. All comments are passed through to the output
+file, except for comments in processed directives, which are deleted
+along with the directive.
+
+You should be prepared for side effects when using @option{-C}; it causes
+the preprocessor to treat comments as tokens in their own right. For example,
+comments appearing at the start of what would be a directive line have the
+effect of turning that line into an ordinary source line, since the first
+token on the line is no longer a @code{'#'}.
+
+Warning: this currently handles C-Style comments only. The preprocessor
+does not yet recognize Fortran-style comments.
+
+@item -CC
+@opindex @code{CC}
+@cindex preprocessing, keep comments
+Do not discard comments, including during macro expansion. This is like
+@option{-C}, except that comments contained within macros are also passed
+through to the output file where the macro is expanded.
+
+In addition to the side-effects of the @option{-C} option, the @option{-CC}
+option causes all C++-style comments inside a macro to be converted to C-style
+comments. This is to prevent later use of that macro from inadvertently
+commenting out the remainder of the source line. The @option{-CC} option
+is generally used to support lint comments.
+
+Warning: this currently handles C- and C++-Style comments only. The
+preprocessor does not yet recognize Fortran-style comments.
+
+@item -D@var{name}
+@opindex @code{D@var{name}}
+@cindex preprocessing, define macros
+Predefine name as a macro, with definition @code{1}.
+
+@item -D@var{name}=@var{definition}
+@opindex @code{D@var{name}=@var{definition}}
+@cindex preprocessing, define macros
+The contents of @var{definition} are tokenized and processed as if they
+appeared during translation phase three in a @code{'#define'} directive.
+In particular, the definition will be truncated by embedded newline
+characters.
+
+If you are invoking the preprocessor from a shell or shell-like program
+you may need to use the shell's quoting syntax to protect characters such
+as spaces that have a meaning in the shell syntax.
+
+If you wish to define a function-like macro on the command line, write
+its argument list with surrounding parentheses before the equals sign
+(if any). Parentheses are meaningful to most shells, so you will need
+to quote the option. With sh and csh, @code{-D'name(args...)=definition'}
+works.
+
+@option{-D} and @option{-U} options are processed in the order they are
+given on the command line. All -imacros file and -include file options
+are processed after all -D and -U options.
+
+@item -H
+@opindex @code{H}
+Print the name of each header file used, in addition to other normal
+activities. Each name is indented to show how deep in the @code{'#include'}
+stack it is.
+
+@item -P
+@opindex @code{P}
+@cindex preprocessing, no linemarkers
+Inhibit generation of linemarkers in the output from the preprocessor.
+This might be useful when running the preprocessor on something that
+is not C code, and will be sent to a program which might be confused
+by the linemarkers.
+
+@item -U@var{name}
+@opindex @code{U@var{name}}
+@cindex preprocessing, undefine macros
+Cancel any previous definition of @var{name}, either built in or provided
+with a @option{-D} option.
+@end table
+
+
+@node Error and Warning Options
+@section Options to request or suppress errors and warnings
+@cindex options, warnings
+@cindex options, errors
+@cindex warnings, suppressing
+@cindex messages, error
+@cindex messages, warning
+@cindex suppressing warnings
+
+Errors are diagnostic messages that report that the GNU Fortran compiler
+cannot compile the relevant piece of source code.  The compiler will
+continue to process the program in an attempt to report further errors
+to aid in debugging, but will not produce any compiled output.  
+
+Warnings are diagnostic messages that report constructions which
+are not inherently erroneous but which are risky or suggest there is
+likely to be a bug in the program.  Unless @option{-Werror} is specified,
+they do not prevent compilation of the program.
+
+You can request many specific warnings with options beginning @option{-W},
+for example @option{-Wimplicit} to request warnings on implicit
+declarations.  Each of these specific warning options also has a
+negative form beginning @option{-Wno-} to turn off warnings;
+for example, @option{-Wno-implicit}.  This manual lists only one of the
+two forms, whichever is not the default.
+
+These options control the amount and kinds of errors and warnings produced
+by GNU Fortran:
+
+@table @gcctabopt
+@item -fmax-errors=@var{n}
+@opindex @code{fmax-errors=}@var{n}
+@cindex errors, limiting
+Limits the maximum number of error messages to @var{n}, at which point
+GNU Fortran bails out rather than attempting to continue processing the
+source code.  If @var{n} is 0, there is no limit on the number of error
+messages produced.
+
+@item -fsyntax-only
+@opindex @code{fsyntax-only}
+@cindex syntax checking
+Check the code for syntax errors, but don't actually compile it.  This
+will generate module files for each module present in the code, but no
+other output file.
+
+@item -pedantic
+@opindex @code{pedantic}
+Issue warnings for uses of extensions to Fortran 95.
+@option{-pedantic} also applies to C-language constructs where they
+occur in GNU Fortran source files, such as use of @samp{\e} in a
+character constant within a directive like @code{#include}.
+
+Valid Fortran 95 programs should compile properly with or without
+this option.
+However, without this option, certain GNU extensions and traditional
+Fortran features are supported as well.
+With this option, many of them are rejected.
+
+Some users try to use @option{-pedantic} to check programs for conformance.
+They soon find that it does not do quite what they want---it finds some
+nonstandard practices, but not all.
+However, improvements to GNU Fortran in this area are welcome.
+
+This should be used in conjunction with @option{-std=f95},
+@option{-std=f2003} or @option{-std=f2008}.
+
+@item -pedantic-errors
+@opindex @code{pedantic-errors}
+Like @option{-pedantic}, except that errors are produced rather than
+warnings.
+
+@item -Wall
+@opindex @code{Wall}
+@cindex all warnings
+@cindex warnings, all
+Enables commonly used warning options pertaining to usage that
+we recommend avoiding and that we believe are easy to avoid.
+This currently includes @option{-Waliasing}, @option{-Wampersand}, 
+@option{-Wconversion}, @option{-Wsurprising}, @option{-Wintrinsics-std},
+@option{-Wno-tabs}, @option{-Wintrinsic-shadow}, @option{-Wline-truncation},
+@option{-Wreal-q-constant} and @option{-Wunused}.
+
+@item -Waliasing
+@opindex @code{Waliasing}
+@cindex aliasing
+@cindex warnings, aliasing
+Warn about possible aliasing of dummy arguments. Specifically, it warns
+if the same actual argument is associated with a dummy argument with
+@code{INTENT(IN)} and a dummy argument with @code{INTENT(OUT)} in a call
+with an explicit interface.
+
+The following example will trigger the warning.
+@smallexample
+  interface
+    subroutine bar(a,b)
+      integer, intent(in) :: a
+      integer, intent(out) :: b
+    end subroutine
+  end interface
+  integer :: a
+
+  call bar(a,a)
+@end smallexample
+
+@item -Wampersand
+@opindex @code{Wampersand}
+@cindex warnings, ampersand
+@cindex @code{&}
+Warn about missing ampersand in continued character constants. The warning is
+given with @option{-Wampersand}, @option{-pedantic}, @option{-std=f95},
+@option{-std=f2003} and @option{-std=f2008}. Note: With no ampersand
+given in a continued character constant, GNU Fortran assumes continuation
+at the first non-comment, non-whitespace character after the ampersand
+that initiated the continuation.
+
+@item -Warray-temporaries
+@opindex @code{Warray-temporaries}
+@cindex warnings, array temporaries
+Warn about array temporaries generated by the compiler.  The information
+generated by this warning is sometimes useful in optimization, in order to
+avoid such temporaries.
+
+@item -Wcharacter-truncation
+@opindex @code{Wcharacter-truncation}
+@cindex warnings, character truncation
+Warn when a character assignment will truncate the assigned string.
+
+@item -Wline-truncation
+@opindex @code{Wline-truncation}
+@cindex warnings, line truncation
+Warn when a source code line will be truncated.
+
+@item -Wconversion
+@opindex @code{Wconversion}
+@cindex warnings, conversion
+@cindex conversion
+Warn about implicit conversions that are likely to change the value of 
+the expression after conversion. Implied by @option{-Wall}.
+
+@item -Wconversion-extra
+@opindex @code{Wconversion-extra}
+@cindex warnings, conversion
+@cindex conversion
+Warn about implicit conversions between different types and kinds.
+
+@item -Wimplicit-interface
+@opindex @code{Wimplicit-interface}
+@cindex warnings, implicit interface
+Warn if a procedure is called without an explicit interface.
+Note this only checks that an explicit interface is present.  It does not
+check that the declared interfaces are consistent across program units.
+
+@item -Wimplicit-procedure
+@opindex @code{Wimplicit-procedure}
+@cindex warnings, implicit procedure
+Warn if a procedure is called that has neither an explicit interface
+nor has been declared as @code{EXTERNAL}.
+
+@item -Wintrinsics-std
+@opindex @code{Wintrinsics-std}
+@cindex warnings, non-standard intrinsics
+@cindex warnings, intrinsics of other standards
+Warn if @command{gfortran} finds a procedure named like an intrinsic not
+available in the currently selected standard (with @option{-std}) and treats
+it as @code{EXTERNAL} procedure because of this.  @option{-fall-intrinsics} can
+be used to never trigger this behavior and always link to the intrinsic
+regardless of the selected standard.
+
+@item -Wreal-q-constant
+@opindex @code{Wreal-q-constant}
+@cindex warnings, @code{q} exponent-letter
+Produce a warning if a real-literal-constant contains a @code{q}
+exponent-letter.
+
+@item -Wsurprising
+@opindex @code{Wsurprising}
+@cindex warnings, suspicious code
+Produce a warning when ``suspicious'' code constructs are encountered.
+While technically legal these usually indicate that an error has been made.
+
+This currently produces a warning under the following circumstances:
+
+@itemize @bullet
+@item
+An INTEGER SELECT construct has a CASE that can never be matched as its
+lower value is greater than its upper value.
+
+@item
+A LOGICAL SELECT construct has three CASE statements.
+
+@item
+A TRANSFER specifies a source that is shorter than the destination.
+
+@item
+The type of a function result is declared more than once with the same type.  If
+@option{-pedantic} or standard-conforming mode is enabled, this is an error.
+
+@item
+A @code{CHARACTER} variable is declared with negative length.
+@end itemize
+
+@item -Wtabs
+@opindex @code{Wtabs}
+@cindex warnings, tabs
+@cindex tabulators
+By default, tabs are accepted as whitespace, but tabs are not members
+of the Fortran Character Set.  For continuation lines, a tab followed
+by a digit between 1 and 9 is supported.  @option{-Wno-tabs} will cause
+a warning to be issued if a tab is encountered. Note, @option{-Wno-tabs}
+is active for @option{-pedantic}, @option{-std=f95}, @option{-std=f2003},
+@option{-std=f2008} and @option{-Wall}.
+
+@item -Wunderflow
+@opindex @code{Wunderflow}
+@cindex warnings, underflow
+@cindex underflow
+Produce a warning when numerical constant expressions are
+encountered, which yield an UNDERFLOW during compilation.
+
+@item -Wintrinsic-shadow
+@opindex @code{Wintrinsic-shadow}
+@cindex warnings, intrinsic
+@cindex intrinsic
+Warn if a user-defined procedure or module procedure has the same name as an
+intrinsic; in this case, an explicit interface or @code{EXTERNAL} or
+@code{INTRINSIC} declaration might be needed to get calls later resolved to
+the desired intrinsic/procedure.
+
+@item -Wunused-dummy-argument
+@opindex @code{Wunused-dummy-argument}
+@cindex warnings, unused dummy argument
+@cindex unused dummy argument
+@cindex dummy argument, unused
+Warn about unused dummy arguments. This option is implied by @option{-Wall}.
+
+@item -Wunused-parameter
+@opindex @code{Wunused-parameter}
+@cindex warnings, unused parameter
+@cindex unused parameter
+Contrary to @command{gcc}'s meaning of @option{-Wunused-parameter},
+@command{gfortran}'s implementation of this option does not warn
+about unused dummy arguments (see @option{-Wunused-dummy-argument}),
+but about unused @code{PARAMETER} values. @option{-Wunused-parameter}
+is not included in @option{-Wall} but is implied by @option{-Wall -Wextra}.
+
+@item -Walign-commons
+@opindex @code{Walign-commons}
+@cindex warnings, alignment of @code{COMMON} blocks
+@cindex alignment of @code{COMMON} blocks
+By default, @command{gfortran} warns about any occasion of variables being
+padded for proper alignment inside a @code{COMMON} block. This warning can be turned
+off via @option{-Wno-align-commons}. See also @option{-falign-commons}.
+
+@item -Werror
+@opindex @code{Werror}
+@cindex warnings, to errors
+Turns all warnings into errors.
+@end table
+
+@xref{Warning Options,,Options to Request or Suppress Errors and
+Warnings, gcc,Using the GNU Compiler Collection (GCC)}, for information on
+more options offered by the GBE shared by @command{gfortran}, @command{gcc}
+and other GNU compilers.
+
+Some of these have no effect when compiling programs written in Fortran.
+
+@node Debugging Options
+@section Options for debugging your program or GNU Fortran
+@cindex options, debugging
+@cindex debugging information options
+
+GNU Fortran has various special options that are used for debugging
+either your program or the GNU Fortran compiler.
+
+@table @gcctabopt
+@item -fdump-fortran-original
+@opindex @code{fdump-fortran-original}
+Output the internal parse tree after translating the source program
+into internal representation.  Only really useful for debugging the
+GNU Fortran compiler itself.
+
+@item -fdump-optimized-tree
+@opindex @code{fdump-fortran-optimized}
+Output the parse tree after front-end optimization.  Only really
+useful for debugging the GNU Fortran compiler itself.
+
+@opindex @code{fdump-parse-tree}
+Output the internal parse tree after translating the source program
+into internal representation.  Only really useful for debugging the
+GNU Fortran compiler itself.  This option is deprecated; use
+@code{-fdump-fortran-original} instead.
+
+@item -ffpe-trap=@var{list}
+@opindex @code{ffpe-trap=}@var{list}
+Specify a list of IEEE exceptions when a Floating Point Exception
+(FPE) should be raised.  On most systems, this will result in a SIGFPE
+signal being sent and the program being interrupted, producing a core
+file useful for debugging.  @var{list} is a (possibly empty) comma-separated
+list of the following IEEE exceptions: @samp{invalid} (invalid floating
+point operation, such as @code{SQRT(-1.0)}), @samp{zero} (division by
+zero), @samp{overflow} (overflow in a floating point operation),
+@samp{underflow} (underflow in a floating point operation),
+@samp{precision} (loss of precision during operation) and @samp{denormal}
+(operation produced a denormal value).
+
+Some of the routines in the Fortran runtime library, like
+@samp{CPU_TIME}, are likely to trigger floating point exceptions when
+@code{ffpe-trap=precision} is used. For this reason, the use of 
+@code{ffpe-trap=precision} is not recommended.
+
+@item -fbacktrace
+@opindex @code{fbacktrace}
+@cindex backtrace
+@cindex trace
+Specify that, when a runtime error is encountered or a deadly signal is
+emitted (segmentation fault, illegal instruction, bus error or
+floating-point exception), the Fortran runtime
+library should output a backtrace of the error.  This option
+only has influence for compilation of the Fortran main program.
+
+@item -fdump-core
+@cindex core, dump
+@opindex @code{fdump-core}
+Request that a core-dump file is written to disk when a runtime error
+is encountered on systems that support core dumps. This option is
+only effective for the compilation of the Fortran main program.
+@end table
+
+@xref{Debugging Options,,Options for Debugging Your Program or GCC,
+gcc,Using the GNU Compiler Collection (GCC)}, for more information on
+debugging options.
+
+@node Directory Options
+@section Options for directory search
+@cindex directory, options
+@cindex options, directory search
+@cindex search path
+@cindex @code{INCLUDE} directive
+@cindex directive, @code{INCLUDE}
+These options affect how GNU Fortran searches
+for files specified by the @code{INCLUDE} directive and where it searches
+for previously compiled modules.
+
+It also affects the search paths used by @command{cpp} when used to preprocess
+Fortran source.
+
+@table @gcctabopt
+@item -I@var{dir}
+@opindex @code{I}@var{dir}
+@cindex directory, search paths for inclusion
+@cindex inclusion, directory search paths for
+@cindex search paths, for included files
+@cindex paths, search
+@cindex module search path
+These affect interpretation of the @code{INCLUDE} directive
+(as well as of the @code{#include} directive of the @command{cpp}
+preprocessor).
+
+Also note that the general behavior of @option{-I} and
+@code{INCLUDE} is pretty much the same as of @option{-I} with
+@code{#include} in the @command{cpp} preprocessor, with regard to
+looking for @file{header.gcc} files and other such things.
+
+This path is also used to search for @file{.mod} files when previously
+compiled modules are required by a @code{USE} statement.
+
+@xref{Directory Options,,Options for Directory Search,
+gcc,Using the GNU Compiler Collection (GCC)}, for information on the
+@option{-I} option.
+
+@item -J@var{dir}
+@opindex @code{J}@var{dir}
+@opindex @code{M}@var{dir}
+@cindex paths, search
+@cindex module search path
+This option specifies where to put @file{.mod} files for compiled modules.
+It is also added to the list of directories to searched by an @code{USE}
+statement.
+
+The default is the current directory.
+
+@item -fintrinsic-modules-path @var{dir}
+@opindex @code{fintrinsic-modules-path} @var{dir}
+@cindex paths, search
+@cindex module search path
+This option specifies the location of pre-compiled intrinsic modules, if
+they are not in the default location expected by the compiler.
+@end table
+
+@node Link Options
+@section Influencing the linking step
+@cindex options, linking
+@cindex linking, static
+
+These options come into play when the compiler links object files into an 
+executable output file. They are meaningless if the compiler is not doing 
+a link step.
+
+@table @gcctabopt
+@item -static-libgfortran
+@opindex @code{static-libgfortran}
+On systems that provide @file{libgfortran} as a shared and a static
+library, this option forces the use of the static version. If no
+shared version of @file{libgfortran} was built when the compiler was
+configured, this option has no effect.
+@end table
+
+
+@node Runtime Options
+@section Influencing runtime behavior
+@cindex options, runtime
+
+These options affect the runtime behavior of programs compiled with GNU Fortran.
+
+@table @gcctabopt
+@item -fconvert=@var{conversion}
+@opindex @code{fconvert=}@var{conversion}
+Specify the representation of data for unformatted files.  Valid
+values for conversion are: @samp{native}, the default; @samp{swap},
+swap between big- and little-endian; @samp{big-endian}, use big-endian
+representation for unformatted files; @samp{little-endian}, use little-endian
+representation for unformatted files.
+
+@emph{This option has an effect only when used in the main program.
+The @code{CONVERT} specifier and the GFORTRAN_CONVERT_UNIT environment
+variable override the default specified by @option{-fconvert}.}
+
+
+@item -fno-range-check
+@opindex @code{fno-range-check}
+Disable range checking of input values during integer @code{READ} operations.
+For example, GNU Fortran will give an error if an input value is
+outside of the relevant range of [@code{-HUGE()}:@code{HUGE()}]. In other words,
+with @code{INTEGER (kind=4) :: i} , attempting to read @math{-2147483648} will
+give an error unless @option{-fno-range-check} is given. 
+
+
+@item -frecord-marker=@var{length}
+@opindex @code{frecord-marker=}@var{length}
+Specify the length of record markers for unformatted files.
+Valid values for @var{length} are 4 and 8.  Default is 4.
+@emph{This is different from previous versions of @command{gfortran}},
+which specified a default record marker length of 8 on most
+systems.  If you want to read or write files compatible
+with earlier versions of @command{gfortran}, use @option{-frecord-marker=8}.
+
+@item -fmax-subrecord-length=@var{length}
+@opindex @code{fmax-subrecord-length=}@var{length}
+Specify the maximum length for a subrecord.  The maximum permitted
+value for length is 2147483639, which is also the default.  Only
+really useful for use by the gfortran testsuite.
+
+@item -fsign-zero
+@opindex @code{fsign-zero}
+When enabled, floating point numbers of value zero with the sign bit set
+are written as negative number in formatted output and treated as
+negative in the @code{SIGN} intrinsic.  @code{fno-sign-zero} does not
+print the negative sign of zero values and regards zero as positive
+number in the @code{SIGN} intrinsic for compatibility with F77.
+Default behavior is to show the negative sign.
+@end table
+
+@node Code Gen Options
+@section Options for code generation conventions
+@cindex code generation, conventions
+@cindex options, code generation
+@cindex options, run-time
+
+These machine-independent options control the interface conventions
+used in code generation.
+
+Most of them have both positive and negative forms; the negative form
+of @option{-ffoo} would be @option{-fno-foo}.  In the table below, only
+one of the forms is listed---the one which is not the default.  You
+can figure out the other form by either removing @option{no-} or adding
+it.
+
+@table @gcctabopt
+@item -fno-automatic
+@opindex @code{fno-automatic}
+@cindex @code{SAVE} statement
+@cindex statement, @code{SAVE}
+Treat each program unit (except those marked as RECURSIVE) as if the
+@code{SAVE} statement were specified for every local variable and array
+referenced in it. Does not affect common blocks. (Some Fortran compilers
+provide this option under the name @option{-static} or @option{-save}.)
+The default, which is @option{-fautomatic}, uses the stack for local
+variables smaller than the value given by @option{-fmax-stack-var-size}.
+Use the option @option{-frecursive} to use no static memory. 
+
+@item -ff2c
+@opindex ff2c
+@cindex calling convention
+@cindex @command{f2c} calling convention
+@cindex @command{g77} calling convention
+@cindex libf2c calling convention
+Generate code designed to be compatible with code generated
+by @command{g77} and @command{f2c}.
+
+The calling conventions used by @command{g77} (originally implemented
+in @command{f2c}) require functions that return type
+default @code{REAL} to actually return the C type @code{double}, and
+functions that return type @code{COMPLEX} to return the values via an
+extra argument in the calling sequence that points to where to
+store the return value.  Under the default GNU calling conventions, such
+functions simply return their results as they would in GNU
+C---default @code{REAL} functions return the C type @code{float}, and
+@code{COMPLEX} functions return the GNU C type @code{complex}.
+Additionally, this option implies the @option{-fsecond-underscore}
+option, unless @option{-fno-second-underscore} is explicitly requested.
+
+This does not affect the generation of code that interfaces with
+the @command{libgfortran} library.
+
+@emph{Caution:} It is not a good idea to mix Fortran code compiled with
+@option{-ff2c} with code compiled with the default @option{-fno-f2c}
+calling conventions as, calling @code{COMPLEX} or default @code{REAL}
+functions between program parts which were compiled with different
+calling conventions will break at execution time.
+
+@emph{Caution:} This will break code which passes intrinsic functions
+of type default @code{REAL} or @code{COMPLEX} as actual arguments, as
+the library implementations use the @option{-fno-f2c} calling conventions.
+
+@item -fno-underscoring
+@opindex @code{fno-underscoring}
+@cindex underscore
+@cindex symbol names, underscores
+@cindex transforming symbol names
+@cindex symbol names, transforming
+Do not transform names of entities specified in the Fortran
+source file by appending underscores to them.
+
+With @option{-funderscoring} in effect, GNU Fortran appends one
+underscore to external names with no underscores.  This is done to ensure
+compatibility with code produced by many UNIX Fortran compilers.
+
+@emph{Caution}: The default behavior of GNU Fortran is
+incompatible with @command{f2c} and @command{g77}, please use the
+@option{-ff2c} option if you want object files compiled with
+GNU Fortran to be compatible with object code created with these
+tools.
+
+Use of @option{-fno-underscoring} is not recommended unless you are
+experimenting with issues such as integration of GNU Fortran into
+existing system environments (vis-@`{a}-vis existing libraries, tools,
+and so on).
+
+For example, with @option{-funderscoring}, and assuming other defaults like
+@option{-fcase-lower} and that @code{j()} and @code{max_count()} are
+external functions while @code{my_var} and @code{lvar} are local variables,
+a statement like
+@smallexample
+I = J() + MAX_COUNT (MY_VAR, LVAR)
+@end smallexample
+@noindent
+is implemented as something akin to:
+@smallexample
+i = j_() + max_count__(&my_var__, &lvar);
+@end smallexample
+
+With @option{-fno-underscoring}, the same statement is implemented as:
+
+@smallexample
+i = j() + max_count(&my_var, &lvar);
+@end smallexample
+
+Use of @option{-fno-underscoring} allows direct specification of
+user-defined names while debugging and when interfacing GNU Fortran
+code with other languages.
+
+Note that just because the names match does @emph{not} mean that the
+interface implemented by GNU Fortran for an external name matches the
+interface implemented by some other language for that same name.
+That is, getting code produced by GNU Fortran to link to code produced
+by some other compiler using this or any other method can be only a
+small part of the overall solution---getting the code generated by
+both compilers to agree on issues other than naming can require
+significant effort, and, unlike naming disagreements, linkers normally
+cannot detect disagreements in these other areas.
+
+Also, note that with @option{-fno-underscoring}, the lack of appended
+underscores introduces the very real possibility that a user-defined
+external name will conflict with a name in a system library, which
+could make finding unresolved-reference bugs quite difficult in some
+cases---they might occur at program run time, and show up only as
+buggy behavior at run time.
+
+In future versions of GNU Fortran we hope to improve naming and linking
+issues so that debugging always involves using the names as they appear
+in the source, even if the names as seen by the linker are mangled to
+prevent accidental linking between procedures with incompatible
+interfaces.
+
+@item -fno-whole-file
+@opindex @code{fno-whole-file}
+This flag causes the compiler to resolve and translate each procedure in
+a file separately. 
+
+By default, the whole file is parsed and placed in a single front-end tree.
+During resolution, in addition to all the usual checks and fixups, references
+to external procedures that are in the same file effect resolution of
+that procedure, if not already done, and a check of the interfaces.  The
+dependences are resolved by changing the order in which the file is
+translated into the backend tree.  Thus, a procedure that is referenced
+is translated before the reference and the duplication of backend tree
+declarations eliminated.
+
+The @option{-fno-whole-file} option is deprecated and may lead to wrong code.
+
+@item -fsecond-underscore
+@opindex @code{fsecond-underscore}
+@cindex underscore
+@cindex symbol names, underscores
+@cindex transforming symbol names
+@cindex symbol names, transforming
+@cindex @command{f2c} calling convention
+@cindex @command{g77} calling convention
+@cindex libf2c calling convention
+By default, GNU Fortran appends an underscore to external
+names.  If this option is used GNU Fortran appends two
+underscores to names with underscores and one underscore to external names
+with no underscores.  GNU Fortran also appends two underscores to
+internal names with underscores to avoid naming collisions with external
+names.
+
+This option has no effect if @option{-fno-underscoring} is
+in effect.  It is implied by the @option{-ff2c} option.
+
+Otherwise, with this option, an external name such as @code{MAX_COUNT}
+is implemented as a reference to the link-time external symbol
+@code{max_count__}, instead of @code{max_count_}.  This is required
+for compatibility with @command{g77} and @command{f2c}, and is implied
+by use of the @option{-ff2c} option.
+
+@item -fcoarray=@var{<keyword>}
+@opindex @code{fcoarray}
+@cindex coarrays
+
+@table @asis
+@item @samp{none}
+Disable coarray support; using coarray declarations and image-control
+statements will produce a compile-time error. (Default)
+
+@item @samp{single}
+Single-image mode, i.e. @code{num_images()} is always one.
+@end table
+
+
+@item -fcheck=@var{<keyword>}
+@opindex @code{fcheck}
+@cindex array, bounds checking
+@cindex bounds checking
+@cindex pointer checking
+@cindex memory checking
+@cindex range checking
+@cindex subscript checking
+@cindex checking subscripts
+@cindex run-time checking
+@cindex checking array temporaries
+
+Enable the generation of run-time checks; the argument shall be
+a comma-delimited list of the following keywords.
+
+@table @asis
+@item @samp{all}
+Enable all run-time test of @option{-fcheck}.
+
+@item @samp{array-temps}
+Warns at run time when for passing an actual argument a temporary array
+had to be generated. The information generated by this warning is
+sometimes useful in optimization, in order to avoid such temporaries.
+
+Note: The warning is only printed once per location.
+
+@item @samp{bounds}
+Enable generation of run-time checks for array subscripts
+and against the declared minimum and maximum values.  It also
+checks array indices for assumed and deferred
+shape arrays against the actual allocated bounds and ensures that all string
+lengths are equal for character array constructors without an explicit
+typespec.
+
+Some checks require that @option{-fcheck=bounds} is set for
+the compilation of the main program.
+
+Note: In the future this may also include other forms of checking, e.g.,
+checking substring references.
+
+@item @samp{do}
+Enable generation of run-time checks for invalid modification of loop
+iteration variables.
+
+@item @samp{mem}
+Enable generation of run-time checks for memory allocation.
+Note: This option does not affect explicit allocations using the
+@code{ALLOCATE} statement, which will be always checked.
+
+@item @samp{pointer}
+Enable generation of run-time checks for pointers and allocatables.
+
+@item @samp{recursion}
+Enable generation of run-time checks for recursively called subroutines and
+functions which are not marked as recursive. See also @option{-frecursive}.
+Note: This check does not work for OpenMP programs and is disabled if used
+together with @option{-frecursive} and @option{-fopenmp}.
+@end table
+
+
+@item -fbounds-check
+@opindex @code{fbounds-check}
+@c Note: This option is also referred in gcc's manpage
+Deprecated alias for @option{-fcheck=bounds}.
+
+@item -fcheck-array-temporaries
+@opindex @code{fcheck-array-temporaries}
+Deprecated alias for @option{-fcheck=array-temps}.
+
+@item -fmax-array-constructor=@var{n}
+@opindex @code{fmax-array-constructor}
+This option can be used to increase the upper limit permitted in 
+array constructors.  The code below requires this option to expand
+the array at compile time.
+
+@smallexample
+program test
+implicit none
+integer j
+integer, parameter :: n = 100000
+integer, parameter :: i(n) = (/ (2*j, j = 1, n) /)
+print '(10(I0,1X))', i
+end program test
+@end smallexample
+
+@emph{Caution:  This option can lead to long compile times and excessively
+large object files.}
+
+The default value for @var{n} is 65535.
+
+
+@item -fmax-stack-var-size=@var{n}
+@opindex @code{fmax-stack-var-size}
+This option specifies the size in bytes of the largest array that will be put
+on the stack; if the size is exceeded static memory is used (except in
+procedures marked as RECURSIVE). Use the option @option{-frecursive} to
+allow for recursive procedures which do not have a RECURSIVE attribute or
+for parallel programs. Use @option{-fno-automatic} to never use the stack.
+
+This option currently only affects local arrays declared with constant
+bounds, and may not apply to all character variables.
+Future versions of GNU Fortran may improve this behavior.
+
+The default value for @var{n} is 32768.
+
+@item -fpack-derived
+@opindex @code{fpack-derived}
+@cindex structure packing
+This option tells GNU Fortran to pack derived type members as closely as
+possible.  Code compiled with this option is likely to be incompatible
+with code compiled without this option, and may execute slower.
+
+@item -frepack-arrays
+@opindex @code{frepack-arrays}
+@cindex repacking arrays
+In some circumstances GNU Fortran may pass assumed shape array
+sections via a descriptor describing a noncontiguous area of memory.
+This option adds code to the function prologue to repack the data into
+a contiguous block at runtime.
+
+This should result in faster accesses to the array.  However it can introduce
+significant overhead to the function call, especially  when the passed data
+is noncontiguous.
+
+@item -fshort-enums
+@opindex @code{fshort-enums}
+This option is provided for interoperability with C code that was
+compiled with the @option{-fshort-enums} option.  It will make
+GNU Fortran choose the smallest @code{INTEGER} kind a given
+enumerator set will fit in, and give all its enumerators this kind.
+
+@item -fexternal-blas
+@opindex @code{fexternal-blas}
+This option will make @command{gfortran} generate calls to BLAS functions
+for some matrix operations like @code{MATMUL}, instead of using our own
+algorithms, if the size of the matrices involved is larger than a given
+limit (see @option{-fblas-matmul-limit}).  This may be profitable if an
+optimized vendor BLAS library is available.  The BLAS library will have
+to be specified at link time.
+
+@item -fblas-matmul-limit=@var{n}
+@opindex @code{fblas-matmul-limit}
+Only significant when @option{-fexternal-blas} is in effect.
+Matrix multiplication of matrices with size larger than (or equal to) @var{n}
+will be performed by calls to BLAS functions, while others will be
+handled by @command{gfortran} internal algorithms. If the matrices
+involved are not square, the size comparison is performed using the
+geometric mean of the dimensions of the argument and result matrices.
+
+The default value for @var{n} is 30.
+
+@item -frecursive
+@opindex @code{frecursive}
+Allow indirect recursion by forcing all local arrays to be allocated
+on the stack. This flag cannot be used together with
+@option{-fmax-stack-var-size=} or @option{-fno-automatic}.
+
+@item -finit-local-zero
+@itemx -finit-integer=@var{n}
+@itemx -finit-real=@var{<zero|inf|-inf|nan|snan>}
+@itemx -finit-logical=@var{<true|false>}
+@itemx -finit-character=@var{n}
+@opindex @code{finit-local-zero}
+@opindex @code{finit-integer}
+@opindex @code{finit-real}
+@opindex @code{finit-logical}
+@opindex @code{finit-character}
+The @option{-finit-local-zero} option instructs the compiler to
+initialize local @code{INTEGER}, @code{REAL}, and @code{COMPLEX}
+variables to zero, @code{LOGICAL} variables to false, and
+@code{CHARACTER} variables to a string of null bytes.  Finer-grained
+initialization options are provided by the
+@option{-finit-integer=@var{n}},
+@option{-finit-real=@var{<zero|inf|-inf|nan|snan>}} (which also initializes
+the real and imaginary parts of local @code{COMPLEX} variables),
+@option{-finit-logical=@var{<true|false>}}, and
+@option{-finit-character=@var{n}} (where @var{n} is an ASCII character
+value) options.  These options do not initialize
+@itemize @bullet
+@item
+allocatable arrays
+@item
+components of derived type variables
+@item
+variables that appear in an @code{EQUIVALENCE} statement.
+@end itemize
+(These limitations may be removed in future releases).
+
+Note that the @option{-finit-real=nan} option initializes @code{REAL}
+and @code{COMPLEX} variables with a quiet NaN. For a signalling NaN
+use @option{-finit-real=snan}; note, however, that compile-time
+optimizations may convert them into quiet NaN and that trapping
+needs to be enabled (e.g. via @option{-ffpe-trap}).
+
+@item -falign-commons
+@opindex @code{falign-commons}
+@cindex alignment of @code{COMMON} blocks
+By default, @command{gfortran} enforces proper alignment of all variables in a
+@code{COMMON} block by padding them as needed. On certain platforms this is mandatory,
+on others it increases performance. If a @code{COMMON} block is not declared with
+consistent data types everywhere, this padding can cause trouble, and
+@option{-fno-align-commons} can be used to disable automatic alignment. The
+same form of this option should be used for all files that share a @code{COMMON} block.
+To avoid potential alignment issues in @code{COMMON} blocks, it is recommended to order
+objects from largest to smallest.
+
+@item -fno-protect-parens
+@opindex @code{fno-protect-parens}
+@cindex re-association of parenthesized expressions
+By default the parentheses in expression are honored for all optimization
+levels such that the compiler does not do any re-association. Using
+@option{-fno-protect-parens} allows the compiler to reorder @code{REAL} and
+@code{COMPLEX} expressions to produce faster code. Note that for the re-association
+optimization @option{-fno-signed-zeros} and @option{-fno-trapping-math}
+need to be in effect.
+
+@item -frealloc-lhs
+@opindex @code{frealloc-lhs}
+@cindex Reallocate the LHS in assignments
+An allocatable left-hand side of an intrinsic assignment is automatically
+(re)allocated if it is either unallocated or has a different shape. The
+option is enabled by default except when @option{-std=f95} is given.
+@end table
+
+@xref{Code Gen Options,,Options for Code Generation Conventions,
+gcc,Using the GNU Compiler Collection (GCC)}, for information on more options
+offered by the GBE
+shared by @command{gfortran}, @command{gcc}, and other GNU compilers.
+
+
+@c man end
+
+@node Environment Variables
+@section Environment variables affecting @command{gfortran}
+@cindex environment variable
+
+@c man begin ENVIRONMENT
+
+The @command{gfortran} compiler currently does not make use of any environment
+variables to control its operation above and beyond those
+that affect the operation of @command{gcc}.
+
+@xref{Environment Variables,,Environment Variables Affecting GCC,
+gcc,Using the GNU Compiler Collection (GCC)}, for information on environment
+variables.
+
+@xref{Runtime}, for environment variables that affect the
+run-time behavior of programs compiled with GNU Fortran.
+@c man end
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
new file mode 100644
index 000000000..b0f3ebe4a
--- /dev/null
+++ b/gcc/fortran/io.c
@@ -0,0 +1,4181 @@
+/* Deal with I/O statements & related stuff.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2009, 2010, 2011
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "match.h"
+#include "parse.h"
+
+gfc_st_label
+format_asterisk = {0, NULL, NULL, -1, ST_LABEL_FORMAT, ST_LABEL_FORMAT, NULL,
+		   0, {NULL, NULL}};
+
+typedef struct
+{
+  const char *name, *spec, *value;
+  bt type;
+}
+io_tag;
+
+static const io_tag
+	tag_file	= {"FILE", " file =", " %e", BT_CHARACTER },
+	tag_status	= {"STATUS", " status =", " %e", BT_CHARACTER},
+	tag_e_access	= {"ACCESS", " access =", " %e", BT_CHARACTER},
+	tag_e_form	= {"FORM", " form =", " %e", BT_CHARACTER},
+	tag_e_recl	= {"RECL", " recl =", " %e", BT_INTEGER},
+	tag_e_blank	= {"BLANK", " blank =", " %e", BT_CHARACTER},
+	tag_e_position	= {"POSITION", " position =", " %e", BT_CHARACTER},
+	tag_e_action	= {"ACTION", " action =", " %e", BT_CHARACTER},
+	tag_e_delim	= {"DELIM", " delim =", " %e", BT_CHARACTER},
+	tag_e_pad	= {"PAD", " pad =", " %e", BT_CHARACTER},
+	tag_e_decimal	= {"DECIMAL", " decimal =", " %e", BT_CHARACTER},
+	tag_e_encoding	= {"ENCODING", " encoding =", " %e", BT_CHARACTER},
+	tag_e_async	= {"ASYNCHRONOUS", " asynchronous =", " %e", BT_CHARACTER},
+	tag_e_round	= {"ROUND", " round =", " %e", BT_CHARACTER},
+	tag_e_sign	= {"SIGN", " sign =", " %e", BT_CHARACTER},
+	tag_unit	= {"UNIT", " unit =", " %e", BT_INTEGER},
+	tag_advance	= {"ADVANCE", " advance =", " %e", BT_CHARACTER},
+	tag_rec		= {"REC", " rec =", " %e", BT_INTEGER},
+	tag_spos	= {"POSITION", " pos =", " %e", BT_INTEGER},
+	tag_format	= {"FORMAT", NULL, NULL, BT_CHARACTER},
+	tag_iomsg	= {"IOMSG", " iomsg =", " %e", BT_CHARACTER},
+	tag_iostat	= {"IOSTAT", " iostat =", " %v", BT_INTEGER},
+	tag_size	= {"SIZE", " size =", " %v", BT_INTEGER},
+	tag_exist	= {"EXIST", " exist =", " %v", BT_LOGICAL},
+	tag_opened	= {"OPENED", " opened =", " %v", BT_LOGICAL},
+	tag_named	= {"NAMED", " named =", " %v", BT_LOGICAL},
+	tag_name	= {"NAME", " name =", " %v", BT_CHARACTER},
+	tag_number	= {"NUMBER", " number =", " %v", BT_INTEGER},
+	tag_s_access	= {"ACCESS", " access =", " %v", BT_CHARACTER},
+	tag_sequential	= {"SEQUENTIAL", " sequential =", " %v", BT_CHARACTER},
+	tag_direct	= {"DIRECT", " direct =", " %v", BT_CHARACTER},
+	tag_s_form	= {"FORM", " form =", " %v", BT_CHARACTER},
+	tag_formatted	= {"FORMATTED", " formatted =", " %v", BT_CHARACTER},
+	tag_unformatted	= {"UNFORMATTED", " unformatted =", " %v", BT_CHARACTER},
+	tag_s_recl	= {"RECL", " recl =", " %v", BT_INTEGER},
+	tag_nextrec	= {"NEXTREC", " nextrec =", " %v", BT_INTEGER},
+	tag_s_blank	= {"BLANK", " blank =", " %v", BT_CHARACTER},
+	tag_s_position	= {"POSITION", " position =", " %v", BT_CHARACTER},
+	tag_s_action	= {"ACTION", " action =", " %v", BT_CHARACTER},
+	tag_read	= {"READ", " read =", " %v", BT_CHARACTER},
+	tag_write	= {"WRITE", " write =", " %v", BT_CHARACTER},
+	tag_readwrite	= {"READWRITE", " readwrite =", " %v", BT_CHARACTER},
+	tag_s_delim	= {"DELIM", " delim =", " %v", BT_CHARACTER},
+	tag_s_pad	= {"PAD", " pad =", " %v", BT_CHARACTER},
+	tag_s_decimal	= {"DECIMAL", " decimal =", " %v", BT_CHARACTER},
+	tag_s_encoding	= {"ENCODING", " encoding =", " %v", BT_CHARACTER},
+	tag_s_async	= {"ASYNCHRONOUS", " asynchronous =", " %v", BT_CHARACTER},
+	tag_s_round	= {"ROUND", " round =", " %v", BT_CHARACTER},
+	tag_s_sign	= {"SIGN", " sign =", " %v", BT_CHARACTER},
+	tag_iolength	= {"IOLENGTH", " iolength =", " %v", BT_INTEGER},
+	tag_convert     = {"CONVERT", " convert =", " %e", BT_CHARACTER},
+	tag_strm_out    = {"POS", " pos =", " %v", BT_INTEGER},
+	tag_err		= {"ERR", " err =", " %l", BT_UNKNOWN},
+	tag_end		= {"END", " end =", " %l", BT_UNKNOWN},
+	tag_eor		= {"EOR", " eor =", " %l", BT_UNKNOWN},
+	tag_id		= {"ID", " id =", " %v", BT_INTEGER},
+	tag_pending	= {"PENDING", " pending =", " %v", BT_LOGICAL},
+	tag_newunit	= {"NEWUNIT", " newunit =", " %v", BT_INTEGER};
+
+static gfc_dt *current_dt;
+
+#define RESOLVE_TAG(x, y) if (resolve_tag(x, y) == FAILURE) return FAILURE;
+
+
+/**************** Fortran 95 FORMAT parser  *****************/
+
+/* FORMAT tokens returned by format_lex().  */
+typedef enum
+{
+  FMT_NONE, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
+  FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_LPAREN,
+  FMT_RPAREN, FMT_X, FMT_SIGN, FMT_BLANK, FMT_CHAR, FMT_P, FMT_IBOZ, FMT_F,
+  FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END,
+  FMT_ERROR, FMT_DC, FMT_DP, FMT_T, FMT_TR, FMT_TL, FMT_STAR, FMT_RC,
+  FMT_RD, FMT_RN, FMT_RP, FMT_RU, FMT_RZ
+}
+format_token;
+
+/* Local variables for checking format strings.  The saved_token is
+   used to back up by a single format token during the parsing
+   process.  */
+static gfc_char_t *format_string;
+static int format_string_pos;
+static int format_length, use_last_char;
+static char error_element;
+static locus format_locus;
+
+static format_token saved_token;
+
+static enum
+{ MODE_STRING, MODE_FORMAT, MODE_COPY }
+mode;
+
+
+/* Return the next character in the format string.  */
+
+static char
+next_char (gfc_instring in_string)
+{
+  static gfc_char_t c;
+
+  if (use_last_char)
+    {
+      use_last_char = 0;
+      return c;
+    }
+
+  format_length++;
+
+  if (mode == MODE_STRING)
+    c = *format_string++;
+  else
+    {
+      c = gfc_next_char_literal (in_string);
+      if (c == '\n')
+	c = '\0';
+    }
+
+  if (gfc_option.flag_backslash && c == '\\')
+    {
+      locus old_locus = gfc_current_locus;
+
+      if (gfc_match_special_char (&c) == MATCH_NO)
+	gfc_current_locus = old_locus;
+
+      if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings)
+	gfc_warning ("Extension: backslash character at %C");
+    }
+
+  if (mode == MODE_COPY)
+    *format_string++ = c;
+
+  if (mode != MODE_STRING)
+    format_locus = gfc_current_locus;
+
+  format_string_pos++;
+
+  c = gfc_wide_toupper (c);
+  return c;
+}
+
+
+/* Back up one character position.  Only works once.  */
+
+static void
+unget_char (void)
+{
+  use_last_char = 1;
+}
+
+/* Eat up the spaces and return a character.  */
+
+static char
+next_char_not_space (bool *error)
+{
+  char c;
+  do
+    {
+      error_element = c = next_char (NONSTRING);
+      if (c == '\t')
+	{
+	  if (gfc_option.allow_std & GFC_STD_GNU)
+	    gfc_warning ("Extension: Tab character in format at %C");
+	  else
+	    {
+	      gfc_error ("Extension: Tab character in format at %C");
+	      *error = true;
+	      return c;
+	    }
+	}
+    }
+  while (gfc_is_whitespace (c));
+  return c;
+}
+
+static int value = 0;
+
+/* Simple lexical analyzer for getting the next token in a FORMAT
+   statement.  */
+
+static format_token
+format_lex (void)
+{
+  format_token token;
+  char c, delim;
+  int zflag;
+  int negative_flag;
+  bool error = false;
+
+  if (saved_token != FMT_NONE)
+    {
+      token = saved_token;
+      saved_token = FMT_NONE;
+      return token;
+    }
+
+  c = next_char_not_space (&error);
+  
+  negative_flag = 0;
+  switch (c)
+    {
+    case '-':
+      negative_flag = 1;
+    case '+':
+      c = next_char_not_space (&error);
+      if (!ISDIGIT (c))
+	{
+	  token = FMT_UNKNOWN;
+	  break;
+	}
+
+      value = c - '0';
+
+      do
+	{
+	  c = next_char_not_space (&error);
+	  if (ISDIGIT (c))
+	    value = 10 * value + c - '0';
+	}
+      while (ISDIGIT (c));
+
+      unget_char ();
+
+      if (negative_flag)
+	value = -value;
+
+      token = FMT_SIGNED_INT;
+      break;
+
+    case '0':
+    case '1':
+    case '2':
+    case '3':
+    case '4':
+    case '5':
+    case '6':
+    case '7':
+    case '8':
+    case '9':
+      zflag = (c == '0');
+
+      value = c - '0';
+
+      do
+	{
+	  c = next_char_not_space (&error);
+	  if (ISDIGIT (c))
+	    {
+	      value = 10 * value + c - '0';
+	      if (c != '0')
+		zflag = 0;
+	    }
+	}
+      while (ISDIGIT (c));
+
+      unget_char ();
+      token = zflag ? FMT_ZERO : FMT_POSINT;
+      break;
+
+    case '.':
+      token = FMT_PERIOD;
+      break;
+
+    case ',':
+      token = FMT_COMMA;
+      break;
+
+    case ':':
+      token = FMT_COLON;
+      break;
+
+    case '/':
+      token = FMT_SLASH;
+      break;
+
+    case '$':
+      token = FMT_DOLLAR;
+      break;
+
+    case 'T':
+      c = next_char_not_space (&error);
+      switch (c)
+	{
+	case 'L':
+	  token = FMT_TL;
+	  break;
+	case 'R':
+	  token = FMT_TR;
+	  break;
+	default:
+	  token = FMT_T;
+	  unget_char ();
+	}
+      break;
+
+    case '(':
+      token = FMT_LPAREN;
+      break;
+
+    case ')':
+      token = FMT_RPAREN;
+      break;
+
+    case 'X':
+      token = FMT_X;
+      break;
+
+    case 'S':
+      c = next_char_not_space (&error);
+      if (c != 'P' && c != 'S')
+	unget_char ();
+
+      token = FMT_SIGN;
+      break;
+
+    case 'B':
+      c = next_char_not_space (&error);
+      if (c == 'N' || c == 'Z')
+	token = FMT_BLANK;
+      else
+	{
+	  unget_char ();
+	  token = FMT_IBOZ;
+	}
+
+      break;
+
+    case '\'':
+    case '"':
+      delim = c;
+
+      value = 0;
+
+      for (;;)
+	{
+	  c = next_char (INSTRING_WARN);
+	  if (c == '\0')
+	    {
+	      token = FMT_END;
+	      break;
+	    }
+
+	  if (c == delim)
+	    {
+	      c = next_char (INSTRING_NOWARN);
+
+	      if (c == '\0')
+		{
+		  token = FMT_END;
+		  break;
+		}
+
+	      if (c != delim)
+		{
+		  unget_char ();
+		  token = FMT_CHAR;
+		  break;
+		}
+	    }
+	  value++;
+	}
+      break;
+
+    case 'P':
+      token = FMT_P;
+      break;
+
+    case 'I':
+    case 'O':
+    case 'Z':
+      token = FMT_IBOZ;
+      break;
+
+    case 'F':
+      token = FMT_F;
+      break;
+
+    case 'E':
+      c = next_char_not_space (&error);
+      if (c == 'N' )
+	token = FMT_EN;
+      else if (c == 'S')
+        token = FMT_ES;
+      else
+	{
+	  token = FMT_E;
+	  unget_char ();
+	}
+
+      break;
+
+    case 'G':
+      token = FMT_G;
+      break;
+
+    case 'H':
+      token = FMT_H;
+      break;
+
+    case 'L':
+      token = FMT_L;
+      break;
+
+    case 'A':
+      token = FMT_A;
+      break;
+
+    case 'D':
+      c = next_char_not_space (&error);
+      if (c == 'P')
+	{
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DP format "
+	      "specifier not allowed at %C") == FAILURE)
+	    return FMT_ERROR;
+	  token = FMT_DP;
+	}
+      else if (c == 'C')
+	{
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DC format "
+	      "specifier not allowed at %C") == FAILURE)
+	    return FMT_ERROR;
+	  token = FMT_DC;
+	}
+      else
+	{
+	  token = FMT_D;
+	  unget_char ();
+	}
+      break;
+
+    case 'R':
+      c = next_char_not_space (&error);
+      switch (c)
+	{
+	case 'C':
+	  token = FMT_RC;
+	  break;
+	case 'D':
+	  token = FMT_RD;
+	  break;
+	case 'N':
+	  token = FMT_RN;
+	  break;
+	case 'P':
+	  token = FMT_RP;
+	  break;
+	case 'U':
+	  token = FMT_RU;
+	  break;
+	case 'Z':
+	  token = FMT_RZ;
+	  break;
+	default:
+	  token = FMT_UNKNOWN;
+	  unget_char ();
+	  break;
+	}
+      break;
+
+    case '\0':
+      token = FMT_END;
+      break;
+
+    case '*':
+      token = FMT_STAR;
+      break;
+
+    default:
+      token = FMT_UNKNOWN;
+      break;
+    }
+
+  if (error)
+    return FMT_ERROR;
+
+  return token;
+}
+
+
+static const char *
+token_to_string (format_token t)
+{
+  switch (t)
+    {
+      case FMT_D:
+	return "D";
+      case FMT_G:
+	return "G";
+      case FMT_E:
+	return "E";
+      case FMT_EN:
+	return "EN";
+      case FMT_ES:
+	return "ES";
+      default:
+        return "";
+    }
+}
+
+/* Check a format statement.  The format string, either from a FORMAT
+   statement or a constant in an I/O statement has already been parsed
+   by itself, and we are checking it for validity.  The dual origin
+   means that the warning message is a little less than great.  */
+
+static gfc_try
+check_format (bool is_input)
+{
+  const char *posint_required	  = _("Positive width required");
+  const char *nonneg_required	  = _("Nonnegative width required");
+  const char *unexpected_element  = _("Unexpected element '%c' in format string"
+				      " at %L");
+  const char *unexpected_end	  = _("Unexpected end of format string");
+  const char *zero_width	  = _("Zero width in format descriptor");
+
+  const char *error;
+  format_token t, u;
+  int level;
+  int repeat;
+  gfc_try rv;
+
+  use_last_char = 0;
+  saved_token = FMT_NONE;
+  level = 0;
+  repeat = 0;
+  rv = SUCCESS;
+  format_string_pos = 0;
+
+  t = format_lex ();
+  if (t == FMT_ERROR)
+    goto fail;
+  if (t != FMT_LPAREN)
+    {
+      error = _("Missing leading left parenthesis");
+      goto syntax;
+    }
+
+  t = format_lex ();
+  if (t == FMT_ERROR)
+    goto fail;
+  if (t == FMT_RPAREN)
+    goto finished;		/* Empty format is legal */
+  saved_token = t;
+
+format_item:
+  /* In this state, the next thing has to be a format item.  */
+  t = format_lex ();
+  if (t == FMT_ERROR)
+    goto fail;
+format_item_1:
+  switch (t)
+    {
+    case FMT_STAR:
+      repeat = -1;
+      t = format_lex ();
+      if (t == FMT_ERROR)
+	goto fail;
+      if (t == FMT_LPAREN)
+	{
+	  level++;
+	  goto format_item;
+	}
+      error = _("Left parenthesis required after '*'");
+      goto syntax;
+
+    case FMT_POSINT:
+      repeat = value;
+      t = format_lex ();
+      if (t == FMT_ERROR)
+	goto fail;
+      if (t == FMT_LPAREN)
+	{
+	  level++;
+	  goto format_item;
+	}
+
+      if (t == FMT_SLASH)
+	goto optional_comma;
+
+      goto data_desc;
+
+    case FMT_LPAREN:
+      level++;
+      goto format_item;
+
+    case FMT_SIGNED_INT:
+    case FMT_ZERO:
+      /* Signed integer can only precede a P format.  */
+      t = format_lex ();
+      if (t == FMT_ERROR)
+	goto fail;
+      if (t != FMT_P)
+	{
+	  error = _("Expected P edit descriptor");
+	  goto syntax;
+	}
+
+      goto data_desc;
+
+    case FMT_P:
+      /* P requires a prior number.  */
+      error = _("P descriptor requires leading scale factor");
+      goto syntax;
+
+    case FMT_X:
+      /* X requires a prior number if we're being pedantic.  */
+      if (mode != MODE_FORMAT)
+	format_locus.nextc += format_string_pos;
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: X descriptor "
+			  "requires leading space count at %L", &format_locus)
+	  == FAILURE)
+	return FAILURE;
+      goto between_desc;
+
+    case FMT_SIGN:
+    case FMT_BLANK:
+    case FMT_DP:
+    case FMT_DC:
+    case FMT_RC:
+    case FMT_RD:
+    case FMT_RN:
+    case FMT_RP:
+    case FMT_RU:
+    case FMT_RZ:
+      goto between_desc;
+
+    case FMT_CHAR:
+      goto extension_optional_comma;
+
+    case FMT_COLON:
+    case FMT_SLASH:
+      goto optional_comma;
+
+    case FMT_DOLLAR:
+      t = format_lex ();
+      if (t == FMT_ERROR)
+	goto fail;
+
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: $ descriptor at %L",
+	  &format_locus) == FAILURE)
+	return FAILURE;
+      if (t != FMT_RPAREN || level > 0)
+	{
+	  gfc_warning ("$ should be the last specifier in format at %L",
+		       &format_locus);
+	  goto optional_comma_1;
+	}
+
+      goto finished;
+
+    case FMT_T:
+    case FMT_TL:
+    case FMT_TR:
+    case FMT_IBOZ:
+    case FMT_F:
+    case FMT_E:
+    case FMT_EN:
+    case FMT_ES:
+    case FMT_G:
+    case FMT_L:
+    case FMT_A:
+    case FMT_D:
+    case FMT_H:
+      goto data_desc;
+
+    case FMT_END:
+      error = unexpected_end;
+      goto syntax;
+
+    default:
+      error = unexpected_element;
+      goto syntax;
+    }
+
+data_desc:
+  /* In this state, t must currently be a data descriptor.
+     Deal with things that can/must follow the descriptor.  */
+  switch (t)
+    {
+    case FMT_SIGN:
+    case FMT_BLANK:
+    case FMT_DP:
+    case FMT_DC:
+    case FMT_X:
+      break;
+
+    case FMT_P:
+      /* No comma after P allowed only for F, E, EN, ES, D, or G.
+	 10.1.1 (1).  */
+      t = format_lex ();
+      if (t == FMT_ERROR)
+	goto fail;
+      if (!(gfc_option.allow_std & GFC_STD_F2003) && t != FMT_COMMA
+	  && t != FMT_F && t != FMT_E && t != FMT_EN && t != FMT_ES
+	  && t != FMT_D && t != FMT_G && t != FMT_RPAREN && t != FMT_SLASH)
+	{
+	  error = _("Comma required after P descriptor");
+	  goto syntax;
+	}
+      if (t != FMT_COMMA)
+	{
+	  if (t == FMT_POSINT)
+	    {
+	      t = format_lex ();
+	      if (t == FMT_ERROR)
+		goto fail;
+	    }
+          if (t != FMT_F && t != FMT_E && t != FMT_EN && t != FMT_ES && t != FMT_D
+	      && t != FMT_G && t != FMT_RPAREN && t != FMT_SLASH)
+	    {
+	      error = _("Comma required after P descriptor");
+	      goto syntax;
+	    }
+	}
+
+      saved_token = t;
+      goto optional_comma;
+
+    case FMT_T:
+    case FMT_TL:
+    case FMT_TR:
+      t = format_lex ();
+      if (t != FMT_POSINT)
+	{
+	  error = _("Positive width required with T descriptor");
+	  goto syntax;
+	}
+      break;
+
+    case FMT_L:
+      t = format_lex ();
+      if (t == FMT_ERROR)
+	goto fail;
+      if (t == FMT_POSINT)
+	break;
+
+      switch (gfc_notification_std (GFC_STD_GNU))
+	{
+	  case WARNING:
+	    if (mode != MODE_FORMAT)
+	      format_locus.nextc += format_string_pos;
+	    gfc_warning ("Extension: Missing positive width after L "
+			 "descriptor at %L", &format_locus);
+	    saved_token = t;
+	    break;
+
+	  case ERROR:
+	    error = posint_required;
+	    goto syntax;
+
+	  case SILENT:
+	    saved_token = t;
+	    break;
+
+	  default:
+	    gcc_unreachable ();
+	}
+      break;
+
+    case FMT_A:
+      t = format_lex ();
+      if (t == FMT_ERROR)
+	goto fail;
+      if (t == FMT_ZERO)
+	{
+	  error = zero_width;
+	  goto syntax;
+	}
+      if (t != FMT_POSINT)
+	saved_token = t;
+      break;
+
+    case FMT_D:
+    case FMT_E:
+    case FMT_G:
+    case FMT_EN:
+    case FMT_ES:
+      u = format_lex ();
+      if (t == FMT_G && u == FMT_ZERO)
+	{
+	  if (is_input)
+	    {
+	      error = zero_width;
+	      goto syntax;
+	    }
+	  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: 'G0' in "
+			      "format at %L", &format_locus) == FAILURE)
+	    return FAILURE;
+	  u = format_lex ();
+	  if (u != FMT_PERIOD)
+	    {
+	      saved_token = u;
+	      break;
+	    }
+	  u = format_lex ();
+	  if (u != FMT_POSINT)
+	    {
+	      error = posint_required;
+	      goto syntax;
+	    }
+	  u = format_lex ();
+	  if (u == FMT_E)
+	    {
+	      error = _("E specifier not allowed with g0 descriptor");
+	      goto syntax;
+	    }
+	  saved_token = u;
+	  break;
+	}
+
+      if (u != FMT_POSINT)
+	{
+	  format_locus.nextc += format_string_pos;
+	  gfc_error ("Positive width required in format "
+			 "specifier %s at %L", token_to_string (t),
+			 &format_locus);
+	  saved_token = u;
+	  goto fail;
+	}
+
+      u = format_lex ();
+      if (u == FMT_ERROR)
+	goto fail;
+      if (u != FMT_PERIOD)
+	{
+	  /* Warn if -std=legacy, otherwise error.  */
+	  format_locus.nextc += format_string_pos;
+	  if (gfc_option.warn_std != 0)
+	    {
+	      gfc_error ("Period required in format "
+			     "specifier %s at %L", token_to_string (t),
+			     &format_locus);
+	      saved_token = u;
+              goto fail;
+	    }
+	  else
+	    gfc_warning ("Period required in format "
+			 "specifier %s at %L", token_to_string (t),
+			  &format_locus);
+	  /* If we go to finished, we need to unwind this
+	     before the next round.  */
+	  format_locus.nextc -= format_string_pos;
+	  saved_token = u;
+	  break;
+	}
+
+      u = format_lex ();
+      if (u == FMT_ERROR)
+	goto fail;
+      if (u != FMT_ZERO && u != FMT_POSINT)
+	{
+	  error = nonneg_required;
+	  goto syntax;
+	}
+
+      if (t == FMT_D)
+	break;
+
+      /* Look for optional exponent.  */
+      u = format_lex ();
+      if (u == FMT_ERROR)
+	goto fail;
+      if (u != FMT_E)
+	{
+	  saved_token = u;
+	}
+      else
+	{
+	  u = format_lex ();
+	  if (u == FMT_ERROR)
+	    goto fail;
+	  if (u != FMT_POSINT)
+	    {
+	      error = _("Positive exponent width required");
+	      goto syntax;
+	    }
+	}
+
+      break;
+
+    case FMT_F:
+      t = format_lex ();
+      if (t == FMT_ERROR)
+	goto fail;
+      if (t != FMT_ZERO && t != FMT_POSINT)
+	{
+	  error = nonneg_required;
+	  goto syntax;
+	}
+      else if (is_input && t == FMT_ZERO)
+	{
+	  error = posint_required;
+	  goto syntax;
+	}
+
+      t = format_lex ();
+      if (t == FMT_ERROR)
+	goto fail;
+      if (t != FMT_PERIOD)
+	{
+	  /* Warn if -std=legacy, otherwise error.  */
+	  if (gfc_option.warn_std != 0)
+	    {
+	      error = _("Period required in format specifier");
+	      goto syntax;
+	    }
+	  if (mode != MODE_FORMAT)
+	    format_locus.nextc += format_string_pos;
+	  gfc_warning ("Period required in format specifier at %L",
+		       &format_locus);
+	  saved_token = t;
+	  break;
+	}
+
+      t = format_lex ();
+      if (t == FMT_ERROR)
+	goto fail;
+      if (t != FMT_ZERO && t != FMT_POSINT)
+	{
+	  error = nonneg_required;
+	  goto syntax;
+	}
+
+      break;
+
+    case FMT_H:
+      if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings)
+	{
+	  if (mode != MODE_FORMAT)
+	    format_locus.nextc += format_string_pos;
+	  gfc_warning ("The H format specifier at %L is"
+		       " a Fortran 95 deleted feature", &format_locus);
+	}
+      if (mode == MODE_STRING)
+	{
+	  format_string += value;
+	  format_length -= value;
+          format_string_pos += repeat;
+	}
+      else
+	{
+	  while (repeat >0)
+	   {
+	     next_char (INSTRING_WARN);
+	     repeat -- ;
+	   }
+	}
+     break;
+
+    case FMT_IBOZ:
+      t = format_lex ();
+      if (t == FMT_ERROR)
+	goto fail;
+      if (t != FMT_ZERO && t != FMT_POSINT)
+	{
+	  error = nonneg_required;
+	  goto syntax;
+	}
+      else if (is_input && t == FMT_ZERO)
+	{
+	  error = posint_required;
+	  goto syntax;
+	}
+
+      t = format_lex ();
+      if (t == FMT_ERROR)
+	goto fail;
+      if (t != FMT_PERIOD)
+	{
+	  saved_token = t;
+	}
+      else
+	{
+	  t = format_lex ();
+	  if (t == FMT_ERROR)
+	    goto fail;
+	  if (t != FMT_ZERO && t != FMT_POSINT)
+	    {
+	      error = nonneg_required;
+	      goto syntax;
+	    }
+	}
+
+      break;
+
+    default:
+      error = unexpected_element;
+      goto syntax;
+    }
+
+between_desc:
+  /* Between a descriptor and what comes next.  */
+  t = format_lex ();
+  if (t == FMT_ERROR)
+    goto fail;
+  switch (t)
+    {
+
+    case FMT_COMMA:
+      goto format_item;
+
+    case FMT_RPAREN:
+      level--;
+      if (level < 0)
+	goto finished;
+      goto between_desc;
+
+    case FMT_COLON:
+    case FMT_SLASH:
+      goto optional_comma;
+
+    case FMT_END:
+      error = unexpected_end;
+      goto syntax;
+
+    default:
+      if (mode != MODE_FORMAT)
+	format_locus.nextc += format_string_pos - 1;
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %L",
+	  &format_locus) == FAILURE)
+	return FAILURE;
+      /* If we do not actually return a failure, we need to unwind this
+         before the next round.  */
+      if (mode != MODE_FORMAT)
+	format_locus.nextc -= format_string_pos;
+      goto format_item_1;
+    }
+
+optional_comma:
+  /* Optional comma is a weird between state where we've just finished
+     reading a colon, slash, dollar or P descriptor.  */
+  t = format_lex ();
+  if (t == FMT_ERROR)
+    goto fail;
+optional_comma_1:
+  switch (t)
+    {
+    case FMT_COMMA:
+      break;
+
+    case FMT_RPAREN:
+      level--;
+      if (level < 0)
+	goto finished;
+      goto between_desc;
+
+    default:
+      /* Assume that we have another format item.  */
+      saved_token = t;
+      break;
+    }
+
+  goto format_item;
+
+extension_optional_comma:
+  /* As a GNU extension, permit a missing comma after a string literal.  */
+  t = format_lex ();
+  if (t == FMT_ERROR)
+    goto fail;
+  switch (t)
+    {
+    case FMT_COMMA:
+      break;
+
+    case FMT_RPAREN:
+      level--;
+      if (level < 0)
+	goto finished;
+      goto between_desc;
+
+    case FMT_COLON:
+    case FMT_SLASH:
+      goto optional_comma;
+
+    case FMT_END:
+      error = unexpected_end;
+      goto syntax;
+
+    default:
+      if (mode != MODE_FORMAT)
+	format_locus.nextc += format_string_pos;
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: Missing comma at %L",
+	  &format_locus) == FAILURE)
+	return FAILURE;
+      /* If we do not actually return a failure, we need to unwind this
+         before the next round.  */
+      if (mode != MODE_FORMAT)
+	format_locus.nextc -= format_string_pos;
+      saved_token = t;
+      break;
+    }
+
+  goto format_item;
+  
+syntax:
+  if (mode != MODE_FORMAT)
+    format_locus.nextc += format_string_pos;
+  if (error == unexpected_element)
+    gfc_error (error, error_element, &format_locus);
+  else
+    gfc_error ("%s in format string at %L", error, &format_locus);
+fail:
+  rv = FAILURE;
+
+finished:
+  return rv;
+}
+
+
+/* Given an expression node that is a constant string, see if it looks
+   like a format string.  */
+
+static gfc_try
+check_format_string (gfc_expr *e, bool is_input)
+{
+  gfc_try rv;
+  int i;
+  if (!e || e->ts.type != BT_CHARACTER || e->expr_type != EXPR_CONSTANT)
+    return SUCCESS;
+
+  mode = MODE_STRING;
+  format_string = e->value.character.string;
+
+  /* More elaborate measures are needed to show where a problem is within a
+     format string that has been calculated, but that's probably not worth the
+     effort.  */
+  format_locus = e->where;
+  rv = check_format (is_input);
+  /* check for extraneous characters at the end of an otherwise valid format
+     string, like '(A10,I3)F5'
+     start at the end and move back to the last character processed,
+     spaces are OK */
+  if (rv == SUCCESS && e->value.character.length > format_string_pos)
+    for (i=e->value.character.length-1;i>format_string_pos-1;i--)
+      if (e->value.character.string[i] != ' ')
+        {
+          format_locus.nextc += format_length + 1; 
+          gfc_warning ("Extraneous characters in format at %L", &format_locus); 
+          break;
+        }
+  return rv;
+}
+
+
+/************ Fortran 95 I/O statement matchers *************/
+
+/* Match a FORMAT statement.  This amounts to actually parsing the
+   format descriptors in order to correctly locate the end of the
+   format string.  */
+
+match
+gfc_match_format (void)
+{
+  gfc_expr *e;
+  locus start;
+
+  if (gfc_current_ns->proc_name
+      && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
+    {
+      gfc_error ("Format statement in module main block at %C");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_statement_label == NULL)
+    {
+      gfc_error ("Missing format label at %C");
+      return MATCH_ERROR;
+    }
+  gfc_gobble_whitespace ();
+
+  mode = MODE_FORMAT;
+  format_length = 0;
+
+  start = gfc_current_locus;
+
+  if (check_format (false) == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      gfc_syntax_error (ST_FORMAT);
+      return MATCH_ERROR;
+    }
+
+  /* The label doesn't get created until after the statement is done
+     being matched, so we have to leave the string for later.  */
+
+  gfc_current_locus = start;	/* Back to the beginning */
+
+  new_st.loc = start;
+  new_st.op = EXEC_NOP;
+
+  e = gfc_get_character_expr (gfc_default_character_kind, &start,
+			      NULL, format_length);
+  format_string = e->value.character.string;
+  gfc_statement_label->format = e;
+
+  mode = MODE_COPY;
+  check_format (false);		/* Guaranteed to succeed */
+  gfc_match_eos ();		/* Guaranteed to succeed */
+
+  return MATCH_YES;
+}
+
+
+/* Match an expression I/O tag of some sort.  */
+
+static match
+match_etag (const io_tag *tag, gfc_expr **v)
+{
+  gfc_expr *result;
+  match m;
+
+  m = gfc_match (tag->spec);
+  if (m != MATCH_YES)
+    return m;
+
+  m = gfc_match (tag->value, &result);
+  if (m != MATCH_YES)
+    {
+      gfc_error ("Invalid value for %s specification at %C", tag->name);
+      return MATCH_ERROR;
+    }
+
+  if (*v != NULL)
+    {
+      gfc_error ("Duplicate %s specification at %C", tag->name);
+      gfc_free_expr (result);
+      return MATCH_ERROR;
+    }
+
+  *v = result;
+  return MATCH_YES;
+}
+
+
+/* Match a variable I/O tag of some sort.  */
+
+static match
+match_vtag (const io_tag *tag, gfc_expr **v)
+{
+  gfc_expr *result;
+  match m;
+
+  m = gfc_match (tag->spec);
+  if (m != MATCH_YES)
+    return m;
+
+  m = gfc_match (tag->value, &result);
+  if (m != MATCH_YES)
+    {
+      gfc_error ("Invalid value for %s specification at %C", tag->name);
+      return MATCH_ERROR;
+    }
+
+  if (*v != NULL)
+    {
+      gfc_error ("Duplicate %s specification at %C", tag->name);
+      gfc_free_expr (result);
+      return MATCH_ERROR;
+    }
+
+  if (result->symtree->n.sym->attr.intent == INTENT_IN)
+    {
+      gfc_error ("Variable %s cannot be INTENT(IN) at %C", tag->name);
+      gfc_free_expr (result);
+      return MATCH_ERROR;
+    }
+
+  if (gfc_pure (NULL) && gfc_impure_variable (result->symtree->n.sym))
+    {
+      gfc_error ("Variable %s cannot be assigned in PURE procedure at %C",
+		 tag->name);
+      gfc_free_expr (result);
+      return MATCH_ERROR;
+    }
+
+  if (gfc_implicit_pure (NULL) && gfc_impure_variable (result->symtree->n.sym))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  *v = result;
+  return MATCH_YES;
+}
+
+
+/* Match I/O tags that cause variables to become redefined.  */
+
+static match
+match_out_tag (const io_tag *tag, gfc_expr **result)
+{
+  match m;
+
+  m = match_vtag (tag, result);
+  if (m == MATCH_YES)
+    gfc_check_do_variable ((*result)->symtree);
+
+  return m;
+}
+
+
+/* Match a label I/O tag.  */
+
+static match
+match_ltag (const io_tag *tag, gfc_st_label ** label)
+{
+  match m;
+  gfc_st_label *old;
+
+  old = *label;
+  m = gfc_match (tag->spec);
+  if (m != MATCH_YES)
+    return m;
+
+  m = gfc_match (tag->value, label);
+  if (m != MATCH_YES)
+    {
+      gfc_error ("Invalid value for %s specification at %C", tag->name);
+      return MATCH_ERROR;
+    }
+
+  if (old)
+    {
+      gfc_error ("Duplicate %s label specification at %C", tag->name);
+      return MATCH_ERROR;
+    }
+
+  if (gfc_reference_st_label (*label, ST_LABEL_TARGET) == FAILURE)
+    return MATCH_ERROR;
+
+  return m;
+}
+
+
+/* Resolution of the FORMAT tag, to be called from resolve_tag.  */
+
+static gfc_try
+resolve_tag_format (const gfc_expr *e)
+{
+  if (e->expr_type == EXPR_CONSTANT
+      && (e->ts.type != BT_CHARACTER
+	  || e->ts.kind != gfc_default_character_kind))
+    {
+      gfc_error ("Constant expression in FORMAT tag at %L must be "
+		 "of type default CHARACTER", &e->where);
+      return FAILURE;
+    }
+
+  /* If e's rank is zero and e is not an element of an array, it should be
+     of integer or character type.  The integer variable should be
+     ASSIGNED.  */
+  if (e->rank == 0
+      && (e->expr_type != EXPR_VARIABLE
+	  || e->symtree == NULL
+	  || e->symtree->n.sym->as == NULL
+	  || e->symtree->n.sym->as->rank == 0))
+    {
+      if (e->ts.type != BT_CHARACTER && e->ts.type != BT_INTEGER)
+	{
+	  gfc_error ("FORMAT tag at %L must be of type CHARACTER or INTEGER",
+		     &e->where);
+	  return FAILURE;
+	}
+      else if (e->ts.type == BT_INTEGER && e->expr_type == EXPR_VARIABLE)
+	{
+	  if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: ASSIGNED "
+			      "variable in FORMAT tag at %L", &e->where)
+	      == FAILURE)
+	    return FAILURE;
+	  if (e->symtree->n.sym->attr.assign != 1)
+	    {
+	      gfc_error ("Variable '%s' at %L has not been assigned a "
+			 "format label", e->symtree->n.sym->name, &e->where);
+	      return FAILURE;
+	    }
+	}
+      else if (e->ts.type == BT_INTEGER)
+	{
+	  gfc_error ("Scalar '%s' in FORMAT tag at %L is not an ASSIGNED "
+		     "variable", gfc_basic_typename (e->ts.type), &e->where);
+	  return FAILURE;
+	}
+
+      return SUCCESS;
+    }
+
+  /* If rank is nonzero and type is not character, we allow it under GFC_STD_LEGACY.
+     It may be assigned an Hollerith constant.  */
+  if (e->ts.type != BT_CHARACTER)
+    {
+      if (gfc_notify_std (GFC_STD_LEGACY, "Extension: Non-character "
+			  "in FORMAT tag at %L", &e->where) == FAILURE)
+	return FAILURE;
+
+      if (e->rank == 0 && e->symtree->n.sym->as->type == AS_ASSUMED_SHAPE)
+	{
+	  gfc_error ("Non-character assumed shape array element in FORMAT"
+		     " tag at %L", &e->where);
+	  return FAILURE;
+	}
+
+      if (e->rank == 0 && e->symtree->n.sym->as->type == AS_ASSUMED_SIZE)
+	{
+	  gfc_error ("Non-character assumed size array element in FORMAT"
+		     " tag at %L", &e->where);
+	  return FAILURE;
+	}
+
+      if (e->rank == 0 && e->symtree->n.sym->attr.pointer)
+	{
+	  gfc_error ("Non-character pointer array element in FORMAT tag at %L",
+		     &e->where);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* Do expression resolution and type-checking on an expression tag.  */
+
+static gfc_try
+resolve_tag (const io_tag *tag, gfc_expr *e)
+{
+  if (e == NULL)
+    return SUCCESS;
+
+  if (gfc_resolve_expr (e) == FAILURE)
+    return FAILURE;
+
+  if (tag == &tag_format)
+    return resolve_tag_format (e);
+
+  if (e->ts.type != tag->type)
+    {
+      gfc_error ("%s tag at %L must be of type %s", tag->name,
+		 &e->where, gfc_basic_typename (tag->type));
+      return FAILURE;
+    }
+
+  if (e->rank != 0)
+    {
+      gfc_error ("%s tag at %L must be scalar", tag->name, &e->where);
+      return FAILURE;
+    }
+
+  if (tag == &tag_iomsg)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: IOMSG tag at %L",
+			  &e->where) == FAILURE)
+	return FAILURE;
+    }
+
+  if ((tag == &tag_iostat || tag == &tag_size || tag == &tag_iolength)
+      && e->ts.kind != gfc_default_integer_kind)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 95 requires default "
+			  "INTEGER in %s tag at %L", tag->name, &e->where)
+	  == FAILURE)
+	return FAILURE;
+    }
+
+  if (tag == &tag_exist && e->ts.kind != gfc_default_logical_kind)
+    {
+      if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Nondefault LOGICAL "
+			  "in %s tag at %L", tag->name, &e->where)
+	  == FAILURE)
+	return FAILURE;
+    }
+
+  if (tag == &tag_newunit)
+    {
+      if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: NEWUNIT specifier"
+			  " at %L", &e->where) == FAILURE)
+	return FAILURE;
+    }
+
+  /* NEWUNIT, IOSTAT, SIZE and IOMSG are variable definition contexts.  */
+  if (tag == &tag_newunit || tag == &tag_iostat
+      || tag == &tag_size || tag == &tag_iomsg)
+    {
+      char context[64];
+
+      sprintf (context, _("%s tag"), tag->name);
+      if (gfc_check_vardef_context (e, false, context) == FAILURE)
+	return FAILURE;
+    }
+  
+  if (tag == &tag_convert)
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: CONVERT tag at %L",
+			  &e->where) == FAILURE)
+	return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Match a single tag of an OPEN statement.  */
+
+static match
+match_open_element (gfc_open *open)
+{
+  match m;
+
+  m = match_etag (&tag_e_async, &open->asynchronous);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_unit, &open->unit);
+  if (m != MATCH_NO)
+    return m;
+  m = match_out_tag (&tag_iomsg, &open->iomsg);
+  if (m != MATCH_NO)
+    return m;
+  m = match_out_tag (&tag_iostat, &open->iostat);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_file, &open->file);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_status, &open->status);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_access, &open->access);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_form, &open->form);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_recl, &open->recl);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_blank, &open->blank);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_position, &open->position);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_action, &open->action);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_delim, &open->delim);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_pad, &open->pad);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_decimal, &open->decimal);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_encoding, &open->encoding);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_round, &open->round);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_sign, &open->sign);
+  if (m != MATCH_NO)
+    return m;
+  m = match_ltag (&tag_err, &open->err);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_convert, &open->convert);
+  if (m != MATCH_NO)
+    return m;
+  m = match_out_tag (&tag_newunit, &open->newunit);
+  if (m != MATCH_NO)
+    return m;
+
+  return MATCH_NO;
+}
+
+
+/* Free the gfc_open structure and all the expressions it contains.  */
+
+void
+gfc_free_open (gfc_open *open)
+{
+  if (open == NULL)
+    return;
+
+  gfc_free_expr (open->unit);
+  gfc_free_expr (open->iomsg);
+  gfc_free_expr (open->iostat);
+  gfc_free_expr (open->file);
+  gfc_free_expr (open->status);
+  gfc_free_expr (open->access);
+  gfc_free_expr (open->form);
+  gfc_free_expr (open->recl);
+  gfc_free_expr (open->blank);
+  gfc_free_expr (open->position);
+  gfc_free_expr (open->action);
+  gfc_free_expr (open->delim);
+  gfc_free_expr (open->pad);
+  gfc_free_expr (open->decimal);
+  gfc_free_expr (open->encoding);
+  gfc_free_expr (open->round);
+  gfc_free_expr (open->sign);
+  gfc_free_expr (open->convert);
+  gfc_free_expr (open->asynchronous);
+  gfc_free_expr (open->newunit);
+  gfc_free (open);
+}
+
+
+/* Resolve everything in a gfc_open structure.  */
+
+gfc_try
+gfc_resolve_open (gfc_open *open)
+{
+
+  RESOLVE_TAG (&tag_unit, open->unit);
+  RESOLVE_TAG (&tag_iomsg, open->iomsg);
+  RESOLVE_TAG (&tag_iostat, open->iostat);
+  RESOLVE_TAG (&tag_file, open->file);
+  RESOLVE_TAG (&tag_status, open->status);
+  RESOLVE_TAG (&tag_e_access, open->access);
+  RESOLVE_TAG (&tag_e_form, open->form);
+  RESOLVE_TAG (&tag_e_recl, open->recl);
+  RESOLVE_TAG (&tag_e_blank, open->blank);
+  RESOLVE_TAG (&tag_e_position, open->position);
+  RESOLVE_TAG (&tag_e_action, open->action);
+  RESOLVE_TAG (&tag_e_delim, open->delim);
+  RESOLVE_TAG (&tag_e_pad, open->pad);
+  RESOLVE_TAG (&tag_e_decimal, open->decimal);
+  RESOLVE_TAG (&tag_e_encoding, open->encoding);
+  RESOLVE_TAG (&tag_e_async, open->asynchronous);
+  RESOLVE_TAG (&tag_e_round, open->round);
+  RESOLVE_TAG (&tag_e_sign, open->sign);
+  RESOLVE_TAG (&tag_convert, open->convert);
+  RESOLVE_TAG (&tag_newunit, open->newunit);
+
+  if (gfc_reference_st_label (open->err, ST_LABEL_TARGET) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Check if a given value for a SPECIFIER is either in the list of values
+   allowed in F95 or F2003, issuing an error message and returning a zero
+   value if it is not allowed.  */
+
+static int
+compare_to_allowed_values (const char *specifier, const char *allowed[],
+			   const char *allowed_f2003[], 
+			   const char *allowed_gnu[], gfc_char_t *value,
+			   const char *statement, bool warn)
+{
+  int i;
+  unsigned int len;
+
+  len = gfc_wide_strlen (value);
+  if (len > 0)
+  {
+    for (len--; len > 0; len--)
+      if (value[len] != ' ')
+	break;
+    len++;
+  }
+
+  for (i = 0; allowed[i]; i++)
+    if (len == strlen (allowed[i])
+	&& gfc_wide_strncasecmp (value, allowed[i], strlen (allowed[i])) == 0)
+      return 1;
+
+  for (i = 0; allowed_f2003 && allowed_f2003[i]; i++)
+    if (len == strlen (allowed_f2003[i])
+	&& gfc_wide_strncasecmp (value, allowed_f2003[i],
+				 strlen (allowed_f2003[i])) == 0)
+      {
+	notification n = gfc_notification_std (GFC_STD_F2003);
+
+	if (n == WARNING || (warn && n == ERROR))
+	  {
+	    gfc_warning ("Fortran 2003: %s specifier in %s statement at %C "
+			 "has value '%s'", specifier, statement,
+			 allowed_f2003[i]);
+	    return 1;
+	  }
+	else
+	  if (n == ERROR)
+	    {
+	      gfc_notify_std (GFC_STD_F2003, "Fortran 2003: %s specifier in "
+			      "%s statement at %C has value '%s'", specifier,
+			      statement, allowed_f2003[i]);
+	      return 0;
+	    }
+
+	/* n == SILENT */
+	return 1;
+      }
+
+  for (i = 0; allowed_gnu && allowed_gnu[i]; i++)
+    if (len == strlen (allowed_gnu[i])
+	&& gfc_wide_strncasecmp (value, allowed_gnu[i],
+				 strlen (allowed_gnu[i])) == 0)
+      {
+	notification n = gfc_notification_std (GFC_STD_GNU);
+
+	if (n == WARNING || (warn && n == ERROR))
+	  {
+	    gfc_warning ("Extension: %s specifier in %s statement at %C "
+			 "has value '%s'", specifier, statement,
+			 allowed_gnu[i]);
+	    return 1;
+	  }
+	else
+	  if (n == ERROR)
+	    {
+	      gfc_notify_std (GFC_STD_GNU, "Extension: %s specifier in "
+			      "%s statement at %C has value '%s'", specifier,
+			      statement, allowed_gnu[i]);
+	      return 0;
+	    }
+
+	/* n == SILENT */
+	return 1;
+      }
+
+  if (warn)
+    {
+      char *s = gfc_widechar_to_char (value, -1);
+      gfc_warning ("%s specifier in %s statement at %C has invalid value '%s'",
+		   specifier, statement, s);
+      gfc_free (s);
+      return 1;
+    }
+  else
+    {
+      char *s = gfc_widechar_to_char (value, -1);
+      gfc_error ("%s specifier in %s statement at %C has invalid value '%s'",
+		 specifier, statement, s);
+      gfc_free (s);
+      return 0;
+    }
+}
+
+
+/* Match an OPEN statement.  */
+
+match
+gfc_match_open (void)
+{
+  gfc_open *open;
+  match m;
+  bool warn;
+
+  m = gfc_match_char ('(');
+  if (m == MATCH_NO)
+    return m;
+
+  open = XCNEW (gfc_open);
+
+  m = match_open_element (open);
+
+  if (m == MATCH_ERROR)
+    goto cleanup;
+  if (m == MATCH_NO)
+    {
+      m = gfc_match_expr (&open->unit);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+    }
+
+  for (;;)
+    {
+      if (gfc_match_char (')') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+
+      m = match_open_element (open);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+  if (gfc_match_eos () == MATCH_NO)
+    goto syntax;
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("OPEN statement not allowed in PURE procedure at %C");
+      goto cleanup;
+    }
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  warn = (open->err || open->iostat) ? true : false;
+
+  /* Checks on NEWUNIT specifier.  */
+  if (open->newunit)
+    {
+      if (open->unit)
+	{
+	  gfc_error ("UNIT specifier not allowed with NEWUNIT at %C");
+	  goto cleanup;
+	}
+
+      if (!(open->file || (open->status
+          && gfc_wide_strncasecmp (open->status->value.character.string,
+				   "scratch", 7) == 0)))
+	{
+	  gfc_error ("NEWUNIT specifier must have FILE= "
+		     "or STATUS='scratch' at %C");
+	  goto cleanup;
+	}
+    }
+  else if (!open->unit)
+    {
+      gfc_error ("OPEN statement at %C must have UNIT or NEWUNIT specified");
+      goto cleanup;
+    }
+
+  /* Checks on the ACCESS specifier.  */
+  if (open->access && open->access->expr_type == EXPR_CONSTANT)
+    {
+      static const char *access_f95[] = { "SEQUENTIAL", "DIRECT", NULL };
+      static const char *access_f2003[] = { "STREAM", NULL };
+      static const char *access_gnu[] = { "APPEND", NULL };
+
+      if (!compare_to_allowed_values ("ACCESS", access_f95, access_f2003,
+				      access_gnu,
+				      open->access->value.character.string,
+				      "OPEN", warn))
+	goto cleanup;
+    }
+
+  /* Checks on the ACTION specifier.  */
+  if (open->action && open->action->expr_type == EXPR_CONSTANT)
+    {
+      static const char *action[] = { "READ", "WRITE", "READWRITE", NULL };
+
+      if (!compare_to_allowed_values ("ACTION", action, NULL, NULL,
+				      open->action->value.character.string,
+				      "OPEN", warn))
+	goto cleanup;
+    }
+
+  /* Checks on the ASYNCHRONOUS specifier.  */
+  if (open->asynchronous)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ASYNCHRONOUS= at %C "
+	  "not allowed in Fortran 95") == FAILURE)
+	goto cleanup;
+
+      if (open->asynchronous->expr_type == EXPR_CONSTANT)
+	{
+	  static const char * asynchronous[] = { "YES", "NO", NULL };
+
+	  if (!compare_to_allowed_values ("ASYNCHRONOUS", asynchronous,
+			NULL, NULL, open->asynchronous->value.character.string,
+			"OPEN", warn))
+	    goto cleanup;
+	}
+    }
+
+  /* Checks on the BLANK specifier.  */
+  if (open->blank)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BLANK= at %C "
+	  "not allowed in Fortran 95") == FAILURE)
+	goto cleanup;
+
+      if (open->blank->expr_type == EXPR_CONSTANT)
+	{
+	  static const char *blank[] = { "ZERO", "NULL", NULL };
+
+	  if (!compare_to_allowed_values ("BLANK", blank, NULL, NULL,
+					  open->blank->value.character.string,
+					  "OPEN", warn))
+	    goto cleanup;
+	}
+    }
+
+  /* Checks on the DECIMAL specifier.  */
+  if (open->decimal)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DECIMAL= at %C "
+	  "not allowed in Fortran 95") == FAILURE)
+	goto cleanup;
+
+      if (open->decimal->expr_type == EXPR_CONSTANT)
+	{
+	  static const char * decimal[] = { "COMMA", "POINT", NULL };
+
+	  if (!compare_to_allowed_values ("DECIMAL", decimal, NULL, NULL,
+					  open->decimal->value.character.string,
+					  "OPEN", warn))
+	    goto cleanup;
+	}
+    }
+
+  /* Checks on the DELIM specifier.  */
+  if (open->delim)
+    {
+      if (open->delim->expr_type == EXPR_CONSTANT)
+	{
+	  static const char *delim[] = { "APOSTROPHE", "QUOTE", "NONE", NULL };
+
+	  if (!compare_to_allowed_values ("DELIM", delim, NULL, NULL,
+					  open->delim->value.character.string,
+					  "OPEN", warn))
+	  goto cleanup;
+	}
+    }
+
+  /* Checks on the ENCODING specifier.  */
+  if (open->encoding)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ENCODING= at %C "
+	  "not allowed in Fortran 95") == FAILURE)
+	goto cleanup;
+    
+      if (open->encoding->expr_type == EXPR_CONSTANT)
+	{
+	  static const char * encoding[] = { "DEFAULT", "UTF-8", NULL };
+
+	  if (!compare_to_allowed_values ("ENCODING", encoding, NULL, NULL,
+					  open->encoding->value.character.string,
+					  "OPEN", warn))
+	  goto cleanup;
+	}
+    }
+
+  /* Checks on the FORM specifier.  */
+  if (open->form && open->form->expr_type == EXPR_CONSTANT)
+    {
+      static const char *form[] = { "FORMATTED", "UNFORMATTED", NULL };
+
+      if (!compare_to_allowed_values ("FORM", form, NULL, NULL,
+				      open->form->value.character.string,
+				      "OPEN", warn))
+	goto cleanup;
+    }
+
+  /* Checks on the PAD specifier.  */
+  if (open->pad && open->pad->expr_type == EXPR_CONSTANT)
+    {
+      static const char *pad[] = { "YES", "NO", NULL };
+
+      if (!compare_to_allowed_values ("PAD", pad, NULL, NULL,
+				      open->pad->value.character.string,
+				      "OPEN", warn))
+	goto cleanup;
+    }
+
+  /* Checks on the POSITION specifier.  */
+  if (open->position && open->position->expr_type == EXPR_CONSTANT)
+    {
+      static const char *position[] = { "ASIS", "REWIND", "APPEND", NULL };
+
+      if (!compare_to_allowed_values ("POSITION", position, NULL, NULL,
+				      open->position->value.character.string,
+				      "OPEN", warn))
+	goto cleanup;
+    }
+
+  /* Checks on the ROUND specifier.  */
+  if (open->round)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran F2003: ROUND= at %C "
+	  "not allowed in Fortran 95") == FAILURE)
+      goto cleanup;
+
+      if (open->round->expr_type == EXPR_CONSTANT)
+	{
+	  static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST",
+					  "COMPATIBLE", "PROCESSOR_DEFINED",
+					   NULL };
+
+	  if (!compare_to_allowed_values ("ROUND", round, NULL, NULL,
+					  open->round->value.character.string,
+					  "OPEN", warn))
+	  goto cleanup;
+	}
+    }
+
+  /* Checks on the SIGN specifier.  */
+  if (open->sign) 
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: SIGN= at %C "
+	  "not allowed in Fortran 95") == FAILURE)
+	goto cleanup;
+
+      if (open->sign->expr_type == EXPR_CONSTANT)
+	{
+	  static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED",
+					  NULL };
+
+	  if (!compare_to_allowed_values ("SIGN", sign, NULL, NULL,
+					  open->sign->value.character.string,
+					  "OPEN", warn))
+	  goto cleanup;
+	}
+    }
+
+#define warn_or_error(...) \
+{ \
+  if (warn) \
+    gfc_warning (__VA_ARGS__); \
+  else \
+    { \
+      gfc_error (__VA_ARGS__); \
+      goto cleanup; \
+    } \
+}
+
+  /* Checks on the RECL specifier.  */
+  if (open->recl && open->recl->expr_type == EXPR_CONSTANT
+      && open->recl->ts.type == BT_INTEGER
+      && mpz_sgn (open->recl->value.integer) != 1)
+    {
+      warn_or_error ("RECL in OPEN statement at %C must be positive");
+    }
+
+  /* Checks on the STATUS specifier.  */
+  if (open->status && open->status->expr_type == EXPR_CONSTANT)
+    {
+      static const char *status[] = { "OLD", "NEW", "SCRATCH",
+	"REPLACE", "UNKNOWN", NULL };
+
+      if (!compare_to_allowed_values ("STATUS", status, NULL, NULL,
+				      open->status->value.character.string,
+				      "OPEN", warn))
+	goto cleanup;
+
+      /* F2003, 9.4.5: If the STATUS= specifier has the value NEW or REPLACE,
+	 the FILE= specifier shall appear.  */
+      if (open->file == NULL
+	  && (gfc_wide_strncasecmp (open->status->value.character.string,
+				    "replace", 7) == 0
+	      || gfc_wide_strncasecmp (open->status->value.character.string,
+				       "new", 3) == 0))
+	{
+	  char *s = gfc_widechar_to_char (open->status->value.character.string,
+					  -1);
+	  warn_or_error ("The STATUS specified in OPEN statement at %C is "
+			 "'%s' and no FILE specifier is present", s);
+	  gfc_free (s);
+	}
+
+      /* F2003, 9.4.5: If the STATUS= specifier has the value SCRATCH,
+	 the FILE= specifier shall not appear.  */
+      if (gfc_wide_strncasecmp (open->status->value.character.string,
+				"scratch", 7) == 0 && open->file)
+	{
+	  warn_or_error ("The STATUS specified in OPEN statement at %C "
+			 "cannot have the value SCRATCH if a FILE specifier "
+			 "is present");
+	}
+    }
+
+  /* Things that are not allowed for unformatted I/O.  */
+  if (open->form && open->form->expr_type == EXPR_CONSTANT
+      && (open->delim || open->decimal || open->encoding || open->round
+	  || open->sign || open->pad || open->blank)
+      && gfc_wide_strncasecmp (open->form->value.character.string,
+			       "unformatted", 11) == 0)
+    {
+      const char *spec = (open->delim ? "DELIM "
+				      : (open->pad ? "PAD " : open->blank
+							    ? "BLANK " : ""));
+
+      warn_or_error ("%s specifier at %C not allowed in OPEN statement for "
+		     "unformatted I/O", spec);
+    }
+
+  if (open->recl && open->access && open->access->expr_type == EXPR_CONSTANT
+      && gfc_wide_strncasecmp (open->access->value.character.string,
+			       "stream", 6) == 0)
+    {
+      warn_or_error ("RECL specifier not allowed in OPEN statement at %C for "
+		     "stream I/O");
+    }
+
+  if (open->position
+      && open->access && open->access->expr_type == EXPR_CONSTANT
+      && !(gfc_wide_strncasecmp (open->access->value.character.string,
+				 "sequential", 10) == 0
+	   || gfc_wide_strncasecmp (open->access->value.character.string,
+				    "stream", 6) == 0
+	   || gfc_wide_strncasecmp (open->access->value.character.string,
+				    "append", 6) == 0))
+    {
+      warn_or_error ("POSITION specifier in OPEN statement at %C only allowed "
+		     "for stream or sequential ACCESS");
+    }
+
+#undef warn_or_error
+
+  new_st.op = EXEC_OPEN;
+  new_st.ext.open = open;
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_OPEN);
+
+cleanup:
+  gfc_free_open (open);
+  return MATCH_ERROR;
+}
+
+
+/* Free a gfc_close structure an all its expressions.  */
+
+void
+gfc_free_close (gfc_close *close)
+{
+  if (close == NULL)
+    return;
+
+  gfc_free_expr (close->unit);
+  gfc_free_expr (close->iomsg);
+  gfc_free_expr (close->iostat);
+  gfc_free_expr (close->status);
+  gfc_free (close);
+}
+
+
+/* Match elements of a CLOSE statement.  */
+
+static match
+match_close_element (gfc_close *close)
+{
+  match m;
+
+  m = match_etag (&tag_unit, &close->unit);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_status, &close->status);
+  if (m != MATCH_NO)
+    return m;
+  m = match_out_tag (&tag_iomsg, &close->iomsg);
+  if (m != MATCH_NO)
+    return m;
+  m = match_out_tag (&tag_iostat, &close->iostat);
+  if (m != MATCH_NO)
+    return m;
+  m = match_ltag (&tag_err, &close->err);
+  if (m != MATCH_NO)
+    return m;
+
+  return MATCH_NO;
+}
+
+
+/* Match a CLOSE statement.  */
+
+match
+gfc_match_close (void)
+{
+  gfc_close *close;
+  match m;
+  bool warn;
+
+  m = gfc_match_char ('(');
+  if (m == MATCH_NO)
+    return m;
+
+  close = XCNEW (gfc_close);
+
+  m = match_close_element (close);
+
+  if (m == MATCH_ERROR)
+    goto cleanup;
+  if (m == MATCH_NO)
+    {
+      m = gfc_match_expr (&close->unit);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	goto cleanup;
+    }
+
+  for (;;)
+    {
+      if (gfc_match_char (')') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+
+      m = match_close_element (close);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+  if (gfc_match_eos () == MATCH_NO)
+    goto syntax;
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("CLOSE statement not allowed in PURE procedure at %C");
+      goto cleanup;
+    }
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  warn = (close->iostat || close->err) ? true : false;
+
+  /* Checks on the STATUS specifier.  */
+  if (close->status && close->status->expr_type == EXPR_CONSTANT)
+    {
+      static const char *status[] = { "KEEP", "DELETE", NULL };
+
+      if (!compare_to_allowed_values ("STATUS", status, NULL, NULL,
+				      close->status->value.character.string,
+				      "CLOSE", warn))
+	goto cleanup;
+    }
+
+  new_st.op = EXEC_CLOSE;
+  new_st.ext.close = close;
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_CLOSE);
+
+cleanup:
+  gfc_free_close (close);
+  return MATCH_ERROR;
+}
+
+
+/* Resolve everything in a gfc_close structure.  */
+
+gfc_try
+gfc_resolve_close (gfc_close *close)
+{
+  RESOLVE_TAG (&tag_unit, close->unit);
+  RESOLVE_TAG (&tag_iomsg, close->iomsg);
+  RESOLVE_TAG (&tag_iostat, close->iostat);
+  RESOLVE_TAG (&tag_status, close->status);
+
+  if (gfc_reference_st_label (close->err, ST_LABEL_TARGET) == FAILURE)
+    return FAILURE;
+
+  if (close->unit->expr_type == EXPR_CONSTANT
+      && close->unit->ts.type == BT_INTEGER
+      && mpz_sgn (close->unit->value.integer) < 0)
+    {
+      gfc_error ("UNIT number in CLOSE statement at %L must be non-negative",
+		 &close->unit->where);
+    }
+
+  return SUCCESS;
+}
+
+
+/* Free a gfc_filepos structure.  */
+
+void
+gfc_free_filepos (gfc_filepos *fp)
+{
+  gfc_free_expr (fp->unit);
+  gfc_free_expr (fp->iomsg);
+  gfc_free_expr (fp->iostat);
+  gfc_free (fp);
+}
+
+
+/* Match elements of a REWIND, BACKSPACE, ENDFILE, or FLUSH statement.  */
+
+static match
+match_file_element (gfc_filepos *fp)
+{
+  match m;
+
+  m = match_etag (&tag_unit, &fp->unit);
+  if (m != MATCH_NO)
+    return m;
+  m = match_out_tag (&tag_iomsg, &fp->iomsg);
+  if (m != MATCH_NO)
+    return m;
+  m = match_out_tag (&tag_iostat, &fp->iostat);
+  if (m != MATCH_NO)
+    return m;
+  m = match_ltag (&tag_err, &fp->err);
+  if (m != MATCH_NO)
+    return m;
+
+  return MATCH_NO;
+}
+
+
+/* Match the second half of the file-positioning statements, REWIND,
+   BACKSPACE, ENDFILE, or the FLUSH statement.  */
+
+static match
+match_filepos (gfc_statement st, gfc_exec_op op)
+{
+  gfc_filepos *fp;
+  match m;
+
+  fp = XCNEW (gfc_filepos);
+
+  if (gfc_match_char ('(') == MATCH_NO)
+    {
+      m = gfc_match_expr (&fp->unit);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      goto done;
+    }
+
+  m = match_file_element (fp);
+  if (m == MATCH_ERROR)
+    goto done;
+  if (m == MATCH_NO)
+    {
+      m = gfc_match_expr (&fp->unit);
+      if (m == MATCH_ERROR)
+	goto done;
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+  for (;;)
+    {
+      if (gfc_match_char (')') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+
+      m = match_file_element (fp);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+done:
+  if (gfc_match_eos () != MATCH_YES)
+    goto syntax;
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("%s statement not allowed in PURE procedure at %C",
+		 gfc_ascii_statement (st));
+
+      goto cleanup;
+    }
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  new_st.op = op;
+  new_st.ext.filepos = fp;
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (st);
+
+cleanup:
+  gfc_free_filepos (fp);
+  return MATCH_ERROR;
+}
+
+
+gfc_try
+gfc_resolve_filepos (gfc_filepos *fp)
+{
+  RESOLVE_TAG (&tag_unit, fp->unit);
+  RESOLVE_TAG (&tag_iostat, fp->iostat);
+  RESOLVE_TAG (&tag_iomsg, fp->iomsg);
+  if (gfc_reference_st_label (fp->err, ST_LABEL_TARGET) == FAILURE)
+    return FAILURE;
+
+  if (fp->unit->expr_type == EXPR_CONSTANT
+      && fp->unit->ts.type == BT_INTEGER
+      && mpz_sgn (fp->unit->value.integer) < 0)
+    {
+      gfc_error ("UNIT number in statement at %L must be non-negative",
+		 &fp->unit->where);
+    }
+
+  return SUCCESS;
+}
+
+
+/* Match the file positioning statements: ENDFILE, BACKSPACE, REWIND,
+   and the FLUSH statement.  */
+
+match
+gfc_match_endfile (void)
+{
+  return match_filepos (ST_END_FILE, EXEC_ENDFILE);
+}
+
+match
+gfc_match_backspace (void)
+{
+  return match_filepos (ST_BACKSPACE, EXEC_BACKSPACE);
+}
+
+match
+gfc_match_rewind (void)
+{
+  return match_filepos (ST_REWIND, EXEC_REWIND);
+}
+
+match
+gfc_match_flush (void)
+{
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: FLUSH statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  return match_filepos (ST_FLUSH, EXEC_FLUSH);
+}
+
+/******************** Data Transfer Statements *********************/
+
+/* Return a default unit number.  */
+
+static gfc_expr *
+default_unit (io_kind k)
+{
+  int unit;
+
+  if (k == M_READ)
+    unit = 5;
+  else
+    unit = 6;
+
+  return gfc_get_int_expr (gfc_default_integer_kind, NULL, unit);
+}
+
+
+/* Match a unit specification for a data transfer statement.  */
+
+static match
+match_dt_unit (io_kind k, gfc_dt *dt)
+{
+  gfc_expr *e;
+
+  if (gfc_match_char ('*') == MATCH_YES)
+    {
+      if (dt->io_unit != NULL)
+	goto conflict;
+
+      dt->io_unit = default_unit (k);
+      return MATCH_YES;
+    }
+
+  if (gfc_match_expr (&e) == MATCH_YES)
+    {
+      if (dt->io_unit != NULL)
+	{
+	  gfc_free_expr (e);
+	  goto conflict;
+	}
+
+      dt->io_unit = e;
+      return MATCH_YES;
+    }
+
+  return MATCH_NO;
+
+conflict:
+  gfc_error ("Duplicate UNIT specification at %C");
+  return MATCH_ERROR;
+}
+
+
+/* Match a format specification.  */
+
+static match
+match_dt_format (gfc_dt *dt)
+{
+  locus where;
+  gfc_expr *e;
+  gfc_st_label *label;
+  match m;
+
+  where = gfc_current_locus;
+
+  if (gfc_match_char ('*') == MATCH_YES)
+    {
+      if (dt->format_expr != NULL || dt->format_label != NULL)
+	goto conflict;
+
+      dt->format_label = &format_asterisk;
+      return MATCH_YES;
+    }
+
+  if ((m = gfc_match_st_label (&label)) == MATCH_YES)
+    {
+      if (dt->format_expr != NULL || dt->format_label != NULL)
+	{
+	  gfc_free_st_label (label);
+	  goto conflict;
+	}
+
+      if (gfc_reference_st_label (label, ST_LABEL_FORMAT) == FAILURE)
+	return MATCH_ERROR;
+
+      dt->format_label = label;
+      return MATCH_YES;
+    }
+  else if (m == MATCH_ERROR)
+    /* The label was zero or too large.  Emit the correct diagnosis.  */
+    return MATCH_ERROR;
+
+  if (gfc_match_expr (&e) == MATCH_YES)
+    {
+      if (dt->format_expr != NULL || dt->format_label != NULL)
+	{
+	  gfc_free_expr (e);
+	  goto conflict;
+	}
+      dt->format_expr = e;
+      return MATCH_YES;
+    }
+
+  gfc_current_locus = where;	/* The only case where we have to restore */
+
+  return MATCH_NO;
+
+conflict:
+  gfc_error ("Duplicate format specification at %C");
+  return MATCH_ERROR;
+}
+
+
+/* Traverse a namelist that is part of a READ statement to make sure
+   that none of the variables in the namelist are INTENT(IN).  Returns
+   nonzero if we find such a variable.  */
+
+static int
+check_namelist (gfc_symbol *sym)
+{
+  gfc_namelist *p;
+
+  for (p = sym->namelist; p; p = p->next)
+    if (p->sym->attr.intent == INTENT_IN)
+      {
+	gfc_error ("Symbol '%s' in namelist '%s' is INTENT(IN) at %C",
+		   p->sym->name, sym->name);
+	return 1;
+      }
+
+  return 0;
+}
+
+
+/* Match a single data transfer element.  */
+
+static match
+match_dt_element (io_kind k, gfc_dt *dt)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symbol *sym;
+  match m;
+
+  if (gfc_match (" unit =") == MATCH_YES)
+    {
+      m = match_dt_unit (k, dt);
+      if (m != MATCH_NO)
+	return m;
+    }
+
+  if (gfc_match (" fmt =") == MATCH_YES)
+    {
+      m = match_dt_format (dt);
+      if (m != MATCH_NO)
+	return m;
+    }
+
+  if (gfc_match (" nml = %n", name) == MATCH_YES)
+    {
+      if (dt->namelist != NULL)
+	{
+	  gfc_error ("Duplicate NML specification at %C");
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_find_symbol (name, NULL, 1, &sym))
+	return MATCH_ERROR;
+
+      if (sym == NULL || sym->attr.flavor != FL_NAMELIST)
+	{
+	  gfc_error ("Symbol '%s' at %C must be a NAMELIST group name",
+		     sym != NULL ? sym->name : name);
+	  return MATCH_ERROR;
+	}
+
+      dt->namelist = sym;
+      if (k == M_READ && check_namelist (sym))
+	return MATCH_ERROR;
+
+      return MATCH_YES;
+    }
+
+  m = match_etag (&tag_e_async, &dt->asynchronous);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_blank, &dt->blank);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_delim, &dt->delim);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_pad, &dt->pad);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_sign, &dt->sign);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_round, &dt->round);
+  if (m != MATCH_NO)
+    return m;
+  m = match_out_tag (&tag_id, &dt->id);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_e_decimal, &dt->decimal);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_rec, &dt->rec);
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_spos, &dt->pos);
+  if (m != MATCH_NO)
+    return m;
+  m = match_out_tag (&tag_iomsg, &dt->iomsg);
+  if (m != MATCH_NO)
+    return m;
+  m = match_out_tag (&tag_iostat, &dt->iostat);
+  if (m != MATCH_NO)
+    return m;
+  m = match_ltag (&tag_err, &dt->err);
+  if (m == MATCH_YES)
+    dt->err_where = gfc_current_locus;
+  if (m != MATCH_NO)
+    return m;
+  m = match_etag (&tag_advance, &dt->advance);
+  if (m != MATCH_NO)
+    return m;
+  m = match_out_tag (&tag_size, &dt->size);
+  if (m != MATCH_NO)
+    return m;
+
+  m = match_ltag (&tag_end, &dt->end);
+  if (m == MATCH_YES)
+    {
+      if (k == M_WRITE)
+       {
+	 gfc_error ("END tag at %C not allowed in output statement");
+	 return MATCH_ERROR;
+       }
+      dt->end_where = gfc_current_locus;
+    }
+  if (m != MATCH_NO)
+    return m;
+
+  m = match_ltag (&tag_eor, &dt->eor);
+  if (m == MATCH_YES)
+    dt->eor_where = gfc_current_locus;
+  if (m != MATCH_NO)
+    return m;
+
+  return MATCH_NO;
+}
+
+
+/* Free a data transfer structure and everything below it.  */
+
+void
+gfc_free_dt (gfc_dt *dt)
+{
+  if (dt == NULL)
+    return;
+
+  gfc_free_expr (dt->io_unit);
+  gfc_free_expr (dt->format_expr);
+  gfc_free_expr (dt->rec);
+  gfc_free_expr (dt->advance);
+  gfc_free_expr (dt->iomsg);
+  gfc_free_expr (dt->iostat);
+  gfc_free_expr (dt->size);
+  gfc_free_expr (dt->pad);
+  gfc_free_expr (dt->delim);
+  gfc_free_expr (dt->sign);
+  gfc_free_expr (dt->round);
+  gfc_free_expr (dt->blank);
+  gfc_free_expr (dt->decimal);
+  gfc_free_expr (dt->pos);
+  gfc_free_expr (dt->dt_io_kind);
+  /* dt->extra_comma is a link to dt_io_kind if it is set.  */
+  gfc_free (dt);
+}
+
+
+/* Resolve everything in a gfc_dt structure.  */
+
+gfc_try
+gfc_resolve_dt (gfc_dt *dt, locus *loc)
+{
+  gfc_expr *e;
+  io_kind k;
+
+  /* This is set in any case.  */
+  gcc_assert (dt->dt_io_kind);
+  k = dt->dt_io_kind->value.iokind;
+
+  RESOLVE_TAG (&tag_format, dt->format_expr);
+  RESOLVE_TAG (&tag_rec, dt->rec);
+  RESOLVE_TAG (&tag_spos, dt->pos);
+  RESOLVE_TAG (&tag_advance, dt->advance);
+  RESOLVE_TAG (&tag_id, dt->id);
+  RESOLVE_TAG (&tag_iomsg, dt->iomsg);
+  RESOLVE_TAG (&tag_iostat, dt->iostat);
+  RESOLVE_TAG (&tag_size, dt->size);
+  RESOLVE_TAG (&tag_e_pad, dt->pad);
+  RESOLVE_TAG (&tag_e_delim, dt->delim);
+  RESOLVE_TAG (&tag_e_sign, dt->sign);
+  RESOLVE_TAG (&tag_e_round, dt->round);
+  RESOLVE_TAG (&tag_e_blank, dt->blank);
+  RESOLVE_TAG (&tag_e_decimal, dt->decimal);
+  RESOLVE_TAG (&tag_e_async, dt->asynchronous);
+
+  e = dt->io_unit;
+  if (e == NULL)
+    {
+      gfc_error ("UNIT not specified at %L", loc);
+      return FAILURE;
+    }
+
+  if (gfc_resolve_expr (e) == SUCCESS
+      && (e->ts.type != BT_INTEGER
+	  && (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_VARIABLE)))
+    {
+      /* If there is no extra comma signifying the "format" form of the IO
+	 statement, then this must be an error.  */
+      if (!dt->extra_comma)
+	{
+	  gfc_error ("UNIT specification at %L must be an INTEGER expression "
+		     "or a CHARACTER variable", &e->where);
+	  return FAILURE;
+	}
+      else
+	{
+	  /* At this point, we have an extra comma.  If io_unit has arrived as
+	     type character, we assume its really the "format" form of the I/O
+	     statement.  We set the io_unit to the default unit and format to
+	     the character expression.  See F95 Standard section 9.4.  */
+	  if (e->ts.type == BT_CHARACTER && (k == M_READ || k == M_PRINT))
+	    {
+	      dt->format_expr = dt->io_unit;
+	      dt->io_unit = default_unit (k);
+
+	      /* Nullify this pointer now so that a warning/error is not
+		 triggered below for the "Extension".  */
+	      dt->extra_comma = NULL;
+	    }
+
+	  if (k == M_WRITE)
+	    {
+	      gfc_error ("Invalid form of WRITE statement at %L, UNIT required",
+			 &dt->extra_comma->where);
+	      return FAILURE;
+	    }
+	}
+    }
+
+  if (e->ts.type == BT_CHARACTER)
+    {
+      if (gfc_has_vector_index (e))
+	{
+	  gfc_error ("Internal unit with vector subscript at %L", &e->where);
+	  return FAILURE;
+	}
+
+      /* If we are writing, make sure the internal unit can be changed.  */
+      gcc_assert (k != M_PRINT);
+      if (k == M_WRITE
+	  && gfc_check_vardef_context (e, false, _("internal unit in WRITE"))
+	       == FAILURE)
+	return FAILURE;
+    }
+
+  if (e->rank && e->ts.type != BT_CHARACTER)
+    {
+      gfc_error ("External IO UNIT cannot be an array at %L", &e->where);
+      return FAILURE;
+    }
+
+  if (e->expr_type == EXPR_CONSTANT && e->ts.type == BT_INTEGER
+      && mpz_sgn (e->value.integer) < 0)
+    {
+      gfc_error ("UNIT number in statement at %L must be non-negative",
+		 &e->where);
+      return FAILURE;
+    }
+
+  /* If we are reading and have a namelist, check that all namelist symbols
+     can appear in a variable definition context.  */
+  if (k == M_READ && dt->namelist)
+    {
+      gfc_namelist* n;
+      for (n = dt->namelist->namelist; n; n = n->next)
+	{
+	  gfc_expr* e;
+	  gfc_try t;
+
+	  e = gfc_get_variable_expr (gfc_find_sym_in_symtree (n->sym));
+	  t = gfc_check_vardef_context (e, false, NULL);
+	  gfc_free_expr (e);
+
+	  if (t == FAILURE)
+	    {
+	      gfc_error ("NAMELIST '%s' in READ statement at %L contains"
+			 " the symbol '%s' which may not appear in a"
+			 " variable definition context",
+			 dt->namelist->name, loc, n->sym->name);
+	      return FAILURE;
+	    }
+	}
+    }
+
+  if (dt->extra_comma
+      && gfc_notify_std (GFC_STD_GNU, "Extension: Comma before i/o "
+			 "item list at %L", &dt->extra_comma->where) == FAILURE)
+    return FAILURE;
+
+  if (dt->err)
+    {
+      if (gfc_reference_st_label (dt->err, ST_LABEL_TARGET) == FAILURE)
+	return FAILURE;
+      if (dt->err->defined == ST_LABEL_UNKNOWN)
+	{
+	  gfc_error ("ERR tag label %d at %L not defined",
+		      dt->err->value, &dt->err_where);
+	  return FAILURE;
+	}
+    }
+
+  if (dt->end)
+    {
+      if (gfc_reference_st_label (dt->end, ST_LABEL_TARGET) == FAILURE)
+	return FAILURE;
+      if (dt->end->defined == ST_LABEL_UNKNOWN)
+	{
+	  gfc_error ("END tag label %d at %L not defined",
+		      dt->end->value, &dt->end_where);
+	  return FAILURE;
+	}
+    }
+
+  if (dt->eor)
+    {
+      if (gfc_reference_st_label (dt->eor, ST_LABEL_TARGET) == FAILURE)
+	return FAILURE;
+      if (dt->eor->defined == ST_LABEL_UNKNOWN)
+	{
+	  gfc_error ("EOR tag label %d at %L not defined",
+		      dt->eor->value, &dt->eor_where);
+	  return FAILURE;
+	}
+    }
+
+  /* Check the format label actually exists.  */
+  if (dt->format_label && dt->format_label != &format_asterisk
+      && dt->format_label->defined == ST_LABEL_UNKNOWN)
+    {
+      gfc_error ("FORMAT label %d at %L not defined", dt->format_label->value,
+		 &dt->format_label->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Given an io_kind, return its name.  */
+
+static const char *
+io_kind_name (io_kind k)
+{
+  const char *name;
+
+  switch (k)
+    {
+    case M_READ:
+      name = "READ";
+      break;
+    case M_WRITE:
+      name = "WRITE";
+      break;
+    case M_PRINT:
+      name = "PRINT";
+      break;
+    case M_INQUIRE:
+      name = "INQUIRE";
+      break;
+    default:
+      gfc_internal_error ("io_kind_name(): bad I/O-kind");
+    }
+
+  return name;
+}
+
+
+/* Match an IO iteration statement of the form:
+
+   ( [<IO element> ,] <IO element>, I = <expr>, <expr> [, <expr> ] )
+
+   which is equivalent to a single IO element.  This function is
+   mutually recursive with match_io_element().  */
+
+static match match_io_element (io_kind, gfc_code **);
+
+static match
+match_io_iterator (io_kind k, gfc_code **result)
+{
+  gfc_code *head, *tail, *new_code;
+  gfc_iterator *iter;
+  locus old_loc;
+  match m;
+  int n;
+
+  iter = NULL;
+  head = NULL;
+  old_loc = gfc_current_locus;
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    return MATCH_NO;
+
+  m = match_io_element (k, &head);
+  tail = head;
+
+  if (m != MATCH_YES || gfc_match_char (',') != MATCH_YES)
+    {
+      m = MATCH_NO;
+      goto cleanup;
+    }
+
+  /* Can't be anything but an IO iterator.  Build a list.  */
+  iter = gfc_get_iterator ();
+
+  for (n = 1;; n++)
+    {
+      m = gfc_match_iterator (iter, 0);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_YES)
+	{
+	  gfc_check_do_variable (iter->var->symtree);
+	  break;
+	}
+
+      m = match_io_element (k, &new_code);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	{
+	  if (n > 2)
+	    goto syntax;
+	  goto cleanup;
+	}
+
+      tail = gfc_append_code (tail, new_code);
+
+      if (gfc_match_char (',') != MATCH_YES)
+	{
+	  if (n > 2)
+	    goto syntax;
+	  m = MATCH_NO;
+	  goto cleanup;
+	}
+    }
+
+  if (gfc_match_char (')') != MATCH_YES)
+    goto syntax;
+
+  new_code = gfc_get_code ();
+  new_code->op = EXEC_DO;
+  new_code->ext.iterator = iter;
+
+  new_code->block = gfc_get_code ();
+  new_code->block->op = EXEC_DO;
+  new_code->block->next = head;
+
+  *result = new_code;
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in I/O iterator at %C");
+  m = MATCH_ERROR;
+
+cleanup:
+  gfc_free_iterator (iter, 1);
+  gfc_free_statements (head);
+  gfc_current_locus = old_loc;
+  return m;
+}
+
+
+/* Match a single element of an IO list, which is either a single
+   expression or an IO Iterator.  */
+
+static match
+match_io_element (io_kind k, gfc_code **cpp)
+{
+  gfc_expr *expr;
+  gfc_code *cp;
+  match m;
+
+  expr = NULL;
+
+  m = match_io_iterator (k, cpp);
+  if (m == MATCH_YES)
+    return MATCH_YES;
+
+  if (k == M_READ)
+    {
+      m = gfc_match_variable (&expr, 0);
+      if (m == MATCH_NO)
+	gfc_error ("Expected variable in READ statement at %C");
+    }
+  else
+    {
+      m = gfc_match_expr (&expr);
+      if (m == MATCH_NO)
+	gfc_error ("Expected expression in %s statement at %C",
+		   io_kind_name (k));
+    }
+
+  if (m == MATCH_YES && k == M_READ && gfc_check_do_variable (expr->symtree))
+    m = MATCH_ERROR;
+
+  if (m != MATCH_YES)
+    {
+      gfc_free_expr (expr);
+      return MATCH_ERROR;
+    }
+
+  cp = gfc_get_code ();
+  cp->op = EXEC_TRANSFER;
+  cp->expr1 = expr;
+  if (k != M_INQUIRE)
+    cp->ext.dt = current_dt;
+
+  *cpp = cp;
+  return MATCH_YES;
+}
+
+
+/* Match an I/O list, building gfc_code structures as we go.  */
+
+static match
+match_io_list (io_kind k, gfc_code **head_p)
+{
+  gfc_code *head, *tail, *new_code;
+  match m;
+
+  *head_p = head = tail = NULL;
+  if (gfc_match_eos () == MATCH_YES)
+    return MATCH_YES;
+
+  for (;;)
+    {
+      m = match_io_element (k, &new_code);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      tail = gfc_append_code (tail, new_code);
+      if (head == NULL)
+	head = new_code;
+
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  *head_p = head;
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in %s statement at %C", io_kind_name (k));
+
+cleanup:
+  gfc_free_statements (head);
+  return MATCH_ERROR;
+}
+
+
+/* Attach the data transfer end node.  */
+
+static void
+terminate_io (gfc_code *io_code)
+{
+  gfc_code *c;
+
+  if (io_code == NULL)
+    io_code = new_st.block;
+
+  c = gfc_get_code ();
+  c->op = EXEC_DT_END;
+
+  /* Point to structure that is already there */
+  c->ext.dt = new_st.ext.dt;
+  gfc_append_code (io_code, c);
+}
+
+
+/* Check the constraints for a data transfer statement.  The majority of the
+   constraints appearing in 9.4 of the standard appear here.  Some are handled
+   in resolve_tag and others in gfc_resolve_dt.  */
+
+static match
+check_io_constraints (io_kind k, gfc_dt *dt, gfc_code *io_code,
+		      locus *spec_end)
+{
+#define io_constraint(condition,msg,arg)\
+if (condition) \
+  {\
+    gfc_error(msg,arg);\
+    m = MATCH_ERROR;\
+  }
+
+  match m;
+  gfc_expr *expr;
+  gfc_symbol *sym = NULL;
+  bool warn, unformatted;
+
+  warn = (dt->err || dt->iostat) ? true : false;
+  unformatted = dt->format_expr == NULL && dt->format_label == NULL
+		&& dt->namelist == NULL;
+
+  m = MATCH_YES;
+
+  expr = dt->io_unit;
+  if (expr && expr->expr_type == EXPR_VARIABLE
+      && expr->ts.type == BT_CHARACTER)
+    {
+      sym = expr->symtree->n.sym;
+
+      io_constraint (k == M_WRITE && sym->attr.intent == INTENT_IN,
+		     "Internal file at %L must not be INTENT(IN)",
+		     &expr->where);
+
+      io_constraint (gfc_has_vector_index (dt->io_unit),
+		     "Internal file incompatible with vector subscript at %L",
+		     &expr->where);
+
+      io_constraint (dt->rec != NULL,
+		     "REC tag at %L is incompatible with internal file",
+		     &dt->rec->where);
+    
+      io_constraint (dt->pos != NULL,
+		     "POS tag at %L is incompatible with internal file",
+		     &dt->pos->where);
+
+      io_constraint (unformatted,
+		     "Unformatted I/O not allowed with internal unit at %L",
+		     &dt->io_unit->where);
+
+      io_constraint (dt->asynchronous != NULL,
+		     "ASYNCHRONOUS tag at %L not allowed with internal file",
+		     &dt->asynchronous->where);
+
+      if (dt->namelist != NULL)
+	{
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Internal file "
+			      "at %L with namelist", &expr->where)
+	      == FAILURE)
+	    m = MATCH_ERROR;
+	}
+
+      io_constraint (dt->advance != NULL,
+		     "ADVANCE tag at %L is incompatible with internal file",
+		     &dt->advance->where);
+    }
+
+  if (expr && expr->ts.type != BT_CHARACTER)
+    {
+
+      io_constraint (gfc_pure (NULL) && (k == M_READ || k == M_WRITE),
+		     "IO UNIT in %s statement at %C must be "
+		     "an internal file in a PURE procedure",
+		     io_kind_name (k));
+
+      if (gfc_implicit_pure (NULL) && (k == M_READ || k == M_WRITE))
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+    }
+
+  if (k != M_READ)
+    {
+      io_constraint (dt->end, "END tag not allowed with output at %L",
+		     &dt->end_where);
+
+      io_constraint (dt->eor, "EOR tag not allowed with output at %L",
+		     &dt->eor_where);
+
+      io_constraint (dt->blank, "BLANK= specifier not allowed with output at %L",
+		     &dt->blank->where);
+
+      io_constraint (dt->pad, "PAD= specifier not allowed with output at %L",
+		     &dt->pad->where);
+
+      io_constraint (dt->size, "SIZE= specifier not allowed with output at %L",
+		     &dt->size->where);
+    }
+  else
+    {
+      io_constraint (dt->size && dt->advance == NULL,
+		     "SIZE tag at %L requires an ADVANCE tag",
+		     &dt->size->where);
+
+      io_constraint (dt->eor && dt->advance == NULL,
+		     "EOR tag at %L requires an ADVANCE tag",
+		     &dt->eor_where);
+    }
+
+  if (dt->asynchronous) 
+    {
+      static const char * asynchronous[] = { "YES", "NO", NULL };
+
+      if (gfc_reduce_init_expr (dt->asynchronous) != SUCCESS)
+	{
+	  gfc_error ("ASYNCHRONOUS= specifier at %L must be an initialization "
+		     "expression", &dt->asynchronous->where);
+	  return MATCH_ERROR;
+	}
+
+      if (!compare_to_allowed_values
+		("ASYNCHRONOUS", asynchronous, NULL, NULL,
+		 dt->asynchronous->value.character.string,
+		 io_kind_name (k), warn))
+	return MATCH_ERROR;
+    }
+
+  if (dt->id)
+    {
+      bool not_yes
+	= !dt->asynchronous
+	  || gfc_wide_strlen (dt->asynchronous->value.character.string) != 3
+	  || gfc_wide_strncasecmp (dt->asynchronous->value.character.string,
+				   "yes", 3) != 0;
+      io_constraint (not_yes,
+		     "ID= specifier at %L must be with ASYNCHRONOUS='yes' "
+		     "specifier", &dt->id->where);
+    }
+
+  if (dt->decimal)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DECIMAL= at %C "
+	  "not allowed in Fortran 95") == FAILURE)
+	return MATCH_ERROR;
+
+      if (dt->decimal->expr_type == EXPR_CONSTANT)
+	{
+	  static const char * decimal[] = { "COMMA", "POINT", NULL };
+
+	  if (!compare_to_allowed_values ("DECIMAL", decimal, NULL, NULL,
+					  dt->decimal->value.character.string,
+					  io_kind_name (k), warn))
+	    return MATCH_ERROR;
+
+	  io_constraint (unformatted,
+			 "the DECIMAL= specifier at %L must be with an "
+			 "explicit format expression", &dt->decimal->where);
+	}
+    }
+  
+  if (dt->blank)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BLANK= at %C "
+	  "not allowed in Fortran 95") == FAILURE)
+	return MATCH_ERROR;
+
+      if (dt->blank->expr_type == EXPR_CONSTANT)
+	{
+	  static const char * blank[] = { "NULL", "ZERO", NULL };
+
+	  if (!compare_to_allowed_values ("BLANK", blank, NULL, NULL,
+					  dt->blank->value.character.string,
+					  io_kind_name (k), warn))
+	    return MATCH_ERROR;
+
+	  io_constraint (unformatted,
+			 "the BLANK= specifier at %L must be with an "
+			 "explicit format expression", &dt->blank->where);
+	}
+    }
+
+  if (dt->pad)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PAD= at %C "
+	  "not allowed in Fortran 95") == FAILURE)
+	return MATCH_ERROR;
+
+      if (dt->pad->expr_type == EXPR_CONSTANT)
+	{
+	  static const char * pad[] = { "YES", "NO", NULL };
+
+	  if (!compare_to_allowed_values ("PAD", pad, NULL, NULL,
+					  dt->pad->value.character.string,
+					  io_kind_name (k), warn))
+	    return MATCH_ERROR;
+
+	  io_constraint (unformatted,
+			 "the PAD= specifier at %L must be with an "
+			 "explicit format expression", &dt->pad->where);
+	}
+    }
+
+  if (dt->round)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ROUND= at %C "
+	  "not allowed in Fortran 95") == FAILURE)
+	return MATCH_ERROR;
+
+      if (dt->round->expr_type == EXPR_CONSTANT)
+	{
+	  static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST",
+					  "COMPATIBLE", "PROCESSOR_DEFINED",
+					  NULL };
+
+	  if (!compare_to_allowed_values ("ROUND", round, NULL, NULL,
+					  dt->round->value.character.string,
+					  io_kind_name (k), warn))
+	    return MATCH_ERROR;
+	}
+    }
+  
+  if (dt->sign)
+    {
+      /* When implemented, change the following to use gfc_notify_std F2003.
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: SIGN= at %C "
+	  "not allowed in Fortran 95") == FAILURE)
+	return MATCH_ERROR;  */
+      if (dt->sign->expr_type == EXPR_CONSTANT)
+	{
+	  static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED",
+					 NULL };
+
+	  if (!compare_to_allowed_values ("SIGN", sign, NULL, NULL,
+				      dt->sign->value.character.string,
+				      io_kind_name (k), warn))
+	    return MATCH_ERROR;
+
+	  io_constraint (unformatted,
+			 "SIGN= specifier at %L must be with an "
+			 "explicit format expression", &dt->sign->where);
+
+	  io_constraint (k == M_READ,
+			 "SIGN= specifier at %L not allowed in a "
+			 "READ statement", &dt->sign->where);
+	}
+    }
+
+  if (dt->delim)
+    {
+      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: DELIM= at %C "
+	  "not allowed in Fortran 95") == FAILURE)
+	return MATCH_ERROR;
+
+      if (dt->delim->expr_type == EXPR_CONSTANT)
+	{
+	  static const char *delim[] = { "APOSTROPHE", "QUOTE", "NONE", NULL };
+
+	  if (!compare_to_allowed_values ("DELIM", delim, NULL, NULL,
+					  dt->delim->value.character.string,
+					  io_kind_name (k), warn))
+	    return MATCH_ERROR;
+
+	  io_constraint (k == M_READ,
+			 "DELIM= specifier at %L not allowed in a "
+			 "READ statement", &dt->delim->where);
+      
+	  io_constraint (dt->format_label != &format_asterisk
+			 && dt->namelist == NULL,
+			 "DELIM= specifier at %L must have FMT=*",
+			 &dt->delim->where);
+
+	  io_constraint (unformatted && dt->namelist == NULL,
+			 "DELIM= specifier at %L must be with FMT=* or "
+			 "NML= specifier ", &dt->delim->where);
+	}
+    }
+  
+  if (dt->namelist)
+    {
+      io_constraint (io_code && dt->namelist,
+		     "NAMELIST cannot be followed by IO-list at %L",
+		     &io_code->loc);
+
+      io_constraint (dt->format_expr,
+		     "IO spec-list cannot contain both NAMELIST group name "
+		     "and format specification at %L",
+		     &dt->format_expr->where);
+
+      io_constraint (dt->format_label,
+		     "IO spec-list cannot contain both NAMELIST group name "
+		     "and format label at %L", spec_end);
+
+      io_constraint (dt->rec,
+		     "NAMELIST IO is not allowed with a REC= specifier "
+		     "at %L", &dt->rec->where);
+
+      io_constraint (dt->advance,
+		     "NAMELIST IO is not allowed with a ADVANCE= specifier "
+		     "at %L", &dt->advance->where);
+    }
+
+  if (dt->rec)
+    {
+      io_constraint (dt->end,
+		     "An END tag is not allowed with a "
+		     "REC= specifier at %L", &dt->end_where);
+
+      io_constraint (dt->format_label == &format_asterisk,
+		     "FMT=* is not allowed with a REC= specifier "
+		     "at %L", spec_end);
+
+      io_constraint (dt->pos,
+		     "POS= is not allowed with REC= specifier "
+		     "at %L", &dt->pos->where);
+    }
+
+  if (dt->advance)
+    {
+      int not_yes, not_no;
+      expr = dt->advance;
+
+      io_constraint (dt->format_label == &format_asterisk,
+		     "List directed format(*) is not allowed with a "
+		     "ADVANCE= specifier at %L.", &expr->where);
+
+      io_constraint (unformatted,
+		     "the ADVANCE= specifier at %L must appear with an "
+		     "explicit format expression", &expr->where);
+
+      if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_CHARACTER)
+	{
+	  const gfc_char_t *advance = expr->value.character.string;
+	  not_no = gfc_wide_strlen (advance) != 2
+		   || gfc_wide_strncasecmp (advance, "no", 2) != 0;
+	  not_yes = gfc_wide_strlen (advance) != 3
+		    || gfc_wide_strncasecmp (advance, "yes", 3) != 0;
+	}
+      else
+	{
+	  not_no = 0;
+	  not_yes = 0;
+	}
+
+      io_constraint (not_no && not_yes,
+		     "ADVANCE= specifier at %L must have value = "
+		     "YES or NO.", &expr->where);
+
+      io_constraint (dt->size && not_no && k == M_READ,
+		     "SIZE tag at %L requires an ADVANCE = 'NO'",
+		     &dt->size->where);
+
+      io_constraint (dt->eor && not_no && k == M_READ,
+		     "EOR tag at %L requires an ADVANCE = 'NO'",
+		     &dt->eor_where);      
+    }
+
+  expr = dt->format_expr;
+  if (gfc_simplify_expr (expr, 0) == FAILURE
+      || check_format_string (expr, k == M_READ) == FAILURE)
+    return MATCH_ERROR;
+
+  return m;
+}
+#undef io_constraint
+
+
+/* Match a READ, WRITE or PRINT statement.  */
+
+static match
+match_io (io_kind k)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_code *io_code;
+  gfc_symbol *sym;
+  int comma_flag;
+  locus where;
+  locus spec_end;
+  gfc_dt *dt;
+  match m;
+
+  where = gfc_current_locus;
+  comma_flag = 0;
+  current_dt = dt = XCNEW (gfc_dt);
+  m = gfc_match_char ('(');
+  if (m == MATCH_NO)
+    {
+      where = gfc_current_locus;
+      if (k == M_WRITE)
+	goto syntax;
+      else if (k == M_PRINT)
+	{
+	  /* Treat the non-standard case of PRINT namelist.  */
+	  if ((gfc_current_form == FORM_FIXED || gfc_peek_ascii_char () == ' ')
+	      && gfc_match_name (name) == MATCH_YES)
+	    {
+	      gfc_find_symbol (name, NULL, 1, &sym);
+	      if (sym && sym->attr.flavor == FL_NAMELIST)
+		{
+		  if (gfc_notify_std (GFC_STD_GNU, "PRINT namelist at "
+				      "%C is an extension") == FAILURE)
+		    {
+		      m = MATCH_ERROR;
+		      goto cleanup;
+		    }
+
+		  dt->io_unit = default_unit (k);
+		  dt->namelist = sym;
+		  goto get_io_list;
+		}
+	      else
+		gfc_current_locus = where;
+	    }
+	}
+
+      if (gfc_current_form == FORM_FREE)
+	{
+	  char c = gfc_peek_ascii_char ();
+	  if (c != ' ' && c != '*' && c != '\'' && c != '"')
+	    {
+	      m = MATCH_NO;
+	      goto cleanup;
+	    }
+	}
+
+      m = match_dt_format (dt);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      comma_flag = 1;
+      dt->io_unit = default_unit (k);
+      goto get_io_list;
+    }
+  else
+    {
+      /* Before issuing an error for a malformed 'print (1,*)' type of
+	 error, check for a default-char-expr of the form ('(I0)').  */
+      if (k == M_PRINT && m == MATCH_YES)
+	{
+	  /* Reset current locus to get the initial '(' in an expression.  */
+	  gfc_current_locus = where;
+	  dt->format_expr = NULL;
+	  m = match_dt_format (dt);
+
+	  if (m == MATCH_ERROR)
+	    goto cleanup;
+	  if (m == MATCH_NO || dt->format_expr == NULL)
+	    goto syntax;
+
+	  comma_flag = 1;
+	  dt->io_unit = default_unit (k);
+	  goto get_io_list;
+	}
+    }
+
+  /* Match a control list */
+  if (match_dt_element (k, dt) == MATCH_YES)
+    goto next;
+  if (match_dt_unit (k, dt) != MATCH_YES)
+    goto loop;
+
+  if (gfc_match_char (')') == MATCH_YES)
+    goto get_io_list;
+  if (gfc_match_char (',') != MATCH_YES)
+    goto syntax;
+
+  m = match_dt_element (k, dt);
+  if (m == MATCH_YES)
+    goto next;
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  m = match_dt_format (dt);
+  if (m == MATCH_YES)
+    goto next;
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  where = gfc_current_locus;
+
+  m = gfc_match_name (name);
+  if (m == MATCH_YES)
+    {
+      gfc_find_symbol (name, NULL, 1, &sym);
+      if (sym && sym->attr.flavor == FL_NAMELIST)
+	{
+	  dt->namelist = sym;
+	  if (k == M_READ && check_namelist (sym))
+	    {
+	      m = MATCH_ERROR;
+	      goto cleanup;
+	    }
+	  goto next;
+	}
+    }
+
+  gfc_current_locus = where;
+
+  goto loop;			/* No matches, try regular elements */
+
+next:
+  if (gfc_match_char (')') == MATCH_YES)
+    goto get_io_list;
+  if (gfc_match_char (',') != MATCH_YES)
+    goto syntax;
+
+loop:
+  for (;;)
+    {
+      m = match_dt_element (k, dt);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	goto cleanup;
+
+      if (gfc_match_char (')') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+get_io_list:
+
+  /* Used in check_io_constraints, where no locus is available.  */
+  spec_end = gfc_current_locus;
+
+  /* Save the IO kind for later use.  */
+  dt->dt_io_kind = gfc_get_iokind_expr (&gfc_current_locus, k);
+
+  /* Optional leading comma (non-standard).  We use a gfc_expr structure here
+     to save the locus.  This is used later when resolving transfer statements
+     that might have a format expression without unit number.  */
+  if (!comma_flag && gfc_match_char (',') == MATCH_YES)
+    dt->extra_comma = dt->dt_io_kind;
+
+  io_code = NULL;
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      if (comma_flag && gfc_match_char (',') != MATCH_YES)
+	{
+	  gfc_error ("Expected comma in I/O list at %C");
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+
+      m = match_io_list (k, &io_code);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+  /* A full IO statement has been matched.  Check the constraints.  spec_end is
+     supplied for cases where no locus is supplied.  */
+  m = check_io_constraints (k, dt, io_code, &spec_end);
+
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  new_st.op = (k == M_READ) ? EXEC_READ : EXEC_WRITE;
+  new_st.ext.dt = dt;
+  new_st.block = gfc_get_code ();
+  new_st.block->op = new_st.op;
+  new_st.block->next = io_code;
+
+  terminate_io (io_code);
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in %s statement at %C", io_kind_name (k));
+  m = MATCH_ERROR;
+
+cleanup:
+  gfc_free_dt (dt);
+  return m;
+}
+
+
+match
+gfc_match_read (void)
+{
+  return match_io (M_READ);
+}
+
+
+match
+gfc_match_write (void)
+{
+  return match_io (M_WRITE);
+}
+
+
+match
+gfc_match_print (void)
+{
+  match m;
+
+  m = match_io (M_PRINT);
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("PRINT statement at %C not allowed within PURE procedure");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  return MATCH_YES;
+}
+
+
+/* Free a gfc_inquire structure.  */
+
+void
+gfc_free_inquire (gfc_inquire *inquire)
+{
+
+  if (inquire == NULL)
+    return;
+
+  gfc_free_expr (inquire->unit);
+  gfc_free_expr (inquire->file);
+  gfc_free_expr (inquire->iomsg);
+  gfc_free_expr (inquire->iostat);
+  gfc_free_expr (inquire->exist);
+  gfc_free_expr (inquire->opened);
+  gfc_free_expr (inquire->number);
+  gfc_free_expr (inquire->named);
+  gfc_free_expr (inquire->name);
+  gfc_free_expr (inquire->access);
+  gfc_free_expr (inquire->sequential);
+  gfc_free_expr (inquire->direct);
+  gfc_free_expr (inquire->form);
+  gfc_free_expr (inquire->formatted);
+  gfc_free_expr (inquire->unformatted);
+  gfc_free_expr (inquire->recl);
+  gfc_free_expr (inquire->nextrec);
+  gfc_free_expr (inquire->blank);
+  gfc_free_expr (inquire->position);
+  gfc_free_expr (inquire->action);
+  gfc_free_expr (inquire->read);
+  gfc_free_expr (inquire->write);
+  gfc_free_expr (inquire->readwrite);
+  gfc_free_expr (inquire->delim);
+  gfc_free_expr (inquire->encoding);
+  gfc_free_expr (inquire->pad);
+  gfc_free_expr (inquire->iolength);
+  gfc_free_expr (inquire->convert);
+  gfc_free_expr (inquire->strm_pos);
+  gfc_free_expr (inquire->asynchronous);
+  gfc_free_expr (inquire->decimal);
+  gfc_free_expr (inquire->pending);
+  gfc_free_expr (inquire->id);
+  gfc_free_expr (inquire->sign);
+  gfc_free_expr (inquire->size);
+  gfc_free_expr (inquire->round);
+  gfc_free (inquire);
+}
+
+
+/* Match an element of an INQUIRE statement.  */
+
+#define RETM   if (m != MATCH_NO) return m;
+
+static match
+match_inquire_element (gfc_inquire *inquire)
+{
+  match m;
+
+  m = match_etag (&tag_unit, &inquire->unit);
+  RETM m = match_etag (&tag_file, &inquire->file);
+  RETM m = match_ltag (&tag_err, &inquire->err);
+  RETM m = match_out_tag (&tag_iomsg, &inquire->iomsg);
+  RETM m = match_out_tag (&tag_iostat, &inquire->iostat);
+  RETM m = match_vtag (&tag_exist, &inquire->exist);
+  RETM m = match_vtag (&tag_opened, &inquire->opened);
+  RETM m = match_vtag (&tag_named, &inquire->named);
+  RETM m = match_vtag (&tag_name, &inquire->name);
+  RETM m = match_out_tag (&tag_number, &inquire->number);
+  RETM m = match_vtag (&tag_s_access, &inquire->access);
+  RETM m = match_vtag (&tag_sequential, &inquire->sequential);
+  RETM m = match_vtag (&tag_direct, &inquire->direct);
+  RETM m = match_vtag (&tag_s_form, &inquire->form);
+  RETM m = match_vtag (&tag_formatted, &inquire->formatted);
+  RETM m = match_vtag (&tag_unformatted, &inquire->unformatted);
+  RETM m = match_out_tag (&tag_s_recl, &inquire->recl);
+  RETM m = match_out_tag (&tag_nextrec, &inquire->nextrec);
+  RETM m = match_vtag (&tag_s_blank, &inquire->blank);
+  RETM m = match_vtag (&tag_s_position, &inquire->position);
+  RETM m = match_vtag (&tag_s_action, &inquire->action);
+  RETM m = match_vtag (&tag_read, &inquire->read);
+  RETM m = match_vtag (&tag_write, &inquire->write);
+  RETM m = match_vtag (&tag_readwrite, &inquire->readwrite);
+  RETM m = match_vtag (&tag_s_async, &inquire->asynchronous);
+  RETM m = match_vtag (&tag_s_delim, &inquire->delim);
+  RETM m = match_vtag (&tag_s_decimal, &inquire->decimal);
+  RETM m = match_vtag (&tag_size, &inquire->size);
+  RETM m = match_vtag (&tag_s_encoding, &inquire->encoding);
+  RETM m = match_vtag (&tag_s_round, &inquire->round);
+  RETM m = match_vtag (&tag_s_sign, &inquire->sign);
+  RETM m = match_vtag (&tag_s_pad, &inquire->pad);
+  RETM m = match_vtag (&tag_iolength, &inquire->iolength);
+  RETM m = match_vtag (&tag_convert, &inquire->convert);
+  RETM m = match_out_tag (&tag_strm_out, &inquire->strm_pos);
+  RETM m = match_vtag (&tag_pending, &inquire->pending);
+  RETM m = match_vtag (&tag_id, &inquire->id);
+  RETM return MATCH_NO;
+}
+
+#undef RETM
+
+
+match
+gfc_match_inquire (void)
+{
+  gfc_inquire *inquire;
+  gfc_code *code;
+  match m;
+  locus loc;
+
+  m = gfc_match_char ('(');
+  if (m == MATCH_NO)
+    return m;
+
+  inquire = XCNEW (gfc_inquire);
+
+  loc = gfc_current_locus;
+
+  m = match_inquire_element (inquire);
+  if (m == MATCH_ERROR)
+    goto cleanup;
+  if (m == MATCH_NO)
+    {
+      m = gfc_match_expr (&inquire->unit);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+  /* See if we have the IOLENGTH form of the inquire statement.  */
+  if (inquire->iolength != NULL)
+    {
+      if (gfc_match_char (')') != MATCH_YES)
+	goto syntax;
+
+      m = match_io_list (M_INQUIRE, &code);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      new_st.op = EXEC_IOLENGTH;
+      new_st.expr1 = inquire->iolength;
+      new_st.ext.inquire = inquire;
+
+      if (gfc_pure (NULL))
+	{
+	  gfc_free_statements (code);
+	  gfc_error ("INQUIRE statement not allowed in PURE procedure at %C");
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_implicit_pure (NULL))
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+      new_st.block = gfc_get_code ();
+      new_st.block->op = EXEC_IOLENGTH;
+      terminate_io (code);
+      new_st.block->next = code;
+      return MATCH_YES;
+    }
+
+  /* At this point, we have the non-IOLENGTH inquire statement.  */
+  for (;;)
+    {
+      if (gfc_match_char (')') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+
+      m = match_inquire_element (inquire);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      if (inquire->iolength != NULL)
+	{
+	  gfc_error ("IOLENGTH tag invalid in INQUIRE statement at %C");
+	  goto cleanup;
+	}
+    }
+
+  if (gfc_match_eos () != MATCH_YES)
+    goto syntax;
+
+  if (inquire->unit != NULL && inquire->file != NULL)
+    {
+      gfc_error ("INQUIRE statement at %L cannot contain both FILE and "
+		 "UNIT specifiers", &loc);
+      goto cleanup;
+    }
+
+  if (inquire->unit == NULL && inquire->file == NULL)
+    {
+      gfc_error ("INQUIRE statement at %L requires either FILE or "
+		 "UNIT specifier", &loc);
+      goto cleanup;
+    }
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("INQUIRE statement not allowed in PURE procedure at %C");
+      goto cleanup;
+    }
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+  
+  if (inquire->id != NULL && inquire->pending == NULL)
+    {
+      gfc_error ("INQUIRE statement at %L requires a PENDING= specifier with "
+		 "the ID= specifier", &loc);
+      goto cleanup;
+    }
+
+  new_st.op = EXEC_INQUIRE;
+  new_st.ext.inquire = inquire;
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_INQUIRE);
+
+cleanup:
+  gfc_free_inquire (inquire);
+  return MATCH_ERROR;
+}
+
+
+/* Resolve everything in a gfc_inquire structure.  */
+
+gfc_try
+gfc_resolve_inquire (gfc_inquire *inquire)
+{
+  RESOLVE_TAG (&tag_unit, inquire->unit);
+  RESOLVE_TAG (&tag_file, inquire->file);
+  RESOLVE_TAG (&tag_id, inquire->id);
+
+  /* For INQUIRE, all tags except FILE, ID and UNIT are variable definition
+     contexts.  Thus, use an extended RESOLVE_TAG macro for that.  */
+#define INQUIRE_RESOLVE_TAG(tag, expr) \
+  RESOLVE_TAG (tag, expr); \
+  if (expr) \
+    { \
+      char context[64]; \
+      sprintf (context, _("%s tag with INQUIRE"), (tag)->name); \
+      if (gfc_check_vardef_context ((expr), false, context) == FAILURE) \
+	return FAILURE; \
+    }
+  INQUIRE_RESOLVE_TAG (&tag_iomsg, inquire->iomsg);
+  INQUIRE_RESOLVE_TAG (&tag_iostat, inquire->iostat);
+  INQUIRE_RESOLVE_TAG (&tag_exist, inquire->exist);
+  INQUIRE_RESOLVE_TAG (&tag_opened, inquire->opened);
+  INQUIRE_RESOLVE_TAG (&tag_number, inquire->number);
+  INQUIRE_RESOLVE_TAG (&tag_named, inquire->named);
+  INQUIRE_RESOLVE_TAG (&tag_name, inquire->name);
+  INQUIRE_RESOLVE_TAG (&tag_s_access, inquire->access);
+  INQUIRE_RESOLVE_TAG (&tag_sequential, inquire->sequential);
+  INQUIRE_RESOLVE_TAG (&tag_direct, inquire->direct);
+  INQUIRE_RESOLVE_TAG (&tag_s_form, inquire->form);
+  INQUIRE_RESOLVE_TAG (&tag_formatted, inquire->formatted);
+  INQUIRE_RESOLVE_TAG (&tag_unformatted, inquire->unformatted);
+  INQUIRE_RESOLVE_TAG (&tag_s_recl, inquire->recl);
+  INQUIRE_RESOLVE_TAG (&tag_nextrec, inquire->nextrec);
+  INQUIRE_RESOLVE_TAG (&tag_s_blank, inquire->blank);
+  INQUIRE_RESOLVE_TAG (&tag_s_position, inquire->position);
+  INQUIRE_RESOLVE_TAG (&tag_s_action, inquire->action);
+  INQUIRE_RESOLVE_TAG (&tag_read, inquire->read);
+  INQUIRE_RESOLVE_TAG (&tag_write, inquire->write);
+  INQUIRE_RESOLVE_TAG (&tag_readwrite, inquire->readwrite);
+  INQUIRE_RESOLVE_TAG (&tag_s_delim, inquire->delim);
+  INQUIRE_RESOLVE_TAG (&tag_s_pad, inquire->pad);
+  INQUIRE_RESOLVE_TAG (&tag_s_encoding, inquire->encoding);
+  INQUIRE_RESOLVE_TAG (&tag_s_round, inquire->round);
+  INQUIRE_RESOLVE_TAG (&tag_iolength, inquire->iolength);
+  INQUIRE_RESOLVE_TAG (&tag_convert, inquire->convert);
+  INQUIRE_RESOLVE_TAG (&tag_strm_out, inquire->strm_pos);
+  INQUIRE_RESOLVE_TAG (&tag_s_async, inquire->asynchronous);
+  INQUIRE_RESOLVE_TAG (&tag_s_sign, inquire->sign);
+  INQUIRE_RESOLVE_TAG (&tag_s_round, inquire->round);
+  INQUIRE_RESOLVE_TAG (&tag_pending, inquire->pending);
+  INQUIRE_RESOLVE_TAG (&tag_size, inquire->size);
+#undef INQUIRE_RESOLVE_TAG
+
+  if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+void
+gfc_free_wait (gfc_wait *wait)
+{
+  if (wait == NULL)
+    return;
+
+  gfc_free_expr (wait->unit);
+  gfc_free_expr (wait->iostat);
+  gfc_free_expr (wait->iomsg);
+  gfc_free_expr (wait->id);
+}
+
+
+gfc_try
+gfc_resolve_wait (gfc_wait *wait)
+{
+  RESOLVE_TAG (&tag_unit, wait->unit);
+  RESOLVE_TAG (&tag_iomsg, wait->iomsg);
+  RESOLVE_TAG (&tag_iostat, wait->iostat);
+  RESOLVE_TAG (&tag_id, wait->id);
+
+  if (gfc_reference_st_label (wait->err, ST_LABEL_TARGET) == FAILURE)
+    return FAILURE;
+  
+  if (gfc_reference_st_label (wait->end, ST_LABEL_TARGET) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+/* Match an element of a WAIT statement.  */
+
+#define RETM   if (m != MATCH_NO) return m;
+
+static match
+match_wait_element (gfc_wait *wait)
+{
+  match m;
+
+  m = match_etag (&tag_unit, &wait->unit);
+  RETM m = match_ltag (&tag_err, &wait->err);
+  RETM m = match_ltag (&tag_end, &wait->eor);
+  RETM m = match_ltag (&tag_eor, &wait->end);
+  RETM m = match_out_tag (&tag_iomsg, &wait->iomsg);
+  RETM m = match_out_tag (&tag_iostat, &wait->iostat);
+  RETM m = match_etag (&tag_id, &wait->id);
+  RETM return MATCH_NO;
+}
+
+#undef RETM
+
+
+match
+gfc_match_wait (void)
+{
+  gfc_wait *wait;
+  match m;
+
+  m = gfc_match_char ('(');
+  if (m == MATCH_NO)
+    return m;
+
+  wait = XCNEW (gfc_wait);
+
+  m = match_wait_element (wait);
+  if (m == MATCH_ERROR)
+    goto cleanup;
+  if (m == MATCH_NO)
+    {
+      m = gfc_match_expr (&wait->unit);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+  for (;;)
+    {
+      if (gfc_match_char (')') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+
+      m = match_wait_element (wait);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: WAIT at %C "
+	  "not allowed in Fortran 95") == FAILURE)
+    goto cleanup;
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("WAIT statement not allowed in PURE procedure at %C");
+      goto cleanup;
+    }
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  new_st.op = EXEC_WAIT;
+  new_st.ext.wait = wait;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_WAIT);
+
+cleanup:
+  gfc_free_wait (wait);
+  return MATCH_ERROR;
+}
diff --git a/gcc/fortran/ioparm.def b/gcc/fortran/ioparm.def
new file mode 100644
index 000000000..5ccd86973
--- /dev/null
+++ b/gcc/fortran/ioparm.def
@@ -0,0 +1,115 @@
+/* Copyright (C) 2005, 2006, 2008, 2010
+   Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#ifndef IOPARM_common_libreturn_mask
+#define IOPARM_common_libreturn_mask	3
+#define IOPARM_common_libreturn_ok	0
+#define IOPARM_common_libreturn_error	1
+#define IOPARM_common_libreturn_end	2
+#define IOPARM_common_libreturn_eor	3
+#define IOPARM_common_err		(1 << 2)
+#define IOPARM_common_end		(1 << 3)
+#define IOPARM_common_eor		(1 << 4)
+#endif
+IOPARM (common,  flags,		0,	 int4)
+IOPARM (common,  unit,		0,	 int4)
+IOPARM (common,  filename,	0,	 pchar)
+IOPARM (common,  line,		0,	 int4)
+IOPARM (common,  iomsg,		1 << 6,  char2)
+IOPARM (common,  iostat,	1 << 5,  pint4)
+IOPARM (open,    common,	0,	 common)
+IOPARM (open,    recl_in,	1 << 7,  int4)
+IOPARM (open,    file,		1 << 8,  char2)
+IOPARM (open,    status,	1 << 9,  char1)
+IOPARM (open,    access,	1 << 10, char2)
+IOPARM (open,    form,		1 << 11, char1)
+IOPARM (open,    blank,		1 << 12, char2)
+IOPARM (open,    position,	1 << 13, char1)
+IOPARM (open,    action,	1 << 14, char2)
+IOPARM (open,    delim,		1 << 15, char1)
+IOPARM (open,    pad,		1 << 16, char2)
+IOPARM (open,    convert,	1 << 17, char1)
+IOPARM (open,    decimal,	1 << 18, char2)
+IOPARM (open,    encoding,	1 << 19, char1)
+IOPARM (open,    round,		1 << 20, char2)
+IOPARM (open,    sign,		1 << 21, char1)
+IOPARM (open,    asynchronous,	1 << 22, char2)
+IOPARM (open,    newunit,	1 << 23, pint4)
+IOPARM (close,   common,	0,	 common)
+IOPARM (close,   status,	1 << 7,  char1)
+IOPARM (filepos, common,	0,	 common)
+IOPARM (inquire, common,	0,	 common)
+IOPARM (inquire, exist,		1 << 7,  pint4)
+IOPARM (inquire, opened,	1 << 8,  pint4)
+IOPARM (inquire, number,	1 << 9,  pint4)
+IOPARM (inquire, named,		1 << 10, pint4)
+IOPARM (inquire, nextrec,	1 << 11, pint4)
+IOPARM (inquire, recl_out,	1 << 12, pint4)
+IOPARM (inquire, strm_pos_out,	1 << 13, pintio)
+IOPARM (inquire, file,		1 << 14, char1)
+IOPARM (inquire, access,	1 << 15, char2)
+IOPARM (inquire, form,		1 << 16, char1)
+IOPARM (inquire, blank,		1 << 17, char2)
+IOPARM (inquire, position,	1 << 18, char1)
+IOPARM (inquire, action,	1 << 19, char2)
+IOPARM (inquire, delim,		1 << 20, char1)
+IOPARM (inquire, pad,		1 << 21, char2)
+IOPARM (inquire, name,		1 << 22, char1)
+IOPARM (inquire, sequential,	1 << 23, char2)
+IOPARM (inquire, direct,	1 << 24, char1)
+IOPARM (inquire, formatted,	1 << 25, char2)
+IOPARM (inquire, unformatted,	1 << 26, char1)
+IOPARM (inquire, read,		1 << 27, char2)
+IOPARM (inquire, write,		1 << 28, char1)
+IOPARM (inquire, readwrite,	1 << 29, char2)
+IOPARM (inquire, convert,	1 << 30, char1)
+IOPARM (inquire, flags2,	1 << 31, int4)
+IOPARM (inquire, asynchronous,	1 << 0,  char1)
+IOPARM (inquire, decimal,	1 << 1,  char2)
+IOPARM (inquire, encoding,	1 << 2,  char1)
+IOPARM (inquire, round,		1 << 3,  char2)
+IOPARM (inquire, sign,		1 << 4,  char1)
+IOPARM (inquire, pending,	1 << 5,  pint4)
+IOPARM (inquire, size,		1 << 6,  pintio)
+IOPARM (inquire, id,		1 << 7,  pint4)
+IOPARM (wait,    common,	0,	 common)
+IOPARM (wait,    id,		1 << 7,  pint4)
+#ifndef IOPARM_dt_list_format
+#define IOPARM_dt_list_format		(1 << 7)
+#define IOPARM_dt_namelist_read_mode	(1 << 8)
+#endif
+IOPARM (dt,      common,	0,	 common)
+IOPARM (dt,      rec,		1 << 9,  intio)
+IOPARM (dt,      size,		1 << 10, pintio)
+IOPARM (dt,      iolength,	1 << 11, pintio)
+IOPARM (dt,      internal_unit_desc, 0,  parray)
+IOPARM (dt,      format,	1 << 12, char1)
+IOPARM (dt,      advance,	1 << 13, char2)
+IOPARM (dt,      internal_unit,	1 << 14, char1)
+IOPARM (dt,      namelist_name,	1 << 15, char2)
+IOPARM (dt,      u,		0,	 pad)
+IOPARM (dt,      id,		1 << 16, pint4)
+IOPARM (dt,      pos,		1 << 17, intio)
+IOPARM (dt,      asynchronous, 	1 << 18, char1)
+IOPARM (dt,      blank,		1 << 19, char2)
+IOPARM (dt,      decimal,	1 << 20, char1)
+IOPARM (dt,      delim,		1 << 21, char2)
+IOPARM (dt,      pad,		1 << 22, char1)
+IOPARM (dt,      round,		1 << 23, char2)
+IOPARM (dt,      sign,		1 << 24, char1)
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
new file mode 100644
index 000000000..d8309d27f
--- /dev/null
+++ b/gcc/fortran/iresolve.c
@@ -0,0 +1,3631 @@
+/* Intrinsic function resolution.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught & Katherine Holcomb
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+/* Assign name and types to intrinsic procedures.  For functions, the
+   first argument to a resolution function is an expression pointer to
+   the original function node and the rest are pointers to the
+   arguments of the function call.  For subroutines, a pointer to the
+   code node is passed.  The result type and library subroutine name
+   are generally set according to the function arguments.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "gfortran.h"
+#include "intrinsic.h"
+#include "constructor.h"
+#include "arith.h"
+
+/* Given printf-like arguments, return a stable version of the result string. 
+
+   We already have a working, optimized string hashing table in the form of
+   the identifier table.  Reusing this table is likely not to be wasted, 
+   since if the function name makes it to the gimple output of the frontend,
+   we'll have to create the identifier anyway.  */
+
+const char *
+gfc_get_string (const char *format, ...)
+{
+  char temp_name[128];
+  va_list ap;
+  tree ident;
+
+  va_start (ap, format);
+  vsnprintf (temp_name, sizeof (temp_name), format, ap);
+  va_end (ap);
+  temp_name[sizeof (temp_name) - 1] = 0;
+
+  ident = get_identifier (temp_name);
+  return IDENTIFIER_POINTER (ident);
+}
+
+/* MERGE and SPREAD need to have source charlen's present for passing
+   to the result expression.  */
+static void
+check_charlen_present (gfc_expr *source)
+{
+  if (source->ts.u.cl == NULL)
+    source->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+
+  if (source->expr_type == EXPR_CONSTANT)
+    {
+      source->ts.u.cl->length
+		= gfc_get_int_expr (gfc_default_integer_kind, NULL,
+				    source->value.character.length);
+      source->rank = 0;
+    }
+  else if (source->expr_type == EXPR_ARRAY)
+    {
+      gfc_constructor *c = gfc_constructor_first (source->value.constructor);
+      source->ts.u.cl->length
+		= gfc_get_int_expr (gfc_default_integer_kind, NULL,
+				    c->expr->value.character.length);
+    }
+}
+
+/* Helper function for resolving the "mask" argument.  */
+
+static void
+resolve_mask_arg (gfc_expr *mask)
+{
+
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+
+  if (mask->rank == 0)
+    {
+      /* For the scalar case, coerce the mask to kind=4 unconditionally
+	 (because this is the only kind we have a library function
+	 for).  */
+
+      if (mask->ts.kind != 4)
+	{
+	  ts.type = BT_LOGICAL;
+	  ts.kind = 4;
+	  gfc_convert_type (mask, &ts, 2);
+	}
+    }
+  else
+    {
+      /* In the library, we access the mask with a GFC_LOGICAL_1
+	 argument.  No need to waste memory if we are about to create
+	 a temporary array.  */
+      if (mask->expr_type == EXPR_OP && mask->ts.kind != 1)
+	{
+	  ts.type = BT_LOGICAL;
+	  ts.kind = 1;
+	  gfc_convert_type_warn (mask, &ts, 2, 0);
+	}
+    }
+}
+
+
+static void
+resolve_bound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind,
+	       const char *name, bool coarray)
+{
+  f->ts.type = BT_INTEGER;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+
+  if (dim == NULL)
+    {
+      f->rank = 1;
+      f->shape = gfc_get_shape (1);
+      mpz_init_set_ui (f->shape[0], coarray ? gfc_get_corank (array)
+					    : array->rank);
+    }
+
+  f->value.function.name = xstrdup (name);
+}
+
+
+static void
+resolve_transformational (const char *name, gfc_expr *f, gfc_expr *array,
+			  gfc_expr *dim, gfc_expr *mask)
+{
+  const char *prefix;
+
+  f->ts = array->ts;
+
+  if (mask)
+    {
+      if (mask->rank == 0)
+	prefix = "s";
+      else
+	prefix = "m";
+
+      resolve_mask_arg (mask);
+    }
+  else
+    prefix = "";
+
+  if (dim != NULL)
+    {
+      f->rank = array->rank - 1;
+      f->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim);
+      gfc_resolve_dim_arg (dim);
+    }
+
+  f->value.function.name
+    = gfc_get_string (PREFIX ("%s%s_%c%d"), prefix, name,
+		    gfc_type_letter (array->ts.type), array->ts.kind);
+}
+
+
+/********************** Resolution functions **********************/
+
+
+void
+gfc_resolve_abs (gfc_expr *f, gfc_expr *a)
+{
+  f->ts = a->ts;
+  if (f->ts.type == BT_COMPLEX)
+    f->ts.type = BT_REAL;
+
+  f->value.function.name
+    = gfc_get_string ("__abs_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_access (gfc_expr *f, gfc_expr *name ATTRIBUTE_UNUSED,
+		    gfc_expr *mode ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  f->value.function.name = PREFIX ("access_func");
+}
+
+
+void
+gfc_resolve_adjustl (gfc_expr *f, gfc_expr *string)
+{
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = string->ts.kind;
+  f->value.function.name = gfc_get_string ("__adjustl_s%d", f->ts.kind);
+}
+
+
+void
+gfc_resolve_adjustr (gfc_expr *f, gfc_expr *string)
+{
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = string->ts.kind;
+  f->value.function.name = gfc_get_string ("__adjustr_s%d", f->ts.kind);
+}
+
+
+static void
+gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind,
+			const char *name)
+{
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = (kind == NULL)
+	     ? gfc_default_character_kind : mpz_get_si (kind->value.integer);
+  f->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+  f->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+
+  f->value.function.name = gfc_get_string (name, f->ts.kind,
+					   gfc_type_letter (x->ts.type),
+					   x->ts.kind);
+}
+
+
+void
+gfc_resolve_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind)
+{
+  gfc_resolve_char_achar (f, x, kind, "__achar_%d_%c%d");
+}
+
+
+void
+gfc_resolve_acos (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__acos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
+
+void
+gfc_resolve_acosh (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__acosh_%c%d", gfc_type_letter (x->ts.type),
+		      x->ts.kind);
+}
+
+
+void
+gfc_resolve_aimag (gfc_expr *f, gfc_expr *x)
+{
+  f->ts.type = BT_REAL;
+  f->ts.kind = x->ts.kind;
+  f->value.function.name
+    = gfc_get_string ("__aimag_%c%d", gfc_type_letter (x->ts.type),
+		      x->ts.kind);
+}
+
+
+void
+gfc_resolve_and (gfc_expr *f, gfc_expr *i, gfc_expr *j)
+{
+  f->ts.type = i->ts.type;
+  f->ts.kind = gfc_kind_max (i, j);
+
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (i->ts.kind == gfc_kind_max (i, j))
+	gfc_convert_type (j, &i->ts, 2);
+      else
+	gfc_convert_type (i, &j->ts, 2);
+    }
+
+  f->value.function.name
+    = gfc_get_string ("__and_%c%d", gfc_type_letter (i->ts.type), f->ts.kind);
+}
+
+
+void
+gfc_resolve_aint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
+{
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+  
+  f->ts.type = a->ts.type;
+  f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer);
+
+  if (a->ts.kind != f->ts.kind)
+    {
+      ts.type = f->ts.type;
+      ts.kind = f->ts.kind;
+      gfc_convert_type (a, &ts, 2);
+    }
+  /* The resolved name is only used for specific intrinsics where
+     the return kind is the same as the arg kind.  */
+  f->value.function.name
+    = gfc_get_string ("__aint_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_dint (gfc_expr *f, gfc_expr *a)
+{
+  gfc_resolve_aint (f, a, NULL);
+}
+
+
+void
+gfc_resolve_all (gfc_expr *f, gfc_expr *mask, gfc_expr *dim)
+{
+  f->ts = mask->ts;
+
+  if (dim != NULL)
+    {
+      gfc_resolve_dim_arg (dim);
+      f->rank = mask->rank - 1;
+      f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
+    }
+
+  f->value.function.name
+    = gfc_get_string (PREFIX ("all_%c%d"), gfc_type_letter (mask->ts.type),
+		      mask->ts.kind);
+}
+
+
+void
+gfc_resolve_anint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
+{
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+  
+  f->ts.type = a->ts.type;
+  f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer);
+
+  if (a->ts.kind != f->ts.kind)
+    {
+      ts.type = f->ts.type;
+      ts.kind = f->ts.kind;
+      gfc_convert_type (a, &ts, 2);
+    }
+
+  /* The resolved name is only used for specific intrinsics where
+     the return kind is the same as the arg kind.  */
+  f->value.function.name
+    = gfc_get_string ("__anint_%c%d", gfc_type_letter (a->ts.type),
+		      a->ts.kind);
+}
+
+
+void
+gfc_resolve_dnint (gfc_expr *f, gfc_expr *a)
+{
+  gfc_resolve_anint (f, a, NULL);
+}
+
+
+void
+gfc_resolve_any (gfc_expr *f, gfc_expr *mask, gfc_expr *dim)
+{
+  f->ts = mask->ts;
+
+  if (dim != NULL)
+    {
+      gfc_resolve_dim_arg (dim);
+      f->rank = mask->rank - 1;
+      f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
+    }
+
+  f->value.function.name
+    = gfc_get_string (PREFIX ("any_%c%d"), gfc_type_letter (mask->ts.type),
+		      mask->ts.kind);
+}
+
+
+void
+gfc_resolve_asin (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__asin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
+void
+gfc_resolve_asinh (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__asinh_%c%d", gfc_type_letter (x->ts.type),
+		      x->ts.kind);
+}
+
+void
+gfc_resolve_atan (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__atan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
+void
+gfc_resolve_atanh (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__atanh_%c%d", gfc_type_letter (x->ts.type),
+		      x->ts.kind);
+}
+
+void
+gfc_resolve_atan2 (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__atan2_%c%d", gfc_type_letter (x->ts.type),
+		      x->ts.kind);
+}
+
+
+/* Resolve the BESYN and BESJN intrinsics.  */
+
+void
+gfc_resolve_besn (gfc_expr *f, gfc_expr *n, gfc_expr *x)
+{
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+  
+  f->ts = x->ts;
+  if (n->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      gfc_convert_type (n, &ts, 2);
+    }
+  f->value.function.name = gfc_get_string ("<intrinsic>");
+}
+
+
+void
+gfc_resolve_bessel_n2 (gfc_expr *f, gfc_expr *n1, gfc_expr *n2, gfc_expr *x)
+{
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+  
+  f->ts = x->ts;
+  f->rank = 1;
+  if (n1->expr_type == EXPR_CONSTANT && n2->expr_type == EXPR_CONSTANT)
+    {
+      f->shape = gfc_get_shape (1);
+      mpz_init (f->shape[0]);
+      mpz_sub (f->shape[0], n2->value.integer, n1->value.integer);
+      mpz_add_ui (f->shape[0], f->shape[0], 1);
+    }
+
+  if (n1->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      gfc_convert_type (n1, &ts, 2);
+    }
+
+  if (n2->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      gfc_convert_type (n2, &ts, 2);
+    }
+
+  if (f->value.function.isym->id == GFC_ISYM_JN2)
+    f->value.function.name = gfc_get_string (PREFIX ("bessel_jn_r%d"),
+					     f->ts.kind);
+  else
+    f->value.function.name = gfc_get_string (PREFIX ("bessel_yn_r%d"),
+					     f->ts.kind);
+}
+
+
+void
+gfc_resolve_btest (gfc_expr *f, gfc_expr *i, gfc_expr *pos)
+{
+  f->ts.type = BT_LOGICAL;
+  f->ts.kind = gfc_default_logical_kind;
+  f->value.function.name
+    = gfc_get_string ("__btest_%d_%d", i->ts.kind, pos->ts.kind);
+}
+
+
+void
+gfc_resolve_ceiling (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = (kind == NULL)
+	     ? gfc_default_integer_kind : mpz_get_si (kind->value.integer);
+  f->value.function.name
+    = gfc_get_string ("__ceiling_%d_%c%d", f->ts.kind,
+		      gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_char (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
+{
+  gfc_resolve_char_achar (f, a, kind, "__char_%d_%c%d");
+}
+
+
+void
+gfc_resolve_chdir (gfc_expr *f, gfc_expr *d ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string (PREFIX ("chdir_i%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_chdir_sub (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->expr != NULL)
+    kind = c->ext.actual->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX ("chdir_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_chmod (gfc_expr *f, gfc_expr *name ATTRIBUTE_UNUSED,
+		   gfc_expr *mode ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  f->value.function.name = PREFIX ("chmod_func");
+}
+
+
+void
+gfc_resolve_chmod_sub (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->next->expr != NULL)
+    kind = c->ext.actual->next->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX ("chmod_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_cmplx (gfc_expr *f, gfc_expr *x, gfc_expr *y, gfc_expr *kind)
+{
+  f->ts.type = BT_COMPLEX;
+  f->ts.kind = (kind == NULL)
+	     ? gfc_default_real_kind : mpz_get_si (kind->value.integer);
+
+  if (y == NULL)
+    f->value.function.name
+      = gfc_get_string ("__cmplx0_%d_%c%d", f->ts.kind,
+			gfc_type_letter (x->ts.type), x->ts.kind);
+  else
+    f->value.function.name
+      = gfc_get_string ("__cmplx1_%d_%c%d_%c%d", f->ts.kind,
+			gfc_type_letter (x->ts.type), x->ts.kind,
+			gfc_type_letter (y->ts.type), y->ts.kind);
+}
+
+
+void
+gfc_resolve_dcmplx (gfc_expr *f, gfc_expr *x, gfc_expr *y)
+{
+  gfc_resolve_cmplx (f, x, y, gfc_get_int_expr (gfc_default_integer_kind, NULL,
+						gfc_default_double_kind));
+}
+
+
+void
+gfc_resolve_complex (gfc_expr *f, gfc_expr *x, gfc_expr *y)
+{
+  int kind;
+
+  if (x->ts.type == BT_INTEGER)
+    {
+      if (y->ts.type == BT_INTEGER)
+	kind = gfc_default_real_kind;
+      else
+	kind = y->ts.kind;
+    }
+  else
+    {
+      if (y->ts.type == BT_REAL)
+	kind = (x->ts.kind > y->ts.kind) ? x->ts.kind : y->ts.kind;
+      else
+	kind = x->ts.kind;
+    }
+
+  f->ts.type = BT_COMPLEX;
+  f->ts.kind = kind;
+  f->value.function.name
+    = gfc_get_string ("__cmplx1_%d_%c%d_%c%d", f->ts.kind,
+		      gfc_type_letter (x->ts.type), x->ts.kind,
+		      gfc_type_letter (y->ts.type), y->ts.kind);
+}
+
+
+void
+gfc_resolve_conjg (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name = gfc_get_string ("__conjg_%d", x->ts.kind);
+}
+
+
+void
+gfc_resolve_cos (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__cos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
+
+void
+gfc_resolve_cosh (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__cosh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
+
+void
+gfc_resolve_count (gfc_expr *f, gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+
+  if (dim != NULL)
+    {
+      f->rank = mask->rank - 1;
+      gfc_resolve_dim_arg (dim);
+      f->shape = gfc_copy_shape_excluding (mask->shape, mask->rank, dim);
+    }
+
+  resolve_mask_arg (mask);
+
+  f->value.function.name
+    = gfc_get_string (PREFIX ("count_%d_%c"), f->ts.kind,
+		      gfc_type_letter (mask->ts.type));
+}
+
+
+void
+gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
+		    gfc_expr *dim)
+{
+  int n, m;
+
+  if (array->ts.type == BT_CHARACTER && array->ref)
+    gfc_resolve_substring_charlen (array);
+
+  f->ts = array->ts;
+  f->rank = array->rank;
+  f->shape = gfc_copy_shape (array->shape, array->rank);
+
+  if (shift->rank > 0)
+    n = 1;
+  else
+    n = 0;
+
+  /* If dim kind is greater than default integer we need to use the larger.  */
+  m = gfc_default_integer_kind;
+  if (dim != NULL)
+    m = m < dim->ts.kind ? dim->ts.kind : m;
+  
+  /* Convert shift to at least m, so we don't need
+      kind=1 and kind=2 versions of the library functions.  */
+  if (shift->ts.kind < m)
+    {
+      gfc_typespec ts;
+      gfc_clear_ts (&ts);
+      ts.type = BT_INTEGER;
+      ts.kind = m;
+      gfc_convert_type_warn (shift, &ts, 2, 0);
+    }
+ 
+  if (dim != NULL)
+    {
+      if (dim->expr_type != EXPR_CONSTANT && dim->symtree != NULL
+	  && dim->symtree->n.sym->attr.optional)
+	{
+	  /* Mark this for later setting the type in gfc_conv_missing_dummy.  */
+	  dim->representation.length = shift->ts.kind;
+	}
+      else
+	{
+	  gfc_resolve_dim_arg (dim);
+	  /* Convert dim to shift's kind to reduce variations.  */
+	  if (dim->ts.kind != shift->ts.kind)
+	    gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+        }
+    }
+
+  if (array->ts.type == BT_CHARACTER)
+    {
+      if (array->ts.kind == gfc_default_character_kind)
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("cshift%d_%d_char"), n, shift->ts.kind);
+      else
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("cshift%d_%d_char%d"), n, shift->ts.kind,
+			    array->ts.kind);
+    }
+  else
+    f->value.function.name
+	= gfc_get_string (PREFIX ("cshift%d_%d"), n, shift->ts.kind);
+}
+
+
+void
+gfc_resolve_ctime (gfc_expr *f, gfc_expr *time)
+{
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+  
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = gfc_default_character_kind;
+
+  /* ctime TIME argument is a INTEGER(KIND=8), says the doc */
+  if (time->ts.kind != 8)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = 8;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (time, &ts, 2);
+    }
+
+  f->value.function.name = gfc_get_string (PREFIX ("ctime"));
+}
+
+
+void
+gfc_resolve_dble (gfc_expr *f, gfc_expr *a)
+{
+  f->ts.type = BT_REAL;
+  f->ts.kind = gfc_default_double_kind;
+  f->value.function.name
+    = gfc_get_string ("__dble_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_dim (gfc_expr *f, gfc_expr *a, gfc_expr *p)
+{
+  f->ts.type = a->ts.type;
+  if (p != NULL)
+    f->ts.kind = gfc_kind_max (a,p);
+  else
+    f->ts.kind = a->ts.kind;
+
+  if (p != NULL && a->ts.kind != p->ts.kind)
+    {
+      if (a->ts.kind == gfc_kind_max (a,p))
+	gfc_convert_type (p, &a->ts, 2);
+      else
+	gfc_convert_type (a, &p->ts, 2);
+    }
+
+  f->value.function.name
+    = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), f->ts.kind);
+}
+
+
+void
+gfc_resolve_dot_product (gfc_expr *f, gfc_expr *a, gfc_expr *b)
+{
+  gfc_expr temp;
+
+  temp.expr_type = EXPR_OP;
+  gfc_clear_ts (&temp.ts);
+  temp.value.op.op = INTRINSIC_NONE;
+  temp.value.op.op1 = a;
+  temp.value.op.op2 = b;
+  gfc_type_convert_binary (&temp, 1);
+  f->ts = temp.ts;
+  f->value.function.name
+    = gfc_get_string (PREFIX ("dot_product_%c%d"),
+		      gfc_type_letter (f->ts.type), f->ts.kind);
+}
+
+
+void
+gfc_resolve_dprod (gfc_expr *f, gfc_expr *a ATTRIBUTE_UNUSED,
+		   gfc_expr *b ATTRIBUTE_UNUSED)
+{
+  f->ts.kind = gfc_default_double_kind;
+  f->ts.type = BT_REAL;
+  f->value.function.name = gfc_get_string ("__dprod_r%d", f->ts.kind);
+}
+
+
+void
+gfc_resolve_dshift (gfc_expr *f, gfc_expr *i, gfc_expr *j ATTRIBUTE_UNUSED,
+		    gfc_expr *shift ATTRIBUTE_UNUSED)
+{
+  f->ts = i->ts;
+  if (f->value.function.isym->id == GFC_ISYM_DSHIFTL)
+    f->value.function.name = gfc_get_string ("dshiftl_i%d", f->ts.kind);
+  else if (f->value.function.isym->id == GFC_ISYM_DSHIFTR)
+    f->value.function.name = gfc_get_string ("dshiftr_i%d", f->ts.kind);
+  else
+    gcc_unreachable ();
+}
+
+
+void
+gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
+		     gfc_expr *boundary, gfc_expr *dim)
+{
+  int n, m;
+
+  if (array->ts.type == BT_CHARACTER && array->ref)
+    gfc_resolve_substring_charlen (array);
+
+  f->ts = array->ts;
+  f->rank = array->rank;
+  f->shape = gfc_copy_shape (array->shape, array->rank);
+
+  n = 0;
+  if (shift->rank > 0)
+    n = n | 1;
+  if (boundary && boundary->rank > 0)
+    n = n | 2;
+
+  /* If dim kind is greater than default integer we need to use the larger.  */
+  m = gfc_default_integer_kind;
+  if (dim != NULL)
+    m = m < dim->ts.kind ? dim->ts.kind : m;
+  
+  /* Convert shift to at least m, so we don't need
+      kind=1 and kind=2 versions of the library functions.  */
+  if (shift->ts.kind < m)
+    {
+      gfc_typespec ts;
+      gfc_clear_ts (&ts);
+      ts.type = BT_INTEGER;
+      ts.kind = m;
+      gfc_convert_type_warn (shift, &ts, 2, 0);
+    }
+ 
+  if (dim != NULL)
+    {
+      if (dim->expr_type != EXPR_CONSTANT && dim->symtree != NULL
+	  && dim->symtree->n.sym->attr.optional)
+	{
+	  /* Mark this for later setting the type in gfc_conv_missing_dummy.  */
+	  dim->representation.length = shift->ts.kind;
+	}
+      else
+	{
+	  gfc_resolve_dim_arg (dim);
+	  /* Convert dim to shift's kind to reduce variations.  */
+	  if (dim->ts.kind != shift->ts.kind)
+	    gfc_convert_type_warn (dim, &shift->ts, 2, 0);
+        }
+    }
+
+  if (array->ts.type == BT_CHARACTER)
+    {
+      if (array->ts.kind == gfc_default_character_kind)
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("eoshift%d_%d_char"), n, shift->ts.kind);
+      else
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("eoshift%d_%d_char%d"), n, shift->ts.kind,
+			    array->ts.kind);
+    }
+  else
+    f->value.function.name
+	= gfc_get_string (PREFIX ("eoshift%d_%d"), n, shift->ts.kind);
+}
+
+
+void
+gfc_resolve_exp (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__exp_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
+
+void
+gfc_resolve_exponent (gfc_expr *f, gfc_expr *x)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string ("__exponent_%d", x->ts.kind);
+}
+
+
+/* Resolve the EXTENDS_TYPE_OF intrinsic function.  */
+
+void
+gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo)
+{
+  gfc_symbol *vtab;
+  gfc_symtree *st;
+
+  /* Prevent double resolution.  */
+  if (f->ts.type == BT_LOGICAL)
+    return;
+
+  /* Replace the first argument with the corresponding vtab.  */
+  if (a->ts.type == BT_CLASS)
+    gfc_add_vptr_component (a);
+  else if (a->ts.type == BT_DERIVED)
+    {
+      vtab = gfc_find_derived_vtab (a->ts.u.derived);
+      /* Clear the old expr.  */
+      gfc_free_ref_list (a->ref);
+      memset (a, '\0', sizeof (gfc_expr));
+      /* Construct a new one.  */
+      a->expr_type = EXPR_VARIABLE;
+      st = gfc_find_symtree (vtab->ns->sym_root, vtab->name);
+      a->symtree = st;
+      a->ts = vtab->ts;
+    }
+
+  /* Replace the second argument with the corresponding vtab.  */
+  if (mo->ts.type == BT_CLASS)
+    gfc_add_vptr_component (mo);
+  else if (mo->ts.type == BT_DERIVED)
+    {
+      vtab = gfc_find_derived_vtab (mo->ts.u.derived);
+      /* Clear the old expr.  */
+      gfc_free_ref_list (mo->ref);
+      memset (mo, '\0', sizeof (gfc_expr));
+      /* Construct a new one.  */
+      mo->expr_type = EXPR_VARIABLE;
+      st = gfc_find_symtree (vtab->ns->sym_root, vtab->name);
+      mo->symtree = st;
+      mo->ts = vtab->ts;
+    }
+
+  f->ts.type = BT_LOGICAL;
+  f->ts.kind = 4;
+
+  f->value.function.isym->formal->ts = a->ts;
+  f->value.function.isym->formal->next->ts = mo->ts;
+
+  /* Call library function.  */
+  f->value.function.name = gfc_get_string (PREFIX ("is_extension_of"));
+}
+
+
+void
+gfc_resolve_fdate (gfc_expr *f)
+{
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = gfc_default_character_kind;
+  f->value.function.name = gfc_get_string (PREFIX ("fdate"));
+}
+
+
+void
+gfc_resolve_floor (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = (kind == NULL)
+	     ? gfc_default_integer_kind : mpz_get_si (kind->value.integer);
+  f->value.function.name
+    = gfc_get_string ("__floor%d_%c%d", f->ts.kind,
+		      gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_fnum (gfc_expr *f, gfc_expr *n)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  if (n->ts.kind != f->ts.kind)
+    gfc_convert_type (n, &f->ts, 2);
+  f->value.function.name = gfc_get_string (PREFIX ("fnum_i%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_fraction (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name = gfc_get_string ("__fraction_%d", x->ts.kind);
+}
+
+
+/* Resolve single-argument g77 math intrinsics, eg BESY0, ERF.  */
+
+void
+gfc_resolve_g77_math1 (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name = gfc_get_string ("<intrinsic>");
+}
+
+
+void
+gfc_resolve_gamma (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__tgamma_%d", x->ts.kind);
+}
+
+
+void
+gfc_resolve_getcwd (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = gfc_get_string (PREFIX ("getcwd"));
+}
+
+
+void
+gfc_resolve_getgid (gfc_expr *f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = gfc_get_string (PREFIX ("getgid"));
+}
+
+
+void
+gfc_resolve_getpid (gfc_expr *f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = gfc_get_string (PREFIX ("getpid"));
+}
+
+
+void
+gfc_resolve_getuid (gfc_expr *f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = gfc_get_string (PREFIX ("getuid"));
+}
+
+
+void
+gfc_resolve_hostnm (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = gfc_get_string (PREFIX ("hostnm"));
+}
+
+
+void
+gfc_resolve_hypot (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED)
+{
+  f->ts = x->ts;
+  f->value.function.name = gfc_get_string ("__hypot_r%d", x->ts.kind);
+}
+
+
+void
+gfc_resolve_iall (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+  resolve_transformational ("iall", f, array, dim, mask);
+}
+
+
+void
+gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j)
+{
+  /* If the kind of i and j are different, then g77 cross-promoted the
+     kinds to the largest value.  The Fortran 95 standard requires the 
+     kinds to match.  */
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (i->ts.kind == gfc_kind_max (i, j))
+	gfc_convert_type (j, &i->ts, 2);
+      else
+	gfc_convert_type (i, &j->ts, 2);
+    }
+
+  f->ts = i->ts;
+  f->value.function.name = gfc_get_string ("__iand_%d", i->ts.kind);
+}
+
+
+void
+gfc_resolve_iany (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+  resolve_transformational ("iany", f, array, dim, mask);
+}
+
+
+void
+gfc_resolve_ibclr (gfc_expr *f, gfc_expr *i, gfc_expr *pos ATTRIBUTE_UNUSED)
+{
+  f->ts = i->ts;
+  f->value.function.name = gfc_get_string ("__ibclr_%d", i->ts.kind);
+}
+
+
+void
+gfc_resolve_ibits (gfc_expr *f, gfc_expr *i, gfc_expr *pos ATTRIBUTE_UNUSED,
+		   gfc_expr *len ATTRIBUTE_UNUSED)
+{
+  f->ts = i->ts;
+  f->value.function.name = gfc_get_string ("__ibits_%d", i->ts.kind);
+}
+
+
+void
+gfc_resolve_ibset (gfc_expr *f, gfc_expr *i, gfc_expr *pos ATTRIBUTE_UNUSED)
+{
+  f->ts = i->ts;
+  f->value.function.name = gfc_get_string ("__ibset_%d", i->ts.kind);
+}
+
+
+void
+gfc_resolve_iachar (gfc_expr *f, gfc_expr *c, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string ("__ichar_%d", c->ts.kind);
+}
+
+
+void
+gfc_resolve_ichar (gfc_expr *f, gfc_expr *c, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string ("__ichar_%d", c->ts.kind);
+}
+
+
+void
+gfc_resolve_idnint (gfc_expr *f, gfc_expr *a)
+{
+  gfc_resolve_nint (f, a, NULL);
+}
+
+
+void
+gfc_resolve_ierrno (gfc_expr *f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string (PREFIX ("ierrno_i%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_ieor (gfc_expr *f, gfc_expr *i, gfc_expr *j)
+{
+  /* If the kind of i and j are different, then g77 cross-promoted the
+     kinds to the largest value.  The Fortran 95 standard requires the 
+     kinds to match.  */
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (i->ts.kind == gfc_kind_max (i, j))
+	gfc_convert_type (j, &i->ts, 2);
+      else
+	gfc_convert_type (i, &j->ts, 2);
+    }
+
+  f->ts = i->ts;
+  f->value.function.name = gfc_get_string ("__ieor_%d", i->ts.kind);
+}
+
+
+void
+gfc_resolve_ior (gfc_expr *f, gfc_expr *i, gfc_expr *j)
+{
+  /* If the kind of i and j are different, then g77 cross-promoted the
+     kinds to the largest value.  The Fortran 95 standard requires the 
+     kinds to match.  */
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (i->ts.kind == gfc_kind_max (i, j))
+	gfc_convert_type (j, &i->ts, 2);
+      else
+	gfc_convert_type (i, &j->ts, 2);
+    }
+
+  f->ts = i->ts;
+  f->value.function.name = gfc_get_string ("__ior_%d", i->ts.kind);
+}
+
+
+void
+gfc_resolve_index_func (gfc_expr *f, gfc_expr *str,
+			gfc_expr *sub_str ATTRIBUTE_UNUSED, gfc_expr *back,
+			gfc_expr *kind)
+{
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+
+  f->ts.type = BT_INTEGER;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+
+  if (back && back->ts.kind != gfc_default_integer_kind)
+    {
+      ts.type = BT_LOGICAL;
+      ts.kind = gfc_default_integer_kind;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (back, &ts, 2);
+    }
+
+  f->value.function.name
+    = gfc_get_string ("__index_%d_i%d", str->ts.kind, f->ts.kind);
+}
+
+
+void
+gfc_resolve_int (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = (kind == NULL)
+	     ? gfc_default_integer_kind : mpz_get_si (kind->value.integer);
+  f->value.function.name
+    = gfc_get_string ("__int_%d_%c%d", f->ts.kind,
+		      gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_int2 (gfc_expr *f, gfc_expr *a)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 2;
+  f->value.function.name
+    = gfc_get_string ("__int_%d_%c%d", f->ts.kind,
+		      gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_int8 (gfc_expr *f, gfc_expr *a)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 8;
+  f->value.function.name
+    = gfc_get_string ("__int_%d_%c%d", f->ts.kind,
+		      gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_long (gfc_expr *f, gfc_expr *a)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name
+    = gfc_get_string ("__int_%d_%c%d", f->ts.kind,
+		      gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_iparity (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+  resolve_transformational ("iparity", f, array, dim, mask);
+}
+
+
+void
+gfc_resolve_isatty (gfc_expr *f, gfc_expr *u)
+{
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+  
+  f->ts.type = BT_LOGICAL;
+  f->ts.kind = gfc_default_integer_kind;
+  if (u->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (u, &ts, 2);
+    }
+
+  f->value.function.name = gfc_get_string (PREFIX ("isatty_l%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_ishft (gfc_expr *f, gfc_expr *i, gfc_expr *shift)
+{
+  f->ts = i->ts;
+  f->value.function.name
+    = gfc_get_string ("__ishft_%d_%d", i->ts.kind, shift->ts.kind);
+}
+
+
+void
+gfc_resolve_rshift (gfc_expr *f, gfc_expr *i, gfc_expr *shift)
+{
+  f->ts = i->ts;
+  f->value.function.name
+    = gfc_get_string ("__rshift_%d_%d", i->ts.kind, shift->ts.kind);
+}
+
+
+void
+gfc_resolve_lshift (gfc_expr *f, gfc_expr *i, gfc_expr *shift)
+{
+  f->ts = i->ts;
+  f->value.function.name
+    = gfc_get_string ("__lshift_%d_%d", i->ts.kind, shift->ts.kind);
+}
+
+
+void
+gfc_resolve_ishftc (gfc_expr *f, gfc_expr *i, gfc_expr *shift, gfc_expr *size)
+{
+  int s_kind;
+
+  s_kind = (size == NULL) ? gfc_default_integer_kind : size->ts.kind;
+
+  f->ts = i->ts;
+  f->value.function.name
+    = gfc_get_string ("__ishftc_%d_%d_%d", i->ts.kind, shift->ts.kind, s_kind);
+}
+
+
+void
+gfc_resolve_kill (gfc_expr *f, gfc_expr *p ATTRIBUTE_UNUSED,
+		  gfc_expr *s ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string (PREFIX ("kill_i%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_lbound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+  resolve_bound (f, array, dim, kind, "__lbound", false);
+}
+
+
+void
+gfc_resolve_lcobound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+  resolve_bound (f, array, dim, kind, "__lcobound", true);
+}
+
+
+void
+gfc_resolve_len (gfc_expr *f, gfc_expr *string, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name
+    = gfc_get_string ("__len_%d_i%d", string->ts.kind,
+		      gfc_default_integer_kind);
+}
+
+
+void
+gfc_resolve_len_trim (gfc_expr *f, gfc_expr *string, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string ("__len_trim%d", string->ts.kind);
+}
+
+
+void
+gfc_resolve_lgamma (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__lgamma_%d", x->ts.kind);
+}
+
+
+void
+gfc_resolve_link (gfc_expr *f, gfc_expr *p1 ATTRIBUTE_UNUSED,
+		  gfc_expr *p2 ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string (PREFIX ("link_i%d"), f->ts.kind);
+}
+
+
+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;
+  f->value.function.name
+    = gfc_get_string ("__log_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
+
+void
+gfc_resolve_log10 (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__log10_%c%d", gfc_type_letter (x->ts.type),
+		      x->ts.kind);
+}
+
+
+void
+gfc_resolve_logical (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
+{
+  f->ts.type = BT_LOGICAL;
+  f->ts.kind = (kind == NULL)
+	     ? gfc_default_logical_kind : mpz_get_si (kind->value.integer);
+  f->rank = a->rank;
+
+  f->value.function.name
+    = gfc_get_string ("__logical_%d_%c%d", f->ts.kind,
+		      gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_malloc (gfc_expr *f, gfc_expr *size)
+{
+  if (size->ts.kind < gfc_index_integer_kind)
+    {
+      gfc_typespec ts;
+      gfc_clear_ts (&ts);
+
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_index_integer_kind;
+      gfc_convert_type_warn (size, &ts, 2, 0);
+    }
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_index_integer_kind;
+  f->value.function.name = gfc_get_string (PREFIX ("malloc"));
+}
+
+
+void
+gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b)
+{
+  gfc_expr temp;
+
+  if (a->ts.type == BT_LOGICAL && b->ts.type == BT_LOGICAL)
+    {
+      f->ts.type = BT_LOGICAL;
+      f->ts.kind = gfc_default_logical_kind;
+    }
+  else
+    {
+      temp.expr_type = EXPR_OP;
+      gfc_clear_ts (&temp.ts);
+      temp.value.op.op = INTRINSIC_NONE;
+      temp.value.op.op1 = a;
+      temp.value.op.op2 = b;
+      gfc_type_convert_binary (&temp, 1);
+      f->ts = temp.ts;
+    }
+
+  f->rank = (a->rank == 2 && b->rank == 2) ? 2 : 1;
+
+  if (a->rank == 2 && b->rank == 2)
+    {
+      if (a->shape && b->shape)
+	{
+	  f->shape = gfc_get_shape (f->rank);
+	  mpz_init_set (f->shape[0], a->shape[0]);
+	  mpz_init_set (f->shape[1], b->shape[1]);
+	}
+    }
+  else if (a->rank == 1)
+    {
+      if (b->shape)
+	{
+	  f->shape = gfc_get_shape (f->rank);
+	  mpz_init_set (f->shape[0], b->shape[1]);
+	}
+    }
+  else 
+    {
+      /* b->rank == 1 and a->rank == 2 here, all other cases have
+	 been caught in check.c.   */
+      if (a->shape)
+	{
+	  f->shape = gfc_get_shape (f->rank);
+	  mpz_init_set (f->shape[0], a->shape[0]);
+	}
+    }
+
+  f->value.function.name
+    = gfc_get_string (PREFIX ("matmul_%c%d"), gfc_type_letter (f->ts.type),
+		      f->ts.kind);
+}
+
+
+static void
+gfc_resolve_minmax (const char *name, gfc_expr *f, gfc_actual_arglist *args)
+{
+  gfc_actual_arglist *a;
+
+  f->ts.type = args->expr->ts.type;
+  f->ts.kind = args->expr->ts.kind;
+  /* Find the largest type kind.  */
+  for (a = args->next; a; a = a->next)
+    {
+      if (a->expr->ts.kind > f->ts.kind)
+	f->ts.kind = a->expr->ts.kind;
+    }
+
+  /* Convert all parameters to the required kind.  */
+  for (a = args; a; a = a->next)
+    {
+      if (a->expr->ts.kind != f->ts.kind)
+	gfc_convert_type (a->expr, &f->ts, 2);
+    }
+
+  f->value.function.name
+    = gfc_get_string (name, gfc_type_letter (f->ts.type), f->ts.kind);
+}
+
+
+void
+gfc_resolve_max (gfc_expr *f, gfc_actual_arglist *args)
+{
+  gfc_resolve_minmax ("__max_%c%d", f, args);
+}
+
+
+void
+gfc_resolve_maxloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
+		    gfc_expr *mask)
+{
+  const char *name;
+  int i, j, idim;
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+
+  if (dim == NULL)
+    {
+      f->rank = 1;
+      f->shape = gfc_get_shape (1);
+      mpz_init_set_si (f->shape[0], array->rank);
+    }
+  else
+    {
+      f->rank = array->rank - 1;
+      gfc_resolve_dim_arg (dim);
+      if (array->shape && dim->expr_type == EXPR_CONSTANT)
+	{
+	  idim = (int) mpz_get_si (dim->value.integer);
+	  f->shape = gfc_get_shape (f->rank);
+	  for (i = 0, j = 0; i < f->rank; i++, j++)
+	    {
+	      if (i == (idim - 1))
+		j++;
+	      mpz_init_set (f->shape[i], array->shape[j]);
+	    }
+	}
+    }
+
+  if (mask)
+    {
+      if (mask->rank == 0)
+	name = "smaxloc";
+      else
+	name = "mmaxloc";
+
+      resolve_mask_arg (mask);
+    }
+  else
+    name = "maxloc";
+
+  f->value.function.name
+    = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
+		      gfc_type_letter (array->ts.type), array->ts.kind);
+}
+
+
+void
+gfc_resolve_maxval (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
+		    gfc_expr *mask)
+{
+  const char *name;
+  int i, j, idim;
+
+  f->ts = array->ts;
+
+  if (dim != NULL)
+    {
+      f->rank = array->rank - 1;
+      gfc_resolve_dim_arg (dim);
+
+      if (f->rank && array->shape && dim->expr_type == EXPR_CONSTANT)
+	{
+	  idim = (int) mpz_get_si (dim->value.integer);
+	  f->shape = gfc_get_shape (f->rank);
+	  for (i = 0, j = 0; i < f->rank; i++, j++)
+	    {
+	      if (i == (idim - 1))
+		j++;
+	      mpz_init_set (f->shape[i], array->shape[j]);
+	    }
+	}
+    }
+
+  if (mask)
+    {
+      if (mask->rank == 0)
+	name = "smaxval";
+      else
+	name = "mmaxval";
+
+      resolve_mask_arg (mask);
+    }
+  else
+    name = "maxval";
+
+  f->value.function.name
+    = gfc_get_string (PREFIX ("%s_%c%d"), name,
+		      gfc_type_letter (array->ts.type), array->ts.kind);
+}
+
+
+void
+gfc_resolve_mclock (gfc_expr *f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = PREFIX ("mclock");
+}
+
+
+void
+gfc_resolve_mclock8 (gfc_expr *f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 8;
+  f->value.function.name = PREFIX ("mclock8");
+}
+
+
+void
+gfc_resolve_mask (gfc_expr *f, gfc_expr *i ATTRIBUTE_UNUSED,
+		  gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = kind ? mpz_get_si (kind->value.integer)
+		    : gfc_default_integer_kind;
+
+  if (f->value.function.isym->id == GFC_ISYM_MASKL)
+    f->value.function.name = gfc_get_string ("__maskl_i%d", f->ts.kind);
+  else
+    f->value.function.name = gfc_get_string ("__maskr_i%d", f->ts.kind);
+}
+
+
+void
+gfc_resolve_merge (gfc_expr *f, gfc_expr *tsource,
+		   gfc_expr *fsource ATTRIBUTE_UNUSED,
+		   gfc_expr *mask ATTRIBUTE_UNUSED)
+{
+  if (tsource->ts.type == BT_CHARACTER && tsource->ref)
+    gfc_resolve_substring_charlen (tsource);
+
+  if (fsource->ts.type == BT_CHARACTER && fsource->ref)
+    gfc_resolve_substring_charlen (fsource);
+
+  if (tsource->ts.type == BT_CHARACTER)
+    check_charlen_present (tsource);
+
+  f->ts = tsource->ts;
+  f->value.function.name
+    = gfc_get_string ("__merge_%c%d", gfc_type_letter (tsource->ts.type),
+		      tsource->ts.kind);
+}
+
+
+void
+gfc_resolve_merge_bits (gfc_expr *f, gfc_expr *i,
+			gfc_expr *j ATTRIBUTE_UNUSED,
+			gfc_expr *mask ATTRIBUTE_UNUSED)
+{
+  f->ts = i->ts;
+  f->value.function.name = gfc_get_string ("__merge_bits_i%d", i->ts.kind);
+}
+
+
+void
+gfc_resolve_min (gfc_expr *f, gfc_actual_arglist *args)
+{
+  gfc_resolve_minmax ("__min_%c%d", f, args);
+}
+
+
+void
+gfc_resolve_minloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
+		    gfc_expr *mask)
+{
+  const char *name;
+  int i, j, idim;
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+
+  if (dim == NULL)
+    {
+      f->rank = 1;
+      f->shape = gfc_get_shape (1);
+      mpz_init_set_si (f->shape[0], array->rank);
+    }
+  else
+    {
+      f->rank = array->rank - 1;
+      gfc_resolve_dim_arg (dim);
+      if (array->shape && dim->expr_type == EXPR_CONSTANT)
+	{
+	  idim = (int) mpz_get_si (dim->value.integer);
+	  f->shape = gfc_get_shape (f->rank);
+	  for (i = 0, j = 0; i < f->rank; i++, j++)
+	    {
+	      if (i == (idim - 1))
+		j++;
+	      mpz_init_set (f->shape[i], array->shape[j]);
+	    }
+	}
+    }
+
+  if (mask)
+    {
+      if (mask->rank == 0)
+	name = "sminloc";
+      else
+	name = "mminloc";
+
+      resolve_mask_arg (mask);
+    }
+  else
+    name = "minloc";
+
+  f->value.function.name
+    = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, dim != NULL, f->ts.kind,
+		      gfc_type_letter (array->ts.type), array->ts.kind);
+}
+
+
+void
+gfc_resolve_minval (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
+		    gfc_expr *mask)
+{
+  const char *name;
+  int i, j, idim;
+
+  f->ts = array->ts;
+
+  if (dim != NULL)
+    {
+      f->rank = array->rank - 1;
+      gfc_resolve_dim_arg (dim);
+
+      if (f->rank && array->shape && dim->expr_type == EXPR_CONSTANT)
+	{
+	  idim = (int) mpz_get_si (dim->value.integer);
+	  f->shape = gfc_get_shape (f->rank);
+	  for (i = 0, j = 0; i < f->rank; i++, j++)
+	    {
+	      if (i == (idim - 1))
+		j++;
+	      mpz_init_set (f->shape[i], array->shape[j]);
+	    }
+	}
+    }
+
+  if (mask)
+    {
+      if (mask->rank == 0)
+	name = "sminval";
+      else
+	name = "mminval";
+
+      resolve_mask_arg (mask);
+    }
+  else
+    name = "minval";
+
+  f->value.function.name
+    = gfc_get_string (PREFIX ("%s_%c%d"), name,
+		      gfc_type_letter (array->ts.type), array->ts.kind);
+}
+
+
+void
+gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p)
+{
+  f->ts.type = a->ts.type;
+  if (p != NULL)
+    f->ts.kind = gfc_kind_max (a,p);
+  else
+    f->ts.kind = a->ts.kind;
+
+  if (p != NULL && a->ts.kind != p->ts.kind)
+    {
+      if (a->ts.kind == gfc_kind_max (a,p))
+	gfc_convert_type (p, &a->ts, 2);
+      else
+	gfc_convert_type (a, &p->ts, 2);
+    }
+
+  f->value.function.name
+    = gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), f->ts.kind);
+}
+
+
+void
+gfc_resolve_modulo (gfc_expr *f, gfc_expr *a, gfc_expr *p)
+{
+  f->ts.type = a->ts.type;
+  if (p != NULL)
+    f->ts.kind = gfc_kind_max (a,p);
+  else
+    f->ts.kind = a->ts.kind;
+
+  if (p != NULL && a->ts.kind != p->ts.kind)
+    {
+      if (a->ts.kind == gfc_kind_max (a,p))
+	gfc_convert_type (p, &a->ts, 2);
+      else
+	gfc_convert_type (a, &p->ts, 2);
+    }
+
+  f->value.function.name
+    = gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type),
+		      f->ts.kind);
+}
+
+void
+gfc_resolve_nearest (gfc_expr *f, gfc_expr *a, gfc_expr *p)
+{
+  if (p->ts.kind != a->ts.kind)
+    gfc_convert_type (p, &a->ts, 2);
+
+  f->ts = a->ts;
+  f->value.function.name
+    = gfc_get_string ("__nearest_%c%d", gfc_type_letter (a->ts.type),
+		      a->ts.kind);
+}
+
+void
+gfc_resolve_nint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = (kind == NULL)
+	     ? gfc_default_integer_kind : mpz_get_si (kind->value.integer);
+  f->value.function.name
+    = gfc_get_string ("__nint_%d_%d", f->ts.kind, a->ts.kind);
+}
+
+
+void
+gfc_resolve_norm2 (gfc_expr *f, gfc_expr *array, gfc_expr *dim)
+{
+  resolve_transformational ("norm2", f, array, dim, NULL);
+}
+
+
+void
+gfc_resolve_not (gfc_expr *f, gfc_expr *i)
+{
+  f->ts = i->ts;
+  f->value.function.name = gfc_get_string ("__not_%d", i->ts.kind);
+}
+
+
+void
+gfc_resolve_or (gfc_expr *f, gfc_expr *i, gfc_expr *j)
+{
+  f->ts.type = i->ts.type;
+  f->ts.kind = gfc_kind_max (i, j);
+
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (i->ts.kind == gfc_kind_max (i, j))
+	gfc_convert_type (j, &i->ts, 2);
+      else
+	gfc_convert_type (i, &j->ts, 2);
+    }
+
+  f->value.function.name
+    = gfc_get_string ("__or_%c%d", gfc_type_letter (i->ts.type), f->ts.kind);
+}
+
+
+void
+gfc_resolve_pack (gfc_expr *f, gfc_expr *array, gfc_expr *mask,
+		  gfc_expr *vector ATTRIBUTE_UNUSED)
+{
+  if (array->ts.type == BT_CHARACTER && array->ref)
+    gfc_resolve_substring_charlen (array);
+
+  f->ts = array->ts;
+  f->rank = 1;
+
+  resolve_mask_arg (mask);
+
+  if (mask->rank != 0)
+    {
+      if (array->ts.type == BT_CHARACTER)
+	f->value.function.name
+	  = array->ts.kind == 1 ? PREFIX ("pack_char")
+				: gfc_get_string
+					(PREFIX ("pack_char%d"),
+					 array->ts.kind);
+      else
+	f->value.function.name = PREFIX ("pack");
+    }
+  else
+    {
+      if (array->ts.type == BT_CHARACTER)
+	f->value.function.name
+	  = array->ts.kind == 1 ? PREFIX ("pack_s_char")
+				: gfc_get_string
+					(PREFIX ("pack_s_char%d"),
+					 array->ts.kind);
+      else
+	f->value.function.name = PREFIX ("pack_s");
+    }
+}
+
+
+void
+gfc_resolve_parity (gfc_expr *f, gfc_expr *array, gfc_expr *dim)
+{
+  resolve_transformational ("parity", f, array, dim, NULL);
+}
+
+
+void
+gfc_resolve_product (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
+		     gfc_expr *mask)
+{
+  resolve_transformational ("product", f, array, dim, mask);
+}
+
+
+void
+gfc_resolve_real (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
+{
+  f->ts.type = BT_REAL;
+
+  if (kind != NULL)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = (a->ts.type == BT_COMPLEX)
+	       ? a->ts.kind : gfc_default_real_kind;
+
+  f->value.function.name
+    = gfc_get_string ("__real_%d_%c%d", f->ts.kind,
+		      gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_realpart (gfc_expr *f, gfc_expr *a)
+{
+  f->ts.type = BT_REAL;
+  f->ts.kind = a->ts.kind;
+  f->value.function.name
+    = gfc_get_string ("__real_%d_%c%d", f->ts.kind,
+		      gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_rename (gfc_expr *f, gfc_expr *p1 ATTRIBUTE_UNUSED,
+		    gfc_expr *p2 ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string (PREFIX ("rename_i%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_repeat (gfc_expr *f, gfc_expr *string,
+		    gfc_expr *ncopies)
+{
+  int len;
+  gfc_expr *tmp;
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = string->ts.kind;
+  f->value.function.name = gfc_get_string ("__repeat_%d", string->ts.kind);
+
+  /* If possible, generate a character length.  */
+  if (f->ts.u.cl == NULL)
+    f->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+
+  tmp = NULL;
+  if (string->expr_type == EXPR_CONSTANT)
+    {
+      len = string->value.character.length;
+      tmp = gfc_get_int_expr (gfc_default_integer_kind, NULL , len);
+    }
+  else if (string->ts.u.cl && string->ts.u.cl->length)
+    {
+      tmp = gfc_copy_expr (string->ts.u.cl->length);
+    }
+
+  if (tmp)
+    f->ts.u.cl->length = gfc_multiply (tmp, gfc_copy_expr (ncopies));
+}
+
+
+void
+gfc_resolve_reshape (gfc_expr *f, gfc_expr *source, gfc_expr *shape,
+		     gfc_expr *pad ATTRIBUTE_UNUSED,
+		     gfc_expr *order ATTRIBUTE_UNUSED)
+{
+  mpz_t rank;
+  int kind;
+  int i;
+
+  if (source->ts.type == BT_CHARACTER && source->ref)
+    gfc_resolve_substring_charlen (source);
+
+  f->ts = source->ts;
+
+  gfc_array_size (shape, &rank);
+  f->rank = mpz_get_si (rank);
+  mpz_clear (rank);
+  switch (source->ts.type)
+    {
+    case BT_COMPLEX:
+    case BT_REAL:
+    case BT_INTEGER:
+    case BT_LOGICAL:
+    case BT_CHARACTER:
+      kind = source->ts.kind;
+      break;
+
+    default:
+      kind = 0;
+      break;
+    }
+
+  switch (kind)
+    {
+    case 4:
+    case 8:
+    case 10:
+    case 16:
+      if (source->ts.type == BT_COMPLEX || source->ts.type == BT_REAL)
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("reshape_%c%d"),
+			    gfc_type_letter (source->ts.type),
+			    source->ts.kind);
+      else if (source->ts.type == BT_CHARACTER)
+	f->value.function.name = gfc_get_string (PREFIX ("reshape_char%d"),
+						 kind);
+      else
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("reshape_%d"), source->ts.kind);
+      break;
+
+    default:
+      f->value.function.name = (source->ts.type == BT_CHARACTER
+				? PREFIX ("reshape_char") : PREFIX ("reshape"));
+      break;
+    }
+
+  /* TODO: Make this work with a constant ORDER parameter.  */
+  if (shape->expr_type == EXPR_ARRAY
+      && gfc_is_constant_expr (shape)
+      && order == NULL)
+    {
+      gfc_constructor *c;
+      f->shape = gfc_get_shape (f->rank);
+      c = gfc_constructor_first (shape->value.constructor);
+      for (i = 0; i < f->rank; i++)
+	{
+	  mpz_init_set (f->shape[i], c->expr->value.integer);
+	  c = gfc_constructor_next (c);
+	}
+    }
+
+  /* Force-convert both SHAPE and ORDER to index_kind so that we don't need
+     so many runtime variations.  */
+  if (shape->ts.kind != gfc_index_integer_kind)
+    {
+      gfc_typespec ts = shape->ts;
+      ts.kind = gfc_index_integer_kind;
+      gfc_convert_type_warn (shape, &ts, 2, 0);
+    }
+  if (order && order->ts.kind != gfc_index_integer_kind)
+    gfc_convert_type_warn (order, &shape->ts, 2, 0);
+}
+
+
+void
+gfc_resolve_rrspacing (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name = gfc_get_string ("__rrspacing_%d", x->ts.kind);
+}
+
+
+void
+gfc_resolve_scale (gfc_expr *f, gfc_expr *x, gfc_expr *i ATTRIBUTE_UNUSED)
+{
+  f->ts = x->ts;
+  f->value.function.name = gfc_get_string ("__scale_%d", x->ts.kind);
+}
+
+
+void
+gfc_resolve_scan (gfc_expr *f, gfc_expr *string,
+		  gfc_expr *set ATTRIBUTE_UNUSED,
+		  gfc_expr *back ATTRIBUTE_UNUSED, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string ("__scan_%d", string->ts.kind);
+}
+
+
+void
+gfc_resolve_secnds (gfc_expr *t1, gfc_expr *t0)
+{
+  t1->ts = t0->ts;
+  t1->value.function.name = gfc_get_string (PREFIX ("secnds"));
+}
+
+
+void
+gfc_resolve_set_exponent (gfc_expr *f, gfc_expr *x,
+			  gfc_expr *i ATTRIBUTE_UNUSED)
+{
+  f->ts = x->ts;
+  f->value.function.name = gfc_get_string ("__set_exponent_%d", x->ts.kind);
+}
+
+
+void
+gfc_resolve_shape (gfc_expr *f, gfc_expr *array, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+
+  f->rank = 1;
+  f->shape = gfc_get_shape (1);
+  mpz_init_set_ui (f->shape[0], array->rank);
+  f->value.function.name = gfc_get_string (PREFIX ("shape_%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_shift (gfc_expr *f, gfc_expr *i, gfc_expr *shift ATTRIBUTE_UNUSED)
+{
+  f->ts = i->ts;
+  if (f->value.function.isym->id == GFC_ISYM_SHIFTA)
+    f->value.function.name = gfc_get_string ("shifta_i%d", f->ts.kind);
+  else if (f->value.function.isym->id == GFC_ISYM_SHIFTL)
+    f->value.function.name = gfc_get_string ("shiftl_i%d", f->ts.kind);
+  else if (f->value.function.isym->id == GFC_ISYM_SHIFTR)
+    f->value.function.name = gfc_get_string ("shiftr_i%d", f->ts.kind);
+  else
+    gcc_unreachable ();
+}
+
+
+void
+gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b ATTRIBUTE_UNUSED)
+{
+  f->ts = a->ts;
+  f->value.function.name
+    = gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
+}
+
+
+void
+gfc_resolve_signal (gfc_expr *f, gfc_expr *number, gfc_expr *handler)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+
+  /* handler can be either BT_INTEGER or BT_PROCEDURE  */
+  if (handler->ts.type == BT_INTEGER)
+    {
+      if (handler->ts.kind != gfc_c_int_kind)
+	gfc_convert_type (handler, &f->ts, 2);
+      f->value.function.name = gfc_get_string (PREFIX ("signal_func_int"));
+    }
+  else
+    f->value.function.name = gfc_get_string (PREFIX ("signal_func"));
+
+  if (number->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (number, &f->ts, 2);
+}
+
+
+void
+gfc_resolve_sin (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__sin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
+
+void
+gfc_resolve_sinh (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__sinh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
+
+void
+gfc_resolve_size (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
+		  gfc_expr *dim ATTRIBUTE_UNUSED, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+}
+
+
+void
+gfc_resolve_spacing (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name = gfc_get_string ("__spacing_%d", x->ts.kind);
+}
+
+
+void
+gfc_resolve_spread (gfc_expr *f, gfc_expr *source, gfc_expr *dim,
+		    gfc_expr *ncopies)
+{
+  if (source->ts.type == BT_CHARACTER && source->ref)
+    gfc_resolve_substring_charlen (source);
+
+  if (source->ts.type == BT_CHARACTER)
+    check_charlen_present (source);
+
+  f->ts = source->ts;
+  f->rank = source->rank + 1;
+  if (source->rank == 0)
+    {
+      if (source->ts.type == BT_CHARACTER)
+	f->value.function.name
+	  = source->ts.kind == 1 ? PREFIX ("spread_char_scalar")
+				 : gfc_get_string
+					(PREFIX ("spread_char%d_scalar"),
+					 source->ts.kind);
+      else
+	f->value.function.name = PREFIX ("spread_scalar");
+    }
+  else
+    {
+      if (source->ts.type == BT_CHARACTER)
+	f->value.function.name
+	  = source->ts.kind == 1 ? PREFIX ("spread_char")
+				 : gfc_get_string
+					(PREFIX ("spread_char%d"),
+					 source->ts.kind);
+      else
+	f->value.function.name = PREFIX ("spread");
+    }
+
+  if (dim && gfc_is_constant_expr (dim)
+      && ncopies && gfc_is_constant_expr (ncopies) && source->shape[0])
+    {
+      int i, idim;
+      idim = mpz_get_ui (dim->value.integer);
+      f->shape = gfc_get_shape (f->rank);
+      for (i = 0; i < (idim - 1); i++)
+	mpz_init_set (f->shape[i], source->shape[i]);
+
+      mpz_init_set (f->shape[idim - 1], ncopies->value.integer);
+
+      for (i = idim; i < f->rank ; i++)
+	mpz_init_set (f->shape[i], source->shape[i-1]);
+    }
+
+
+  gfc_resolve_dim_arg (dim);
+  gfc_resolve_index (ncopies, 1);
+}
+
+
+void
+gfc_resolve_sqrt (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__sqrt_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
+
+/* Resolve the g77 compatibility function STAT AND FSTAT.  */
+
+void
+gfc_resolve_stat (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED,
+		  gfc_expr *a ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string (PREFIX ("stat_i%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_lstat (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED,
+		   gfc_expr *a ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string (PREFIX ("lstat_i%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_fstat (gfc_expr *f, gfc_expr *n, gfc_expr *a ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  if (n->ts.kind != f->ts.kind)
+    gfc_convert_type (n, &f->ts, 2);
+
+  f->value.function.name = gfc_get_string (PREFIX ("fstat_i%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_fgetc (gfc_expr *f, gfc_expr *u, gfc_expr *c ATTRIBUTE_UNUSED)
+{
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  if (u->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (u, &ts, 2);
+    }
+
+  f->value.function.name = gfc_get_string (PREFIX ("fgetc"));
+}
+
+
+void
+gfc_resolve_fget (gfc_expr *f, gfc_expr *c ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  f->value.function.name = gfc_get_string (PREFIX ("fget"));
+}
+
+
+void
+gfc_resolve_fputc (gfc_expr *f, gfc_expr *u, gfc_expr *c ATTRIBUTE_UNUSED)
+{
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  if (u->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (u, &ts, 2);
+    }
+
+  f->value.function.name = gfc_get_string (PREFIX ("fputc"));
+}
+
+
+void
+gfc_resolve_fput (gfc_expr *f, gfc_expr *c ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_c_int_kind;
+  f->value.function.name = gfc_get_string (PREFIX ("fput"));
+}
+
+
+void
+gfc_resolve_ftell (gfc_expr *f, gfc_expr *u)
+{
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_index_integer_kind;
+  if (u->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (u, &ts, 2);
+    }
+
+  f->value.function.name = gfc_get_string (PREFIX ("ftell"));
+}
+
+
+void
+gfc_resolve_storage_size (gfc_expr *f, gfc_expr *a ATTRIBUTE_UNUSED,
+			  gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+}
+
+
+void
+gfc_resolve_sum (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+  resolve_transformational ("sum", f, array, dim, mask);
+}
+
+
+void
+gfc_resolve_symlnk (gfc_expr *f, gfc_expr *p1 ATTRIBUTE_UNUSED,
+		    gfc_expr *p2 ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string (PREFIX ("symlnk_i%d"), f->ts.kind);
+}
+
+
+/* Resolve the g77 compatibility function SYSTEM.  */
+
+void
+gfc_resolve_system (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = gfc_get_string (PREFIX ("system"));
+}
+
+
+void
+gfc_resolve_tan (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__tan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
+
+void
+gfc_resolve_tanh (gfc_expr *f, gfc_expr *x)
+{
+  f->ts = x->ts;
+  f->value.function.name
+    = gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind);
+}
+
+
+void
+gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
+			 gfc_expr *sub ATTRIBUTE_UNUSED)
+{
+  static char this_image[] = "__image_index";
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = this_image;
+}
+
+
+void
+gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim)
+{
+  resolve_bound (f, array, dim, NULL, "__this_image", true);
+}
+
+
+void
+gfc_resolve_time (gfc_expr *f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = gfc_get_string (PREFIX ("time_func"));
+}
+
+
+void
+gfc_resolve_time8 (gfc_expr *f)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 8;
+  f->value.function.name = gfc_get_string (PREFIX ("time8_func"));
+}
+
+
+void
+gfc_resolve_transfer (gfc_expr *f, gfc_expr *source ATTRIBUTE_UNUSED,
+		      gfc_expr *mold, gfc_expr *size)
+{
+  /* TODO: Make this do something meaningful.  */
+  static char transfer0[] = "__transfer0", transfer1[] = "__transfer1";
+
+  if (mold->ts.type == BT_CHARACTER
+	&& !mold->ts.u.cl->length
+	&& gfc_is_constant_expr (mold))
+    {
+      int len;
+      if (mold->expr_type == EXPR_CONSTANT)
+        {
+	  len = mold->value.character.length;
+	  mold->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+						    NULL, len);
+	}
+      else
+	{
+	  gfc_constructor *c = gfc_constructor_first (mold->value.constructor);
+	  len = c->expr->value.character.length;
+	  mold->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+						    NULL, len);
+	}
+    }
+
+  f->ts = mold->ts;
+
+  if (size == NULL && mold->rank == 0)
+    {
+      f->rank = 0;
+      f->value.function.name = transfer0;
+    }
+  else
+    {
+      f->rank = 1;
+      f->value.function.name = transfer1;
+      if (size && gfc_is_constant_expr (size))
+	{
+	  f->shape = gfc_get_shape (1);
+	  mpz_init_set (f->shape[0], size->value.integer);
+	}
+    }
+}
+
+
+void
+gfc_resolve_transpose (gfc_expr *f, gfc_expr *matrix)
+{
+
+  if (matrix->ts.type == BT_CHARACTER && matrix->ref)
+    gfc_resolve_substring_charlen (matrix);
+
+  f->ts = matrix->ts;
+  f->rank = 2;
+  if (matrix->shape)
+    {
+      f->shape = gfc_get_shape (2);
+      mpz_init_set (f->shape[0], matrix->shape[1]);
+      mpz_init_set (f->shape[1], matrix->shape[0]);
+    }
+
+  switch (matrix->ts.kind)
+    {
+    case 4:
+    case 8:
+    case 10:
+    case 16:
+      switch (matrix->ts.type)
+	{
+	case BT_REAL:
+	case BT_COMPLEX:
+	  f->value.function.name
+	    = gfc_get_string (PREFIX ("transpose_%c%d"),
+			      gfc_type_letter (matrix->ts.type),
+			      matrix->ts.kind);
+	  break;
+
+	case BT_INTEGER:
+	case BT_LOGICAL:
+	  /* Use the integer routines for real and logical cases.  This
+	     assumes they all have the same alignment requirements.  */
+	  f->value.function.name
+	    = gfc_get_string (PREFIX ("transpose_i%d"), matrix->ts.kind);
+	  break;
+
+	default:
+	  if (matrix->ts.type == BT_CHARACTER && matrix->ts.kind == 4)
+	    f->value.function.name = PREFIX ("transpose_char4");
+	  else
+	    f->value.function.name = PREFIX ("transpose");
+	  break;
+	}
+      break;
+
+    default:
+      f->value.function.name = (matrix->ts.type == BT_CHARACTER
+				? PREFIX ("transpose_char")
+				: PREFIX ("transpose"));
+      break;
+    }
+}
+
+
+void
+gfc_resolve_trim (gfc_expr *f, gfc_expr *string)
+{
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = string->ts.kind;
+  f->value.function.name = gfc_get_string ("__trim_%d", string->ts.kind);
+}
+
+
+void
+gfc_resolve_ubound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+  resolve_bound (f, array, dim, kind, "__ubound", false);
+}
+
+
+void
+gfc_resolve_ucobound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+  resolve_bound (f, array, dim, kind, "__ucobound", true);
+}
+
+
+/* Resolve the g77 compatibility function UMASK.  */
+
+void
+gfc_resolve_umask (gfc_expr *f, gfc_expr *n)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = n->ts.kind;
+  f->value.function.name = gfc_get_string (PREFIX ("umask_i%d"), n->ts.kind);
+}
+
+
+/* Resolve the g77 compatibility function UNLINK.  */
+
+void
+gfc_resolve_unlink (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED)
+{
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = 4;
+  f->value.function.name = gfc_get_string (PREFIX ("unlink"));
+}
+
+
+void
+gfc_resolve_ttynam (gfc_expr *f, gfc_expr *unit)
+{
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+  
+  f->ts.type = BT_CHARACTER;
+  f->ts.kind = gfc_default_character_kind;
+
+  if (unit->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (unit, &ts, 2);
+    }
+
+  f->value.function.name = gfc_get_string (PREFIX ("ttynam"));
+}
+
+
+void
+gfc_resolve_unpack (gfc_expr *f, gfc_expr *vector, gfc_expr *mask,
+		    gfc_expr *field ATTRIBUTE_UNUSED)
+{
+  if (vector->ts.type == BT_CHARACTER && vector->ref)
+    gfc_resolve_substring_charlen (vector);
+
+  f->ts = vector->ts;
+  f->rank = mask->rank;
+  resolve_mask_arg (mask);
+
+  if (vector->ts.type == BT_CHARACTER)
+    {
+      if (vector->ts.kind == 1)
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("unpack%d_char"), field->rank > 0 ? 1 : 0);
+      else
+	f->value.function.name
+	  = gfc_get_string (PREFIX ("unpack%d_char%d"),
+			    field->rank > 0 ? 1 : 0, vector->ts.kind);
+    }
+  else
+    f->value.function.name
+      = gfc_get_string (PREFIX ("unpack%d"), field->rank > 0 ? 1 : 0);
+}
+
+
+void
+gfc_resolve_verify (gfc_expr *f, gfc_expr *string,
+		    gfc_expr *set ATTRIBUTE_UNUSED,
+		    gfc_expr *back ATTRIBUTE_UNUSED, gfc_expr *kind)
+{
+  f->ts.type = BT_INTEGER;
+  if (kind)
+    f->ts.kind = mpz_get_si (kind->value.integer);
+  else
+    f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = gfc_get_string ("__verify_%d", string->ts.kind);
+}
+
+
+void
+gfc_resolve_xor (gfc_expr *f, gfc_expr *i, gfc_expr *j)
+{
+  f->ts.type = i->ts.type;
+  f->ts.kind = gfc_kind_max (i, j);
+
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (i->ts.kind == gfc_kind_max (i, j))
+	gfc_convert_type (j, &i->ts, 2);
+      else
+	gfc_convert_type (i, &j->ts, 2);
+    }
+
+  f->value.function.name
+    = gfc_get_string ("__xor_%c%d", gfc_type_letter (i->ts.type), f->ts.kind);
+}
+
+
+/* Intrinsic subroutine resolution.  */
+
+void
+gfc_resolve_alarm_sub (gfc_code *c)
+{
+  const char *name;
+  gfc_expr *seconds, *handler;
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+
+  seconds = c->ext.actual->expr;
+  handler = c->ext.actual->next->expr;
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_c_int_kind;
+
+  /* handler can be either BT_INTEGER or BT_PROCEDURE.
+     In all cases, the status argument is of default integer kind
+     (enforced in check.c) so that the function suffix is fixed.  */
+  if (handler->ts.type == BT_INTEGER)
+    {
+      if (handler->ts.kind != gfc_c_int_kind)
+	gfc_convert_type (handler, &ts, 2);
+      name = gfc_get_string (PREFIX ("alarm_sub_int_i%d"),
+			     gfc_default_integer_kind);
+    }
+  else
+    name = gfc_get_string (PREFIX ("alarm_sub_i%d"),
+			   gfc_default_integer_kind);
+
+  if (seconds->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (seconds, &ts, 2);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+void
+gfc_resolve_cpu_time (gfc_code *c)
+{
+  const char *name;
+  name = gfc_get_string (PREFIX ("cpu_time_%d"), c->ext.actual->expr->ts.kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* Create a formal arglist based on an actual one and set the INTENTs given.  */
+
+static gfc_formal_arglist*
+create_formal_for_intents (gfc_actual_arglist* actual, const sym_intent* ints)
+{
+  gfc_formal_arglist* head;
+  gfc_formal_arglist* tail;
+  int i;
+
+  if (!actual)
+    return NULL;
+
+  head = tail = gfc_get_formal_arglist ();
+  for (i = 0; actual; actual = actual->next, tail = tail->next, ++i)
+    {
+      gfc_symbol* sym;
+
+      sym = gfc_new_symbol ("dummyarg", NULL);
+      sym->ts = actual->expr->ts;
+
+      sym->attr.intent = ints[i];
+      tail->sym = sym;
+
+      if (actual->next)
+	tail->next = gfc_get_formal_arglist ();
+    }
+
+  return head;
+}
+
+
+void
+gfc_resolve_mvbits (gfc_code *c)
+{
+  static const sym_intent INTENTS[] = {INTENT_IN, INTENT_IN, INTENT_IN,
+				       INTENT_INOUT, INTENT_IN};
+
+  const char *name;
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+
+  /* FROMPOS, LEN and TOPOS are restricted to small values.  As such,
+     they will be converted so that they fit into a C int.  */
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_c_int_kind;
+  if (c->ext.actual->next->expr->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (c->ext.actual->next->expr, &ts, 2);
+  if (c->ext.actual->next->next->expr->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (c->ext.actual->next->next->expr, &ts, 2);
+  if (c->ext.actual->next->next->next->next->expr->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (c->ext.actual->next->next->next->next->expr, &ts, 2);
+
+  /* TO and FROM are guaranteed to have the same kind parameter.  */
+  name = gfc_get_string (PREFIX ("mvbits_i%d"),
+			 c->ext.actual->expr->ts.kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+  /* Mark as elemental subroutine as this does not happen automatically.  */
+  c->resolved_sym->attr.elemental = 1;
+
+  /* Create a dummy formal arglist so the INTENTs are known later for purpose
+     of creating temporaries.  */
+  c->resolved_sym->formal = create_formal_for_intents (c->ext.actual, INTENTS);
+}
+
+
+void
+gfc_resolve_random_number (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  kind = c->ext.actual->expr->ts.kind;
+  if (c->ext.actual->expr->rank == 0)
+    name = gfc_get_string (PREFIX ("random_r%d"), kind);
+  else
+    name = gfc_get_string (PREFIX ("arandom_r%d"), kind);
+  
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_random_seed (gfc_code *c)
+{
+  const char *name;
+
+  name = gfc_get_string (PREFIX ("random_seed_i%d"), gfc_default_integer_kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_rename_sub (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->next->expr != NULL)
+    kind = c->ext.actual->next->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX ("rename_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_kill_sub (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->next->expr != NULL)
+    kind = c->ext.actual->next->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX ("kill_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+    
+
+void
+gfc_resolve_link_sub (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->next->expr != NULL)
+    kind = c->ext.actual->next->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX ("link_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_symlnk_sub (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->next->expr != NULL)
+    kind = c->ext.actual->next->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX ("symlnk_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* G77 compatibility subroutines dtime() and etime().  */
+
+void
+gfc_resolve_dtime_sub (gfc_code *c)
+{
+  const char *name;
+  name = gfc_get_string (PREFIX ("dtime_sub"));
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+void
+gfc_resolve_etime_sub (gfc_code *c)
+{
+  const char *name;
+  name = gfc_get_string (PREFIX ("etime_sub"));
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* G77 compatibility subroutines itime(), idate(), ltime() and gmtime().  */
+
+void
+gfc_resolve_itime (gfc_code *c)
+{
+  c->resolved_sym
+    = gfc_get_intrinsic_sub_symbol (gfc_get_string (PREFIX ("itime_i%d"),
+						    gfc_default_integer_kind));
+}
+
+void
+gfc_resolve_idate (gfc_code *c)
+{
+  c->resolved_sym
+    = gfc_get_intrinsic_sub_symbol (gfc_get_string (PREFIX ("idate_i%d"),
+						    gfc_default_integer_kind));
+}
+
+void
+gfc_resolve_ltime (gfc_code *c)
+{
+  c->resolved_sym
+    = gfc_get_intrinsic_sub_symbol (gfc_get_string (PREFIX ("ltime_i%d"),
+						    gfc_default_integer_kind));
+}
+
+void
+gfc_resolve_gmtime (gfc_code *c)
+{
+  c->resolved_sym
+    = gfc_get_intrinsic_sub_symbol (gfc_get_string (PREFIX ("gmtime_i%d"),
+						    gfc_default_integer_kind));
+}
+
+
+/* G77 compatibility subroutine second().  */
+
+void
+gfc_resolve_second_sub (gfc_code *c)
+{
+  const char *name;
+  name = gfc_get_string (PREFIX ("second_sub"));
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_sleep_sub (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->expr != NULL)
+    kind = c->ext.actual->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX ("sleep_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* G77 compatibility function srand().  */
+
+void
+gfc_resolve_srand (gfc_code *c)
+{
+  const char *name;
+  name = gfc_get_string (PREFIX ("srand"));
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* Resolve the getarg intrinsic subroutine.  */
+
+void
+gfc_resolve_getarg (gfc_code *c)
+{
+  const char *name;
+
+  if (c->ext.actual->expr->ts.kind != gfc_default_integer_kind)
+    {
+      gfc_typespec ts;
+      gfc_clear_ts (&ts);
+
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_default_integer_kind;
+
+      gfc_convert_type (c->ext.actual->expr, &ts, 2);
+    }
+
+  name = gfc_get_string (PREFIX ("getarg_i%d"), gfc_default_integer_kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* Resolve the getcwd intrinsic subroutine.  */
+
+void
+gfc_resolve_getcwd_sub (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->expr != NULL)
+    kind = c->ext.actual->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX ("getcwd_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* Resolve the get_command intrinsic subroutine.  */
+
+void
+gfc_resolve_get_command (gfc_code *c)
+{
+  const char *name;
+  int kind;
+  kind = gfc_default_integer_kind;
+  name = gfc_get_string (PREFIX ("get_command_i%d"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* Resolve the get_command_argument intrinsic subroutine.  */
+
+void
+gfc_resolve_get_command_argument (gfc_code *c)
+{
+  const char *name;
+  int kind;
+  kind = gfc_default_integer_kind;
+  name = gfc_get_string (PREFIX ("get_command_argument_i%d"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* Resolve the get_environment_variable intrinsic subroutine.  */
+
+void
+gfc_resolve_get_environment_variable (gfc_code *code)
+{
+  const char *name;
+  int kind;
+  kind = gfc_default_integer_kind;
+  name = gfc_get_string (PREFIX ("get_environment_variable_i%d"), kind);
+  code->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_signal_sub (gfc_code *c)
+{
+  const char *name;
+  gfc_expr *number, *handler, *status;
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+
+  number = c->ext.actual->expr;
+  handler = c->ext.actual->next->expr;
+  status = c->ext.actual->next->next->expr;
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_c_int_kind;
+
+  /* handler can be either BT_INTEGER or BT_PROCEDURE  */
+  if (handler->ts.type == BT_INTEGER)
+    {
+      if (handler->ts.kind != gfc_c_int_kind)
+	gfc_convert_type (handler, &ts, 2);
+      name = gfc_get_string (PREFIX ("signal_sub_int"));
+    }
+  else
+    name = gfc_get_string (PREFIX ("signal_sub"));
+
+  if (number->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (number, &ts, 2);
+  if (status != NULL && status->ts.kind != gfc_c_int_kind)
+    gfc_convert_type (status, &ts, 2);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* Resolve the SYSTEM intrinsic subroutine.  */
+
+void
+gfc_resolve_system_sub (gfc_code *c)
+{
+  const char *name;
+  name = gfc_get_string (PREFIX ("system_sub"));
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* Determine if the arguments to SYSTEM_CLOCK are INTEGER(4) or INTEGER(8) */
+
+void
+gfc_resolve_system_clock (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->expr != NULL)
+    kind = c->ext.actual->expr->ts.kind;
+  else if (c->ext.actual->next->expr != NULL)
+      kind = c->ext.actual->next->expr->ts.kind;
+  else if (c->ext.actual->next->next->expr != NULL)
+      kind = c->ext.actual->next->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX ("system_clock_%d"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* Resolve the EXECUTE_COMMAND_LINE intrinsic subroutine.  */
+void
+gfc_resolve_execute_command_line (gfc_code *c)
+{
+  const char *name;
+  name = gfc_get_string (PREFIX ("execute_command_line_i%d"),
+			 gfc_default_integer_kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* Resolve the EXIT intrinsic subroutine.  */
+
+void
+gfc_resolve_exit (gfc_code *c)
+{
+  const char *name;
+  gfc_typespec ts;
+  gfc_expr *n;
+  gfc_clear_ts (&ts);
+
+  /* The STATUS argument has to be of default kind.  If it is not,
+     we convert it.  */
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_default_integer_kind;
+  n = c->ext.actual->expr;
+  if (n != NULL && n->ts.kind != ts.kind)
+    gfc_convert_type (n, &ts, 2);
+
+  name = gfc_get_string (PREFIX ("exit_i%d"), ts.kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+/* Resolve the FLUSH intrinsic subroutine.  */
+
+void
+gfc_resolve_flush (gfc_code *c)
+{
+  const char *name;
+  gfc_typespec ts;
+  gfc_expr *n;
+  gfc_clear_ts (&ts);
+
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_default_integer_kind;
+  n = c->ext.actual->expr;
+  if (n != NULL && n->ts.kind != ts.kind)
+    gfc_convert_type (n, &ts, 2);
+
+  name = gfc_get_string (PREFIX ("flush_i%d"), ts.kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_free (gfc_code *c)
+{
+  gfc_typespec ts;
+  gfc_expr *n;
+  gfc_clear_ts (&ts);
+
+  ts.type = BT_INTEGER;
+  ts.kind = gfc_index_integer_kind;
+  n = c->ext.actual->expr;
+  if (n->ts.kind != ts.kind)
+    gfc_convert_type (n, &ts, 2);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("free"));
+}
+
+
+void
+gfc_resolve_ctime_sub (gfc_code *c)
+{
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+  
+  /* ctime TIME argument is a INTEGER(KIND=8), says the doc */
+  if (c->ext.actual->expr->ts.kind != 8)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = 8;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (c->ext.actual->expr, &ts, 2);
+    }
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("ctime_sub"));
+}
+
+
+void
+gfc_resolve_fdate_sub (gfc_code *c)
+{
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fdate_sub"));
+}
+
+
+void
+gfc_resolve_gerror (gfc_code *c)
+{
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("gerror"));
+}
+
+
+void
+gfc_resolve_getlog (gfc_code *c)
+{
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("getlog"));
+}
+
+
+void
+gfc_resolve_hostnm_sub (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->expr != NULL)
+    kind = c->ext.actual->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX ("hostnm_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_perror (gfc_code *c)
+{
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("perror_sub"));
+}
+
+/* Resolve the STAT and FSTAT intrinsic subroutines.  */
+
+void
+gfc_resolve_stat_sub (gfc_code *c)
+{
+  const char *name;
+  name = gfc_get_string (PREFIX ("stat_i%d_sub"), gfc_default_integer_kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_lstat_sub (gfc_code *c)
+{
+  const char *name;
+  name = gfc_get_string (PREFIX ("lstat_i%d_sub"), gfc_default_integer_kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_fstat_sub (gfc_code *c)
+{
+  const char *name;
+  gfc_expr *u;
+  gfc_typespec *ts;
+
+  u = c->ext.actual->expr;
+  ts = &c->ext.actual->next->expr->ts;
+  if (u->ts.kind != ts->kind)
+    gfc_convert_type (u, ts, 2);
+  name = gfc_get_string (PREFIX ("fstat_i%d_sub"), ts->kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_fgetc_sub (gfc_code *c)
+{
+  const char *name;
+  gfc_typespec ts;
+  gfc_expr *u, *st;
+  gfc_clear_ts (&ts);
+
+  u = c->ext.actual->expr;
+  st = c->ext.actual->next->next->expr;
+
+  if (u->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (u, &ts, 2);
+    }
+
+  if (st != NULL)
+    name = gfc_get_string (PREFIX ("fgetc_i%d_sub"), st->ts.kind);
+  else
+    name = gfc_get_string (PREFIX ("fgetc_i%d_sub"), gfc_default_integer_kind);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_fget_sub (gfc_code *c)
+{
+  const char *name;
+  gfc_expr *st;
+
+  st = c->ext.actual->next->expr;
+  if (st != NULL)
+    name = gfc_get_string (PREFIX ("fget_i%d_sub"), st->ts.kind);
+  else
+    name = gfc_get_string (PREFIX ("fget_i%d_sub"), gfc_default_integer_kind);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_fputc_sub (gfc_code *c)
+{
+  const char *name;
+  gfc_typespec ts;
+  gfc_expr *u, *st;
+  gfc_clear_ts (&ts);
+
+  u = c->ext.actual->expr;
+  st = c->ext.actual->next->next->expr;
+
+  if (u->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (u, &ts, 2);
+    }
+
+  if (st != NULL)
+    name = gfc_get_string (PREFIX ("fputc_i%d_sub"), st->ts.kind);
+  else
+    name = gfc_get_string (PREFIX ("fputc_i%d_sub"), gfc_default_integer_kind);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_fput_sub (gfc_code *c)
+{
+  const char *name;
+  gfc_expr *st;
+
+  st = c->ext.actual->next->expr;
+  if (st != NULL)
+    name = gfc_get_string (PREFIX ("fput_i%d_sub"), st->ts.kind);
+  else
+    name = gfc_get_string (PREFIX ("fput_i%d_sub"), gfc_default_integer_kind);
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void 
+gfc_resolve_fseek_sub (gfc_code *c)
+{
+  gfc_expr *unit;
+  gfc_expr *offset;
+  gfc_expr *whence;
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+
+  unit   = c->ext.actual->expr;
+  offset = c->ext.actual->next->expr;
+  whence = c->ext.actual->next->next->expr;
+
+  if (unit->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (unit, &ts, 2);
+    }
+
+  if (offset->ts.kind != gfc_intio_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_intio_kind;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (offset, &ts, 2);
+    }
+
+  if (whence->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (whence, &ts, 2);
+    }
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("fseek_sub"));
+}
+
+void
+gfc_resolve_ftell_sub (gfc_code *c)
+{
+  const char *name;
+  gfc_expr *unit;
+  gfc_expr *offset;
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+
+  unit = c->ext.actual->expr;
+  offset = c->ext.actual->next->expr;
+
+  if (unit->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (unit, &ts, 2);
+    }
+
+  name = gfc_get_string (PREFIX ("ftell_i%d_sub"), offset->ts.kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_ttynam_sub (gfc_code *c)
+{
+  gfc_typespec ts;
+  gfc_clear_ts (&ts);
+  
+  if (c->ext.actual->expr->ts.kind != gfc_c_int_kind)
+    {
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_c_int_kind;
+      ts.u.derived = NULL;
+      ts.u.cl = NULL;
+      gfc_convert_type (c->ext.actual->expr, &ts, 2);
+    }
+
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("ttynam_sub"));
+}
+
+
+/* Resolve the UMASK intrinsic subroutine.  */
+
+void
+gfc_resolve_umask_sub (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->expr != NULL)
+    kind = c->ext.actual->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX ("umask_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+/* Resolve the UNLINK intrinsic subroutine.  */
+
+void
+gfc_resolve_unlink_sub (gfc_code *c)
+{
+  const char *name;
+  int kind;
+
+  if (c->ext.actual->next->expr != NULL)
+    kind = c->ext.actual->next->expr->ts.kind;
+  else
+    kind = gfc_default_integer_kind;
+
+  name = gfc_get_string (PREFIX ("unlink_i%d_sub"), kind);
+  c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
diff --git a/gcc/fortran/iso-c-binding.def b/gcc/fortran/iso-c-binding.def
new file mode 100644
index 000000000..bea83067b
--- /dev/null
+++ b/gcc/fortran/iso-c-binding.def
@@ -0,0 +1,186 @@
+/* Copyright (C) 2006, 2007, 2008, 2010 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* This file contains the definition of the types provided by the
+   Fortran 2003 ISO_C_BINDING intrinsic module.  */
+
+#ifndef NAMED_INTCST
+# define NAMED_INTCST(a,b,c,d) 
+#endif
+
+#ifndef NAMED_REALCST
+# define NAMED_REALCST(a,b,c) 
+#endif
+
+#ifndef NAMED_CMPXCST
+# define NAMED_CMPXCST(a,b,c) 
+#endif
+
+#ifndef NAMED_LOGCST
+# define NAMED_LOGCST(a,b,c) 
+#endif
+
+#ifndef NAMED_CHARKNDCST
+# define NAMED_CHARKNDCST(a,b,c) 
+#endif
+
+#ifndef NAMED_FUNCTION
+# define NAMED_FUNCTION(a,b,c,d)
+#endif
+
+/* The arguments to NAMED_*CST are:
+     -- an internal name
+     -- the symbol name in the module, as seen by Fortran code
+     -- the value it has, for use in trans-types.c  
+     -- the standard that supports this type  */
+
+NAMED_INTCST (ISOCBINDING_INT, "c_int", gfc_c_int_kind, GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_SHORT, "c_short", \
+              get_int_kind_from_node (short_integer_type_node), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_LONG, "c_long", \
+              get_int_kind_from_node (long_integer_type_node), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_LONG_LONG, "c_long_long", \
+              get_int_kind_from_node (long_long_integer_type_node), GFC_STD_F2003)
+
+NAMED_INTCST (ISOCBINDING_INTMAX_T, "c_intmax_t", \
+              get_int_kind_from_name (INTMAX_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INTPTR_T, "c_intptr_t", \
+              get_int_kind_from_name (INTPTR_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_SIZE_T, "c_size_t", \
+              gfc_index_integer_kind, GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_SIGNED_CHAR, "c_signed_char", \
+              get_int_kind_from_node (signed_char_type_node), GFC_STD_F2003)
+
+NAMED_INTCST (ISOCBINDING_INT8_T, "c_int8_t", \
+              get_int_kind_from_name (INT8_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT16_T, "c_int16_t", \
+              get_int_kind_from_name (INT16_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT32_T, "c_int32_t", \
+              get_int_kind_from_name (INT32_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT64_T, "c_int64_t", \
+              get_int_kind_from_name (INT64_TYPE), GFC_STD_F2003)
+/* GNU Extension.  */
+NAMED_INTCST (ISOCBINDING_INT128_T, "c_int128_t", \
+              get_int_kind_from_width (128), GFC_STD_GNU)
+
+NAMED_INTCST (ISOCBINDING_INT_LEAST8_T, "c_int_least8_t", \
+              get_int_kind_from_name (INT_LEAST8_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT_LEAST16_T, "c_int_least16_t", \
+              get_int_kind_from_name (INT_LEAST16_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT_LEAST32_T, "c_int_least32_t", \
+              get_int_kind_from_name (INT_LEAST32_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT_LEAST64_T, "c_int_least64_t", \
+              get_int_kind_from_name (INT_LEAST64_TYPE), GFC_STD_F2003)
+/* GNU Extension.  */
+NAMED_INTCST (ISOCBINDING_INT_LEAST128_T, "c_int_least128_t", \
+              get_int_kind_from_minimal_width (128), GFC_STD_GNU)
+
+NAMED_INTCST (ISOCBINDING_INT_FAST8_T, "c_int_fast8_t", \
+              get_int_kind_from_name (INT_FAST8_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT_FAST16_T, "c_int_fast16_t", \
+              get_int_kind_from_name (INT_FAST16_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT_FAST32_T, "c_int_fast32_t", \
+              get_int_kind_from_name (INT_FAST32_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT_FAST64_T, "c_int_fast64_t", \
+              get_int_kind_from_name (INT_FAST64_TYPE), GFC_STD_F2003)
+/* GNU Extension.  */
+NAMED_INTCST (ISOCBINDING_INT_FAST128_T, "c_int_fast128_t",
+	      get_int_kind_from_width (128), GFC_STD_GNU)
+
+NAMED_REALCST (ISOCBINDING_FLOAT, "c_float", \
+               get_real_kind_from_node (float_type_node))
+NAMED_REALCST (ISOCBINDING_DOUBLE, "c_double", \
+               get_real_kind_from_node (double_type_node))
+NAMED_REALCST (ISOCBINDING_LONG_DOUBLE, "c_long_double", \
+               get_real_kind_from_node (long_double_type_node))
+NAMED_CMPXCST (ISOCBINDING_FLOAT_COMPLEX, "c_float_complex", \
+               get_real_kind_from_node (float_type_node))
+NAMED_CMPXCST (ISOCBINDING_DOUBLE_COMPLEX, "c_double_complex", \
+               get_real_kind_from_node (double_type_node))
+NAMED_CMPXCST (ISOCBINDING_LONG_DOUBLE_COMPLEX, "c_long_double_complex", \
+               get_real_kind_from_node (long_double_type_node))
+
+NAMED_LOGCST (ISOCBINDING_BOOL, "c_bool", \
+              get_int_kind_from_width (BOOL_TYPE_SIZE))
+
+NAMED_CHARKNDCST (ISOCBINDING_CHAR, "c_char", gfc_default_character_kind)
+
+#ifndef NAMED_CHARCST
+# define NAMED_CHARCST(a,b,c) 
+#endif
+
+/* Use langhooks to deal with host to target translations.  */ 
+NAMED_CHARCST (ISOCBINDING_NULL_CHAR, "c_null_char", \
+	       lang_hooks.to_target_charset ('\0'))
+NAMED_CHARCST (ISOCBINDING_ALERT, "c_alert", \
+	       lang_hooks.to_target_charset ('\a'))
+NAMED_CHARCST (ISOCBINDING_BACKSPACE, "c_backspace", \
+	       lang_hooks.to_target_charset ('\b'))
+NAMED_CHARCST (ISOCBINDING_FORM_FEED, "c_form_feed", \
+	       lang_hooks.to_target_charset ('\f'))
+NAMED_CHARCST (ISOCBINDING_NEW_LINE, "c_new_line", \
+	       lang_hooks.to_target_charset ('\n'))
+NAMED_CHARCST (ISOCBINDING_CARRIAGE_RETURN, "c_carriage_return", \
+	       lang_hooks.to_target_charset ('\r'))
+NAMED_CHARCST (ISOCBINDING_HORIZONTAL_TAB, "c_horizontal_tab", \
+	       lang_hooks.to_target_charset ('\t'))
+NAMED_CHARCST (ISOCBINDING_VERTICAL_TAB, "c_vertical_tab", \
+	       lang_hooks.to_target_charset ('\v'))
+
+#ifndef DERIVED_TYPE
+# define DERIVED_TYPE(a,b,c) 
+#endif
+
+DERIVED_TYPE (ISOCBINDING_PTR, "c_ptr", \
+              get_int_kind_from_node (ptr_type_node))
+DERIVED_TYPE (ISOCBINDING_NULL_PTR, "c_null_ptr", \
+              get_int_kind_from_node (ptr_type_node))
+DERIVED_TYPE (ISOCBINDING_FUNPTR, "c_funptr", \
+              get_int_kind_from_node (ptr_type_node))
+DERIVED_TYPE (ISOCBINDING_NULL_FUNPTR, "c_null_funptr", \
+              get_int_kind_from_node (ptr_type_node))
+
+  
+#ifndef PROCEDURE
+# define PROCEDURE(a,b) 
+#endif
+
+PROCEDURE (ISOCBINDING_F_POINTER, "c_f_pointer")
+PROCEDURE (ISOCBINDING_ASSOCIATED, "c_associated")
+PROCEDURE (ISOCBINDING_LOC, "c_loc")
+PROCEDURE (ISOCBINDING_FUNLOC, "c_funloc")
+PROCEDURE (ISOCBINDING_F_PROCPOINTER, "c_f_procpointer")
+
+/* The arguments to NAMED_FUNCTIONS are:
+     -- the ISYM
+     -- the symbol name in the module, as seen by Fortran code
+     -- the Fortran standard  */
+
+NAMED_FUNCTION (ISOCBINDING_C_SIZEOF, "c_sizeof", \
+                GFC_ISYM_C_SIZEOF, GFC_STD_F2008)
+
+
+#undef NAMED_INTCST
+#undef NAMED_REALCST
+#undef NAMED_CMPXCST
+#undef NAMED_LOGCST
+#undef NAMED_CHARCST
+#undef NAMED_CHARKNDCST
+#undef DERIVED_TYPE
+#undef PROCEDURE
+#undef NAMED_FUNCTION
diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def
new file mode 100644
index 000000000..3586f0769
--- /dev/null
+++ b/gcc/fortran/iso-fortran-env.def
@@ -0,0 +1,116 @@
+/* Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* This file contains the definition of the named integer constants provided
+   by the Fortran 2003 ISO_FORTRAN_ENV intrinsic module.  */
+
+#ifndef NAMED_INTCST
+# define NAMED_INTCST(a,b,c,d)
+#endif
+
+#ifndef NAMED_KINDARRAY
+# define NAMED_KINDARRAY(a,b,c,d)
+#endif
+
+#ifndef NAMED_FUNCTION
+# define NAMED_FUNCTION(a,b,c,d)
+#endif
+
+/* The arguments to NAMED_INTCST are:
+     -- an internal name
+     -- the symbol name in the module, as seen by Fortran code
+     -- the value it has
+     -- the standard that supports this type  */ 
+
+NAMED_INTCST (ISOFORTRANENV_FILE_ATOMIC_INT_KIND, "atomic_int_kind", \
+              gfc_default_integer_kind, GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_FILE_ATOMIC_LOGICAL_KIND, "atomic_logical_kind", \
+              gfc_default_logical_kind, GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_CHARACTER_STORAGE_SIZE, "character_storage_size", \
+              gfc_character_storage_size, GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit", GFC_STDERR_UNIT_NUMBER, \
+              GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_FILE_STORAGE_SIZE, "file_storage_size", 8, \
+              GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_INPUT_UNIT, "input_unit", GFC_STDIN_UNIT_NUMBER, \
+              GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_INT8, "int8", \
+              gfc_get_int_kind_from_width_isofortranenv (8), GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_INT16, "int16", \
+              gfc_get_int_kind_from_width_isofortranenv (16), GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_INT32, "int32", \
+              gfc_get_int_kind_from_width_isofortranenv (32), GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_INT64, "int64", \
+              gfc_get_int_kind_from_width_isofortranenv (64), GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", LIBERROR_END, \
+              GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", LIBERROR_EOR, \
+              GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_IOSTAT_INQUIRE_INTERNAL_UNIT, \
+              "iostat_inquire_internal_unit", LIBERROR_INQUIRE_INTERNAL_UNIT, \
+              GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_NUMERIC_STORAGE_SIZE, "numeric_storage_size", \
+              gfc_numeric_storage_size, GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_OUTPUT_UNIT, "output_unit", GFC_STDOUT_UNIT_NUMBER, \
+              GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_REAL32, "real32", \
+              gfc_get_real_kind_from_width_isofortranenv (32), GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_REAL64, "real64", \
+              gfc_get_real_kind_from_width_isofortranenv (64), GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_REAL128, "real128", \
+              gfc_get_real_kind_from_width_isofortranenv (128), GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_FILE_STAT_LOCKED, "stat_locked", \
+              GFC_STAT_LOCKED, GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_FILE_STAT_LOCKED_OTHER_IMAGE, \
+              "stat_locked_other_image", \
+	      GFC_STAT_LOCKED_OTHER_IMAGE, GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_FILE_STAT_STOPPED_IMAGE, "stat_stopped_image", \
+              GFC_STAT_STOPPED_IMAGE, GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_FILE_STAT_UNLOCKED, "stat_unlocked", \
+              GFC_STAT_UNLOCKED, GFC_STD_F2008)
+
+
+/* The arguments to NAMED_KINDARRAY are:
+     -- an internal name
+     -- the symbol name in the module, as seen by Fortran code
+     -- the gfortran variable containing the information
+     -- the Fortran standard  */
+
+NAMED_KINDARRAY (ISOFORTRAN_CHARACTER_KINDS, "character_kinds", \
+                 gfc_character_kinds, GFC_STD_F2008)
+NAMED_KINDARRAY (ISOFORTRAN_INTEGER_KINDS, "integer_kinds", \
+                 gfc_integer_kinds, GFC_STD_F2008)
+NAMED_KINDARRAY (ISOFORTRAN_LOGICAL_KINDS, "logical_kinds", \
+                 gfc_logical_kinds, GFC_STD_F2008)
+NAMED_KINDARRAY (ISOFORTRAN_REAL_KINDS, "real_kinds", \
+                 gfc_real_kinds, GFC_STD_F2008)
+
+/* The arguments to NAMED_FUNCTIONS are:
+     -- the ISYM
+     -- the symbol name in the module, as seen by Fortran code
+     -- the Fortran standard  */
+
+NAMED_FUNCTION (ISOFORTRAN_COMPILER_OPTIONS, "compiler_options", \
+                GFC_ISYM_COMPILER_OPTIONS, GFC_STD_F2008)
+NAMED_FUNCTION (ISOFORTRAN_COMPILER_VERSION, "compiler_version", \
+                GFC_ISYM_COMPILER_VERSION, GFC_STD_F2008)
+
+
+#undef NAMED_INTCST
+#undef NAMED_KINDARRAY
+#undef NAMED_FUNCTION
diff --git a/gcc/fortran/lang-specs.h b/gcc/fortran/lang-specs.h
new file mode 100644
index 000000000..73bfc89ec
--- /dev/null
+++ b/gcc/fortran/lang-specs.h
@@ -0,0 +1,78 @@
+/* Contribution to the specs for the GNU Compiler Collection
+   from GNU Fortran 95 compiler.
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2010
+   Free Software Foundation, Inc.
+
+   This file is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This file is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with GCC; see the file COPYING3.  If not see
+   <http://www.gnu.org/licenses/>.  */
+
+/* This is the contribution to the `default_compilers' array in gcc.c
+   for the f95 language.  */
+
+/* Identical to gcc.c (cpp_options), but omitting %(cpp_unique_options)
+   and -fpch-preprocess on -save-temps.  */
+#define CPP_ONLY_OPTIONS    "%1 %{m*} %{f*} %{g*:%{!g0:%{g*} \
+			     %{!fno-working-directory:-fworking-directory}}} \
+			     %{std*&ansi&trigraphs} %{W*&pedantic*} %{w} \
+			     %{O*} %{undef}"
+
+/* Options that f951 should know about, even if not preprocessing.  */
+#define CPP_FORWARD_OPTIONS "%{i*} %{I*} %{M*}"
+
+#define F951_CPP_OPTIONS    "%{!nocpp: -cpp=%g.f90 %{E} %(cpp_unique_options) \
+			     %{E|M|MM:%(cpp_debug_options) " CPP_ONLY_OPTIONS \
+			     " -fsyntax-only};: " CPP_FORWARD_OPTIONS "}"
+#define F951_OPTIONS        "%(cc1_options) %{J*} \
+			     %{!nostdinc:-fintrinsic-modules-path finclude%s}\
+			     %{!fsyntax-only:%(invoke_as)}"
+#define F951_SOURCE_FORM    "%{!ffree-form:-ffixed-form}"
+
+
+{".F",   "@f77-cpp-input", 0, 0, 0},
+{".FOR", "@f77-cpp-input", 0, 0, 0},
+{".FTN", "@f77-cpp-input", 0, 0, 0},
+{".fpp", "@f77-cpp-input", 0, 0, 0},
+{".FPP", "@f77-cpp-input", 0, 0, 0},
+{"@f77-cpp-input",
+    "f951 %i " F951_SOURCE_FORM " " \
+	  F951_CPP_OPTIONS " %{!E:" F951_OPTIONS "}", 0, 0, 0},
+{".f",   "@f77", 0, 0, 0},
+{".for", "@f77", 0, 0, 0},
+{".ftn", "@f77", 0, 0, 0},
+{"@f77",
+    "f951 %i " F951_SOURCE_FORM " \
+          %{E:%{!cpp:%egfortran does not support -E without -cpp}} \
+          %{cpp:" F951_CPP_OPTIONS ";: " CPP_FORWARD_OPTIONS  "} \
+	  %{!E:" F951_OPTIONS "}", 0, 0, 0},
+{".F90", "@f95-cpp-input", 0, 0, 0},
+{".F95", "@f95-cpp-input", 0, 0, 0},
+{".F03", "@f95-cpp-input", 0, 0, 0},
+{".F08", "@f95-cpp-input", 0, 0, 0},
+{"@f95-cpp-input",
+    "f951 %i " F951_CPP_OPTIONS " %{!E:" F951_OPTIONS "}", 0, 0, 0},
+{".f90", "@f95", 0, 0, 0},
+{".f95", "@f95", 0, 0, 0},
+{".f03", "@f95", 0, 0, 0},
+{".f08", "@f95", 0, 0, 0},
+{"@f95",
+    "f951 %i %{E:%{!cpp:%egfortran does not support -E without -cpp}}\
+	  %{cpp:" F951_CPP_OPTIONS ";:  " CPP_FORWARD_OPTIONS  "} \
+	  %{!E:" F951_OPTIONS "}", 0, 0, 0},
+
+
+#undef CPP_ONLY_OPTIONS
+#undef CPP_FORWARD_OPTIONS
+#undef F951_SOURCE_FORM
+#undef F951_CPP_OPTIONS
+#undef F951_OPTIONS
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
new file mode 100644
index 000000000..02fbaeb37
--- /dev/null
+++ b/gcc/fortran/lang.opt
@@ -0,0 +1,597 @@
+; Options for the Fortran 95 front end.
+; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+; Free Software Foundation, Inc.
+;
+; This file is part of GCC.
+;
+; GCC is free software; you can redistribute it and/or modify it under
+; the terms of the GNU General Public License as published by the Free
+; Software Foundation; either version 3, or (at your option) any later
+; version.
+; 
+; GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+; WARRANTY; without even the implied warranty of MERCHANTABILITY or
+; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+; for more details.
+; 
+; You should have received a copy of the GNU General Public License
+; along with GCC; see the file COPYING3.  If not see
+; <http://www.gnu.org/licenses/>.
+
+; See the GCC internals manual for a description of this file's format.
+
+; Please try to keep this file in ASCII collating order.
+
+Language
+Fortran
+
+-all-warnings
+Fortran Alias(Wall)
+
+-assert
+Fortran Separate Alias(A)
+
+-assert=
+Fortran Joined Alias(A)
+
+-comments
+Fortran Alias(C)
+
+-comments-in-macros
+Fortran Alias(CC)
+
+-define-macro
+Fortran Separate Alias(D)
+
+-define-macro=
+Fortran Joined Alias(D)
+
+-dependencies
+Fortran Alias(M)
+
+-dump
+Fortran Separate Alias(d)
+
+-dump=
+Fortran Joined Alias(d)
+
+-include-barrier
+Fortran Alias(I, -)
+
+-include-directory
+Fortran Separate Alias(I)
+
+-include-directory=
+Fortran Joined Alias(I)
+
+-include-directory-after
+Fortran Separate Alias(idirafter)
+
+-include-directory-after=
+Fortran Joined Alias(idirafter)
+
+-include-prefix
+Fortran Separate Alias(iprefix)
+
+-include-prefix=
+Fortran JoinedOrMissing Alias(iprefix)
+
+-no-line-commands
+Fortran Alias(P)
+
+-no-standard-includes
+Fortran Alias(nostdinc)
+
+-output
+Fortran Separate Alias(o)
+
+-output=
+Fortran Joined Alias(o)
+
+-preprocess
+Fortran Undocumented Alias(E)
+
+-print-missing-file-dependencies
+Fortran Alias(MG)
+
+-trace-includes
+Fortran Alias(H)
+
+-undefine-macro
+Fortran Separate Alias(U)
+
+-undefine-macro=
+Fortran Joined Alias(U)
+
+-user-dependencies
+Fortran Alias(MM)
+
+-verbose
+Fortran Alias(v)
+
+-write-dependencies
+Fortran NoDriverArg Separate Alias(MD)
+
+-write-user-dependencies
+Fortran NoDriverArg Separate Alias(MMD)
+
+A
+Fortran Joined Separate
+; Documented in C
+
+C
+Fortran
+; Documented in C
+
+CC
+Fortran
+; Documented in C
+
+D
+Fortran Joined Separate
+; Documented in C
+
+E
+Fortran Undocumented
+
+H
+Fortran
+; Documented in C
+
+I
+Fortran Joined Separate
+; Documented in C
+
+J
+Fortran Joined Separate
+-J<directory>	Put MODULE files in 'directory'
+
+M
+Fortran
+; Documented in C
+
+MD
+Fortran Separate NoDriverArg
+; Documented in C
+
+MF
+Fortran Joined Separate
+; Documented in C
+
+MG
+Fortran
+; Documented in C
+
+MM
+Fortran
+; Documented in C
+
+MMD
+Fortran Separate NoDriverArg
+; Documented in C
+
+MP
+Fortran
+; Documented in C
+
+MT
+Fortran Joined Separate
+; Documented in C
+
+MQ
+Fortran Joined Separate
+; Documented in C
+
+P
+Fortran
+; Documented in C
+
+U
+Fortran Joined Separate
+; Documented in C
+
+Wall
+Fortran
+; Documented in C
+
+Waliasing
+Fortran Warning
+Warn about possible aliasing of dummy arguments
+
+Walign-commons
+Fortran Warning
+Warn about alignment of COMMON blocks
+
+Wampersand
+Fortran Warning
+Warn about missing ampersand in continued character constants
+
+Warray-temporaries
+Fortran Warning
+Warn about creation of array temporaries
+
+Wcharacter-truncation
+Fortran Warning
+Warn about truncated character expressions
+
+Wconversion
+Fortran Warning
+; Documented in C
+
+Wconversion-extra
+Fortran Warning
+Warn about most implicit conversions
+
+Wimplicit-interface
+Fortran Warning
+Warn about calls with implicit interface
+
+Wimplicit-procedure
+Fortran Warning
+Warn about called procedures not explicitly declared
+
+Wline-truncation
+Fortran Warning
+Warn about truncated source lines
+
+Wintrinsics-std
+Fortran Warning
+Warn on intrinsics not part of the selected standard
+
+Wreal-q-constant
+Fortran Warning
+Warn about real-literal-constants with 'q' exponent-letter
+
+Wreturn-type
+Fortran Warning
+; Documented in C
+
+Wsurprising
+Fortran Warning
+Warn about \"suspicious\" constructs
+
+Wtabs
+Fortran Warning
+Permit nonconforming uses of the tab character
+
+Wunderflow
+Fortran Warning
+Warn about underflow of numerical constant expressions
+
+Wintrinsic-shadow
+Fortran Warning
+Warn if a user-procedure has the same name as an intrinsic
+
+Wunused-dummy-argument
+Fortran Warning
+Warn about unused dummy arguments.
+
+cpp
+Fortran Negative(nocpp)
+Enable preprocessing
+
+cpp=
+Fortran Joined Negative(nocpp) Undocumented
+; Internal option generated by specs from -cpp.
+
+nocpp
+Fortran Negative(cpp)
+Disable preprocessing
+
+d
+Fortran Joined
+; Documented in common.opt
+
+falign-commons
+Fortran
+Enable alignment of COMMON blocks
+
+fall-intrinsics
+Fortran RejectNegative
+All intrinsics procedures are available regardless of selected standard
+
+fallow-leading-underscore
+Fortran Undocumented
+; For internal use only: allow the first character of symbol names to be an underscore
+
+fautomatic
+Fortran
+Do not treat local variables and COMMON blocks as if they were named in SAVE statements
+
+fbackslash
+Fortran
+Specify that backslash in string introduces an escape character
+
+fbacktrace
+Fortran
+Produce a backtrace when a runtime error is encountered
+
+fblas-matmul-limit=
+Fortran RejectNegative Joined UInteger
+-fblas-matmul-limit=<n>	Size of the smallest matrix for which matmul will use BLAS
+
+fcheck-array-temporaries
+Fortran
+Produce a warning at runtime if a array temporary has been created for a procedure argument
+
+fconvert=big-endian
+Fortran RejectNegative
+Use big-endian format for unformatted files
+
+fconvert=little-endian
+Fortran RejectNegative
+Use little-endian format for unformatted files
+
+fconvert=native
+Fortran RejectNegative
+Use native format for unformatted files
+
+fconvert=swap
+Fortran RejectNegative
+Swap endianness for unformatted files
+
+fcray-pointer
+Fortran
+Use the Cray Pointer extension
+
+fd-lines-as-code
+Fortran RejectNegative
+Ignore 'D' in column one in fixed form
+
+fd-lines-as-comments
+Fortran RejectNegative
+Treat lines with 'D' in column one as comments
+
+fdefault-double-8
+Fortran
+Set the default double precision kind to an 8 byte wide type
+
+fdefault-integer-8
+Fortran
+Set the default integer kind to an 8 byte wide type
+
+fdefault-real-8
+Fortran
+Set the default real kind to an 8 byte wide type
+
+fdollar-ok
+Fortran
+Allow dollar signs in entity names
+
+fdump-core
+Fortran
+Dump a core file when a runtime error occurs
+
+fdump-fortran-original
+Fortran
+Display the code tree after parsing
+
+fdump-fortran-optimized
+Fortran
+Display the code tree after front end optimization
+
+fdump-parse-tree
+Fortran
+Display the code tree after parsing; deprecated option
+
+fexternal-blas
+Fortran
+Specify that an external BLAS library should be used for matmul calls on large-size arrays
+
+ff2c
+Fortran
+Use f2c calling convention
+
+ffixed-form
+Fortran RejectNegative
+Assume that the source file is fixed form
+
+fintrinsic-modules-path
+Fortran RejectNegative Joined Separate
+Specify where to find the compiled intrinsic modules
+
+ffixed-line-length-none
+Fortran RejectNegative
+Allow arbitrary character line width in fixed mode
+
+ffixed-line-length-
+Fortran RejectNegative Joined UInteger
+-ffixed-line-length-<n>	Use n as character line width in fixed mode
+
+ffpe-trap=
+Fortran RejectNegative JoinedOrMissing
+-ffpe-trap=[...]	Stop on following floating point exceptions
+
+ffree-form
+Fortran RejectNegative
+Assume that the source file is free form
+
+ffree-line-length-none
+Fortran RejectNegative
+Allow arbitrary character line width in free mode
+
+ffree-line-length-
+Fortran RejectNegative Joined UInteger
+-ffree-line-length-<n>	Use n as character line width in free mode
+
+fimplicit-none
+Fortran
+Specify that no implicit typing is allowed, unless overridden by explicit IMPLICIT statements
+
+finit-character=
+Fortran RejectNegative Joined UInteger
+-finit-character=<n>	Initialize local character variables to ASCII value n
+
+finit-integer=
+Fortran RejectNegative Joined
+-finit-integer=<n>	Initialize local integer variables to n
+
+finit-local-zero
+Fortran
+Initialize local variables to zero (from g77)
+
+finit-logical=
+Fortran RejectNegative Joined
+-finit-logical=<true|false>	Initialize local logical variables
+
+finit-real=
+Fortran RejectNegative Joined
+-finit-real=<zero|nan|inf|-inf>	Initialize local real variables
+
+fmax-array-constructor=
+Fortran RejectNegative Joined UInteger
+-fmax-array-constructor=<n>	Maximum number of objects in an array constructor
+
+fmax-identifier-length=
+Fortran RejectNegative Joined UInteger
+-fmax-identifier-length=<n>	Maximum identifier length
+
+fmax-subrecord-length=
+Fortran RejectNegative Joined UInteger
+-fmax-subrecord-length=<n>	Maximum length for subrecords
+
+fmax-stack-var-size=
+Fortran RejectNegative Joined UInteger
+-fmax-stack-var-size=<n>	Size in bytes of the largest array that will be put on the stack
+
+fmodule-private
+Fortran
+Set default accessibility of module entities to PRIVATE.
+
+fopenmp
+Fortran
+; Documented in C
+
+fpack-derived
+Fortran
+Try to lay out derived types as compactly as possible
+
+fpreprocessed
+Fortran
+; Documented in C
+
+fprotect-parens
+Fortran
+Protect parentheses in expressions
+
+frange-check
+Fortran
+Enable range checking during compilation
+
+frealloc-lhs
+Fortran
+Reallocate the LHS in assignments
+
+frecord-marker=4
+Fortran RejectNegative
+Use a 4-byte record marker for unformatted files
+
+frecord-marker=8
+Fortran RejectNegative
+Use an 8-byte record marker for unformatted files
+
+frecursive
+Fortran
+Allocate local variables on the stack to allow indirect recursion
+
+frepack-arrays
+Fortran
+Copy array sections into a contiguous block on procedure entry
+
+fcoarray=
+Fortran RejectNegative JoinedOrMissing
+-fcoarray=[...]	Specify which coarray parallelization should be used
+
+fcheck=
+Fortran RejectNegative JoinedOrMissing
+-fcheck=[...]	Specify which runtime checks are to be performed
+
+fsecond-underscore
+Fortran
+Append a second underscore if the name already contains an underscore
+
+fshort-enums
+Fortran Var(flag_short_enums)
+; Documented in C
+
+fsign-zero
+Fortran
+Apply negative sign to zero values
+
+funderscoring
+Fortran
+Append underscores to externally visible names
+
+fwhole-file
+Fortran
+Compile all program units at once and check all interfaces
+
+fworking-directory
+Fortran
+; Documented in C
+
+idirafter
+Fortran Joined Separate
+; Documented in C
+
+imultilib
+Fortran Joined Separate
+; Documented in C
+
+iprefix
+Fortran Joined Separate
+; Documented in C
+
+iquote
+Fortran Joined Separate
+; Documented in C
+
+isysroot
+Fortran Joined Separate
+; Documented in C
+
+isystem
+Fortran Joined Separate
+; Documented in C
+
+nostdinc
+Fortran
+; Documented in C
+
+o
+Fortran Joined Separate
+; Documented in common.opt
+
+static-libgfortran
+Fortran
+Statically link the GNU Fortran helper library (libgfortran)
+
+std=f2003
+Fortran
+Conform to the ISO Fortran 2003 standard
+
+std=f2008
+Fortran
+Conform to the ISO Fortran 2008 standard
+
+std=f95
+Fortran
+Conform to the ISO Fortran 95 standard
+
+std=gnu
+Fortran
+Conform to nothing in particular
+
+std=legacy
+Fortran
+Accept extensions to support legacy code
+
+undef
+Fortran
+; Documented in C
+
+v
+Fortran
+; Documented in C
+
+; This comment is to ensure we retain the blank line above.
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
new file mode 100644
index 000000000..85a73d816
--- /dev/null
+++ b/gcc/fortran/libgfortran.h
@@ -0,0 +1,132 @@
+/* Header file to the Fortran front-end and runtime library
+   Copyright (C) 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+/* Flags to specify which standard/extension contains a feature.
+   Note that no features were obsoleted nor deleted in F2003.
+   Please remember to keep those definitions in sync with
+   gfortran.texi.  */
+#define GFC_STD_F2008_OBS	(1<<8)	/* Obsolescent in F2008.  */
+#define GFC_STD_F2008		(1<<7)	/* New in F2008.  */
+#define GFC_STD_LEGACY		(1<<6)	/* Backward compatibility.  */
+#define GFC_STD_GNU		(1<<5)	/* GNU Fortran extension.  */
+#define GFC_STD_F2003		(1<<4)	/* New in F2003.  */
+#define GFC_STD_F95		(1<<3)	/* New in F95.  */
+#define GFC_STD_F95_DEL		(1<<2)	/* Deleted in F95.  */
+#define GFC_STD_F95_OBS		(1<<1)	/* Obsolescent in F95.  */
+#define GFC_STD_F77		(1<<0)	/* Included in F77, but not deleted or
+					   obsolescent in later standards.  */
+
+
+/* Bitmasks for the various FPE that can be enabled.  */
+#define GFC_FPE_INVALID    (1<<0)
+#define GFC_FPE_DENORMAL   (1<<1)
+#define GFC_FPE_ZERO       (1<<2)
+#define GFC_FPE_OVERFLOW   (1<<3)
+#define GFC_FPE_UNDERFLOW  (1<<4)
+#define GFC_FPE_PRECISION  (1<<5)
+
+
+/* Bitmasks for the various runtime checks that can be enabled.  */
+#define GFC_RTCHECK_BOUNDS      (1<<0)
+#define GFC_RTCHECK_ARRAY_TEMPS (1<<1)
+#define GFC_RTCHECK_RECURSION   (1<<2)
+#define GFC_RTCHECK_DO          (1<<3)
+#define GFC_RTCHECK_POINTER     (1<<4)
+#define GFC_RTCHECK_MEM         (1<<5)
+#define GFC_RTCHECK_ALL        (GFC_RTCHECK_BOUNDS | GFC_RTCHECK_ARRAY_TEMPS \
+				| GFC_RTCHECK_RECURSION | GFC_RTCHECK_DO \
+				| GFC_RTCHECK_POINTER | GFC_RTCHECK_MEM)
+
+
+/* Possible values for the CONVERT I/O specifier.  */
+typedef enum
+{
+  GFC_CONVERT_NONE = -1,
+  GFC_CONVERT_NATIVE = 0,
+  GFC_CONVERT_SWAP,
+  GFC_CONVERT_BIG,
+  GFC_CONVERT_LITTLE
+}
+unit_convert;
+
+
+/* Runtime errors.  */
+typedef enum
+{
+  LIBERROR_FIRST = -3,		/* Marker for the first error.  */
+  LIBERROR_EOR = -2,		/* End of record, must be negative.  */
+  LIBERROR_END = -1,		/* End of file, must be negative.  */
+  LIBERROR_OK = 0,		/* Indicates success, must be zero.  */
+  LIBERROR_OS = 5000,		/* OS error, more info in errno.  */
+  LIBERROR_OPTION_CONFLICT,
+  LIBERROR_BAD_OPTION,
+  LIBERROR_MISSING_OPTION,
+  LIBERROR_ALREADY_OPEN,
+  LIBERROR_BAD_UNIT,
+  LIBERROR_FORMAT,
+  LIBERROR_BAD_ACTION,
+  LIBERROR_ENDFILE,
+  LIBERROR_BAD_US,
+  LIBERROR_READ_VALUE,
+  LIBERROR_READ_OVERFLOW,
+  LIBERROR_INTERNAL,
+  LIBERROR_INTERNAL_UNIT,
+  LIBERROR_ALLOCATION,
+  LIBERROR_DIRECT_EOR,
+  LIBERROR_SHORT_RECORD,
+  LIBERROR_CORRUPT_FILE,
+  LIBERROR_INQUIRE_INTERNAL_UNIT, /* Must be different from STAT_STOPPED_IMAGE.  */
+  LIBERROR_LAST			/* Not a real error, the last error # + 1.  */
+}
+libgfortran_error_codes;
+
+typedef enum
+{
+  GFC_STAT_UNLOCKED = 0,
+  GFC_STAT_LOCKED,
+  GFC_STAT_LOCKED_OTHER_IMAGE,
+  GFC_STAT_STOPPED_IMAGE
+}
+libgfortran_stat_codes;
+
+/* Default unit number for preconnected standard input and output.  */
+#define GFC_STDIN_UNIT_NUMBER 5
+#define GFC_STDOUT_UNIT_NUMBER 6
+#define GFC_STDERR_UNIT_NUMBER 0
+
+
+/* FIXME: Increase to 15 for Fortran 2008. Also needs changes to
+   GFC_DTYPE_RANK_MASK. See PR 36825.  */
+#define GFC_MAX_DIMENSIONS 7
+
+#define GFC_DTYPE_RANK_MASK 0x07
+#define GFC_DTYPE_TYPE_SHIFT 3
+#define GFC_DTYPE_TYPE_MASK 0x38
+#define GFC_DTYPE_SIZE_SHIFT 6
+
+/* Basic types.  BT_VOID is used by ISO C Binding so funcs like c_f_pointer
+   can take any arg with the pointer attribute as a param.  These are also
+   used in the run-time library for IO.  */
+typedef enum
+{ BT_UNKNOWN = 0, BT_INTEGER, BT_LOGICAL, BT_REAL, BT_COMPLEX,
+  BT_DERIVED, BT_CHARACTER, BT_CLASS, BT_PROCEDURE, BT_HOLLERITH, BT_VOID
+}
+bt;
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
new file mode 100644
index 000000000..d2d9f5f93
--- /dev/null
+++ b/gcc/fortran/match.c
@@ -0,0 +1,5289 @@
+/* Matching subroutines in all sizes, shapes and colors.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2009, 2010, 2011
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "match.h"
+#include "parse.h"
+
+int gfc_matching_ptr_assignment = 0;
+int gfc_matching_procptr_assignment = 0;
+bool gfc_matching_prefix = false;
+
+/* Stack of SELECT TYPE statements.  */
+gfc_select_type_stack *select_type_stack = NULL;
+
+/* For debugging and diagnostic purposes.  Return the textual representation
+   of the intrinsic operator OP.  */
+const char *
+gfc_op2string (gfc_intrinsic_op op)
+{
+  switch (op)
+    {
+    case INTRINSIC_UPLUS:
+    case INTRINSIC_PLUS:
+      return "+";
+
+    case INTRINSIC_UMINUS:
+    case INTRINSIC_MINUS:
+      return "-";
+
+    case INTRINSIC_POWER:
+      return "**";
+    case INTRINSIC_CONCAT:
+      return "//";
+    case INTRINSIC_TIMES:
+      return "*";
+    case INTRINSIC_DIVIDE:
+      return "/";
+
+    case INTRINSIC_AND:
+      return ".and.";
+    case INTRINSIC_OR:
+      return ".or.";
+    case INTRINSIC_EQV:
+      return ".eqv.";
+    case INTRINSIC_NEQV:
+      return ".neqv.";
+
+    case INTRINSIC_EQ_OS:
+      return ".eq.";
+    case INTRINSIC_EQ:
+      return "==";
+    case INTRINSIC_NE_OS:
+      return ".ne.";
+    case INTRINSIC_NE:
+      return "/=";
+    case INTRINSIC_GE_OS:
+      return ".ge.";
+    case INTRINSIC_GE:
+      return ">=";
+    case INTRINSIC_LE_OS:
+      return ".le.";
+    case INTRINSIC_LE:
+      return "<=";
+    case INTRINSIC_LT_OS:
+      return ".lt.";
+    case INTRINSIC_LT:
+      return "<";
+    case INTRINSIC_GT_OS:
+      return ".gt.";
+    case INTRINSIC_GT:
+      return ">";
+    case INTRINSIC_NOT:
+      return ".not.";
+
+    case INTRINSIC_ASSIGN:
+      return "=";
+
+    case INTRINSIC_PARENTHESES:
+      return "parens";
+
+    default:
+      break;
+    }
+
+  gfc_internal_error ("gfc_op2string(): Bad code");
+  /* Not reached.  */
+}
+
+
+/******************** Generic matching subroutines ************************/
+
+/* This function scans the current statement counting the opened and closed
+   parenthesis to make sure they are balanced.  */
+
+match
+gfc_match_parens (void)
+{
+  locus old_loc, where;
+  int count;
+  gfc_instring instring;
+  gfc_char_t c, quote;
+
+  old_loc = gfc_current_locus;
+  count = 0;
+  instring = NONSTRING;
+  quote = ' ';
+
+  for (;;)
+    {
+      c = gfc_next_char_literal (instring);
+      if (c == '\n')
+	break;
+      if (quote == ' ' && ((c == '\'') || (c == '"')))
+	{
+	  quote = c;
+	  instring = INSTRING_WARN;
+	  continue;
+	}
+      if (quote != ' ' && c == quote)
+	{
+	  quote = ' ';
+	  instring = NONSTRING;
+	  continue;
+	}
+
+      if (c == '(' && quote == ' ')
+	{
+	  count++;
+	  where = gfc_current_locus;
+	}
+      if (c == ')' && quote == ' ')
+	{
+	  count--;
+	  where = gfc_current_locus;
+	}
+    }
+
+  gfc_current_locus = old_loc;
+
+  if (count > 0)
+    {
+      gfc_error ("Missing ')' in statement at or before %L", &where);
+      return MATCH_ERROR;
+    }
+  if (count < 0)
+    {
+      gfc_error ("Missing '(' in statement at or before %L", &where);
+      return MATCH_ERROR;
+    }
+
+  return MATCH_YES;
+}
+
+
+/* See if the next character is a special character that has
+   escaped by a \ via the -fbackslash option.  */
+
+match
+gfc_match_special_char (gfc_char_t *res)
+{
+  int len, i;
+  gfc_char_t c, n;
+  match m;
+
+  m = MATCH_YES;
+
+  switch ((c = gfc_next_char_literal (INSTRING_WARN)))
+    {
+    case 'a':
+      *res = '\a';
+      break;
+    case 'b':
+      *res = '\b';
+      break;
+    case 't':
+      *res = '\t';
+      break;
+    case 'f':
+      *res = '\f';
+      break;
+    case 'n':
+      *res = '\n';
+      break;
+    case 'r':
+      *res = '\r';
+      break;
+    case 'v':
+      *res = '\v';
+      break;
+    case '\\':
+      *res = '\\';
+      break;
+    case '0':
+      *res = '\0';
+      break;
+
+    case 'x':
+    case 'u':
+    case 'U':
+      /* Hexadecimal form of wide characters.  */
+      len = (c == 'x' ? 2 : (c == 'u' ? 4 : 8));
+      n = 0;
+      for (i = 0; i < len; i++)
+	{
+	  char buf[2] = { '\0', '\0' };
+
+	  c = gfc_next_char_literal (INSTRING_WARN);
+	  if (!gfc_wide_fits_in_byte (c)
+	      || !gfc_check_digit ((unsigned char) c, 16))
+	    return MATCH_NO;
+
+	  buf[0] = (unsigned char) c;
+	  n = n << 4;
+	  n += strtol (buf, NULL, 16);
+	}
+      *res = n;
+      break;
+
+    default:
+      /* Unknown backslash codes are simply not expanded.  */
+      m = MATCH_NO;
+      break;
+    }
+
+  return m;
+}
+
+
+/* In free form, match at least one space.  Always matches in fixed
+   form.  */
+
+match
+gfc_match_space (void)
+{
+  locus old_loc;
+  char c;
+
+  if (gfc_current_form == FORM_FIXED)
+    return MATCH_YES;
+
+  old_loc = gfc_current_locus;
+
+  c = gfc_next_ascii_char ();
+  if (!gfc_is_whitespace (c))
+    {
+      gfc_current_locus = old_loc;
+      return MATCH_NO;
+    }
+
+  gfc_gobble_whitespace ();
+
+  return MATCH_YES;
+}
+
+
+/* Match an end of statement.  End of statement is optional
+   whitespace, followed by a ';' or '\n' or comment '!'.  If a
+   semicolon is found, we continue to eat whitespace and semicolons.  */
+
+match
+gfc_match_eos (void)
+{
+  locus old_loc;
+  int flag;
+  char c;
+
+  flag = 0;
+
+  for (;;)
+    {
+      old_loc = gfc_current_locus;
+      gfc_gobble_whitespace ();
+
+      c = gfc_next_ascii_char ();
+      switch (c)
+	{
+	case '!':
+	  do
+	    {
+	      c = gfc_next_ascii_char ();
+	    }
+	  while (c != '\n');
+
+	  /* Fall through.  */
+
+	case '\n':
+	  return MATCH_YES;
+
+	case ';':
+	  flag = 1;
+	  continue;
+	}
+
+      break;
+    }
+
+  gfc_current_locus = old_loc;
+  return (flag) ? MATCH_YES : MATCH_NO;
+}
+
+
+/* Match a literal integer on the input, setting the value on
+   MATCH_YES.  Literal ints occur in kind-parameters as well as
+   old-style character length specifications.  If cnt is non-NULL it
+   will be set to the number of digits.  */
+
+match
+gfc_match_small_literal_int (int *value, int *cnt)
+{
+  locus old_loc;
+  char c;
+  int i, j;
+
+  old_loc = gfc_current_locus;
+
+  *value = -1;
+  gfc_gobble_whitespace ();
+  c = gfc_next_ascii_char ();
+  if (cnt)
+    *cnt = 0;
+
+  if (!ISDIGIT (c))
+    {
+      gfc_current_locus = old_loc;
+      return MATCH_NO;
+    }
+
+  i = c - '0';
+  j = 1;
+
+  for (;;)
+    {
+      old_loc = gfc_current_locus;
+      c = gfc_next_ascii_char ();
+
+      if (!ISDIGIT (c))
+	break;
+
+      i = 10 * i + c - '0';
+      j++;
+
+      if (i > 99999999)
+	{
+	  gfc_error ("Integer too large at %C");
+	  return MATCH_ERROR;
+	}
+    }
+
+  gfc_current_locus = old_loc;
+
+  *value = i;
+  if (cnt)
+    *cnt = j;
+  return MATCH_YES;
+}
+
+
+/* Match a small, constant integer expression, like in a kind
+   statement.  On MATCH_YES, 'value' is set.  */
+
+match
+gfc_match_small_int (int *value)
+{
+  gfc_expr *expr;
+  const char *p;
+  match m;
+  int i;
+
+  m = gfc_match_expr (&expr);
+  if (m != MATCH_YES)
+    return m;
+
+  p = gfc_extract_int (expr, &i);
+  gfc_free_expr (expr);
+
+  if (p != NULL)
+    {
+      gfc_error (p);
+      m = MATCH_ERROR;
+    }
+
+  *value = i;
+  return m;
+}
+
+
+/* This function is the same as the gfc_match_small_int, except that
+   we're keeping the pointer to the expr.  This function could just be
+   removed and the previously mentioned one modified, though all calls
+   to it would have to be modified then (and there were a number of
+   them).  Return MATCH_ERROR if fail to extract the int; otherwise,
+   return the result of gfc_match_expr().  The expr (if any) that was
+   matched is returned in the parameter expr.  */
+
+match
+gfc_match_small_int_expr (int *value, gfc_expr **expr)
+{
+  const char *p;
+  match m;
+  int i;
+
+  m = gfc_match_expr (expr);
+  if (m != MATCH_YES)
+    return m;
+
+  p = gfc_extract_int (*expr, &i);
+
+  if (p != NULL)
+    {
+      gfc_error (p);
+      m = MATCH_ERROR;
+    }
+
+  *value = i;
+  return m;
+}
+
+
+/* Matches a statement label.  Uses gfc_match_small_literal_int() to
+   do most of the work.  */
+
+match
+gfc_match_st_label (gfc_st_label **label)
+{
+  locus old_loc;
+  match m;
+  int i, cnt;
+
+  old_loc = gfc_current_locus;
+
+  m = gfc_match_small_literal_int (&i, &cnt);
+  if (m != MATCH_YES)
+    return m;
+
+  if (cnt > 5)
+    {
+      gfc_error ("Too many digits in statement label at %C");
+      goto cleanup;
+    }
+
+  if (i == 0)
+    {
+      gfc_error ("Statement label at %C is zero");
+      goto cleanup;
+    }
+
+  *label = gfc_get_st_label (i);
+  return MATCH_YES;
+
+cleanup:
+
+  gfc_current_locus = old_loc;
+  return MATCH_ERROR;
+}
+
+
+/* Match and validate a label associated with a named IF, DO or SELECT
+   statement.  If the symbol does not have the label attribute, we add
+   it.  We also make sure the symbol does not refer to another
+   (active) block.  A matched label is pointed to by gfc_new_block.  */
+
+match
+gfc_match_label (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  match m;
+
+  gfc_new_block = NULL;
+
+  m = gfc_match (" %n :", name);
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_get_symbol (name, NULL, &gfc_new_block))
+    {
+      gfc_error ("Label name '%s' at %C is ambiguous", name);
+      return MATCH_ERROR;
+    }
+
+  if (gfc_new_block->attr.flavor == FL_LABEL)
+    {
+      gfc_error ("Duplicate construct label '%s' at %C", name);
+      return MATCH_ERROR;
+    }
+
+  if (gfc_add_flavor (&gfc_new_block->attr, FL_LABEL,
+		      gfc_new_block->name, NULL) == FAILURE)
+    return MATCH_ERROR;
+
+  return MATCH_YES;
+}
+
+
+/* See if the current input looks like a name of some sort.  Modifies
+   the passed buffer which must be GFC_MAX_SYMBOL_LEN+1 bytes long.
+   Note that options.c restricts max_identifier_length to not more
+   than GFC_MAX_SYMBOL_LEN.  */
+
+match
+gfc_match_name (char *buffer)
+{
+  locus old_loc;
+  int i;
+  char c;
+
+  old_loc = gfc_current_locus;
+  gfc_gobble_whitespace ();
+
+  c = gfc_next_ascii_char ();
+  if (!(ISALPHA (c) || (c == '_' && gfc_option.flag_allow_leading_underscore)))
+    {
+      if (gfc_error_flag_test() == 0 && c != '(')
+	gfc_error ("Invalid character in name at %C");
+      gfc_current_locus = old_loc;
+      return MATCH_NO;
+    }
+
+  i = 0;
+
+  do
+    {
+      buffer[i++] = c;
+
+      if (i > gfc_option.max_identifier_length)
+	{
+	  gfc_error ("Name at %C is too long");
+	  return MATCH_ERROR;
+	}
+
+      old_loc = gfc_current_locus;
+      c = gfc_next_ascii_char ();
+    }
+  while (ISALNUM (c) || c == '_' || (gfc_option.flag_dollar_ok && c == '$'));
+
+  if (c == '$' && !gfc_option.flag_dollar_ok)
+    {
+      gfc_error ("Invalid character '$' at %C. Use -fdollar-ok to allow it "
+		 "as an extension");
+      return MATCH_ERROR;
+    }
+
+  buffer[i] = '\0';
+  gfc_current_locus = old_loc;
+
+  return MATCH_YES;
+}
+
+
+/* Match a valid name for C, which is almost the same as for Fortran,
+   except that you can start with an underscore, etc..  It could have
+   been done by modifying the gfc_match_name, but this way other
+   things C allows can be added, such as no limits on the length.
+   Right now, the length is limited to the same thing as Fortran..
+   Also, by rewriting it, we use the gfc_next_char_C() to prevent the
+   input characters from being automatically lower cased, since C is
+   case sensitive.  The parameter, buffer, is used to return the name
+   that is matched.  Return MATCH_ERROR if the name is too long
+   (though this is a self-imposed limit), MATCH_NO if what we're
+   seeing isn't a name, and MATCH_YES if we successfully match a C
+   name.  */
+
+match
+gfc_match_name_C (char *buffer)
+{
+  locus old_loc;
+  int i = 0;
+  gfc_char_t c;
+
+  old_loc = gfc_current_locus;
+  gfc_gobble_whitespace ();
+
+  /* Get the next char (first possible char of name) and see if
+     it's valid for C (either a letter or an underscore).  */
+  c = gfc_next_char_literal (INSTRING_WARN);
+
+  /* If the user put nothing expect spaces between the quotes, it is valid
+     and simply means there is no name= specifier and the name is the fortran
+     symbol name, all lowercase.  */
+  if (c == '"' || c == '\'')
+    {
+      buffer[0] = '\0';
+      gfc_current_locus = old_loc;
+      return MATCH_YES;
+    }
+  
+  if (!ISALPHA (c) && c != '_')
+    {
+      gfc_error ("Invalid C name in NAME= specifier at %C");
+      return MATCH_ERROR;
+    }
+
+  /* Continue to read valid variable name characters.  */
+  do
+    {
+      gcc_assert (gfc_wide_fits_in_byte (c));
+
+      buffer[i++] = (unsigned char) c;
+      
+    /* C does not define a maximum length of variable names, to my
+       knowledge, but the compiler typically places a limit on them.
+       For now, i'll use the same as the fortran limit for simplicity,
+       but this may need to be changed to a dynamic buffer that can
+       be realloc'ed here if necessary, or more likely, a larger
+       upper-bound set.  */
+      if (i > gfc_option.max_identifier_length)
+        {
+          gfc_error ("Name at %C is too long");
+          return MATCH_ERROR;
+        }
+      
+      old_loc = gfc_current_locus;
+      
+      /* Get next char; param means we're in a string.  */
+      c = gfc_next_char_literal (INSTRING_WARN);
+    } while (ISALNUM (c) || c == '_');
+
+  buffer[i] = '\0';
+  gfc_current_locus = old_loc;
+
+  /* See if we stopped because of whitespace.  */
+  if (c == ' ')
+    {
+      gfc_gobble_whitespace ();
+      c = gfc_peek_ascii_char ();
+      if (c != '"' && c != '\'')
+        {
+          gfc_error ("Embedded space in NAME= specifier at %C");
+          return MATCH_ERROR;
+        }
+    }
+  
+  /* If we stopped because we had an invalid character for a C name, report
+     that to the user by returning MATCH_NO.  */
+  if (c != '"' && c != '\'')
+    {
+      gfc_error ("Invalid C name in NAME= specifier at %C");
+      return MATCH_ERROR;
+    }
+
+  return MATCH_YES;
+}
+
+
+/* Match a symbol on the input.  Modifies the pointer to the symbol
+   pointer if successful.  */
+
+match
+gfc_match_sym_tree (gfc_symtree **matched_symbol, int host_assoc)
+{
+  char buffer[GFC_MAX_SYMBOL_LEN + 1];
+  match m;
+
+  m = gfc_match_name (buffer);
+  if (m != MATCH_YES)
+    return m;
+
+  if (host_assoc)
+    return (gfc_get_ha_sym_tree (buffer, matched_symbol))
+	    ? MATCH_ERROR : MATCH_YES;
+
+  if (gfc_get_sym_tree (buffer, NULL, matched_symbol, false))
+    return MATCH_ERROR;
+
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_symbol (gfc_symbol **matched_symbol, int host_assoc)
+{
+  gfc_symtree *st;
+  match m;
+
+  m = gfc_match_sym_tree (&st, host_assoc);
+
+  if (m == MATCH_YES)
+    {
+      if (st)
+	*matched_symbol = st->n.sym;
+      else
+	*matched_symbol = NULL;
+    }
+  else
+    *matched_symbol = NULL;
+  return m;
+}
+
+
+/* Match an intrinsic operator.  Returns an INTRINSIC enum. While matching, 
+   we always find INTRINSIC_PLUS before INTRINSIC_UPLUS. We work around this 
+   in matchexp.c.  */
+
+match
+gfc_match_intrinsic_op (gfc_intrinsic_op *result)
+{
+  locus orig_loc = gfc_current_locus;
+  char ch;
+
+  gfc_gobble_whitespace ();
+  ch = gfc_next_ascii_char ();
+  switch (ch)
+    {
+    case '+':
+      /* Matched "+".  */
+      *result = INTRINSIC_PLUS;
+      return MATCH_YES;
+
+    case '-':
+      /* Matched "-".  */
+      *result = INTRINSIC_MINUS;
+      return MATCH_YES;
+
+    case '=':
+      if (gfc_next_ascii_char () == '=')
+	{
+	  /* Matched "==".  */
+	  *result = INTRINSIC_EQ;
+	  return MATCH_YES;
+	}
+      break;
+
+    case '<':
+      if (gfc_peek_ascii_char () == '=')
+	{
+	  /* Matched "<=".  */
+	  gfc_next_ascii_char ();
+	  *result = INTRINSIC_LE;
+	  return MATCH_YES;
+	}
+      /* Matched "<".  */
+      *result = INTRINSIC_LT;
+      return MATCH_YES;
+
+    case '>':
+      if (gfc_peek_ascii_char () == '=')
+	{
+	  /* Matched ">=".  */
+	  gfc_next_ascii_char ();
+	  *result = INTRINSIC_GE;
+	  return MATCH_YES;
+	}
+      /* Matched ">".  */
+      *result = INTRINSIC_GT;
+      return MATCH_YES;
+
+    case '*':
+      if (gfc_peek_ascii_char () == '*')
+	{
+	  /* Matched "**".  */
+	  gfc_next_ascii_char ();
+	  *result = INTRINSIC_POWER;
+	  return MATCH_YES;
+	}
+      /* Matched "*".  */
+      *result = INTRINSIC_TIMES;
+      return MATCH_YES;
+
+    case '/':
+      ch = gfc_peek_ascii_char ();
+      if (ch == '=')
+	{
+	  /* Matched "/=".  */
+	  gfc_next_ascii_char ();
+	  *result = INTRINSIC_NE;
+	  return MATCH_YES;
+	}
+      else if (ch == '/')
+	{
+	  /* Matched "//".  */
+	  gfc_next_ascii_char ();
+	  *result = INTRINSIC_CONCAT;
+	  return MATCH_YES;
+	}
+      /* Matched "/".  */
+      *result = INTRINSIC_DIVIDE;
+      return MATCH_YES;
+
+    case '.':
+      ch = gfc_next_ascii_char ();
+      switch (ch)
+	{
+	case 'a':
+	  if (gfc_next_ascii_char () == 'n'
+	      && gfc_next_ascii_char () == 'd'
+	      && gfc_next_ascii_char () == '.')
+	    {
+	      /* Matched ".and.".  */
+	      *result = INTRINSIC_AND;
+	      return MATCH_YES;
+	    }
+	  break;
+
+	case 'e':
+	  if (gfc_next_ascii_char () == 'q')
+	    {
+	      ch = gfc_next_ascii_char ();
+	      if (ch == '.')
+		{
+		  /* Matched ".eq.".  */
+		  *result = INTRINSIC_EQ_OS;
+		  return MATCH_YES;
+		}
+	      else if (ch == 'v')
+		{
+		  if (gfc_next_ascii_char () == '.')
+		    {
+		      /* Matched ".eqv.".  */
+		      *result = INTRINSIC_EQV;
+		      return MATCH_YES;
+		    }
+		}
+	    }
+	  break;
+
+	case 'g':
+	  ch = gfc_next_ascii_char ();
+	  if (ch == 'e')
+	    {
+	      if (gfc_next_ascii_char () == '.')
+		{
+		  /* Matched ".ge.".  */
+		  *result = INTRINSIC_GE_OS;
+		  return MATCH_YES;
+		}
+	    }
+	  else if (ch == 't')
+	    {
+	      if (gfc_next_ascii_char () == '.')
+		{
+		  /* Matched ".gt.".  */
+		  *result = INTRINSIC_GT_OS;
+		  return MATCH_YES;
+		}
+	    }
+	  break;
+
+	case 'l':
+	  ch = gfc_next_ascii_char ();
+	  if (ch == 'e')
+	    {
+	      if (gfc_next_ascii_char () == '.')
+		{
+		  /* Matched ".le.".  */
+		  *result = INTRINSIC_LE_OS;
+		  return MATCH_YES;
+		}
+	    }
+	  else if (ch == 't')
+	    {
+	      if (gfc_next_ascii_char () == '.')
+		{
+		  /* Matched ".lt.".  */
+		  *result = INTRINSIC_LT_OS;
+		  return MATCH_YES;
+		}
+	    }
+	  break;
+
+	case 'n':
+	  ch = gfc_next_ascii_char ();
+	  if (ch == 'e')
+	    {
+	      ch = gfc_next_ascii_char ();
+	      if (ch == '.')
+		{
+		  /* Matched ".ne.".  */
+		  *result = INTRINSIC_NE_OS;
+		  return MATCH_YES;
+		}
+	      else if (ch == 'q')
+		{
+		  if (gfc_next_ascii_char () == 'v'
+		      && gfc_next_ascii_char () == '.')
+		    {
+		      /* Matched ".neqv.".  */
+		      *result = INTRINSIC_NEQV;
+		      return MATCH_YES;
+		    }
+		}
+	    }
+	  else if (ch == 'o')
+	    {
+	      if (gfc_next_ascii_char () == 't'
+		  && gfc_next_ascii_char () == '.')
+		{
+		  /* Matched ".not.".  */
+		  *result = INTRINSIC_NOT;
+		  return MATCH_YES;
+		}
+	    }
+	  break;
+
+	case 'o':
+	  if (gfc_next_ascii_char () == 'r'
+	      && gfc_next_ascii_char () == '.')
+	    {
+	      /* Matched ".or.".  */
+	      *result = INTRINSIC_OR;
+	      return MATCH_YES;
+	    }
+	  break;
+
+	default:
+	  break;
+	}
+      break;
+
+    default:
+      break;
+    }
+
+  gfc_current_locus = orig_loc;
+  return MATCH_NO;
+}
+
+
+/* Match a loop control phrase:
+
+    <LVALUE> = <EXPR>, <EXPR> [, <EXPR> ]
+
+   If the final integer expression is not present, a constant unity
+   expression is returned.  We don't return MATCH_ERROR until after
+   the equals sign is seen.  */
+
+match
+gfc_match_iterator (gfc_iterator *iter, int init_flag)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_expr *var, *e1, *e2, *e3;
+  locus start;
+  match m;
+
+  e1 = e2 = e3 = NULL;
+
+  /* Match the start of an iterator without affecting the symbol table.  */
+
+  start = gfc_current_locus;
+  m = gfc_match (" %n =", name);
+  gfc_current_locus = start;
+
+  if (m != MATCH_YES)
+    return MATCH_NO;
+
+  m = gfc_match_variable (&var, 0);
+  if (m != MATCH_YES)
+    return MATCH_NO;
+
+  /* F2008, C617 & C565.  */
+  if (var->symtree->n.sym->attr.codimension)
+    {
+      gfc_error ("Loop variable at %C cannot be a coarray");
+      goto cleanup;
+    }
+
+  if (var->ref != NULL)
+    {
+      gfc_error ("Loop variable at %C cannot be a sub-component");
+      goto cleanup;
+    }
+
+  gfc_match_char ('=');
+
+  var->symtree->n.sym->attr.implied_index = 1;
+
+  m = init_flag ? gfc_match_init_expr (&e1) : gfc_match_expr (&e1);
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  if (gfc_match_char (',') != MATCH_YES)
+    goto syntax;
+
+  m = init_flag ? gfc_match_init_expr (&e2) : gfc_match_expr (&e2);
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  if (gfc_match_char (',') != MATCH_YES)
+    {
+      e3 = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+      goto done;
+    }
+
+  m = init_flag ? gfc_match_init_expr (&e3) : gfc_match_expr (&e3);
+  if (m == MATCH_ERROR)
+    goto cleanup;
+  if (m == MATCH_NO)
+    {
+      gfc_error ("Expected a step value in iterator at %C");
+      goto cleanup;
+    }
+
+done:
+  iter->var = var;
+  iter->start = e1;
+  iter->end = e2;
+  iter->step = e3;
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in iterator at %C");
+
+cleanup:
+  gfc_free_expr (e1);
+  gfc_free_expr (e2);
+  gfc_free_expr (e3);
+
+  return MATCH_ERROR;
+}
+
+
+/* Tries to match the next non-whitespace character on the input.
+   This subroutine does not return MATCH_ERROR.  */
+
+match
+gfc_match_char (char c)
+{
+  locus where;
+
+  where = gfc_current_locus;
+  gfc_gobble_whitespace ();
+
+  if (gfc_next_ascii_char () == c)
+    return MATCH_YES;
+
+  gfc_current_locus = where;
+  return MATCH_NO;
+}
+
+
+/* General purpose matching subroutine.  The target string is a
+   scanf-like format string in which spaces correspond to arbitrary
+   whitespace (including no whitespace), characters correspond to
+   themselves.  The %-codes are:
+
+   %%  Literal percent sign
+   %e  Expression, pointer to a pointer is set
+   %s  Symbol, pointer to the symbol is set
+   %n  Name, character buffer is set to name
+   %t  Matches end of statement.
+   %o  Matches an intrinsic operator, returned as an INTRINSIC enum.
+   %l  Matches a statement label
+   %v  Matches a variable expression (an lvalue)
+   %   Matches a required space (in free form) and optional spaces.  */
+
+match
+gfc_match (const char *target, ...)
+{
+  gfc_st_label **label;
+  int matches, *ip;
+  locus old_loc;
+  va_list argp;
+  char c, *np;
+  match m, n;
+  void **vp;
+  const char *p;
+
+  old_loc = gfc_current_locus;
+  va_start (argp, target);
+  m = MATCH_NO;
+  matches = 0;
+  p = target;
+
+loop:
+  c = *p++;
+  switch (c)
+    {
+    case ' ':
+      gfc_gobble_whitespace ();
+      goto loop;
+    case '\0':
+      m = MATCH_YES;
+      break;
+
+    case '%':
+      c = *p++;
+      switch (c)
+	{
+	case 'e':
+	  vp = va_arg (argp, void **);
+	  n = gfc_match_expr ((gfc_expr **) vp);
+	  if (n != MATCH_YES)
+	    {
+	      m = n;
+	      goto not_yes;
+	    }
+
+	  matches++;
+	  goto loop;
+
+	case 'v':
+	  vp = va_arg (argp, void **);
+	  n = gfc_match_variable ((gfc_expr **) vp, 0);
+	  if (n != MATCH_YES)
+	    {
+	      m = n;
+	      goto not_yes;
+	    }
+
+	  matches++;
+	  goto loop;
+
+	case 's':
+	  vp = va_arg (argp, void **);
+	  n = gfc_match_symbol ((gfc_symbol **) vp, 0);
+	  if (n != MATCH_YES)
+	    {
+	      m = n;
+	      goto not_yes;
+	    }
+
+	  matches++;
+	  goto loop;
+
+	case 'n':
+	  np = va_arg (argp, char *);
+	  n = gfc_match_name (np);
+	  if (n != MATCH_YES)
+	    {
+	      m = n;
+	      goto not_yes;
+	    }
+
+	  matches++;
+	  goto loop;
+
+	case 'l':
+	  label = va_arg (argp, gfc_st_label **);
+	  n = gfc_match_st_label (label);
+	  if (n != MATCH_YES)
+	    {
+	      m = n;
+	      goto not_yes;
+	    }
+
+	  matches++;
+	  goto loop;
+
+	case 'o':
+	  ip = va_arg (argp, int *);
+	  n = gfc_match_intrinsic_op ((gfc_intrinsic_op *) ip);
+	  if (n != MATCH_YES)
+	    {
+	      m = n;
+	      goto not_yes;
+	    }
+
+	  matches++;
+	  goto loop;
+
+	case 't':
+	  if (gfc_match_eos () != MATCH_YES)
+	    {
+	      m = MATCH_NO;
+	      goto not_yes;
+	    }
+	  goto loop;
+
+	case ' ':
+	  if (gfc_match_space () == MATCH_YES)
+	    goto loop;
+	  m = MATCH_NO;
+	  goto not_yes;
+
+	case '%':
+	  break;	/* Fall through to character matcher.  */
+
+	default:
+	  gfc_internal_error ("gfc_match(): Bad match code %c", c);
+	}
+
+    default:
+
+      /* gfc_next_ascii_char converts characters to lower-case, so we shouldn't
+	 expect an upper case character here!  */
+      gcc_assert (TOLOWER (c) == c);
+
+      if (c == gfc_next_ascii_char ())
+	goto loop;
+      break;
+    }
+
+not_yes:
+  va_end (argp);
+
+  if (m != MATCH_YES)
+    {
+      /* Clean up after a failed match.  */
+      gfc_current_locus = old_loc;
+      va_start (argp, target);
+
+      p = target;
+      for (; matches > 0; matches--)
+	{
+	  while (*p++ != '%');
+
+	  switch (*p++)
+	    {
+	    case '%':
+	      matches++;
+	      break;		/* Skip.  */
+
+	    /* Matches that don't have to be undone */
+	    case 'o':
+	    case 'l':
+	    case 'n':
+	    case 's':
+	      (void) va_arg (argp, void **);
+	      break;
+
+	    case 'e':
+	    case 'v':
+	      vp = va_arg (argp, void **);
+	      gfc_free_expr ((struct gfc_expr *)*vp);
+	      *vp = NULL;
+	      break;
+	    }
+	}
+
+      va_end (argp);
+    }
+
+  return m;
+}
+
+
+/*********************** Statement level matching **********************/
+
+/* Matches the start of a program unit, which is the program keyword
+   followed by an obligatory symbol.  */
+
+match
+gfc_match_program (void)
+{
+  gfc_symbol *sym;
+  match m;
+
+  m = gfc_match ("% %s%t", &sym);
+
+  if (m == MATCH_NO)
+    {
+      gfc_error ("Invalid form of PROGRAM statement at %C");
+      m = MATCH_ERROR;
+    }
+
+  if (m == MATCH_ERROR)
+    return m;
+
+  if (gfc_add_flavor (&sym->attr, FL_PROGRAM, sym->name, NULL) == FAILURE)
+    return MATCH_ERROR;
+
+  gfc_new_block = sym;
+
+  return MATCH_YES;
+}
+
+
+/* Match a simple assignment statement.  */
+
+match
+gfc_match_assignment (void)
+{
+  gfc_expr *lvalue, *rvalue;
+  locus old_loc;
+  match m;
+
+  old_loc = gfc_current_locus;
+
+  lvalue = NULL;
+  m = gfc_match (" %v =", &lvalue);
+  if (m != MATCH_YES)
+    {
+      gfc_current_locus = old_loc;
+      gfc_free_expr (lvalue);
+      return MATCH_NO;
+    }
+
+  rvalue = NULL;
+  m = gfc_match (" %e%t", &rvalue);
+  if (m != MATCH_YES)
+    {
+      gfc_current_locus = old_loc;
+      gfc_free_expr (lvalue);
+      gfc_free_expr (rvalue);
+      return m;
+    }
+
+  gfc_set_sym_referenced (lvalue->symtree->n.sym);
+
+  new_st.op = EXEC_ASSIGN;
+  new_st.expr1 = lvalue;
+  new_st.expr2 = rvalue;
+
+  gfc_check_do_variable (lvalue->symtree);
+
+  return MATCH_YES;
+}
+
+
+/* Match a pointer assignment statement.  */
+
+match
+gfc_match_pointer_assignment (void)
+{
+  gfc_expr *lvalue, *rvalue;
+  locus old_loc;
+  match m;
+
+  old_loc = gfc_current_locus;
+
+  lvalue = rvalue = NULL;
+  gfc_matching_ptr_assignment = 0;
+  gfc_matching_procptr_assignment = 0;
+
+  m = gfc_match (" %v =>", &lvalue);
+  if (m != MATCH_YES)
+    {
+      m = MATCH_NO;
+      goto cleanup;
+    }
+
+  if (lvalue->symtree->n.sym->attr.proc_pointer
+      || gfc_is_proc_ptr_comp (lvalue, NULL))
+    gfc_matching_procptr_assignment = 1;
+  else
+    gfc_matching_ptr_assignment = 1;
+
+  m = gfc_match (" %e%t", &rvalue);
+  gfc_matching_ptr_assignment = 0;
+  gfc_matching_procptr_assignment = 0;
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  new_st.op = EXEC_POINTER_ASSIGN;
+  new_st.expr1 = lvalue;
+  new_st.expr2 = rvalue;
+
+  return MATCH_YES;
+
+cleanup:
+  gfc_current_locus = old_loc;
+  gfc_free_expr (lvalue);
+  gfc_free_expr (rvalue);
+  return m;
+}
+
+
+/* We try to match an easy arithmetic IF statement. This only happens
+   when just after having encountered a simple IF statement. This code
+   is really duplicate with parts of the gfc_match_if code, but this is
+   *much* easier.  */
+
+static match
+match_arithmetic_if (void)
+{
+  gfc_st_label *l1, *l2, *l3;
+  gfc_expr *expr;
+  match m;
+
+  m = gfc_match (" ( %e ) %l , %l , %l%t", &expr, &l1, &l2, &l3);
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_reference_st_label (l1, ST_LABEL_TARGET) == FAILURE
+      || gfc_reference_st_label (l2, ST_LABEL_TARGET) == FAILURE
+      || gfc_reference_st_label (l3, ST_LABEL_TARGET) == FAILURE)
+    {
+      gfc_free_expr (expr);
+      return MATCH_ERROR;
+    }
+
+  if (gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: Arithmetic IF "
+		      "statement at %C") == FAILURE)
+    return MATCH_ERROR;
+
+  new_st.op = EXEC_ARITHMETIC_IF;
+  new_st.expr1 = expr;
+  new_st.label1 = l1;
+  new_st.label2 = l2;
+  new_st.label3 = l3;
+
+  return MATCH_YES;
+}
+
+
+/* The IF statement is a bit of a pain.  First of all, there are three
+   forms of it, the simple IF, the IF that starts a block and the
+   arithmetic IF.
+
+   There is a problem with the simple IF and that is the fact that we
+   only have a single level of undo information on symbols.  What this
+   means is for a simple IF, we must re-match the whole IF statement
+   multiple times in order to guarantee that the symbol table ends up
+   in the proper state.  */
+
+static match match_simple_forall (void);
+static match match_simple_where (void);
+
+match
+gfc_match_if (gfc_statement *if_type)
+{
+  gfc_expr *expr;
+  gfc_st_label *l1, *l2, *l3;
+  locus old_loc, old_loc2;
+  gfc_code *p;
+  match m, n;
+
+  n = gfc_match_label ();
+  if (n == MATCH_ERROR)
+    return n;
+
+  old_loc = gfc_current_locus;
+
+  m = gfc_match (" if ( %e", &expr);
+  if (m != MATCH_YES)
+    return m;
+
+  old_loc2 = gfc_current_locus;
+  gfc_current_locus = old_loc;
+  
+  if (gfc_match_parens () == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  gfc_current_locus = old_loc2;
+
+  if (gfc_match_char (')') != MATCH_YES)
+    {
+      gfc_error ("Syntax error in IF-expression at %C");
+      gfc_free_expr (expr);
+      return MATCH_ERROR;
+    }
+
+  m = gfc_match (" %l , %l , %l%t", &l1, &l2, &l3);
+
+  if (m == MATCH_YES)
+    {
+      if (n == MATCH_YES)
+	{
+	  gfc_error ("Block label not appropriate for arithmetic IF "
+		     "statement at %C");
+	  gfc_free_expr (expr);
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_reference_st_label (l1, ST_LABEL_TARGET) == FAILURE
+	  || gfc_reference_st_label (l2, ST_LABEL_TARGET) == FAILURE
+	  || gfc_reference_st_label (l3, ST_LABEL_TARGET) == FAILURE)
+	{
+	  gfc_free_expr (expr);
+	  return MATCH_ERROR;
+	}
+      
+      if (gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: Arithmetic IF "
+			  "statement at %C") == FAILURE)
+	return MATCH_ERROR;
+
+      new_st.op = EXEC_ARITHMETIC_IF;
+      new_st.expr1 = expr;
+      new_st.label1 = l1;
+      new_st.label2 = l2;
+      new_st.label3 = l3;
+
+      *if_type = ST_ARITHMETIC_IF;
+      return MATCH_YES;
+    }
+
+  if (gfc_match (" then%t") == MATCH_YES)
+    {
+      new_st.op = EXEC_IF;
+      new_st.expr1 = expr;
+      *if_type = ST_IF_BLOCK;
+      return MATCH_YES;
+    }
+
+  if (n == MATCH_YES)
+    {
+      gfc_error ("Block label is not appropriate for IF statement at %C");
+      gfc_free_expr (expr);
+      return MATCH_ERROR;
+    }
+
+  /* At this point the only thing left is a simple IF statement.  At
+     this point, n has to be MATCH_NO, so we don't have to worry about
+     re-matching a block label.  From what we've got so far, try
+     matching an assignment.  */
+
+  *if_type = ST_SIMPLE_IF;
+
+  m = gfc_match_assignment ();
+  if (m == MATCH_YES)
+    goto got_match;
+
+  gfc_free_expr (expr);
+  gfc_undo_symbols ();
+  gfc_current_locus = old_loc;
+
+  /* m can be MATCH_NO or MATCH_ERROR, here.  For MATCH_ERROR, a mangled
+     assignment was found.  For MATCH_NO, continue to call the various
+     matchers.  */
+  if (m == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  gfc_match (" if ( %e ) ", &expr);	/* Guaranteed to match.  */
+
+  m = gfc_match_pointer_assignment ();
+  if (m == MATCH_YES)
+    goto got_match;
+
+  gfc_free_expr (expr);
+  gfc_undo_symbols ();
+  gfc_current_locus = old_loc;
+
+  gfc_match (" if ( %e ) ", &expr);	/* Guaranteed to match.  */
+
+  /* Look at the next keyword to see which matcher to call.  Matching
+     the keyword doesn't affect the symbol table, so we don't have to
+     restore between tries.  */
+
+#define match(string, subr, statement) \
+  if (gfc_match(string) == MATCH_YES) { m = subr(); goto got_match; }
+
+  gfc_clear_error ();
+
+  match ("allocate", gfc_match_allocate, ST_ALLOCATE)
+  match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT)
+  match ("backspace", gfc_match_backspace, ST_BACKSPACE)
+  match ("call", gfc_match_call, ST_CALL)
+  match ("close", gfc_match_close, ST_CLOSE)
+  match ("continue", gfc_match_continue, ST_CONTINUE)
+  match ("cycle", gfc_match_cycle, ST_CYCLE)
+  match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE)
+  match ("end file", gfc_match_endfile, ST_END_FILE)
+  match ("error stop", gfc_match_error_stop, ST_ERROR_STOP)
+  match ("exit", gfc_match_exit, ST_EXIT)
+  match ("flush", gfc_match_flush, ST_FLUSH)
+  match ("forall", match_simple_forall, ST_FORALL)
+  match ("go to", gfc_match_goto, ST_GOTO)
+  match ("if", match_arithmetic_if, ST_ARITHMETIC_IF)
+  match ("inquire", gfc_match_inquire, ST_INQUIRE)
+  match ("nullify", gfc_match_nullify, ST_NULLIFY)
+  match ("open", gfc_match_open, ST_OPEN)
+  match ("pause", gfc_match_pause, ST_NONE)
+  match ("print", gfc_match_print, ST_WRITE)
+  match ("read", gfc_match_read, ST_READ)
+  match ("return", gfc_match_return, ST_RETURN)
+  match ("rewind", gfc_match_rewind, ST_REWIND)
+  match ("stop", gfc_match_stop, ST_STOP)
+  match ("wait", gfc_match_wait, ST_WAIT)
+  match ("sync all", gfc_match_sync_all, ST_SYNC_CALL);
+  match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
+  match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
+  match ("where", match_simple_where, ST_WHERE)
+  match ("write", gfc_match_write, ST_WRITE)
+
+  /* The gfc_match_assignment() above may have returned a MATCH_NO
+     where the assignment was to a named constant.  Check that 
+     special case here.  */
+  m = gfc_match_assignment ();
+  if (m == MATCH_NO)
+   {
+      gfc_error ("Cannot assign to a named constant at %C");
+      gfc_free_expr (expr);
+      gfc_undo_symbols ();
+      gfc_current_locus = old_loc;
+      return MATCH_ERROR;
+   }
+
+  /* All else has failed, so give up.  See if any of the matchers has
+     stored an error message of some sort.  */
+  if (gfc_error_check () == 0)
+    gfc_error ("Unclassifiable statement in IF-clause at %C");
+
+  gfc_free_expr (expr);
+  return MATCH_ERROR;
+
+got_match:
+  if (m == MATCH_NO)
+    gfc_error ("Syntax error in IF-clause at %C");
+  if (m != MATCH_YES)
+    {
+      gfc_free_expr (expr);
+      return MATCH_ERROR;
+    }
+
+  /* At this point, we've matched the single IF and the action clause
+     is in new_st.  Rearrange things so that the IF statement appears
+     in new_st.  */
+
+  p = gfc_get_code ();
+  p->next = gfc_get_code ();
+  *p->next = new_st;
+  p->next->loc = gfc_current_locus;
+
+  p->expr1 = expr;
+  p->op = EXEC_IF;
+
+  gfc_clear_new_st ();
+
+  new_st.op = EXEC_IF;
+  new_st.block = p;
+
+  return MATCH_YES;
+}
+
+#undef match
+
+
+/* Match an ELSE statement.  */
+
+match
+gfc_match_else (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+
+  if (gfc_match_eos () == MATCH_YES)
+    return MATCH_YES;
+
+  if (gfc_match_name (name) != MATCH_YES
+      || gfc_current_block () == NULL
+      || gfc_match_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after ELSE statement at %C");
+      return MATCH_ERROR;
+    }
+
+  if (strcmp (name, gfc_current_block ()->name) != 0)
+    {
+      gfc_error ("Label '%s' at %C doesn't match IF label '%s'",
+		 name, gfc_current_block ()->name);
+      return MATCH_ERROR;
+    }
+
+  return MATCH_YES;
+}
+
+
+/* Match an ELSE IF statement.  */
+
+match
+gfc_match_elseif (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_expr *expr;
+  match m;
+
+  m = gfc_match (" ( %e ) then", &expr);
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_match_eos () == MATCH_YES)
+    goto done;
+
+  if (gfc_match_name (name) != MATCH_YES
+      || gfc_current_block () == NULL
+      || gfc_match_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after ELSE IF statement at %C");
+      goto cleanup;
+    }
+
+  if (strcmp (name, gfc_current_block ()->name) != 0)
+    {
+      gfc_error ("Label '%s' at %C doesn't match IF label '%s'",
+		 name, gfc_current_block ()->name);
+      goto cleanup;
+    }
+
+done:
+  new_st.op = EXEC_IF;
+  new_st.expr1 = expr;
+  return MATCH_YES;
+
+cleanup:
+  gfc_free_expr (expr);
+  return MATCH_ERROR;
+}
+
+
+/* Free a gfc_iterator structure.  */
+
+void
+gfc_free_iterator (gfc_iterator *iter, int flag)
+{
+
+  if (iter == NULL)
+    return;
+
+  gfc_free_expr (iter->var);
+  gfc_free_expr (iter->start);
+  gfc_free_expr (iter->end);
+  gfc_free_expr (iter->step);
+
+  if (flag)
+    gfc_free (iter);
+}
+
+
+/* Match a CRITICAL statement.  */
+match
+gfc_match_critical (void)
+{
+  gfc_st_label *label = NULL;
+
+  if (gfc_match_label () == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  if (gfc_match (" critical") != MATCH_YES)
+    return MATCH_NO;
+
+  if (gfc_match_st_label (&label) == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      gfc_syntax_error (ST_CRITICAL);
+      return MATCH_ERROR;
+    }
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("Image control statement CRITICAL at %C in PURE procedure");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: CRITICAL statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
+    {
+       gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
+       return MATCH_ERROR;
+    }
+
+  if (gfc_find_state (COMP_CRITICAL) == SUCCESS)
+    {
+      gfc_error ("Nested CRITICAL block at %C");
+      return MATCH_ERROR;
+    }
+
+  new_st.op = EXEC_CRITICAL;
+
+  if (label != NULL
+      && gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
+    return MATCH_ERROR;
+
+  return MATCH_YES;
+}
+
+
+/* Match a BLOCK statement.  */
+
+match
+gfc_match_block (void)
+{
+  match m;
+
+  if (gfc_match_label () == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  if (gfc_match (" block") != MATCH_YES)
+    return MATCH_NO;
+
+  /* For this to be a correct BLOCK statement, the line must end now.  */
+  m = gfc_match_eos ();
+  if (m == MATCH_ERROR)
+    return MATCH_ERROR;
+  if (m == MATCH_NO)
+    return MATCH_NO;
+
+  return MATCH_YES;
+}
+
+
+/* Match an ASSOCIATE statement.  */
+
+match
+gfc_match_associate (void)
+{
+  if (gfc_match_label () == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  if (gfc_match (" associate") != MATCH_YES)
+    return MATCH_NO;
+
+  /* Match the association list.  */
+  if (gfc_match_char ('(') != MATCH_YES)
+    {
+      gfc_error ("Expected association list at %C");
+      return MATCH_ERROR;
+    }
+  new_st.ext.block.assoc = NULL;
+  while (true)
+    {
+      gfc_association_list* newAssoc = gfc_get_association_list ();
+      gfc_association_list* a;
+
+      /* Match the next association.  */
+      if (gfc_match (" %n => %e", newAssoc->name, &newAssoc->target)
+	    != MATCH_YES)
+	{
+	  gfc_error ("Expected association at %C");
+	  goto assocListError;
+	}
+      newAssoc->where = gfc_current_locus;
+
+      /* Check that the current name is not yet in the list.  */
+      for (a = new_st.ext.block.assoc; a; a = a->next)
+	if (!strcmp (a->name, newAssoc->name))
+	  {
+	    gfc_error ("Duplicate name '%s' in association at %C",
+		       newAssoc->name);
+	    goto assocListError;
+	  }
+
+      /* The target expression must not be coindexed.  */
+      if (gfc_is_coindexed (newAssoc->target))
+	{
+	  gfc_error ("Association target at %C must not be coindexed");
+	  goto assocListError;
+	}
+
+      /* The `variable' field is left blank for now; because the target is not
+	 yet resolved, we can't use gfc_has_vector_subscript to determine it
+	 for now.  This is set during resolution.  */
+
+      /* Put it into the list.  */
+      newAssoc->next = new_st.ext.block.assoc;
+      new_st.ext.block.assoc = newAssoc;
+
+      /* Try next one or end if closing parenthesis is found.  */
+      gfc_gobble_whitespace ();
+      if (gfc_peek_char () == ')')
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	{
+	  gfc_error ("Expected ')' or ',' at %C");
+	  return MATCH_ERROR;
+	}
+
+      continue;
+
+assocListError:
+      gfc_free (newAssoc);
+      goto error;
+    }
+  if (gfc_match_char (')') != MATCH_YES)
+    {
+      /* This should never happen as we peek above.  */
+      gcc_unreachable ();
+    }
+
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      gfc_error ("Junk after ASSOCIATE statement at %C");
+      goto error;
+    }
+
+  return MATCH_YES;
+
+error:
+  gfc_free_association_list (new_st.ext.block.assoc);
+  return MATCH_ERROR;
+}
+
+
+/* Match a DO statement.  */
+
+match
+gfc_match_do (void)
+{
+  gfc_iterator iter, *ip;
+  locus old_loc;
+  gfc_st_label *label;
+  match m;
+
+  old_loc = gfc_current_locus;
+
+  label = NULL;
+  iter.var = iter.start = iter.end = iter.step = NULL;
+
+  m = gfc_match_label ();
+  if (m == MATCH_ERROR)
+    return m;
+
+  if (gfc_match (" do") != MATCH_YES)
+    return MATCH_NO;
+
+  m = gfc_match_st_label (&label);
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  /* Match an infinite DO, make it like a DO WHILE(.TRUE.).  */
+
+  if (gfc_match_eos () == MATCH_YES)
+    {
+      iter.end = gfc_get_logical_expr (gfc_default_logical_kind, NULL, true);
+      new_st.op = EXEC_DO_WHILE;
+      goto done;
+    }
+
+  /* Match an optional comma, if no comma is found, a space is obligatory.  */
+  if (gfc_match_char (',') != MATCH_YES && gfc_match ("% ") != MATCH_YES)
+    return MATCH_NO;
+
+  /* Check for balanced parens.  */
+  
+  if (gfc_match_parens () == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  /* See if we have a DO WHILE.  */
+  if (gfc_match (" while ( %e )%t", &iter.end) == MATCH_YES)
+    {
+      new_st.op = EXEC_DO_WHILE;
+      goto done;
+    }
+
+  /* The abortive DO WHILE may have done something to the symbol
+     table, so we start over.  */
+  gfc_undo_symbols ();
+  gfc_current_locus = old_loc;
+
+  gfc_match_label ();		/* This won't error.  */
+  gfc_match (" do ");		/* This will work.  */
+
+  gfc_match_st_label (&label);	/* Can't error out.  */
+  gfc_match_char (',');		/* Optional comma.  */
+
+  m = gfc_match_iterator (&iter, 0);
+  if (m == MATCH_NO)
+    return MATCH_NO;
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  iter.var->symtree->n.sym->attr.implied_index = 0;
+  gfc_check_do_variable (iter.var->symtree);
+
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      gfc_syntax_error (ST_DO);
+      goto cleanup;
+    }
+
+  new_st.op = EXEC_DO;
+
+done:
+  if (label != NULL
+      && gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
+    goto cleanup;
+
+  new_st.label1 = label;
+
+  if (new_st.op == EXEC_DO_WHILE)
+    new_st.expr1 = iter.end;
+  else
+    {
+      new_st.ext.iterator = ip = gfc_get_iterator ();
+      *ip = iter;
+    }
+
+  return MATCH_YES;
+
+cleanup:
+  gfc_free_iterator (&iter, 0);
+
+  return MATCH_ERROR;
+}
+
+
+/* Match an EXIT or CYCLE statement.  */
+
+static match
+match_exit_cycle (gfc_statement st, gfc_exec_op op)
+{
+  gfc_state_data *p, *o;
+  gfc_symbol *sym;
+  match m;
+  int cnt;
+
+  if (gfc_match_eos () == MATCH_YES)
+    sym = NULL;
+  else
+    {
+      char name[GFC_MAX_SYMBOL_LEN + 1];
+      gfc_symtree* stree;
+
+      m = gfc_match ("% %n%t", name);
+      if (m == MATCH_ERROR)
+	return MATCH_ERROR;
+      if (m == MATCH_NO)
+	{
+	  gfc_syntax_error (st);
+	  return MATCH_ERROR;
+	}
+
+      /* Find the corresponding symbol.  If there's a BLOCK statement
+	 between here and the label, it is not in gfc_current_ns but a parent
+	 namespace!  */
+      stree = gfc_find_symtree_in_proc (name, gfc_current_ns);
+      if (!stree)
+	{
+	  gfc_error ("Name '%s' in %s statement at %C is unknown",
+		     name, gfc_ascii_statement (st));
+	  return MATCH_ERROR;
+	}
+
+      sym = stree->n.sym;
+      if (sym->attr.flavor != FL_LABEL)
+	{
+	  gfc_error ("Name '%s' in %s statement at %C is not a construct name",
+		     name, gfc_ascii_statement (st));
+	  return MATCH_ERROR;
+	}
+    }
+
+  /* Find the loop specified by the label (or lack of a label).  */
+  for (o = NULL, p = gfc_state_stack; p; p = p->previous)
+    if (o == NULL && p->state == COMP_OMP_STRUCTURED_BLOCK)
+      o = p;
+    else if (p->state == COMP_CRITICAL)
+      {
+	gfc_error("%s statement at %C leaves CRITICAL construct",
+		  gfc_ascii_statement (st));
+	return MATCH_ERROR;
+      }
+    else if ((sym && sym == p->sym) || (!sym && p->state == COMP_DO))
+      break;
+
+  if (p == NULL)
+    {
+      if (sym == NULL)
+	gfc_error ("%s statement at %C is not within a construct",
+		   gfc_ascii_statement (st));
+      else
+	gfc_error ("%s statement at %C is not within construct '%s'",
+		   gfc_ascii_statement (st), sym->name);
+
+      return MATCH_ERROR;
+    }
+
+  /* Special checks for EXIT from non-loop constructs.  */
+  switch (p->state)
+    {
+    case COMP_DO:
+      break;
+
+    case COMP_CRITICAL:
+      /* This is already handled above.  */
+      gcc_unreachable ();
+
+    case COMP_ASSOCIATE:
+    case COMP_BLOCK:
+    case COMP_IF:
+    case COMP_SELECT:
+    case COMP_SELECT_TYPE:
+      gcc_assert (sym);
+      if (op == EXEC_CYCLE)
+	{
+	  gfc_error ("CYCLE statement at %C is not applicable to non-loop"
+		     " construct '%s'", sym->name);
+	  return MATCH_ERROR;
+	}
+      gcc_assert (op == EXEC_EXIT);
+      if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: EXIT statement with no"
+			  " do-construct-name at %C") == FAILURE)
+	return MATCH_ERROR;
+      break;
+      
+    default:
+      gfc_error ("%s statement at %C is not applicable to construct '%s'",
+		 gfc_ascii_statement (st), sym->name);
+      return MATCH_ERROR;
+    }
+
+  if (o != NULL)
+    {
+      gfc_error ("%s statement at %C leaving OpenMP structured block",
+		 gfc_ascii_statement (st));
+      return MATCH_ERROR;
+    }
+
+  for (o = p, cnt = 0; o->state == COMP_DO && o->previous != NULL; cnt++)
+    o = o->previous;
+  if (cnt > 0
+      && o != NULL
+      && o->state == COMP_OMP_STRUCTURED_BLOCK
+      && (o->head->op == EXEC_OMP_DO
+	  || o->head->op == EXEC_OMP_PARALLEL_DO))
+    {
+      int collapse = 1;
+      gcc_assert (o->head->next != NULL
+		  && (o->head->next->op == EXEC_DO
+		      || o->head->next->op == EXEC_DO_WHILE)
+		  && o->previous != NULL
+		  && o->previous->tail->op == o->head->op);
+      if (o->previous->tail->ext.omp_clauses != NULL
+	  && o->previous->tail->ext.omp_clauses->collapse > 1)
+	collapse = o->previous->tail->ext.omp_clauses->collapse;
+      if (st == ST_EXIT && cnt <= collapse)
+	{
+	  gfc_error ("EXIT statement at %C terminating !$OMP DO loop");
+	  return MATCH_ERROR;
+	}
+      if (st == ST_CYCLE && cnt < collapse)
+	{
+	  gfc_error ("CYCLE statement at %C to non-innermost collapsed"
+		     " !$OMP DO loop");
+	  return MATCH_ERROR;
+	}
+    }
+
+  /* Save the first statement in the construct - needed by the backend.  */
+  new_st.ext.which_construct = p->construct;
+
+  new_st.op = op;
+
+  return MATCH_YES;
+}
+
+
+/* Match the EXIT statement.  */
+
+match
+gfc_match_exit (void)
+{
+  return match_exit_cycle (ST_EXIT, EXEC_EXIT);
+}
+
+
+/* Match the CYCLE statement.  */
+
+match
+gfc_match_cycle (void)
+{
+  return match_exit_cycle (ST_CYCLE, EXEC_CYCLE);
+}
+
+
+/* Match a number or character constant after an (ALL) STOP or PAUSE statement.  */
+
+static match
+gfc_match_stopcode (gfc_statement st)
+{
+  gfc_expr *e;
+  match m;
+
+  e = NULL;
+
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      m = gfc_match_init_expr (&e);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      if (gfc_match_eos () != MATCH_YES)
+	goto syntax;
+    }
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("%s statement not allowed in PURE procedure at %C",
+		 gfc_ascii_statement (st));
+      goto cleanup;
+    }
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  if (st == ST_STOP && gfc_find_state (COMP_CRITICAL) == SUCCESS)
+    {
+      gfc_error ("Image control statement STOP at %C in CRITICAL block");
+      goto cleanup;
+    }
+
+  if (e != NULL)
+    {
+      if (!(e->ts.type == BT_CHARACTER || e->ts.type == BT_INTEGER))
+	{
+	  gfc_error ("STOP code at %L must be either INTEGER or CHARACTER type",
+		     &e->where);
+	  goto cleanup;
+	}
+
+      if (e->rank != 0)
+	{
+	  gfc_error ("STOP code at %L must be scalar",
+		     &e->where);
+	  goto cleanup;
+	}
+
+      if (e->ts.type == BT_CHARACTER
+	  && e->ts.kind != gfc_default_character_kind)
+	{
+	  gfc_error ("STOP code at %L must be default character KIND=%d",
+		     &e->where, (int) gfc_default_character_kind);
+	  goto cleanup;
+	}
+
+      if (e->ts.type == BT_INTEGER
+	  && e->ts.kind != gfc_default_integer_kind)
+	{
+	  gfc_error ("STOP code at %L must be default integer KIND=%d",
+		     &e->where, (int) gfc_default_integer_kind);
+	  goto cleanup;
+	}
+    }
+
+  switch (st)
+    {
+    case ST_STOP:
+      new_st.op = EXEC_STOP;
+      break;
+    case ST_ERROR_STOP:
+      new_st.op = EXEC_ERROR_STOP;
+      break;
+    case ST_PAUSE:
+      new_st.op = EXEC_PAUSE;
+      break;
+    default:
+      gcc_unreachable ();
+    }
+
+  new_st.expr1 = e;
+  new_st.ext.stop_code = -1;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (st);
+
+cleanup:
+
+  gfc_free_expr (e);
+  return MATCH_ERROR;
+}
+
+
+/* Match the (deprecated) PAUSE statement.  */
+
+match
+gfc_match_pause (void)
+{
+  match m;
+
+  m = gfc_match_stopcode (ST_PAUSE);
+  if (m == MATCH_YES)
+    {
+      if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: PAUSE statement"
+	  " at %C")
+	  == FAILURE)
+	m = MATCH_ERROR;
+    }
+  return m;
+}
+
+
+/* Match the STOP statement.  */
+
+match
+gfc_match_stop (void)
+{
+  return gfc_match_stopcode (ST_STOP);
+}
+
+
+/* Match the ERROR STOP statement.  */
+
+match
+gfc_match_error_stop (void)
+{
+  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: ERROR STOP statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  return gfc_match_stopcode (ST_ERROR_STOP);
+}
+
+
+/* Match SYNC ALL/IMAGES/MEMORY statement. Syntax:
+     SYNC ALL [(sync-stat-list)]
+     SYNC MEMORY [(sync-stat-list)]
+     SYNC IMAGES (image-set [, sync-stat-list] )
+   with sync-stat is int-expr or *.  */
+
+static match
+sync_statement (gfc_statement st)
+{
+  match m;
+  gfc_expr *tmp, *imageset, *stat, *errmsg;
+  bool saw_stat, saw_errmsg;
+
+  tmp = imageset = stat = errmsg = NULL;
+  saw_stat = saw_errmsg = false;
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("Image control statement SYNC at %C in PURE procedure");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: SYNC statement at %C")
+      == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
+    {
+       gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
+       return MATCH_ERROR;
+    }
+
+  if (gfc_find_state (COMP_CRITICAL) == SUCCESS)
+    {
+      gfc_error ("Image control statement SYNC at %C in CRITICAL block");
+      return MATCH_ERROR;
+    }
+	
+  if (gfc_match_eos () == MATCH_YES)
+    {
+      if (st == ST_SYNC_IMAGES)
+	goto syntax;
+      goto done;
+    }
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    goto syntax;
+
+  if (st == ST_SYNC_IMAGES)
+    {
+      /* Denote '*' as imageset == NULL.  */
+      m = gfc_match_char ('*');
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_NO)
+	{
+	  if (gfc_match ("%e", &imageset) != MATCH_YES)
+	    goto syntax;
+	}
+      m = gfc_match_char (',');
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_NO)
+	{
+	  m = gfc_match_char (')');
+	  if (m == MATCH_YES)
+	    goto done;
+	  goto syntax;
+	}
+    }
+
+  for (;;)
+    {
+      m = gfc_match (" stat = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_stat)
+	    {
+	      gfc_error ("Redundant STAT tag found at %L ", &tmp->where);
+	      goto cleanup;
+	    }
+	  stat = tmp;
+	  saw_stat = true;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    continue;
+	}
+
+      m = gfc_match (" errmsg = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto syntax;
+      if (m == MATCH_YES)
+	{
+	  if (saw_errmsg)
+	    {
+	      gfc_error ("Redundant ERRMSG tag found at %L ", &tmp->where);
+	      goto cleanup;
+	    }
+	  errmsg = tmp;
+	  saw_errmsg = true;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    continue;
+	}
+
+      gfc_gobble_whitespace ();
+
+      if (gfc_peek_char () == ')')
+	break;
+
+      goto syntax;
+    }
+
+  if (gfc_match (" )%t") != MATCH_YES)
+    goto syntax;
+
+done:
+  switch (st)
+    {
+    case ST_SYNC_ALL:
+      new_st.op = EXEC_SYNC_ALL;
+      break;
+    case ST_SYNC_IMAGES:
+      new_st.op = EXEC_SYNC_IMAGES;
+      break;
+    case ST_SYNC_MEMORY:
+      new_st.op = EXEC_SYNC_MEMORY;
+      break;
+    default:
+      gcc_unreachable ();
+    }
+
+  new_st.expr1 = imageset;
+  new_st.expr2 = stat;
+  new_st.expr3 = errmsg;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (st);
+
+cleanup:
+  gfc_free_expr (tmp);
+  gfc_free_expr (imageset);
+  gfc_free_expr (stat);
+  gfc_free_expr (errmsg);
+
+  return MATCH_ERROR;
+}
+
+
+/* Match SYNC ALL statement.  */
+
+match
+gfc_match_sync_all (void)
+{
+  return sync_statement (ST_SYNC_ALL);
+}
+
+
+/* Match SYNC IMAGES statement.  */
+
+match
+gfc_match_sync_images (void)
+{
+  return sync_statement (ST_SYNC_IMAGES);
+}
+
+
+/* Match SYNC MEMORY statement.  */
+
+match
+gfc_match_sync_memory (void)
+{
+  return sync_statement (ST_SYNC_MEMORY);
+}
+
+
+/* Match a CONTINUE statement.  */
+
+match
+gfc_match_continue (void)
+{
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      gfc_syntax_error (ST_CONTINUE);
+      return MATCH_ERROR;
+    }
+
+  new_st.op = EXEC_CONTINUE;
+  return MATCH_YES;
+}
+
+
+/* Match the (deprecated) ASSIGN statement.  */
+
+match
+gfc_match_assign (void)
+{
+  gfc_expr *expr;
+  gfc_st_label *label;
+
+  if (gfc_match (" %l", &label) == MATCH_YES)
+    {
+      if (gfc_reference_st_label (label, ST_LABEL_UNKNOWN) == FAILURE)
+	return MATCH_ERROR;
+      if (gfc_match (" to %v%t", &expr) == MATCH_YES)
+	{
+	  if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: ASSIGN "
+			      "statement at %C")
+	      == FAILURE)
+	    return MATCH_ERROR;
+
+	  expr->symtree->n.sym->attr.assign = 1;
+
+	  new_st.op = EXEC_LABEL_ASSIGN;
+	  new_st.label1 = label;
+	  new_st.expr1 = expr;
+	  return MATCH_YES;
+	}
+    }
+  return MATCH_NO;
+}
+
+
+/* Match the GO TO statement.  As a computed GOTO statement is
+   matched, it is transformed into an equivalent SELECT block.  No
+   tree is necessary, and the resulting jumps-to-jumps are
+   specifically optimized away by the back end.  */
+
+match
+gfc_match_goto (void)
+{
+  gfc_code *head, *tail;
+  gfc_expr *expr;
+  gfc_case *cp;
+  gfc_st_label *label;
+  int i;
+  match m;
+
+  if (gfc_match (" %l%t", &label) == MATCH_YES)
+    {
+      if (gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
+	return MATCH_ERROR;
+
+      new_st.op = EXEC_GOTO;
+      new_st.label1 = label;
+      return MATCH_YES;
+    }
+
+  /* The assigned GO TO statement.  */ 
+
+  if (gfc_match_variable (&expr, 0) == MATCH_YES)
+    {
+      if (gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: Assigned GOTO "
+			  "statement at %C")
+	  == FAILURE)
+	return MATCH_ERROR;
+
+      new_st.op = EXEC_GOTO;
+      new_st.expr1 = expr;
+
+      if (gfc_match_eos () == MATCH_YES)
+	return MATCH_YES;
+
+      /* Match label list.  */
+      gfc_match_char (',');
+      if (gfc_match_char ('(') != MATCH_YES)
+	{
+	  gfc_syntax_error (ST_GOTO);
+	  return MATCH_ERROR;
+	}
+      head = tail = NULL;
+
+      do
+	{
+	  m = gfc_match_st_label (&label);
+	  if (m != MATCH_YES)
+	    goto syntax;
+
+	  if (gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
+	    goto cleanup;
+
+	  if (head == NULL)
+	    head = tail = gfc_get_code ();
+	  else
+	    {
+	      tail->block = gfc_get_code ();
+	      tail = tail->block;
+	    }
+
+	  tail->label1 = label;
+	  tail->op = EXEC_GOTO;
+	}
+      while (gfc_match_char (',') == MATCH_YES);
+
+      if (gfc_match (")%t") != MATCH_YES)
+	goto syntax;
+
+      if (head == NULL)
+	{
+	   gfc_error ("Statement label list in GOTO at %C cannot be empty");
+	   goto syntax;
+	}
+      new_st.block = head;
+
+      return MATCH_YES;
+    }
+
+  /* Last chance is a computed GO TO statement.  */
+  if (gfc_match_char ('(') != MATCH_YES)
+    {
+      gfc_syntax_error (ST_GOTO);
+      return MATCH_ERROR;
+    }
+
+  head = tail = NULL;
+  i = 1;
+
+  do
+    {
+      m = gfc_match_st_label (&label);
+      if (m != MATCH_YES)
+	goto syntax;
+
+      if (gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
+	goto cleanup;
+
+      if (head == NULL)
+	head = tail = gfc_get_code ();
+      else
+	{
+	  tail->block = gfc_get_code ();
+	  tail = tail->block;
+	}
+
+      cp = gfc_get_case ();
+      cp->low = cp->high = gfc_get_int_expr (gfc_default_integer_kind,
+					     NULL, i++);
+
+      tail->op = EXEC_SELECT;
+      tail->ext.block.case_list = cp;
+
+      tail->next = gfc_get_code ();
+      tail->next->op = EXEC_GOTO;
+      tail->next->label1 = label;
+    }
+  while (gfc_match_char (',') == MATCH_YES);
+
+  if (gfc_match_char (')') != MATCH_YES)
+    goto syntax;
+
+  if (head == NULL)
+    {
+      gfc_error ("Statement label list in GOTO at %C cannot be empty");
+      goto syntax;
+    }
+
+  /* Get the rest of the statement.  */
+  gfc_match_char (',');
+
+  if (gfc_match (" %e%t", &expr) != MATCH_YES)
+    goto syntax;
+
+  if (gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: Computed GOTO "
+		      "at %C") == FAILURE)
+    return MATCH_ERROR;
+
+  /* At this point, a computed GOTO has been fully matched and an
+     equivalent SELECT statement constructed.  */
+
+  new_st.op = EXEC_SELECT;
+  new_st.expr1 = NULL;
+
+  /* Hack: For a "real" SELECT, the expression is in expr. We put
+     it in expr2 so we can distinguish then and produce the correct
+     diagnostics.  */
+  new_st.expr2 = expr;
+  new_st.block = head;
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_GOTO);
+cleanup:
+  gfc_free_statements (head);
+  return MATCH_ERROR;
+}
+
+
+/* Frees a list of gfc_alloc structures.  */
+
+void
+gfc_free_alloc_list (gfc_alloc *p)
+{
+  gfc_alloc *q;
+
+  for (; p; p = q)
+    {
+      q = p->next;
+      gfc_free_expr (p->expr);
+      gfc_free (p);
+    }
+}
+
+
+/* Match a Fortran 2003 derived-type-spec (F03:R455), which is just the name of
+   an accessible derived type.  */
+
+static match
+match_derived_type_spec (gfc_typespec *ts)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  locus old_locus; 
+  gfc_symbol *derived;
+
+  old_locus = gfc_current_locus;
+
+  if (gfc_match ("%n", name) != MATCH_YES)
+    {
+       gfc_current_locus = old_locus;
+       return MATCH_NO;
+    }
+
+  gfc_find_symbol (name, NULL, 1, &derived);
+
+  if (derived && derived->attr.flavor == FL_DERIVED)
+    {
+      ts->type = BT_DERIVED;
+      ts->u.derived = derived;
+      return MATCH_YES;
+    }
+
+  gfc_current_locus = old_locus; 
+  return MATCH_NO;
+}
+
+
+/* Match a Fortran 2003 type-spec (F03:R401).  This is similar to
+   gfc_match_decl_type_spec() from decl.c, with the following exceptions:
+   It only includes the intrinsic types from the Fortran 2003 standard
+   (thus, neither BYTE nor forms like REAL*4 are allowed). Additionally,
+   the implicit_flag is not needed, so it was removed. Derived types are
+   identified by their name alone.  */
+
+static match
+match_type_spec (gfc_typespec *ts)
+{
+  match m;
+  locus old_locus;
+
+  gfc_clear_ts (ts);
+  gfc_gobble_whitespace ();
+  old_locus = gfc_current_locus;
+
+  if (match_derived_type_spec (ts) == MATCH_YES)
+    {
+      /* Enforce F03:C401.  */
+      if (ts->u.derived->attr.abstract)
+	{
+	  gfc_error ("Derived type '%s' at %L may not be ABSTRACT",
+		     ts->u.derived->name, &old_locus);
+	  return MATCH_ERROR;
+	}
+      return MATCH_YES;
+    }
+
+  if (gfc_match ("integer") == MATCH_YES)
+    {
+      ts->type = BT_INTEGER;
+      ts->kind = gfc_default_integer_kind;
+      goto kind_selector;
+    }
+
+  if (gfc_match ("real") == MATCH_YES)
+    {
+      ts->type = BT_REAL;
+      ts->kind = gfc_default_real_kind;
+      goto kind_selector;
+    }
+
+  if (gfc_match ("double precision") == MATCH_YES)
+    {
+      ts->type = BT_REAL;
+      ts->kind = gfc_default_double_kind;
+      return MATCH_YES;
+    }
+
+  if (gfc_match ("complex") == MATCH_YES)
+    {
+      ts->type = BT_COMPLEX;
+      ts->kind = gfc_default_complex_kind;
+      goto kind_selector;
+    }
+
+  if (gfc_match ("character") == MATCH_YES)
+    {
+      ts->type = BT_CHARACTER;
+
+      m = gfc_match_char_spec (ts);
+
+      if (m == MATCH_NO)
+	m = MATCH_YES;
+
+      return m;
+    }
+
+  if (gfc_match ("logical") == MATCH_YES)
+    {
+      ts->type = BT_LOGICAL;
+      ts->kind = gfc_default_logical_kind;
+      goto kind_selector;
+    }
+
+  /* If a type is not matched, simply return MATCH_NO.  */
+  gfc_current_locus = old_locus;
+  return MATCH_NO;
+
+kind_selector:
+
+  gfc_gobble_whitespace ();
+  if (gfc_peek_ascii_char () == '*')
+    {
+      gfc_error ("Invalid type-spec at %C");
+      return MATCH_ERROR;
+    }
+
+  m = gfc_match_kind_spec (ts, false);
+
+  if (m == MATCH_NO)
+    m = MATCH_YES;		/* No kind specifier found.  */
+
+  return m;
+}
+
+
+/* Match an ALLOCATE statement.  */
+
+match
+gfc_match_allocate (void)
+{
+  gfc_alloc *head, *tail;
+  gfc_expr *stat, *errmsg, *tmp, *source, *mold;
+  gfc_typespec ts;
+  gfc_symbol *sym;
+  match m;
+  locus old_locus, deferred_locus;
+  bool saw_stat, saw_errmsg, saw_source, saw_mold, saw_deferred, b1, b2, b3;
+
+  head = tail = NULL;
+  stat = errmsg = source = mold = tmp = NULL;
+  saw_stat = saw_errmsg = saw_source = saw_mold = saw_deferred = false;
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    goto syntax;
+
+  /* Match an optional type-spec.  */
+  old_locus = gfc_current_locus;
+  m = match_type_spec (&ts);
+  if (m == MATCH_ERROR)
+    goto cleanup;
+  else if (m == MATCH_NO)
+    {
+      char name[GFC_MAX_SYMBOL_LEN + 3];
+
+      if (gfc_match ("%n :: ", name) == MATCH_YES)
+	{
+	  gfc_error ("Error in type-spec at %L", &old_locus);
+	  goto cleanup;
+	}
+
+      ts.type = BT_UNKNOWN;
+    }
+  else
+    {
+      if (gfc_match (" :: ") == MATCH_YES)
+	{
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: typespec in "
+			      "ALLOCATE at %L", &old_locus) == FAILURE)
+	    goto cleanup;
+
+	  if (ts.deferred)
+	    {
+	      gfc_error ("Type-spec at %L cannot contain a deferred "
+			 "type parameter", &old_locus);
+	      goto cleanup;
+	    }
+	}
+      else
+	{
+	  ts.type = BT_UNKNOWN;
+	  gfc_current_locus = old_locus;
+	}
+    }
+
+  for (;;)
+    {
+      if (head == NULL)
+	head = tail = gfc_get_alloc ();
+      else
+	{
+	  tail->next = gfc_get_alloc ();
+	  tail = tail->next;
+	}
+
+      m = gfc_match_variable (&tail->expr, 0);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	goto cleanup;
+
+      if (gfc_check_do_variable (tail->expr->symtree))
+	goto cleanup;
+
+      if (gfc_pure (NULL) && gfc_impure_variable (tail->expr->symtree->n.sym))
+	{
+	  gfc_error ("Bad allocate-object at %C for a PURE procedure");
+	  goto cleanup;
+	}
+
+      if (gfc_implicit_pure (NULL)
+	    && gfc_impure_variable (tail->expr->symtree->n.sym))
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+      if (tail->expr->ts.deferred)
+	{
+	  saw_deferred = true;
+	  deferred_locus = tail->expr->where;
+	}
+
+      /* The ALLOCATE statement had an optional typespec.  Check the
+	 constraints.  */
+      if (ts.type != BT_UNKNOWN)
+	{
+	  /* Enforce F03:C624.  */
+	  if (!gfc_type_compatible (&tail->expr->ts, &ts))
+	    {
+	      gfc_error ("Type of entity at %L is type incompatible with "
+			 "typespec", &tail->expr->where);
+	      goto cleanup;
+	    }
+
+	  /* Enforce F03:C627.  */
+	  if (ts.kind != tail->expr->ts.kind)
+	    {
+	      gfc_error ("Kind type parameter for entity at %L differs from "
+			 "the kind type parameter of the typespec",
+			 &tail->expr->where);
+	      goto cleanup;
+	    }
+	}
+
+      if (tail->expr->ts.type == BT_DERIVED)
+	tail->expr->ts.u.derived = gfc_use_derived (tail->expr->ts.u.derived);
+
+      /* FIXME: disable the checking on derived types and arrays.  */
+      sym = tail->expr->symtree->n.sym;
+      b1 = !(tail->expr->ref
+	   && (tail->expr->ref->type == REF_COMPONENT
+		|| tail->expr->ref->type == REF_ARRAY));
+      if (sym && sym->ts.type == BT_CLASS && sym->attr.class_ok)
+	b2 = !(CLASS_DATA (sym)->attr.allocatable
+	       || CLASS_DATA (sym)->attr.class_pointer);
+      else
+	b2 = sym && !(sym->attr.allocatable || sym->attr.pointer
+		      || sym->attr.proc_pointer);
+      b3 = sym && sym->ns && sym->ns->proc_name
+	   && (sym->ns->proc_name->attr.allocatable
+		|| sym->ns->proc_name->attr.pointer
+		|| sym->ns->proc_name->attr.proc_pointer);
+      if (b1 && b2 && !b3)
+	{
+	  gfc_error ("Allocate-object at %L is not a nonprocedure pointer "
+		     "or an allocatable variable", &tail->expr->where);
+	  goto cleanup;
+	}
+
+      if (gfc_peek_ascii_char () == '(' && !sym->attr.dimension)
+	{
+	  gfc_error ("Shape specification for allocatable scalar at %C");
+	  goto cleanup;
+	}
+
+      if (gfc_match_char (',') != MATCH_YES)
+	break;
+
+alloc_opt_list:
+
+      m = gfc_match (" stat = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_YES)
+	{
+	  /* Enforce C630.  */
+	  if (saw_stat)
+	    {
+	      gfc_error ("Redundant STAT tag found at %L ", &tmp->where);
+	      goto cleanup;
+	    }
+
+	  stat = tmp;
+	  tmp = NULL;
+	  saw_stat = true;
+
+	  if (gfc_check_do_variable (stat->symtree))
+	    goto cleanup;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    goto alloc_opt_list;
+	}
+
+      m = gfc_match (" errmsg = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_YES)
+	{
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ERRMSG tag at %L",
+			      &tmp->where) == FAILURE)
+	    goto cleanup;
+
+	  /* Enforce C630.  */
+	  if (saw_errmsg)
+	    {
+	      gfc_error ("Redundant ERRMSG tag found at %L ", &tmp->where);
+	      goto cleanup;
+	    }
+
+	  errmsg = tmp;
+	  tmp = NULL;
+	  saw_errmsg = true;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    goto alloc_opt_list;
+	}
+
+      m = gfc_match (" source = %e", &tmp);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_YES)
+	{
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: SOURCE tag at %L",
+			      &tmp->where) == FAILURE)
+	    goto cleanup;
+
+	  /* Enforce C630.  */
+	  if (saw_source)
+	    {
+	      gfc_error ("Redundant SOURCE tag found at %L ", &tmp->where);
+	      goto cleanup;
+	    }
+
+	  /* The next 2 conditionals check C631.  */
+	  if (ts.type != BT_UNKNOWN)
+	    {
+	      gfc_error ("SOURCE tag at %L conflicts with the typespec at %L",
+			 &tmp->where, &old_locus);
+	      goto cleanup;
+	    }
+
+	  if (head->next)
+	    {
+ 	      gfc_error ("SOURCE tag at %L requires only a single entity in "
+			 "the allocation-list", &tmp->where);
+	      goto cleanup;
+            }
+
+	  source = tmp;
+	  tmp = NULL;
+	  saw_source = true;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    goto alloc_opt_list;
+	}
+
+      m = gfc_match (" mold = %e", &tmp);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_YES)
+	{
+	  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: MOLD tag at %L",
+			      &tmp->where) == FAILURE)
+	    goto cleanup;
+
+	  /* Check F08:C636.  */
+	  if (saw_mold)
+	    {
+	      gfc_error ("Redundant MOLD tag found at %L ", &tmp->where);
+	      goto cleanup;
+	    }
+  
+	  /* Check F08:C637.  */
+	  if (ts.type != BT_UNKNOWN)
+	    {
+	      gfc_error ("MOLD tag at %L conflicts with the typespec at %L",
+			 &tmp->where, &old_locus);
+	      goto cleanup;
+	    }
+
+	  mold = tmp;
+	  tmp = NULL;
+	  saw_mold = true;
+	  mold->mold = 1;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    goto alloc_opt_list;
+	}
+
+	gfc_gobble_whitespace ();
+
+	if (gfc_peek_char () == ')')
+	  break;
+    }
+
+  if (gfc_match (" )%t") != MATCH_YES)
+    goto syntax;
+
+  /* Check F08:C637.  */
+  if (source && mold)
+    {
+      gfc_error ("MOLD tag at %L conflicts with SOURCE tag at %L",
+		  &mold->where, &source->where);
+      goto cleanup;
+    }
+
+  /* Check F03:C623,  */
+  if (saw_deferred && ts.type == BT_UNKNOWN && !source && !mold)
+    {
+      gfc_error ("Allocate-object at %L with a deferred type parameter "
+		 "requires either a type-spec or SOURCE tag or a MOLD tag",
+		 &deferred_locus);
+      goto cleanup;
+    }
+  
+  new_st.op = EXEC_ALLOCATE;
+  new_st.expr1 = stat;
+  new_st.expr2 = errmsg;
+  if (source)
+    new_st.expr3 = source;
+  else
+    new_st.expr3 = mold;
+  new_st.ext.alloc.list = head;
+  new_st.ext.alloc.ts = ts;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_ALLOCATE);
+
+cleanup:
+  gfc_free_expr (errmsg);
+  gfc_free_expr (source);
+  gfc_free_expr (stat);
+  gfc_free_expr (mold);
+  if (tmp && tmp->expr_type) gfc_free_expr (tmp);
+  gfc_free_alloc_list (head);
+  return MATCH_ERROR;
+}
+
+
+/* Match a NULLIFY statement. A NULLIFY statement is transformed into
+   a set of pointer assignments to intrinsic NULL().  */
+
+match
+gfc_match_nullify (void)
+{
+  gfc_code *tail;
+  gfc_expr *e, *p;
+  match m;
+
+  tail = NULL;
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    goto syntax;
+
+  for (;;)
+    {
+      m = gfc_match_variable (&p, 0);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      if (gfc_check_do_variable (p->symtree))
+	goto cleanup;
+
+      /* build ' => NULL() '.  */
+      e = gfc_get_null_expr (&gfc_current_locus);
+
+      /* Chain to list.  */
+      if (tail == NULL)
+	tail = &new_st;
+      else
+	{
+	  tail->next = gfc_get_code ();
+	  tail = tail->next;
+	}
+
+      tail->op = EXEC_POINTER_ASSIGN;
+      tail->expr1 = p;
+      tail->expr2 = e;
+
+      if (gfc_match (" )%t") == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_NULLIFY);
+
+cleanup:
+  gfc_free_statements (new_st.next);
+  new_st.next = NULL;
+  gfc_free_expr (new_st.expr1);
+  new_st.expr1 = NULL;
+  gfc_free_expr (new_st.expr2);
+  new_st.expr2 = NULL;
+  return MATCH_ERROR;
+}
+
+
+/* Match a DEALLOCATE statement.  */
+
+match
+gfc_match_deallocate (void)
+{
+  gfc_alloc *head, *tail;
+  gfc_expr *stat, *errmsg, *tmp;
+  gfc_symbol *sym;
+  match m;
+  bool saw_stat, saw_errmsg, b1, b2;
+
+  head = tail = NULL;
+  stat = errmsg = tmp = NULL;
+  saw_stat = saw_errmsg = false;
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    goto syntax;
+
+  for (;;)
+    {
+      if (head == NULL)
+	head = tail = gfc_get_alloc ();
+      else
+	{
+	  tail->next = gfc_get_alloc ();
+	  tail = tail->next;
+	}
+
+      m = gfc_match_variable (&tail->expr, 0);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      if (gfc_check_do_variable (tail->expr->symtree))
+	goto cleanup;
+
+      sym = tail->expr->symtree->n.sym;
+
+      if (gfc_pure (NULL) && gfc_impure_variable (sym))
+	{
+	  gfc_error ("Illegal allocate-object at %C for a PURE procedure");
+	  goto cleanup;
+	}
+
+      if (gfc_implicit_pure (NULL) && gfc_impure_variable (sym))
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+      /* FIXME: disable the checking on derived types.  */
+      b1 = !(tail->expr->ref
+	   && (tail->expr->ref->type == REF_COMPONENT
+	       || tail->expr->ref->type == REF_ARRAY));
+      if (sym && sym->ts.type == BT_CLASS)
+	b2 = !(CLASS_DATA (sym)->attr.allocatable
+	       || CLASS_DATA (sym)->attr.class_pointer);
+      else
+	b2 = sym && !(sym->attr.allocatable || sym->attr.pointer
+		      || sym->attr.proc_pointer);
+      if (b1 && b2)
+	{
+	  gfc_error ("Allocate-object at %C is not a nonprocedure pointer "
+		     "or an allocatable variable");
+	  goto cleanup;
+	}
+
+      if (gfc_match_char (',') != MATCH_YES)
+	break;
+
+dealloc_opt_list:
+
+      m = gfc_match (" stat = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_YES)
+	{
+	  if (saw_stat)
+	    {
+	      gfc_error ("Redundant STAT tag found at %L ", &tmp->where);
+	      gfc_free_expr (tmp);
+	      goto cleanup;
+	    }
+
+	  stat = tmp;
+	  saw_stat = true;
+
+	  if (gfc_check_do_variable (stat->symtree))
+	    goto cleanup;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    goto dealloc_opt_list;
+	}
+
+      m = gfc_match (" errmsg = %v", &tmp);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_YES)
+	{
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ERRMSG at %L",
+			      &tmp->where) == FAILURE)
+	    goto cleanup;
+
+	  if (saw_errmsg)
+	    {
+	      gfc_error ("Redundant ERRMSG tag found at %L ", &tmp->where);
+	      gfc_free_expr (tmp);
+	      goto cleanup;
+	    }
+
+	  errmsg = tmp;
+	  saw_errmsg = true;
+
+	  if (gfc_match_char (',') == MATCH_YES)
+	    goto dealloc_opt_list;
+	}
+
+	gfc_gobble_whitespace ();
+
+	if (gfc_peek_char () == ')')
+	  break;
+    }
+
+  if (gfc_match (" )%t") != MATCH_YES)
+    goto syntax;
+
+  new_st.op = EXEC_DEALLOCATE;
+  new_st.expr1 = stat;
+  new_st.expr2 = errmsg;
+  new_st.ext.alloc.list = head;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_DEALLOCATE);
+
+cleanup:
+  gfc_free_expr (errmsg);
+  gfc_free_expr (stat);
+  gfc_free_alloc_list (head);
+  return MATCH_ERROR;
+}
+
+
+/* Match a RETURN statement.  */
+
+match
+gfc_match_return (void)
+{
+  gfc_expr *e;
+  match m;
+  gfc_compile_state s;
+
+  e = NULL;
+
+  if (gfc_find_state (COMP_CRITICAL) == SUCCESS)
+    {
+      gfc_error ("Image control statement RETURN at %C in CRITICAL block");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    goto done;
+
+  if (gfc_find_state (COMP_SUBROUTINE) == FAILURE)
+    {
+      gfc_error ("Alternate RETURN statement at %C is only allowed within "
+		 "a SUBROUTINE");
+      goto cleanup;
+    }
+
+  if (gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: Alternate RETURN "
+		      "at %C") == FAILURE)
+    return MATCH_ERROR;
+
+  if (gfc_current_form == FORM_FREE)
+    {
+      /* The following are valid, so we can't require a blank after the
+	RETURN keyword:
+	  return+1
+	  return(1)  */
+      char c = gfc_peek_ascii_char ();
+      if (ISALPHA (c) || ISDIGIT (c))
+	return MATCH_NO;
+    }
+
+  m = gfc_match (" %e%t", &e);
+  if (m == MATCH_YES)
+    goto done;
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  gfc_syntax_error (ST_RETURN);
+
+cleanup:
+  gfc_free_expr (e);
+  return MATCH_ERROR;
+
+done:
+  gfc_enclosing_unit (&s);
+  if (s == COMP_PROGRAM
+      && gfc_notify_std (GFC_STD_GNU, "Extension: RETURN statement in "
+			"main program at %C") == FAILURE)
+      return MATCH_ERROR;
+
+  new_st.op = EXEC_RETURN;
+  new_st.expr1 = e;
+
+  return MATCH_YES;
+}
+
+
+/* Match the call of a type-bound procedure, if CALL%var has already been 
+   matched and var found to be a derived-type variable.  */
+
+static match
+match_typebound_call (gfc_symtree* varst)
+{
+  gfc_expr* base;
+  match m;
+
+  base = gfc_get_expr ();
+  base->expr_type = EXPR_VARIABLE;
+  base->symtree = varst;
+  base->where = gfc_current_locus;
+  gfc_set_sym_referenced (varst->n.sym);
+  
+  m = gfc_match_varspec (base, 0, true, true);
+  if (m == MATCH_NO)
+    gfc_error ("Expected component reference at %C");
+  if (m != MATCH_YES)
+    return MATCH_ERROR;
+
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      gfc_error ("Junk after CALL at %C");
+      return MATCH_ERROR;
+    }
+
+  if (base->expr_type == EXPR_COMPCALL)
+    new_st.op = EXEC_COMPCALL;
+  else if (base->expr_type == EXPR_PPC)
+    new_st.op = EXEC_CALL_PPC;
+  else
+    {
+      gfc_error ("Expected type-bound procedure or procedure pointer component "
+		 "at %C");
+      return MATCH_ERROR;
+    }
+  new_st.expr1 = base;
+
+  return MATCH_YES;
+}
+
+
+/* Match a CALL statement.  The tricky part here are possible
+   alternate return specifiers.  We handle these by having all
+   "subroutines" actually return an integer via a register that gives
+   the return number.  If the call specifies alternate returns, we
+   generate code for a SELECT statement whose case clauses contain
+   GOTOs to the various labels.  */
+
+match
+gfc_match_call (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_actual_arglist *a, *arglist;
+  gfc_case *new_case;
+  gfc_symbol *sym;
+  gfc_symtree *st;
+  gfc_code *c;
+  match m;
+  int i;
+
+  arglist = NULL;
+
+  m = gfc_match ("% %n", name);
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_get_ha_sym_tree (name, &st))
+    return MATCH_ERROR;
+
+  sym = st->n.sym;
+
+  /* If this is a variable of derived-type, it probably starts a type-bound
+     procedure call.  */
+  if ((sym->attr.flavor != FL_PROCEDURE
+       || gfc_is_function_return_value (sym, gfc_current_ns))
+      && (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS))
+    return match_typebound_call (st);
+
+  /* If it does not seem to be callable (include functions so that the
+     right association is made.  They are thrown out in resolution.)
+     ...  */
+  if (!sym->attr.generic
+	&& !sym->attr.subroutine
+	&& !sym->attr.function)
+    {
+      if (!(sym->attr.external && !sym->attr.referenced))
+	{
+	  /* ...create a symbol in this scope...  */
+	  if (sym->ns != gfc_current_ns
+	        && gfc_get_sym_tree (name, NULL, &st, false) == 1)
+            return MATCH_ERROR;
+
+	  if (sym != st->n.sym)
+	    sym = st->n.sym;
+	}
+
+      /* ...and then to try to make the symbol into a subroutine.  */
+      if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
+	return MATCH_ERROR;
+    }
+
+  gfc_set_sym_referenced (sym);
+
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      m = gfc_match_actual_arglist (1, &arglist);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	goto cleanup;
+
+      if (gfc_match_eos () != MATCH_YES)
+	goto syntax;
+    }
+
+  /* If any alternate return labels were found, construct a SELECT
+     statement that will jump to the right place.  */
+
+  i = 0;
+  for (a = arglist; a; a = a->next)
+    if (a->expr == NULL)
+      i = 1;
+
+  if (i)
+    {
+      gfc_symtree *select_st;
+      gfc_symbol *select_sym;
+      char name[GFC_MAX_SYMBOL_LEN + 1];
+
+      new_st.next = c = gfc_get_code ();
+      c->op = EXEC_SELECT;
+      sprintf (name, "_result_%s", sym->name);
+      gfc_get_ha_sym_tree (name, &select_st);   /* Can't fail.  */
+
+      select_sym = select_st->n.sym;
+      select_sym->ts.type = BT_INTEGER;
+      select_sym->ts.kind = gfc_default_integer_kind;
+      gfc_set_sym_referenced (select_sym);
+      c->expr1 = gfc_get_expr ();
+      c->expr1->expr_type = EXPR_VARIABLE;
+      c->expr1->symtree = select_st;
+      c->expr1->ts = select_sym->ts;
+      c->expr1->where = gfc_current_locus;
+
+      i = 0;
+      for (a = arglist; a; a = a->next)
+	{
+	  if (a->expr != NULL)
+	    continue;
+
+	  if (gfc_reference_st_label (a->label, ST_LABEL_TARGET) == FAILURE)
+	    continue;
+
+	  i++;
+
+	  c->block = gfc_get_code ();
+	  c = c->block;
+	  c->op = EXEC_SELECT;
+
+	  new_case = gfc_get_case ();
+	  new_case->high = gfc_get_int_expr (gfc_default_integer_kind, NULL, i);
+	  new_case->low = new_case->high;
+	  c->ext.block.case_list = new_case;
+
+	  c->next = gfc_get_code ();
+	  c->next->op = EXEC_GOTO;
+	  c->next->label1 = a->label;
+	}
+    }
+
+  new_st.op = EXEC_CALL;
+  new_st.symtree = st;
+  new_st.ext.actual = arglist;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_CALL);
+
+cleanup:
+  gfc_free_actual_arglist (arglist);
+  return MATCH_ERROR;
+}
+
+
+/* Given a name, return a pointer to the common head structure,
+   creating it if it does not exist. If FROM_MODULE is nonzero, we
+   mangle the name so that it doesn't interfere with commons defined 
+   in the using namespace.
+   TODO: Add to global symbol tree.  */
+
+gfc_common_head *
+gfc_get_common (const char *name, int from_module)
+{
+  gfc_symtree *st;
+  static int serial = 0;
+  char mangled_name[GFC_MAX_SYMBOL_LEN + 1];
+
+  if (from_module)
+    {
+      /* A use associated common block is only needed to correctly layout
+	 the variables it contains.  */
+      snprintf (mangled_name, GFC_MAX_SYMBOL_LEN, "_%d_%s", serial++, name);
+      st = gfc_new_symtree (&gfc_current_ns->common_root, mangled_name);
+    }
+  else
+    {
+      st = gfc_find_symtree (gfc_current_ns->common_root, name);
+
+      if (st == NULL)
+	st = gfc_new_symtree (&gfc_current_ns->common_root, name);
+    }
+
+  if (st->n.common == NULL)
+    {
+      st->n.common = gfc_get_common_head ();
+      st->n.common->where = gfc_current_locus;
+      strcpy (st->n.common->name, name);
+    }
+
+  return st->n.common;
+}
+
+
+/* Match a common block name.  */
+
+match match_common_name (char *name)
+{
+  match m;
+
+  if (gfc_match_char ('/') == MATCH_NO)
+    {
+      name[0] = '\0';
+      return MATCH_YES;
+    }
+
+  if (gfc_match_char ('/') == MATCH_YES)
+    {
+      name[0] = '\0';
+      return MATCH_YES;
+    }
+
+  m = gfc_match_name (name);
+
+  if (m == MATCH_ERROR)
+    return MATCH_ERROR;
+  if (m == MATCH_YES && gfc_match_char ('/') == MATCH_YES)
+    return MATCH_YES;
+
+  gfc_error ("Syntax error in common block name at %C");
+  return MATCH_ERROR;
+}
+
+
+/* Match a COMMON statement.  */
+
+match
+gfc_match_common (void)
+{
+  gfc_symbol *sym, **head, *tail, *other, *old_blank_common;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_common_head *t;
+  gfc_array_spec *as;
+  gfc_equiv *e1, *e2;
+  match m;
+  gfc_gsymbol *gsym;
+
+  old_blank_common = gfc_current_ns->blank_common.head;
+  if (old_blank_common)
+    {
+      while (old_blank_common->common_next)
+	old_blank_common = old_blank_common->common_next;
+    }
+
+  as = NULL;
+
+  for (;;)
+    {
+      m = match_common_name (name);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+
+      gsym = gfc_get_gsymbol (name);
+      if (gsym->type != GSYM_UNKNOWN && gsym->type != GSYM_COMMON)
+	{
+	  gfc_error ("Symbol '%s' at %C is already an external symbol that "
+		     "is not COMMON", name);
+	  goto cleanup;
+	}
+
+      if (gsym->type == GSYM_UNKNOWN)
+	{
+	  gsym->type = GSYM_COMMON;
+	  gsym->where = gfc_current_locus;
+	  gsym->defined = 1;
+	}
+
+      gsym->used = 1;
+
+      if (name[0] == '\0')
+	{
+	  t = &gfc_current_ns->blank_common;
+	  if (t->head == NULL)
+	    t->where = gfc_current_locus;
+	}
+      else
+	{
+	  t = gfc_get_common (name, 0);
+	}
+      head = &t->head;
+
+      if (*head == NULL)
+	tail = NULL;
+      else
+	{
+	  tail = *head;
+	  while (tail->common_next)
+	    tail = tail->common_next;
+	}
+
+      /* Grab the list of symbols.  */
+      for (;;)
+	{
+	  m = gfc_match_symbol (&sym, 0);
+	  if (m == MATCH_ERROR)
+	    goto cleanup;
+	  if (m == MATCH_NO)
+	    goto syntax;
+
+          /* Store a ref to the common block for error checking.  */
+          sym->common_block = t;
+          
+          /* See if we know the current common block is bind(c), and if
+             so, then see if we can check if the symbol is (which it'll
+             need to be).  This can happen if the bind(c) attr stmt was
+             applied to the common block, and the variable(s) already
+             defined, before declaring the common block.  */
+          if (t->is_bind_c == 1)
+            {
+              if (sym->ts.type != BT_UNKNOWN && sym->ts.is_c_interop != 1)
+                {
+                  /* If we find an error, just print it and continue,
+                     cause it's just semantic, and we can see if there
+                     are more errors.  */
+                  gfc_error_now ("Variable '%s' at %L in common block '%s' "
+                                 "at %C must be declared with a C "
+                                 "interoperable kind since common block "
+                                 "'%s' is bind(c)",
+                                 sym->name, &(sym->declared_at), t->name,
+                                 t->name);
+                }
+              
+              if (sym->attr.is_bind_c == 1)
+                gfc_error_now ("Variable '%s' in common block "
+                               "'%s' at %C can not be bind(c) since "
+                               "it is not global", sym->name, t->name);
+            }
+          
+	  if (sym->attr.in_common)
+	    {
+	      gfc_error ("Symbol '%s' at %C is already in a COMMON block",
+			 sym->name);
+	      goto cleanup;
+	    }
+
+	  if (((sym->value != NULL && sym->value->expr_type != EXPR_NULL)
+	       || sym->attr.data) && gfc_current_state () != COMP_BLOCK_DATA)
+	    {
+	      if (gfc_notify_std (GFC_STD_GNU, "Initialized symbol '%s' at %C "
+					       "can only be COMMON in "
+					       "BLOCK DATA", sym->name)
+		  == FAILURE)
+		goto cleanup;
+	    }
+
+	  if (gfc_add_in_common (&sym->attr, sym->name, NULL) == FAILURE)
+	    goto cleanup;
+
+	  if (tail != NULL)
+	    tail->common_next = sym;
+	  else
+	    *head = sym;
+
+	  tail = sym;
+
+	  /* Deal with an optional array specification after the
+	     symbol name.  */
+	  m = gfc_match_array_spec (&as, true, true);
+	  if (m == MATCH_ERROR)
+	    goto cleanup;
+
+	  if (m == MATCH_YES)
+	    {
+	      if (as->type != AS_EXPLICIT)
+		{
+		  gfc_error ("Array specification for symbol '%s' in COMMON "
+			     "at %C must be explicit", sym->name);
+		  goto cleanup;
+		}
+
+	      if (gfc_add_dimension (&sym->attr, sym->name, NULL) == FAILURE)
+		goto cleanup;
+
+	      if (sym->attr.pointer)
+		{
+		  gfc_error ("Symbol '%s' in COMMON at %C cannot be a "
+			     "POINTER array", sym->name);
+		  goto cleanup;
+		}
+
+	      sym->as = as;
+	      as = NULL;
+
+	    }
+
+	  sym->common_head = t;
+
+	  /* Check to see if the symbol is already in an equivalence group.
+	     If it is, set the other members as being in common.  */
+	  if (sym->attr.in_equivalence)
+	    {
+	      for (e1 = gfc_current_ns->equiv; e1; e1 = e1->next)
+		{
+		  for (e2 = e1; e2; e2 = e2->eq)
+		    if (e2->expr->symtree->n.sym == sym)
+		      goto equiv_found;
+
+		  continue;
+
+	  equiv_found:
+
+		  for (e2 = e1; e2; e2 = e2->eq)
+		    {
+		      other = e2->expr->symtree->n.sym;
+		      if (other->common_head
+			  && other->common_head != sym->common_head)
+			{
+			  gfc_error ("Symbol '%s', in COMMON block '%s' at "
+				     "%C is being indirectly equivalenced to "
+				     "another COMMON block '%s'",
+				     sym->name, sym->common_head->name,
+				     other->common_head->name);
+			    goto cleanup;
+			}
+		      other->attr.in_common = 1;
+		      other->common_head = t;
+		    }
+		}
+	    }
+
+
+	  gfc_gobble_whitespace ();
+	  if (gfc_match_eos () == MATCH_YES)
+	    goto done;
+	  if (gfc_peek_ascii_char () == '/')
+	    break;
+	  if (gfc_match_char (',') != MATCH_YES)
+	    goto syntax;
+	  gfc_gobble_whitespace ();
+	  if (gfc_peek_ascii_char () == '/')
+	    break;
+	}
+    }
+
+done:
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_COMMON);
+
+cleanup:
+  if (old_blank_common)
+    old_blank_common->common_next = NULL;
+  else
+    gfc_current_ns->blank_common.head = NULL;
+  gfc_free_array_spec (as);
+  return MATCH_ERROR;
+}
+
+
+/* Match a BLOCK DATA program unit.  */
+
+match
+gfc_match_block_data (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symbol *sym;
+  match m;
+
+  if (gfc_match_eos () == MATCH_YES)
+    {
+      gfc_new_block = NULL;
+      return MATCH_YES;
+    }
+
+  m = gfc_match ("% %n%t", name);
+  if (m != MATCH_YES)
+    return MATCH_ERROR;
+
+  if (gfc_get_symbol (name, NULL, &sym))
+    return MATCH_ERROR;
+
+  if (gfc_add_flavor (&sym->attr, FL_BLOCK_DATA, sym->name, NULL) == FAILURE)
+    return MATCH_ERROR;
+
+  gfc_new_block = sym;
+
+  return MATCH_YES;
+}
+
+
+/* Free a namelist structure.  */
+
+void
+gfc_free_namelist (gfc_namelist *name)
+{
+  gfc_namelist *n;
+
+  for (; name; name = n)
+    {
+      n = name->next;
+      gfc_free (name);
+    }
+}
+
+
+/* Match a NAMELIST statement.  */
+
+match
+gfc_match_namelist (void)
+{
+  gfc_symbol *group_name, *sym;
+  gfc_namelist *nl;
+  match m, m2;
+
+  m = gfc_match (" / %s /", &group_name);
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
+    goto error;
+
+  for (;;)
+    {
+      if (group_name->ts.type != BT_UNKNOWN)
+	{
+	  gfc_error ("Namelist group name '%s' at %C already has a basic "
+		     "type of %s", group_name->name,
+		     gfc_typename (&group_name->ts));
+	  return MATCH_ERROR;
+	}
+
+      if (group_name->attr.flavor == FL_NAMELIST
+	  && group_name->attr.use_assoc
+	  && gfc_notify_std (GFC_STD_GNU, "Namelist group name '%s' "
+			     "at %C already is USE associated and can"
+			     "not be respecified.", group_name->name)
+	     == FAILURE)
+	return MATCH_ERROR;
+
+      if (group_name->attr.flavor != FL_NAMELIST
+	  && gfc_add_flavor (&group_name->attr, FL_NAMELIST,
+			     group_name->name, NULL) == FAILURE)
+	return MATCH_ERROR;
+
+      for (;;)
+	{
+	  m = gfc_match_symbol (&sym, 1);
+	  if (m == MATCH_NO)
+	    goto syntax;
+	  if (m == MATCH_ERROR)
+	    goto error;
+
+	  if (sym->attr.in_namelist == 0
+	      && gfc_add_in_namelist (&sym->attr, sym->name, NULL) == FAILURE)
+	    goto error;
+
+	  /* Use gfc_error_check here, rather than goto error, so that
+	     these are the only errors for the next two lines.  */
+	  if (sym->as && sym->as->type == AS_ASSUMED_SIZE)
+	    {
+	      gfc_error ("Assumed size array '%s' in namelist '%s' at "
+			 "%C is not allowed", sym->name, group_name->name);
+	      gfc_error_check ();
+	    }
+
+	  nl = gfc_get_namelist ();
+	  nl->sym = sym;
+	  sym->refs++;
+
+	  if (group_name->namelist == NULL)
+	    group_name->namelist = group_name->namelist_tail = nl;
+	  else
+	    {
+	      group_name->namelist_tail->next = nl;
+	      group_name->namelist_tail = nl;
+	    }
+
+	  if (gfc_match_eos () == MATCH_YES)
+	    goto done;
+
+	  m = gfc_match_char (',');
+
+	  if (gfc_match_char ('/') == MATCH_YES)
+	    {
+	      m2 = gfc_match (" %s /", &group_name);
+	      if (m2 == MATCH_YES)
+		break;
+	      if (m2 == MATCH_ERROR)
+		goto error;
+	      goto syntax;
+	    }
+
+	  if (m != MATCH_YES)
+	    goto syntax;
+	}
+    }
+
+done:
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_NAMELIST);
+
+error:
+  return MATCH_ERROR;
+}
+
+
+/* Match a MODULE statement.  */
+
+match
+gfc_match_module (void)
+{
+  match m;
+
+  m = gfc_match (" %s%t", &gfc_new_block);
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_add_flavor (&gfc_new_block->attr, FL_MODULE,
+		      gfc_new_block->name, NULL) == FAILURE)
+    return MATCH_ERROR;
+
+  return MATCH_YES;
+}
+
+
+/* Free equivalence sets and lists.  Recursively is the easiest way to
+   do this.  */
+
+void
+gfc_free_equiv_until (gfc_equiv *eq, gfc_equiv *stop)
+{
+  if (eq == stop)
+    return;
+
+  gfc_free_equiv (eq->eq);
+  gfc_free_equiv_until (eq->next, stop);
+  gfc_free_expr (eq->expr);
+  gfc_free (eq);
+}
+
+
+void
+gfc_free_equiv (gfc_equiv *eq)
+{
+  gfc_free_equiv_until (eq, NULL);
+}
+
+
+/* Match an EQUIVALENCE statement.  */
+
+match
+gfc_match_equivalence (void)
+{
+  gfc_equiv *eq, *set, *tail;
+  gfc_ref *ref;
+  gfc_symbol *sym;
+  match m;
+  gfc_common_head *common_head = NULL;
+  bool common_flag;
+  int cnt;
+
+  tail = NULL;
+
+  for (;;)
+    {
+      eq = gfc_get_equiv ();
+      if (tail == NULL)
+	tail = eq;
+
+      eq->next = gfc_current_ns->equiv;
+      gfc_current_ns->equiv = eq;
+
+      if (gfc_match_char ('(') != MATCH_YES)
+	goto syntax;
+
+      set = eq;
+      common_flag = FALSE;
+      cnt = 0;
+
+      for (;;)
+	{
+	  m = gfc_match_equiv_variable (&set->expr);
+	  if (m == MATCH_ERROR)
+	    goto cleanup;
+	  if (m == MATCH_NO)
+	    goto syntax;
+
+	  /*  count the number of objects.  */
+	  cnt++;
+
+	  if (gfc_match_char ('%') == MATCH_YES)
+	    {
+	      gfc_error ("Derived type component %C is not a "
+			 "permitted EQUIVALENCE member");
+	      goto cleanup;
+	    }
+
+	  for (ref = set->expr->ref; ref; ref = ref->next)
+	    if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
+	      {
+		gfc_error ("Array reference in EQUIVALENCE at %C cannot "
+			   "be an array section");
+		goto cleanup;
+	      }
+
+	  sym = set->expr->symtree->n.sym;
+
+	  if (gfc_add_in_equivalence (&sym->attr, sym->name, NULL) == FAILURE)
+	    goto cleanup;
+
+	  if (sym->attr.in_common)
+	    {
+	      common_flag = TRUE;
+	      common_head = sym->common_head;
+	    }
+
+	  if (gfc_match_char (')') == MATCH_YES)
+	    break;
+
+	  if (gfc_match_char (',') != MATCH_YES)
+	    goto syntax;
+
+	  set->eq = gfc_get_equiv ();
+	  set = set->eq;
+	}
+
+      if (cnt < 2)
+	{
+	  gfc_error ("EQUIVALENCE at %C requires two or more objects");
+	  goto cleanup;
+	}
+
+      /* If one of the members of an equivalence is in common, then
+	 mark them all as being in common.  Before doing this, check
+	 that members of the equivalence group are not in different
+	 common blocks.  */
+      if (common_flag)
+	for (set = eq; set; set = set->eq)
+	  {
+	    sym = set->expr->symtree->n.sym;
+	    if (sym->common_head && sym->common_head != common_head)
+	      {
+		gfc_error ("Attempt to indirectly overlap COMMON "
+			   "blocks %s and %s by EQUIVALENCE at %C",
+			   sym->common_head->name, common_head->name);
+		goto cleanup;
+	      }
+	    sym->attr.in_common = 1;
+	    sym->common_head = common_head;
+	  }
+
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	{
+	  gfc_error ("Expecting a comma in EQUIVALENCE at %C");
+	  goto cleanup;
+	}
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_EQUIVALENCE);
+
+cleanup:
+  eq = tail->next;
+  tail->next = NULL;
+
+  gfc_free_equiv (gfc_current_ns->equiv);
+  gfc_current_ns->equiv = eq;
+
+  return MATCH_ERROR;
+}
+
+
+/* Check that a statement function is not recursive. This is done by looking
+   for the statement function symbol(sym) by looking recursively through its
+   expression(e).  If a reference to sym is found, true is returned.  
+   12.5.4 requires that any variable of function that is implicitly typed
+   shall have that type confirmed by any subsequent type declaration.  The
+   implicit typing is conveniently done here.  */
+static bool
+recursive_stmt_fcn (gfc_expr *, gfc_symbol *);
+
+static bool
+check_stmt_fcn (gfc_expr *e, gfc_symbol *sym, int *f ATTRIBUTE_UNUSED)
+{
+
+  if (e == NULL)
+    return false;
+
+  switch (e->expr_type)
+    {
+    case EXPR_FUNCTION:
+      if (e->symtree == NULL)
+	return false;
+
+      /* Check the name before testing for nested recursion!  */
+      if (sym->name == e->symtree->n.sym->name)
+	return true;
+
+      /* Catch recursion via other statement functions.  */
+      if (e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION
+	  && e->symtree->n.sym->value
+	  && recursive_stmt_fcn (e->symtree->n.sym->value, sym))
+	return true;
+
+      if (e->symtree->n.sym->ts.type == BT_UNKNOWN)
+	gfc_set_default_type (e->symtree->n.sym, 0, NULL);
+
+      break;
+
+    case EXPR_VARIABLE:
+      if (e->symtree && sym->name == e->symtree->n.sym->name)
+	return true;
+
+      if (e->symtree->n.sym->ts.type == BT_UNKNOWN)
+	gfc_set_default_type (e->symtree->n.sym, 0, NULL);
+      break;
+
+    default:
+      break;
+    }
+
+  return false;
+}
+
+
+static bool
+recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym)
+{
+  return gfc_traverse_expr (e, sym, check_stmt_fcn, 0);
+}
+
+
+/* Match a statement function declaration.  It is so easy to match
+   non-statement function statements with a MATCH_ERROR as opposed to
+   MATCH_NO that we suppress error message in most cases.  */
+
+match
+gfc_match_st_function (void)
+{
+  gfc_error_buf old_error;
+  gfc_symbol *sym;
+  gfc_expr *expr;
+  match m;
+
+  m = gfc_match_symbol (&sym, 0);
+  if (m != MATCH_YES)
+    return m;
+
+  gfc_push_error (&old_error);
+
+  if (gfc_add_procedure (&sym->attr, PROC_ST_FUNCTION,
+			 sym->name, NULL) == FAILURE)
+    goto undo_error;
+
+  if (gfc_match_formal_arglist (sym, 1, 0) != MATCH_YES)
+    goto undo_error;
+
+  m = gfc_match (" = %e%t", &expr);
+  if (m == MATCH_NO)
+    goto undo_error;
+
+  gfc_free_error (&old_error);
+  if (m == MATCH_ERROR)
+    return m;
+
+  if (recursive_stmt_fcn (expr, sym))
+    {
+      gfc_error ("Statement function at %L is recursive", &expr->where);
+      return MATCH_ERROR;
+    }
+
+  sym->value = expr;
+
+  if (gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: "
+		      "Statement function at %C") == FAILURE)
+    return MATCH_ERROR;
+
+  return MATCH_YES;
+
+undo_error:
+  gfc_pop_error (&old_error);
+  return MATCH_NO;
+}
+
+
+/***************** SELECT CASE subroutines ******************/
+
+/* Free a single case structure.  */
+
+static void
+free_case (gfc_case *p)
+{
+  if (p->low == p->high)
+    p->high = NULL;
+  gfc_free_expr (p->low);
+  gfc_free_expr (p->high);
+  gfc_free (p);
+}
+
+
+/* Free a list of case structures.  */
+
+void
+gfc_free_case_list (gfc_case *p)
+{
+  gfc_case *q;
+
+  for (; p; p = q)
+    {
+      q = p->next;
+      free_case (p);
+    }
+}
+
+
+/* Match a single case selector.  */
+
+static match
+match_case_selector (gfc_case **cp)
+{
+  gfc_case *c;
+  match m;
+
+  c = gfc_get_case ();
+  c->where = gfc_current_locus;
+
+  if (gfc_match_char (':') == MATCH_YES)
+    {
+      m = gfc_match_init_expr (&c->high);
+      if (m == MATCH_NO)
+	goto need_expr;
+      if (m == MATCH_ERROR)
+	goto cleanup;
+    }
+  else
+    {
+      m = gfc_match_init_expr (&c->low);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto need_expr;
+
+      /* If we're not looking at a ':' now, make a range out of a single
+	 target.  Else get the upper bound for the case range.  */
+      if (gfc_match_char (':') != MATCH_YES)
+	c->high = c->low;
+      else
+	{
+	  m = gfc_match_init_expr (&c->high);
+	  if (m == MATCH_ERROR)
+	    goto cleanup;
+	  /* MATCH_NO is fine.  It's OK if nothing is there!  */
+	}
+    }
+
+  *cp = c;
+  return MATCH_YES;
+
+need_expr:
+  gfc_error ("Expected initialization expression in CASE at %C");
+
+cleanup:
+  free_case (c);
+  return MATCH_ERROR;
+}
+
+
+/* Match the end of a case statement.  */
+
+static match
+match_case_eos (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  match m;
+
+  if (gfc_match_eos () == MATCH_YES)
+    return MATCH_YES;
+
+  /* If the case construct doesn't have a case-construct-name, we
+     should have matched the EOS.  */
+  if (!gfc_current_block ())
+    return MATCH_NO;
+
+  gfc_gobble_whitespace ();
+
+  m = gfc_match_name (name);
+  if (m != MATCH_YES)
+    return m;
+
+  if (strcmp (name, gfc_current_block ()->name) != 0)
+    {
+      gfc_error ("Expected block name '%s' of SELECT construct at %C",
+		 gfc_current_block ()->name);
+      return MATCH_ERROR;
+    }
+
+  return gfc_match_eos ();
+}
+
+
+/* Match a SELECT statement.  */
+
+match
+gfc_match_select (void)
+{
+  gfc_expr *expr;
+  match m;
+
+  m = gfc_match_label ();
+  if (m == MATCH_ERROR)
+    return m;
+
+  m = gfc_match (" select case ( %e )%t", &expr);
+  if (m != MATCH_YES)
+    return m;
+
+  new_st.op = EXEC_SELECT;
+  new_st.expr1 = expr;
+
+  return MATCH_YES;
+}
+
+
+/* Push the current selector onto the SELECT TYPE stack.  */
+
+static void
+select_type_push (gfc_symbol *sel)
+{
+  gfc_select_type_stack *top = gfc_get_select_type_stack ();
+  top->selector = sel;
+  top->tmp = NULL;
+  top->prev = select_type_stack;
+
+  select_type_stack = top;
+}
+
+
+/* Set the temporary for the current SELECT TYPE selector.  */
+
+static void
+select_type_set_tmp (gfc_typespec *ts)
+{
+  char name[GFC_MAX_SYMBOL_LEN];
+  gfc_symtree *tmp;
+  
+  if (!ts)
+    {
+      select_type_stack->tmp = NULL;
+      return;
+    }
+  
+  if (!gfc_type_is_extensible (ts->u.derived))
+    return;
+
+  if (ts->type == BT_CLASS)
+    sprintf (name, "__tmp_class_%s", ts->u.derived->name);
+  else
+    sprintf (name, "__tmp_type_%s", ts->u.derived->name);
+  gfc_get_sym_tree (name, gfc_current_ns, &tmp, false);
+  gfc_add_type (tmp->n.sym, ts, NULL);
+  gfc_set_sym_referenced (tmp->n.sym);
+  gfc_add_pointer (&tmp->n.sym->attr, NULL);
+  gfc_add_flavor (&tmp->n.sym->attr, FL_VARIABLE, name, NULL);
+  if (ts->type == BT_CLASS)
+    gfc_build_class_symbol (&tmp->n.sym->ts, &tmp->n.sym->attr,
+			    &tmp->n.sym->as, false);
+  tmp->n.sym->attr.select_type_temporary = 1;
+
+  /* Add an association for it, so the rest of the parser knows it is
+     an associate-name.  The target will be set during resolution.  */
+  tmp->n.sym->assoc = gfc_get_association_list ();
+  tmp->n.sym->assoc->dangling = 1;
+  tmp->n.sym->assoc->st = tmp;
+
+  select_type_stack->tmp = tmp;
+}
+
+
+/* Match a SELECT TYPE statement.  */
+
+match
+gfc_match_select_type (void)
+{
+  gfc_expr *expr1, *expr2 = NULL;
+  match m;
+  char name[GFC_MAX_SYMBOL_LEN];
+
+  m = gfc_match_label ();
+  if (m == MATCH_ERROR)
+    return m;
+
+  m = gfc_match (" select type ( ");
+  if (m != MATCH_YES)
+    return m;
+
+  gfc_current_ns = gfc_build_block_ns (gfc_current_ns);
+
+  m = gfc_match (" %n => %e", name, &expr2);
+  if (m == MATCH_YES)
+    {
+      expr1 = gfc_get_expr();
+      expr1->expr_type = EXPR_VARIABLE;
+      if (gfc_get_sym_tree (name, NULL, &expr1->symtree, false))
+	{
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+      if (expr2->ts.type == BT_UNKNOWN)
+	expr1->symtree->n.sym->attr.untyped = 1;
+      else
+	expr1->symtree->n.sym->ts = expr2->ts;
+      expr1->symtree->n.sym->attr.flavor = FL_VARIABLE;
+      expr1->symtree->n.sym->attr.referenced = 1;
+      expr1->symtree->n.sym->attr.class_ok = 1;
+    }
+  else
+    {
+      m = gfc_match (" %e ", &expr1);
+      if (m != MATCH_YES)
+	goto cleanup;
+    }
+
+  m = gfc_match (" )%t");
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  /* Check for F03:C811.  */
+  if (!expr2 && (expr1->expr_type != EXPR_VARIABLE || expr1->ref != NULL))
+    {
+      gfc_error ("Selector in SELECT TYPE at %C is not a named variable; "
+		 "use associate-name=>");
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  new_st.op = EXEC_SELECT_TYPE;
+  new_st.expr1 = expr1;
+  new_st.expr2 = expr2;
+  new_st.ext.block.ns = gfc_current_ns;
+
+  select_type_push (expr1->symtree->n.sym);
+
+  return MATCH_YES;
+  
+cleanup:
+  gfc_current_ns = gfc_current_ns->parent;
+  return m;
+}
+
+
+/* Match a CASE statement.  */
+
+match
+gfc_match_case (void)
+{
+  gfc_case *c, *head, *tail;
+  match m;
+
+  head = tail = NULL;
+
+  if (gfc_current_state () != COMP_SELECT)
+    {
+      gfc_error ("Unexpected CASE statement at %C");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match ("% default") == MATCH_YES)
+    {
+      m = match_case_eos ();
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	goto cleanup;
+
+      new_st.op = EXEC_SELECT;
+      c = gfc_get_case ();
+      c->where = gfc_current_locus;
+      new_st.ext.block.case_list = c;
+      return MATCH_YES;
+    }
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    goto syntax;
+
+  for (;;)
+    {
+      if (match_case_selector (&c) == MATCH_ERROR)
+	goto cleanup;
+
+      if (head == NULL)
+	head = c;
+      else
+	tail->next = c;
+
+      tail = c;
+
+      if (gfc_match_char (')') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  m = match_case_eos ();
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  new_st.op = EXEC_SELECT;
+  new_st.ext.block.case_list = head;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in CASE specification at %C");
+
+cleanup:
+  gfc_free_case_list (head);  /* new_st is cleaned up in parse.c.  */
+  return MATCH_ERROR;
+}
+
+
+/* Match a TYPE IS statement.  */
+
+match
+gfc_match_type_is (void)
+{
+  gfc_case *c = NULL;
+  match m;
+
+  if (gfc_current_state () != COMP_SELECT_TYPE)
+    {
+      gfc_error ("Unexpected TYPE IS statement at %C");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    goto syntax;
+
+  c = gfc_get_case ();
+  c->where = gfc_current_locus;
+
+  /* TODO: Once unlimited polymorphism is implemented, we will need to call
+     match_type_spec here.  */
+  if (match_derived_type_spec (&c->ts) == MATCH_ERROR)
+    goto cleanup;
+
+  if (gfc_match_char (')') != MATCH_YES)
+    goto syntax;
+
+  m = match_case_eos ();
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  new_st.op = EXEC_SELECT_TYPE;
+  new_st.ext.block.case_list = c;
+
+  /* Create temporary variable.  */
+  select_type_set_tmp (&c->ts);
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in TYPE IS specification at %C");
+
+cleanup:
+  if (c != NULL)
+    gfc_free_case_list (c);  /* new_st is cleaned up in parse.c.  */
+  return MATCH_ERROR;
+}
+
+
+/* Match a CLASS IS or CLASS DEFAULT statement.  */
+
+match
+gfc_match_class_is (void)
+{
+  gfc_case *c = NULL;
+  match m;
+
+  if (gfc_current_state () != COMP_SELECT_TYPE)
+    return MATCH_NO;
+
+  if (gfc_match ("% default") == MATCH_YES)
+    {
+      m = match_case_eos ();
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	goto cleanup;
+
+      new_st.op = EXEC_SELECT_TYPE;
+      c = gfc_get_case ();
+      c->where = gfc_current_locus;
+      c->ts.type = BT_UNKNOWN;
+      new_st.ext.block.case_list = c;
+      select_type_set_tmp (NULL);
+      return MATCH_YES;
+    }
+
+  m = gfc_match ("% is");
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    goto syntax;
+
+  c = gfc_get_case ();
+  c->where = gfc_current_locus;
+
+  if (match_derived_type_spec (&c->ts) == MATCH_ERROR)
+    goto cleanup;
+
+  if (c->ts.type == BT_DERIVED)
+    c->ts.type = BT_CLASS;
+
+  if (gfc_match_char (')') != MATCH_YES)
+    goto syntax;
+
+  m = match_case_eos ();
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  new_st.op = EXEC_SELECT_TYPE;
+  new_st.ext.block.case_list = c;
+  
+  /* Create temporary variable.  */
+  select_type_set_tmp (&c->ts);
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in CLASS IS specification at %C");
+
+cleanup:
+  if (c != NULL)
+    gfc_free_case_list (c);  /* new_st is cleaned up in parse.c.  */
+  return MATCH_ERROR;
+}
+
+
+/********************* WHERE subroutines ********************/
+
+/* Match the rest of a simple WHERE statement that follows an IF statement.  
+ */
+
+static match
+match_simple_where (void)
+{
+  gfc_expr *expr;
+  gfc_code *c;
+  match m;
+
+  m = gfc_match (" ( %e )", &expr);
+  if (m != MATCH_YES)
+    return m;
+
+  m = gfc_match_assignment ();
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  if (gfc_match_eos () != MATCH_YES)
+    goto syntax;
+
+  c = gfc_get_code ();
+
+  c->op = EXEC_WHERE;
+  c->expr1 = expr;
+  c->next = gfc_get_code ();
+
+  *c->next = new_st;
+  gfc_clear_new_st ();
+
+  new_st.op = EXEC_WHERE;
+  new_st.block = c;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_WHERE);
+
+cleanup:
+  gfc_free_expr (expr);
+  return MATCH_ERROR;
+}
+
+
+/* Match a WHERE statement.  */
+
+match
+gfc_match_where (gfc_statement *st)
+{
+  gfc_expr *expr;
+  match m0, m;
+  gfc_code *c;
+
+  m0 = gfc_match_label ();
+  if (m0 == MATCH_ERROR)
+    return m0;
+
+  m = gfc_match (" where ( %e )", &expr);
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_match_eos () == MATCH_YES)
+    {
+      *st = ST_WHERE_BLOCK;
+      new_st.op = EXEC_WHERE;
+      new_st.expr1 = expr;
+      return MATCH_YES;
+    }
+
+  m = gfc_match_assignment ();
+  if (m == MATCH_NO)
+    gfc_syntax_error (ST_WHERE);
+
+  if (m != MATCH_YES)
+    {
+      gfc_free_expr (expr);
+      return MATCH_ERROR;
+    }
+
+  /* We've got a simple WHERE statement.  */
+  *st = ST_WHERE;
+  c = gfc_get_code ();
+
+  c->op = EXEC_WHERE;
+  c->expr1 = expr;
+  c->next = gfc_get_code ();
+
+  *c->next = new_st;
+  gfc_clear_new_st ();
+
+  new_st.op = EXEC_WHERE;
+  new_st.block = c;
+
+  return MATCH_YES;
+}
+
+
+/* Match an ELSEWHERE statement.  We leave behind a WHERE node in
+   new_st if successful.  */
+
+match
+gfc_match_elsewhere (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_expr *expr;
+  match m;
+
+  if (gfc_current_state () != COMP_WHERE)
+    {
+      gfc_error ("ELSEWHERE statement at %C not enclosed in WHERE block");
+      return MATCH_ERROR;
+    }
+
+  expr = NULL;
+
+  if (gfc_match_char ('(') == MATCH_YES)
+    {
+      m = gfc_match_expr (&expr);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	return MATCH_ERROR;
+
+      if (gfc_match_char (')') != MATCH_YES)
+	goto syntax;
+    }
+
+  if (gfc_match_eos () != MATCH_YES)
+    {
+      /* Only makes sense if we have a where-construct-name.  */
+      if (!gfc_current_block ())
+	{
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+      /* Better be a name at this point.  */
+      m = gfc_match_name (name);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	goto cleanup;
+
+      if (gfc_match_eos () != MATCH_YES)
+	goto syntax;
+
+      if (strcmp (name, gfc_current_block ()->name) != 0)
+	{
+	  gfc_error ("Label '%s' at %C doesn't match WHERE label '%s'",
+		     name, gfc_current_block ()->name);
+	  goto cleanup;
+	}
+    }
+
+  new_st.op = EXEC_WHERE;
+  new_st.expr1 = expr;
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_ELSEWHERE);
+
+cleanup:
+  gfc_free_expr (expr);
+  return MATCH_ERROR;
+}
+
+
+/******************** FORALL subroutines ********************/
+
+/* Free a list of FORALL iterators.  */
+
+void
+gfc_free_forall_iterator (gfc_forall_iterator *iter)
+{
+  gfc_forall_iterator *next;
+
+  while (iter)
+    {
+      next = iter->next;
+      gfc_free_expr (iter->var);
+      gfc_free_expr (iter->start);
+      gfc_free_expr (iter->end);
+      gfc_free_expr (iter->stride);
+      gfc_free (iter);
+      iter = next;
+    }
+}
+
+
+/* Match an iterator as part of a FORALL statement.  The format is:
+
+     <var> = <start>:<end>[:<stride>]
+
+   On MATCH_NO, the caller tests for the possibility that there is a
+   scalar mask expression.  */
+
+static match
+match_forall_iterator (gfc_forall_iterator **result)
+{
+  gfc_forall_iterator *iter;
+  locus where;
+  match m;
+
+  where = gfc_current_locus;
+  iter = XCNEW (gfc_forall_iterator);
+
+  m = gfc_match_expr (&iter->var);
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  if (gfc_match_char ('=') != MATCH_YES
+      || iter->var->expr_type != EXPR_VARIABLE)
+    {
+      m = MATCH_NO;
+      goto cleanup;
+    }
+
+  m = gfc_match_expr (&iter->start);
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  if (gfc_match_char (':') != MATCH_YES)
+    goto syntax;
+
+  m = gfc_match_expr (&iter->end);
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  if (gfc_match_char (':') == MATCH_NO)
+    iter->stride = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+  else
+    {
+      m = gfc_match_expr (&iter->stride);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	goto cleanup;
+    }
+
+  /* Mark the iteration variable's symbol as used as a FORALL index.  */
+  iter->var->symtree->n.sym->forall_index = true;
+
+  *result = iter;
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in FORALL iterator at %C");
+  m = MATCH_ERROR;
+
+cleanup:
+
+  gfc_current_locus = where;
+  gfc_free_forall_iterator (iter);
+  return m;
+}
+
+
+/* Match the header of a FORALL statement.  */
+
+static match
+match_forall_header (gfc_forall_iterator **phead, gfc_expr **mask)
+{
+  gfc_forall_iterator *head, *tail, *new_iter;
+  gfc_expr *msk;
+  match m;
+
+  gfc_gobble_whitespace ();
+
+  head = tail = NULL;
+  msk = NULL;
+
+  if (gfc_match_char ('(') != MATCH_YES)
+    return MATCH_NO;
+
+  m = match_forall_iterator (&new_iter);
+  if (m == MATCH_ERROR)
+    goto cleanup;
+  if (m == MATCH_NO)
+    goto syntax;
+
+  head = tail = new_iter;
+
+  for (;;)
+    {
+      if (gfc_match_char (',') != MATCH_YES)
+	break;
+
+      m = match_forall_iterator (&new_iter);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+
+      if (m == MATCH_YES)
+	{
+	  tail->next = new_iter;
+	  tail = new_iter;
+	  continue;
+	}
+
+      /* Have to have a mask expression.  */
+
+      m = gfc_match_expr (&msk);
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	goto cleanup;
+
+      break;
+    }
+
+  if (gfc_match_char (')') == MATCH_NO)
+    goto syntax;
+
+  *phead = head;
+  *mask = msk;
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_FORALL);
+
+cleanup:
+  gfc_free_expr (msk);
+  gfc_free_forall_iterator (head);
+
+  return MATCH_ERROR;
+}
+
+/* Match the rest of a simple FORALL statement that follows an 
+   IF statement.  */
+
+static match
+match_simple_forall (void)
+{
+  gfc_forall_iterator *head;
+  gfc_expr *mask;
+  gfc_code *c;
+  match m;
+
+  mask = NULL;
+  head = NULL;
+  c = NULL;
+
+  m = match_forall_header (&head, &mask);
+
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  m = gfc_match_assignment ();
+
+  if (m == MATCH_ERROR)
+    goto cleanup;
+  if (m == MATCH_NO)
+    {
+      m = gfc_match_pointer_assignment ();
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+  c = gfc_get_code ();
+  *c = new_st;
+  c->loc = gfc_current_locus;
+
+  if (gfc_match_eos () != MATCH_YES)
+    goto syntax;
+
+  gfc_clear_new_st ();
+  new_st.op = EXEC_FORALL;
+  new_st.expr1 = mask;
+  new_st.ext.forall_iterator = head;
+  new_st.block = gfc_get_code ();
+
+  new_st.block->op = EXEC_FORALL;
+  new_st.block->next = c;
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_FORALL);
+
+cleanup:
+  gfc_free_forall_iterator (head);
+  gfc_free_expr (mask);
+
+  return MATCH_ERROR;
+}
+
+
+/* Match a FORALL statement.  */
+
+match
+gfc_match_forall (gfc_statement *st)
+{
+  gfc_forall_iterator *head;
+  gfc_expr *mask;
+  gfc_code *c;
+  match m0, m;
+
+  head = NULL;
+  mask = NULL;
+  c = NULL;
+
+  m0 = gfc_match_label ();
+  if (m0 == MATCH_ERROR)
+    return MATCH_ERROR;
+
+  m = gfc_match (" forall");
+  if (m != MATCH_YES)
+    return m;
+
+  m = match_forall_header (&head, &mask);
+  if (m == MATCH_ERROR)
+    goto cleanup;
+  if (m == MATCH_NO)
+    goto syntax;
+
+  if (gfc_match_eos () == MATCH_YES)
+    {
+      *st = ST_FORALL_BLOCK;
+      new_st.op = EXEC_FORALL;
+      new_st.expr1 = mask;
+      new_st.ext.forall_iterator = head;
+      return MATCH_YES;
+    }
+
+  m = gfc_match_assignment ();
+  if (m == MATCH_ERROR)
+    goto cleanup;
+  if (m == MATCH_NO)
+    {
+      m = gfc_match_pointer_assignment ();
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+  c = gfc_get_code ();
+  *c = new_st;
+  c->loc = gfc_current_locus;
+
+  gfc_clear_new_st ();
+  new_st.op = EXEC_FORALL;
+  new_st.expr1 = mask;
+  new_st.ext.forall_iterator = head;
+  new_st.block = gfc_get_code ();
+  new_st.block->op = EXEC_FORALL;
+  new_st.block->next = c;
+
+  *st = ST_FORALL;
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_FORALL);
+
+cleanup:
+  gfc_free_forall_iterator (head);
+  gfc_free_expr (mask);
+  gfc_free_statements (c);
+  return MATCH_NO;
+}
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
new file mode 100644
index 000000000..69f1d9e60
--- /dev/null
+++ b/gcc/fortran/match.h
@@ -0,0 +1,252 @@
+/* All matcher functions.
+   Copyright (C) 2003, 2005, 2007, 2008, 2010
+   Free Software Foundation, Inc.
+   Contributed by Steven Bosscher
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+#ifndef GFC_MATCH_H
+#define GFC_MATCH_H
+
+/* gfc_new_block points to the symbol of a newly matched block.  */
+extern gfc_symbol *gfc_new_block;
+
+/* Current statement label.  Zero means no statement label.  Because
+   new_st can get wiped during statement matching, we have to keep it
+   separate.  */
+extern gfc_st_label *gfc_statement_label;
+
+extern int gfc_matching_ptr_assignment;
+extern int gfc_matching_procptr_assignment;
+extern bool gfc_matching_prefix;
+
+/* Default access specifier while matching procedure bindings.  */
+extern gfc_access gfc_typebound_default_access;
+
+/****************** All gfc_match* routines *****************/
+
+/* match.c.  */
+
+/* Generic match subroutines.  */
+match gfc_match_special_char (gfc_char_t *);
+match gfc_match_space (void);
+match gfc_match_eos (void);
+match gfc_match_small_literal_int (int *, int *);
+match gfc_match_st_label (gfc_st_label **);
+match gfc_match_label (void);
+match gfc_match_small_int (int *);
+match gfc_match_small_int_expr (int *, gfc_expr **);
+match gfc_match_name (char *);
+match gfc_match_name_C (char *buffer);
+match gfc_match_symbol (gfc_symbol **, int);
+match gfc_match_sym_tree (gfc_symtree **, int);
+match gfc_match_intrinsic_op (gfc_intrinsic_op *);
+match gfc_match_char (char);
+match gfc_match (const char *, ...);
+match gfc_match_iterator (gfc_iterator *, int);
+match gfc_match_parens (void);
+
+/* Statement matchers.  */
+match gfc_match_program (void);
+match gfc_match_pointer_assignment (void);
+match gfc_match_assignment (void);
+match gfc_match_if (gfc_statement *);
+match gfc_match_else (void);
+match gfc_match_elseif (void);
+match gfc_match_critical (void);
+match gfc_match_block (void);
+match gfc_match_associate (void);
+match gfc_match_do (void);
+match gfc_match_cycle (void);
+match gfc_match_exit (void);
+match gfc_match_pause (void);
+match gfc_match_stop (void);
+match gfc_match_error_stop (void);
+match gfc_match_continue (void);
+match gfc_match_assign (void);
+match gfc_match_goto (void);
+match gfc_match_sync_all (void);
+match gfc_match_sync_images (void);
+match gfc_match_sync_memory (void);
+
+match gfc_match_allocate (void);
+match gfc_match_nullify (void);
+match gfc_match_deallocate (void);
+match gfc_match_return (void);
+match gfc_match_call (void);
+
+/* We want to use this function to check for a common-block-name
+   that can exist in a bind statement, so removed the "static"
+   declaration of the function in match.c.
+ 
+   TODO: should probably rename this now that it'll be globally seen to
+   gfc_match_common_name.  */
+match match_common_name (char *name);
+
+match gfc_match_common (void);
+match gfc_match_block_data (void);
+match gfc_match_namelist (void);
+match gfc_match_module (void);
+match gfc_match_equivalence (void);
+match gfc_match_st_function (void);
+match gfc_match_case (void);
+match gfc_match_select (void);
+match gfc_match_select_type (void);
+match gfc_match_type_is (void);
+match gfc_match_class_is (void);
+match gfc_match_where (gfc_statement *);
+match gfc_match_elsewhere (void);
+match gfc_match_forall (gfc_statement *);
+
+/* Other functions.  */
+
+gfc_common_head *gfc_get_common (const char *, int);
+
+/* openmp.c.  */
+
+/* OpenMP directive matchers.  */
+match gfc_match_omp_eos (void);
+match gfc_match_omp_atomic (void);
+match gfc_match_omp_barrier (void);
+match gfc_match_omp_critical (void);
+match gfc_match_omp_do (void);
+match gfc_match_omp_flush (void);
+match gfc_match_omp_master (void);
+match gfc_match_omp_ordered (void);
+match gfc_match_omp_parallel (void);
+match gfc_match_omp_parallel_do (void);
+match gfc_match_omp_parallel_sections (void);
+match gfc_match_omp_parallel_workshare (void);
+match gfc_match_omp_sections (void);
+match gfc_match_omp_single (void);
+match gfc_match_omp_task (void);
+match gfc_match_omp_taskwait (void);
+match gfc_match_omp_threadprivate (void);
+match gfc_match_omp_workshare (void);
+match gfc_match_omp_end_nowait (void);
+match gfc_match_omp_end_single (void);
+
+/* decl.c.  */
+
+match gfc_match_data (void);
+match gfc_match_null (gfc_expr **);
+match gfc_match_kind_spec (gfc_typespec *, bool);
+match gfc_match_old_kind_spec (gfc_typespec *);
+match gfc_match_decl_type_spec (gfc_typespec *, int);
+
+match gfc_match_end (gfc_statement *);
+match gfc_match_data_decl (void);
+match gfc_match_formal_arglist (gfc_symbol *, int, int);
+match gfc_match_procedure (void);
+match gfc_match_generic (void);
+match gfc_match_function_decl (void);
+match gfc_match_entry (void);
+match gfc_match_subroutine (void);
+match gfc_match_derived_decl (void);
+match gfc_match_final_decl (void);
+
+match gfc_match_implicit_none (void);
+match gfc_match_implicit (void);
+
+void gfc_set_constant_character_len (int, gfc_expr *, int);
+
+/* Matchers for attribute declarations.  */
+match gfc_match_allocatable (void);
+match gfc_match_asynchronous (void);
+match gfc_match_codimension (void);
+match gfc_match_contiguous (void);
+match gfc_match_dimension (void);
+match gfc_match_external (void);
+match gfc_match_gcc_attributes (void);
+match gfc_match_import (void);
+match gfc_match_intent (void);
+match gfc_match_intrinsic (void);
+match gfc_match_optional (void);
+match gfc_match_parameter (void);
+match gfc_match_pointer (void);
+match gfc_match_protected (void);
+match gfc_match_private (gfc_statement *);
+match gfc_match_public (gfc_statement *);
+match gfc_match_save (void);
+match gfc_match_modproc (void);
+match gfc_match_target (void);
+match gfc_match_value (void);
+match gfc_match_volatile (void);
+
+/* decl.c.  */
+
+/* Fortran 2003 c interop.
+   TODO: some of these should be moved to another file rather than decl.c */
+void set_com_block_bind_c (gfc_common_head *, int);
+gfc_try set_binding_label (char *, const char *, int);
+gfc_try set_verify_bind_c_sym (gfc_symbol *, int);
+gfc_try set_verify_bind_c_com_block (gfc_common_head *, int);
+gfc_try get_bind_c_idents (void);
+match gfc_match_bind_c_stmt (void);
+match gfc_match_suffix (gfc_symbol *, gfc_symbol **);
+match gfc_match_bind_c (gfc_symbol *, bool);
+match gfc_get_type_attr_spec (symbol_attribute *, char*);
+
+/* primary.c.  */
+match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **, bool);
+match gfc_match_variable (gfc_expr **, int);
+match gfc_match_equiv_variable (gfc_expr **);
+match gfc_match_actual_arglist (int, gfc_actual_arglist **);
+match gfc_match_literal_constant (gfc_expr **, int);
+
+/* expr.c -- FIXME: this one should be eliminated by moving the
+   matcher to matchexp.c and a call to a new function in expr.c that
+   only makes sure the init expr. is valid.  */
+gfc_try gfc_reduce_init_expr (gfc_expr *expr);
+match gfc_match_init_expr (gfc_expr **);
+
+/* array.c.  */
+match gfc_match_array_spec (gfc_array_spec **, bool, bool);
+match gfc_match_array_ref (gfc_array_ref *, gfc_array_spec *, int, int);
+match gfc_match_array_constructor (gfc_expr **);
+
+/* interface.c.  */
+match gfc_match_abstract_interface (void);
+match gfc_match_generic_spec (interface_type *, char *, gfc_intrinsic_op *);
+match gfc_match_interface (void);
+match gfc_match_end_interface (void);
+
+/* io.c.  */
+match gfc_match_format (void);
+match gfc_match_open (void);
+match gfc_match_close (void);
+match gfc_match_endfile (void);
+match gfc_match_backspace (void);
+match gfc_match_rewind (void);
+match gfc_match_flush (void);
+match gfc_match_inquire (void);
+match gfc_match_read (void);
+match gfc_match_wait (void);
+match gfc_match_write (void);
+match gfc_match_print (void);
+
+/* matchexp.c.  */
+match gfc_match_defined_op_name (char *, int);
+match gfc_match_expr (gfc_expr **);
+
+/* module.c.  */
+match gfc_match_use (void);
+void gfc_use_module (void);
+
+#endif  /* GFC_MATCH_H  */
+
diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c
new file mode 100644
index 000000000..8b99ce986
--- /dev/null
+++ b/gcc/fortran/matchexp.c
@@ -0,0 +1,900 @@
+/* Expression parser.
+   Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+#include "arith.h"
+#include "match.h"
+
+static char expression_syntax[] = N_("Syntax error in expression at %C");
+
+
+/* Match a user-defined operator name.  This is a normal name with a
+   few restrictions.  The error_flag controls whether an error is
+   raised if 'true' or 'false' are used or not.  */
+
+match
+gfc_match_defined_op_name (char *result, int error_flag)
+{
+  static const char * const badops[] = {
+    "and", "or", "not", "eqv", "neqv", "eq", "ne", "ge", "le", "lt", "gt",
+      NULL
+  };
+
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  locus old_loc;
+  match m;
+  int i;
+
+  old_loc = gfc_current_locus;
+
+  m = gfc_match (" . %n .", name);
+  if (m != MATCH_YES)
+    return m;
+
+  /* .true. and .false. have interpretations as constants.  Trying to
+     use these as operators will fail at a later time.  */
+
+  if (strcmp (name, "true") == 0 || strcmp (name, "false") == 0)
+    {
+      if (error_flag)
+	goto error;
+      gfc_current_locus = old_loc;
+      return MATCH_NO;
+    }
+
+  for (i = 0; badops[i]; i++)
+    if (strcmp (badops[i], name) == 0)
+      goto error;
+
+  for (i = 0; name[i]; i++)
+    if (!ISALPHA (name[i]))
+      {
+	gfc_error ("Bad character '%c' in OPERATOR name at %C", name[i]);
+	return MATCH_ERROR;
+      }
+
+  strcpy (result, name);
+  return MATCH_YES;
+
+error:
+  gfc_error ("The name '%s' cannot be used as a defined operator at %C",
+	     name);
+
+  gfc_current_locus = old_loc;
+  return MATCH_ERROR;
+}
+
+
+/* Match a user defined operator.  The symbol found must be an
+   operator already.  */
+
+static match
+match_defined_operator (gfc_user_op **result)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  match m;
+
+  m = gfc_match_defined_op_name (name, 0);
+  if (m != MATCH_YES)
+    return m;
+
+  *result = gfc_get_uop (name);
+  return MATCH_YES;
+}
+
+
+/* Check to see if the given operator is next on the input.  If this
+   is not the case, the parse pointer remains where it was.  */
+
+static int
+next_operator (gfc_intrinsic_op t)
+{
+  gfc_intrinsic_op u;
+  locus old_loc;
+
+  old_loc = gfc_current_locus;
+  if (gfc_match_intrinsic_op (&u) == MATCH_YES && t == u)
+    return 1;
+
+  gfc_current_locus = old_loc;
+  return 0;
+}
+
+
+/* Call the INTRINSIC_PARENTHESES function.  This is both
+   used explicitly, as below, or by resolve.c to generate
+   temporaries.  */
+
+gfc_expr *
+gfc_get_parentheses (gfc_expr *e)
+{
+  gfc_expr *e2;
+
+  e2 = gfc_get_operator_expr (&e->where, INTRINSIC_PARENTHESES, e, NULL);
+  e2->ts = e->ts;
+  e2->rank = e->rank;
+
+  return e2;
+}
+
+
+/* Match a primary expression.  */
+
+static match
+match_primary (gfc_expr **result)
+{
+  match m;
+  gfc_expr *e;
+
+  m = gfc_match_literal_constant (result, 0);
+  if (m != MATCH_NO)
+    return m;
+
+  m = gfc_match_array_constructor (result);
+  if (m != MATCH_NO)
+    return m;
+
+  m = gfc_match_rvalue (result);
+  if (m != MATCH_NO)
+    return m;
+
+  /* Match an expression in parentheses.  */
+  if (gfc_match_char ('(') != MATCH_YES)
+    return MATCH_NO;
+
+  m = gfc_match_expr (&e);
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
+    return m;
+
+  m = gfc_match_char (')');
+  if (m == MATCH_NO)
+    gfc_error ("Expected a right parenthesis in expression at %C");
+
+  /* Now we have the expression inside the parentheses, build the
+     expression pointing to it. By 7.1.7.2, any expression in
+     parentheses shall be treated as a data entity.  */
+  *result = gfc_get_parentheses (e);
+
+  if (m != MATCH_YES)
+    {
+      gfc_free_expr (*result);
+      return MATCH_ERROR;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error (expression_syntax);
+  return MATCH_ERROR;
+}
+
+
+/* Match a level 1 expression.  */
+
+static match
+match_level_1 (gfc_expr **result)
+{
+  gfc_user_op *uop;
+  gfc_expr *e, *f;
+  locus where;
+  match m;
+
+  where = gfc_current_locus;
+  uop = NULL;
+  m = match_defined_operator (&uop);
+  if (m == MATCH_ERROR)
+    return m;
+
+  m = match_primary (&e);
+  if (m != MATCH_YES)
+    return m;
+
+  if (uop == NULL)
+    *result = e;
+  else
+    {
+      f = gfc_get_operator_expr (&where, INTRINSIC_USER, e, NULL);
+      f->value.op.uop = uop;
+      *result = f;
+    }
+
+  return MATCH_YES;
+}
+
+
+/* As a GNU extension we support an expanded level-2 expression syntax.
+   Via this extension we support (arbitrary) nesting of unary plus and
+   minus operations following unary and binary operators, such as **.
+   The grammar of section 7.1.1.3 is effectively rewritten as:
+
+	R704  mult-operand     is level-1-expr [ power-op ext-mult-operand ]
+	R704' ext-mult-operand is add-op ext-mult-operand
+			       or mult-operand
+	R705  add-operand      is add-operand mult-op ext-mult-operand
+			       or mult-operand
+	R705' ext-add-operand  is add-op ext-add-operand
+			       or add-operand
+	R706  level-2-expr     is [ level-2-expr ] add-op ext-add-operand
+			       or add-operand
+ */
+
+static match match_ext_mult_operand (gfc_expr **result);
+static match match_ext_add_operand (gfc_expr **result);
+
+static int
+match_add_op (void)
+{
+  if (next_operator (INTRINSIC_MINUS))
+    return -1;
+  if (next_operator (INTRINSIC_PLUS))
+    return 1;
+  return 0;
+}
+
+
+static match
+match_mult_operand (gfc_expr **result)
+{
+  gfc_expr *e, *exp, *r;
+  locus where;
+  match m;
+
+  m = match_level_1 (&e);
+  if (m != MATCH_YES)
+    return m;
+
+  if (!next_operator (INTRINSIC_POWER))
+    {
+      *result = e;
+      return MATCH_YES;
+    }
+
+  where = gfc_current_locus;
+
+  m = match_ext_mult_operand (&exp);
+  if (m == MATCH_NO)
+    gfc_error ("Expected exponent in expression at %C");
+  if (m != MATCH_YES)
+    {
+      gfc_free_expr (e);
+      return MATCH_ERROR;
+    }
+
+  r = gfc_power (e, exp);
+  if (r == NULL)
+    {
+      gfc_free_expr (e);
+      gfc_free_expr (exp);
+      return MATCH_ERROR;
+    }
+
+  r->where = where;
+  *result = r;
+
+  return MATCH_YES;
+}
+
+
+static match
+match_ext_mult_operand (gfc_expr **result)
+{
+  gfc_expr *all, *e;
+  locus where;
+  match m;
+  int i;
+
+  where = gfc_current_locus;
+  i = match_add_op ();
+
+  if (i == 0)
+    return match_mult_operand (result);
+
+  if (gfc_notification_std (GFC_STD_GNU) == ERROR)
+    {
+      gfc_error ("Extension: Unary operator following "
+		 "arithmetic operator (use parentheses) at %C");
+      return MATCH_ERROR;
+    }
+  else
+    gfc_warning ("Extension: Unary operator following "
+		 "arithmetic operator (use parentheses) at %C");
+
+  m = match_ext_mult_operand (&e);
+  if (m != MATCH_YES)
+    return m;
+
+  if (i == -1)
+    all = gfc_uminus (e);
+  else
+    all = gfc_uplus (e);
+
+  if (all == NULL)
+    {
+      gfc_free_expr (e);
+      return MATCH_ERROR;
+    }
+
+  all->where = where;
+  *result = all;
+  return MATCH_YES;
+}
+
+
+static match
+match_add_operand (gfc_expr **result)
+{
+  gfc_expr *all, *e, *total;
+  locus where, old_loc;
+  match m;
+  gfc_intrinsic_op i;
+
+  m = match_mult_operand (&all);
+  if (m != MATCH_YES)
+    return m;
+
+  for (;;)
+    {
+      /* Build up a string of products or quotients.  */
+
+      old_loc = gfc_current_locus;
+
+      if (next_operator (INTRINSIC_TIMES))
+	i = INTRINSIC_TIMES;
+      else
+	{
+	  if (next_operator (INTRINSIC_DIVIDE))
+	    i = INTRINSIC_DIVIDE;
+	  else
+	    break;
+	}
+
+      where = gfc_current_locus;
+
+      m = match_ext_mult_operand (&e);
+      if (m == MATCH_NO)
+	{
+	  gfc_current_locus = old_loc;
+	  break;
+	}
+
+      if (m == MATCH_ERROR)
+	{
+	  gfc_free_expr (all);
+	  return MATCH_ERROR;
+	}
+
+      if (i == INTRINSIC_TIMES)
+	total = gfc_multiply (all, e);
+      else
+	total = gfc_divide (all, e);
+
+      if (total == NULL)
+	{
+	  gfc_free_expr (all);
+	  gfc_free_expr (e);
+	  return MATCH_ERROR;
+	}
+
+      all = total;
+      all->where = where;
+    }
+
+  *result = all;
+  return MATCH_YES;
+}
+
+
+static match
+match_ext_add_operand (gfc_expr **result)
+{
+  gfc_expr *all, *e;
+  locus where;
+  match m;
+  int i;
+
+  where = gfc_current_locus;
+  i = match_add_op ();
+
+  if (i == 0)
+    return match_add_operand (result);
+
+  if (gfc_notification_std (GFC_STD_GNU) == ERROR)
+    {
+      gfc_error ("Extension: Unary operator following "
+		 "arithmetic operator (use parentheses) at %C");
+      return MATCH_ERROR;
+    }
+  else
+    gfc_warning ("Extension: Unary operator following "
+		"arithmetic operator (use parentheses) at %C");
+
+  m = match_ext_add_operand (&e);
+  if (m != MATCH_YES)
+    return m;
+
+  if (i == -1)
+    all = gfc_uminus (e);
+  else
+    all = gfc_uplus (e);
+
+  if (all == NULL)
+    {
+      gfc_free_expr (e);
+      return MATCH_ERROR;
+    }
+
+  all->where = where;
+  *result = all;
+  return MATCH_YES;
+}
+
+
+/* Match a level 2 expression.  */
+
+static match
+match_level_2 (gfc_expr **result)
+{
+  gfc_expr *all, *e, *total;
+  locus where;
+  match m;
+  int i;
+
+  where = gfc_current_locus;
+  i = match_add_op ();
+
+  if (i != 0)
+    {
+      m = match_ext_add_operand (&e);
+      if (m == MATCH_NO)
+	{
+	  gfc_error (expression_syntax);
+	  m = MATCH_ERROR;
+	}
+    }
+  else
+    m = match_add_operand (&e);
+
+  if (m != MATCH_YES)
+    return m;
+
+  if (i == 0)
+    all = e;
+  else
+    {
+      if (i == -1)
+	all = gfc_uminus (e);
+      else
+	all = gfc_uplus (e);
+
+      if (all == NULL)
+	{
+	  gfc_free_expr (e);
+	  return MATCH_ERROR;
+	}
+    }
+
+  all->where = where;
+
+  /* Append add-operands to the sum.  */
+
+  for (;;)
+    {
+      where = gfc_current_locus;
+      i = match_add_op ();
+      if (i == 0)
+	break;
+
+      m = match_ext_add_operand (&e);
+      if (m == MATCH_NO)
+	gfc_error (expression_syntax);
+      if (m != MATCH_YES)
+	{
+	  gfc_free_expr (all);
+	  return MATCH_ERROR;
+	}
+
+      if (i == -1)
+	total = gfc_subtract (all, e);
+      else
+	total = gfc_add (all, e);
+
+      if (total == NULL)
+	{
+	  gfc_free_expr (all);
+	  gfc_free_expr (e);
+	  return MATCH_ERROR;
+	}
+
+      all = total;
+      all->where = where;
+    }
+
+  *result = all;
+  return MATCH_YES;
+}
+
+
+/* Match a level three expression.  */
+
+static match
+match_level_3 (gfc_expr **result)
+{
+  gfc_expr *all, *e, *total;
+  locus where;
+  match m;
+
+  m = match_level_2 (&all);
+  if (m != MATCH_YES)
+    return m;
+
+  for (;;)
+    {
+      if (!next_operator (INTRINSIC_CONCAT))
+	break;
+
+      where = gfc_current_locus;
+
+      m = match_level_2 (&e);
+      if (m == MATCH_NO)
+	{
+	  gfc_error (expression_syntax);
+	  gfc_free_expr (all);
+	}
+      if (m != MATCH_YES)
+	return MATCH_ERROR;
+
+      total = gfc_concat (all, e);
+      if (total == NULL)
+	{
+	  gfc_free_expr (all);
+	  gfc_free_expr (e);
+	  return MATCH_ERROR;
+	}
+
+      all = total;
+      all->where = where;
+    }
+
+  *result = all;
+  return MATCH_YES;
+}
+
+
+/* Match a level 4 expression.  */
+
+static match
+match_level_4 (gfc_expr **result)
+{
+  gfc_expr *left, *right, *r;
+  gfc_intrinsic_op i;
+  locus old_loc;
+  locus where;
+  match m;
+
+  m = match_level_3 (&left);
+  if (m != MATCH_YES)
+    return m;
+
+  old_loc = gfc_current_locus;
+
+  if (gfc_match_intrinsic_op (&i) != MATCH_YES)
+    {
+      *result = left;
+      return MATCH_YES;
+    }
+
+  if (i != INTRINSIC_EQ && i != INTRINSIC_NE && i != INTRINSIC_GE
+      && i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT
+      && i != INTRINSIC_EQ_OS && i != INTRINSIC_NE_OS && i != INTRINSIC_GE_OS
+      && i != INTRINSIC_LE_OS && i != INTRINSIC_LT_OS && i != INTRINSIC_GT_OS)
+    {
+      gfc_current_locus = old_loc;
+      *result = left;
+      return MATCH_YES;
+    }
+
+  where = gfc_current_locus;
+
+  m = match_level_3 (&right);
+  if (m == MATCH_NO)
+    gfc_error (expression_syntax);
+  if (m != MATCH_YES)
+    {
+      gfc_free_expr (left);
+      return MATCH_ERROR;
+    }
+
+  switch (i)
+    {
+    case INTRINSIC_EQ:
+    case INTRINSIC_EQ_OS:
+      r = gfc_eq (left, right, i);
+      break;
+
+    case INTRINSIC_NE:
+    case INTRINSIC_NE_OS:
+      r = gfc_ne (left, right, i);
+      break;
+
+    case INTRINSIC_LT:
+    case INTRINSIC_LT_OS:
+      r = gfc_lt (left, right, i);
+      break;
+
+    case INTRINSIC_LE:
+    case INTRINSIC_LE_OS:
+      r = gfc_le (left, right, i);
+      break;
+
+    case INTRINSIC_GT:
+    case INTRINSIC_GT_OS:
+      r = gfc_gt (left, right, i);
+      break;
+
+    case INTRINSIC_GE:
+    case INTRINSIC_GE_OS:
+      r = gfc_ge (left, right, i);
+      break;
+
+    default:
+      gfc_internal_error ("match_level_4(): Bad operator");
+    }
+
+  if (r == NULL)
+    {
+      gfc_free_expr (left);
+      gfc_free_expr (right);
+      return MATCH_ERROR;
+    }
+
+  r->where = where;
+  *result = r;
+
+  return MATCH_YES;
+}
+
+
+static match
+match_and_operand (gfc_expr **result)
+{
+  gfc_expr *e, *r;
+  locus where;
+  match m;
+  int i;
+
+  i = next_operator (INTRINSIC_NOT);
+  where = gfc_current_locus;
+
+  m = match_level_4 (&e);
+  if (m != MATCH_YES)
+    return m;
+
+  r = e;
+  if (i)
+    {
+      r = gfc_not (e);
+      if (r == NULL)
+	{
+	  gfc_free_expr (e);
+	  return MATCH_ERROR;
+	}
+    }
+
+  r->where = where;
+  *result = r;
+
+  return MATCH_YES;
+}
+
+
+static match
+match_or_operand (gfc_expr **result)
+{
+  gfc_expr *all, *e, *total;
+  locus where;
+  match m;
+
+  m = match_and_operand (&all);
+  if (m != MATCH_YES)
+    return m;
+
+  for (;;)
+    {
+      if (!next_operator (INTRINSIC_AND))
+	break;
+      where = gfc_current_locus;
+
+      m = match_and_operand (&e);
+      if (m == MATCH_NO)
+	gfc_error (expression_syntax);
+      if (m != MATCH_YES)
+	{
+	  gfc_free_expr (all);
+	  return MATCH_ERROR;
+	}
+
+      total = gfc_and (all, e);
+      if (total == NULL)
+	{
+	  gfc_free_expr (all);
+	  gfc_free_expr (e);
+	  return MATCH_ERROR;
+	}
+
+      all = total;
+      all->where = where;
+    }
+
+  *result = all;
+  return MATCH_YES;
+}
+
+
+static match
+match_equiv_operand (gfc_expr **result)
+{
+  gfc_expr *all, *e, *total;
+  locus where;
+  match m;
+
+  m = match_or_operand (&all);
+  if (m != MATCH_YES)
+    return m;
+
+  for (;;)
+    {
+      if (!next_operator (INTRINSIC_OR))
+	break;
+      where = gfc_current_locus;
+
+      m = match_or_operand (&e);
+      if (m == MATCH_NO)
+	gfc_error (expression_syntax);
+      if (m != MATCH_YES)
+	{
+	  gfc_free_expr (all);
+	  return MATCH_ERROR;
+	}
+
+      total = gfc_or (all, e);
+      if (total == NULL)
+	{
+	  gfc_free_expr (all);
+	  gfc_free_expr (e);
+	  return MATCH_ERROR;
+	}
+
+      all = total;
+      all->where = where;
+    }
+
+  *result = all;
+  return MATCH_YES;
+}
+
+
+/* Match a level 5 expression.  */
+
+static match
+match_level_5 (gfc_expr **result)
+{
+  gfc_expr *all, *e, *total;
+  locus where;
+  match m;
+  gfc_intrinsic_op i;
+
+  m = match_equiv_operand (&all);
+  if (m != MATCH_YES)
+    return m;
+
+  for (;;)
+    {
+      if (next_operator (INTRINSIC_EQV))
+	i = INTRINSIC_EQV;
+      else
+	{
+	  if (next_operator (INTRINSIC_NEQV))
+	    i = INTRINSIC_NEQV;
+	  else
+	    break;
+	}
+
+      where = gfc_current_locus;
+
+      m = match_equiv_operand (&e);
+      if (m == MATCH_NO)
+	gfc_error (expression_syntax);
+      if (m != MATCH_YES)
+	{
+	  gfc_free_expr (all);
+	  return MATCH_ERROR;
+	}
+
+      if (i == INTRINSIC_EQV)
+	total = gfc_eqv (all, e);
+      else
+	total = gfc_neqv (all, e);
+
+      if (total == NULL)
+	{
+	  gfc_free_expr (all);
+	  gfc_free_expr (e);
+	  return MATCH_ERROR;
+	}
+
+      all = total;
+      all->where = where;
+    }
+
+  *result = all;
+  return MATCH_YES;
+}
+
+
+/* Match an expression.  At this level, we are stringing together
+   level 5 expressions separated by binary operators.  */
+
+match
+gfc_match_expr (gfc_expr **result)
+{
+  gfc_expr *all, *e;
+  gfc_user_op *uop;
+  locus where;
+  match m;
+
+  m = match_level_5 (&all);
+  if (m != MATCH_YES)
+    return m;
+
+  for (;;)
+    {
+      uop = NULL;
+      m = match_defined_operator (&uop);
+      if (m == MATCH_NO)
+	break;
+      if (m == MATCH_ERROR)
+	{
+	  gfc_free_expr (all);
+	  return MATCH_ERROR;
+	}
+
+      where = gfc_current_locus;
+
+      m = match_level_5 (&e);
+      if (m == MATCH_NO)
+	gfc_error (expression_syntax);
+      if (m != MATCH_YES)
+	{
+	  gfc_free_expr (all);
+	  return MATCH_ERROR;
+	}
+
+      all = gfc_get_operator_expr (&where, INTRINSIC_USER, all, e);
+      all->value.op.uop = uop;
+    }
+
+  *result = all;
+  return MATCH_YES;
+}
diff --git a/gcc/fortran/mathbuiltins.def b/gcc/fortran/mathbuiltins.def
new file mode 100644
index 000000000..b0bcc1fa6
--- /dev/null
+++ b/gcc/fortran/mathbuiltins.def
@@ -0,0 +1,71 @@
+/* Copyright (C) 2004, 2005, 2007, 2008, 2010 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* DEFINE_MATH_BUILTIN (CODE, NAME, ARGTYPE)
+   NAME	  The name of the builtin
+   SNAME  The name of the builtin as a string
+   ARGTYPE The type of the arguments.  See f95-lang.c
+
+   Use DEFINE_MATH_BUILTIN_C if the complex versions of the builtin are
+   also available.  */
+DEFINE_MATH_BUILTIN_C (ACOS,  "acos",   0)
+DEFINE_MATH_BUILTIN_C (ACOSH, "acosh",  0)
+DEFINE_MATH_BUILTIN_C (ASIN,  "asin",   0)
+DEFINE_MATH_BUILTIN_C (ASINH, "asinh",  0)
+DEFINE_MATH_BUILTIN_C (ATAN,  "atan",   0)
+DEFINE_MATH_BUILTIN_C (ATANH, "atanh",  0)
+DEFINE_MATH_BUILTIN   (ATAN2, "atan2",  1)
+DEFINE_MATH_BUILTIN_C (COS,   "cos",    0)
+DEFINE_MATH_BUILTIN_C (COSH,  "cosh",   0)
+DEFINE_MATH_BUILTIN_C (EXP,   "exp",    0)
+DEFINE_MATH_BUILTIN_C (LOG,   "log",    0)
+DEFINE_MATH_BUILTIN_C (LOG10, "log10",  0)
+DEFINE_MATH_BUILTIN_C (SIN,   "sin",    0)
+DEFINE_MATH_BUILTIN_C (SINH,  "sinh",   0)
+DEFINE_MATH_BUILTIN_C (SQRT,  "sqrt",   0)
+DEFINE_MATH_BUILTIN_C (TAN,   "tan",    0)
+DEFINE_MATH_BUILTIN_C (TANH,  "tanh",   0)
+DEFINE_MATH_BUILTIN   (J0,    "j0",     0)
+DEFINE_MATH_BUILTIN   (J1,    "j1",     0)
+DEFINE_MATH_BUILTIN   (JN,    "jn",     2)
+DEFINE_MATH_BUILTIN   (Y0,    "y0",     0)
+DEFINE_MATH_BUILTIN   (Y1,    "y1",     0)
+DEFINE_MATH_BUILTIN   (YN,    "yn",     2)
+DEFINE_MATH_BUILTIN   (ERF,   "erf",    0)
+DEFINE_MATH_BUILTIN   (ERFC,  "erfc",   0)
+DEFINE_MATH_BUILTIN   (TGAMMA,"tgamma", 0)
+DEFINE_MATH_BUILTIN   (LGAMMA,"lgamma", 0)
+DEFINE_MATH_BUILTIN   (HYPOT, "hypot",  1)
+
+/* OTHER_BUILTIN (CODE, NAME, PROTOTYPE_TYPE, CONST)
+   For floating-point builtins that do not directly correspond to a
+   Fortran intrinsic. This is used to map the different variants (float,
+   double and long double) and to build the quad-precision decls.  */
+OTHER_BUILTIN (CABS,      "cabs",      cabs,    true)
+OTHER_BUILTIN (COPYSIGN,  "copysign",  2,       true)
+OTHER_BUILTIN (CPOW,      "cpow",      cpow,    true)
+OTHER_BUILTIN (FABS,      "fabs",      1,       true)
+OTHER_BUILTIN (FMOD,      "fmod",      2,       true)
+OTHER_BUILTIN (FREXP,     "frexp",     frexp,   false)
+OTHER_BUILTIN (LLROUND,   "llround",   llround, true)
+OTHER_BUILTIN (LROUND,    "lround",    lround,  true)
+OTHER_BUILTIN (NEXTAFTER, "nextafter", 2,       true)
+OTHER_BUILTIN (POW,       "pow",       1,       true)
+OTHER_BUILTIN (ROUND,     "round",     1,       true)
+OTHER_BUILTIN (SCALBN,    "scalbn",    scalbn,  true)
+OTHER_BUILTIN (TRUNC,     "trunc",     1,       true)
diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c
new file mode 100644
index 000000000..4dd186f6a
--- /dev/null
+++ b/gcc/fortran/misc.c
@@ -0,0 +1,312 @@
+/* Miscellaneous stuff that doesn't fit anywhere else.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2010
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+
+/* Get a block of memory.  Many callers assume that the memory we
+   return is zeroed.  */
+
+void *
+gfc_getmem (size_t n)
+{
+  void *p;
+
+  if (n == 0)
+    return NULL;
+
+  p = xmalloc (n);
+  if (p == NULL)
+    gfc_fatal_error ("Allocation would exceed memory limit -- malloc() failed");
+  memset (p, 0, n);
+  return p;
+}
+
+
+void
+gfc_free (void *p)
+{
+  /* The parentheses around free are needed in order to call not
+     the redefined free of gfortran.h.  */
+  if (p != NULL)
+    (free) (p);
+}
+
+
+/* Get terminal width.  */
+
+int
+gfc_terminal_width (void)
+{
+  return 80;
+}
+
+
+/* Initialize a typespec to unknown.  */
+
+void
+gfc_clear_ts (gfc_typespec *ts)
+{
+  ts->type = BT_UNKNOWN;
+  ts->u.derived = NULL;
+  ts->kind = 0;
+  ts->u.cl = NULL;
+  ts->interface = NULL;
+  /* flag that says if the type is C interoperable */
+  ts->is_c_interop = 0;
+  /* says what f90 type the C kind interops with */
+  ts->f90_type = BT_UNKNOWN;
+  /* flag that says whether it's from iso_c_binding or not */
+  ts->is_iso_c = 0;
+  ts->deferred = false;
+}
+
+
+/* Open a file for reading.  */
+
+FILE *
+gfc_open_file (const char *name)
+{
+  struct stat statbuf;
+
+  if (!*name)
+    return stdin;
+
+  if (stat (name, &statbuf) < 0)
+    return NULL;
+
+  if (!S_ISREG (statbuf.st_mode))
+    return NULL;
+
+  return fopen (name, "r");
+}
+
+
+/* Return a string for each type.  */
+
+const char *
+gfc_basic_typename (bt type)
+{
+  const char *p;
+
+  switch (type)
+    {
+    case BT_INTEGER:
+      p = "INTEGER";
+      break;
+    case BT_REAL:
+      p = "REAL";
+      break;
+    case BT_COMPLEX:
+      p = "COMPLEX";
+      break;
+    case BT_LOGICAL:
+      p = "LOGICAL";
+      break;
+    case BT_CHARACTER:
+      p = "CHARACTER";
+      break;
+    case BT_HOLLERITH:
+      p = "HOLLERITH";
+      break;
+    case BT_DERIVED:
+      p = "DERIVED";
+      break;
+    case BT_CLASS:
+      p = "CLASS";
+      break;
+    case BT_PROCEDURE:
+      p = "PROCEDURE";
+      break;
+    case BT_VOID:
+      p = "VOID";
+      break;
+    case BT_UNKNOWN:
+      p = "UNKNOWN";
+      break;
+    default:
+      gfc_internal_error ("gfc_basic_typename(): Undefined type");
+    }
+
+  return p;
+}
+
+
+/* Return a string describing the type and kind of a typespec.  Because
+   we return alternating buffers, this subroutine can appear twice in
+   the argument list of a single statement.  */
+
+const char *
+gfc_typename (gfc_typespec *ts)
+{
+  static char buffer1[GFC_MAX_SYMBOL_LEN + 7];  /* 7 for "TYPE()" + '\0'.  */
+  static char buffer2[GFC_MAX_SYMBOL_LEN + 7];
+  static int flag = 0;
+  char *buffer;
+
+  buffer = flag ? buffer1 : buffer2;
+  flag = !flag;
+
+  switch (ts->type)
+    {
+    case BT_INTEGER:
+      sprintf (buffer, "INTEGER(%d)", ts->kind);
+      break;
+    case BT_REAL:
+      sprintf (buffer, "REAL(%d)", ts->kind);
+      break;
+    case BT_COMPLEX:
+      sprintf (buffer, "COMPLEX(%d)", ts->kind);
+      break;
+    case BT_LOGICAL:
+      sprintf (buffer, "LOGICAL(%d)", ts->kind);
+      break;
+    case BT_CHARACTER:
+      sprintf (buffer, "CHARACTER(%d)", ts->kind);
+      break;
+    case BT_HOLLERITH:
+      sprintf (buffer, "HOLLERITH");
+      break;
+    case BT_DERIVED:
+      sprintf (buffer, "TYPE(%s)", ts->u.derived->name);
+      break;
+    case BT_CLASS:
+      sprintf (buffer, "CLASS(%s)",
+	       ts->u.derived->components->ts.u.derived->name);
+      break;
+    case BT_PROCEDURE:
+      strcpy (buffer, "PROCEDURE");
+      break;
+    case BT_UNKNOWN:
+      strcpy (buffer, "UNKNOWN");
+      break;
+    default:
+      gfc_internal_error ("gfc_typename(): Undefined type");
+    }
+
+  return buffer;
+}
+
+
+/* Given an mstring array and a code, locate the code in the table,
+   returning a pointer to the string.  */
+
+const char *
+gfc_code2string (const mstring *m, int code)
+{
+  while (m->string != NULL)
+    {
+      if (m->tag == code)
+	return m->string;
+      m++;
+    }
+
+  gfc_internal_error ("gfc_code2string(): Bad code");
+  /* Not reached */
+}
+
+
+/* Given an mstring array and a string, returns the value of the tag
+   field.  Returns the final tag if no matches to the string are found.  */
+
+int
+gfc_string2code (const mstring *m, const char *string)
+{
+  for (; m->string != NULL; m++)
+    if (strcmp (m->string, string) == 0)
+      return m->tag;
+
+  return m->tag;
+}
+
+
+/* Convert an intent code to a string.  */
+/* TODO: move to gfortran.h as define.  */
+
+const char *
+gfc_intent_string (sym_intent i)
+{
+  return gfc_code2string (intents, i);
+}
+
+
+/***************** Initialization functions ****************/
+
+/* Top level initialization.  */
+
+void
+gfc_init_1 (void)
+{
+  gfc_error_init_1 ();
+  gfc_scanner_init_1 ();
+  gfc_arith_init_1 ();
+  gfc_intrinsic_init_1 ();
+}
+
+
+/* Per program unit initialization.  */
+
+void
+gfc_init_2 (void)
+{
+  gfc_symbol_init_2 ();
+  gfc_module_init_2 ();
+}
+
+
+/******************* Destructor functions ******************/
+
+/* Call all of the top level destructors.  */
+
+void
+gfc_done_1 (void)
+{
+  gfc_scanner_done_1 ();
+  gfc_intrinsic_done_1 ();
+  gfc_arith_done_1 ();
+}
+
+
+/* Per program unit destructors.  */
+
+void
+gfc_done_2 (void)
+{
+  gfc_symbol_done_2 ();
+  gfc_module_done_2 ();
+}
+
+
+/* Returns the index into the table of C interoperable kinds where the
+   kind with the given name (c_kind_name) was found.  */
+
+int
+get_c_kind(const char *c_kind_name, CInteropKind_t kinds_table[])
+{
+  int index = 0;
+
+  for (index = 0; index < ISOCBINDING_LAST; index++)
+    if (strcmp (kinds_table[index].name, c_kind_name) == 0)
+      return index;
+
+  return ISOCBINDING_INVALID;
+}
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
new file mode 100644
index 000000000..c52015db5
--- /dev/null
+++ b/gcc/fortran/module.c
@@ -0,0 +1,5820 @@
+/* Handle modules, which amounts to loading and saving symbols and
+   their attendant structures.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2009, 2010, 2011
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* The syntax of gfortran modules resembles that of lisp lists, i.e. a
+   sequence of atoms, which can be left or right parenthesis, names,
+   integers or strings.  Parenthesis are always matched which allows
+   us to skip over sections at high speed without having to know
+   anything about the internal structure of the lists.  A "name" is
+   usually a fortran 95 identifier, but can also start with '@' in
+   order to reference a hidden symbol.
+
+   The first line of a module is an informational message about what
+   created the module, the file it came from and when it was created.
+   The second line is a warning for people not to edit the module.
+   The rest of the module looks like:
+
+   ( ( <Interface info for UPLUS> )
+     ( <Interface info for UMINUS> )
+     ...
+   )
+   ( ( <name of operator interface> <module of op interface> <i/f1> ... )
+     ...
+   )
+   ( ( <name of generic interface> <module of generic interface> <i/f1> ... )
+     ...
+   )
+   ( ( <common name> <symbol> <saved flag>)
+     ...
+   )
+
+   ( equivalence list )
+
+   ( <Symbol Number (in no particular order)>
+     <True name of symbol>
+     <Module name of symbol>
+     ( <symbol information> )
+     ...
+   )
+   ( <Symtree name>
+     <Ambiguous flag>
+     <Symbol number>
+     ...
+   )
+
+   In general, symbols refer to other symbols by their symbol number,
+   which are zero based.  Symbols are written to the module in no
+   particular order.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+#include "arith.h"
+#include "match.h"
+#include "parse.h" /* FIXME */
+#include "md5.h"
+#include "constructor.h"
+#include "cpp.h"
+
+#define MODULE_EXTENSION ".mod"
+
+/* Don't put any single quote (') in MOD_VERSION, 
+   if yout want it to be recognized.  */
+#define MOD_VERSION "6"
+
+
+/* Structure that describes a position within a module file.  */
+
+typedef struct
+{
+  int column, line;
+  fpos_t pos;
+}
+module_locus;
+
+/* Structure for list of symbols of intrinsic modules.  */
+typedef struct
+{
+  int id;
+  const char *name;
+  int value;
+  int standard;
+}
+intmod_sym;
+
+
+typedef enum
+{
+  P_UNKNOWN = 0, P_OTHER, P_NAMESPACE, P_COMPONENT, P_SYMBOL
+}
+pointer_t;
+
+/* The fixup structure lists pointers to pointers that have to
+   be updated when a pointer value becomes known.  */
+
+typedef struct fixup_t
+{
+  void **pointer;
+  struct fixup_t *next;
+}
+fixup_t;
+
+
+/* Structure for holding extra info needed for pointers being read.  */
+
+enum gfc_rsym_state
+{
+  UNUSED,
+  NEEDED,
+  USED
+};
+
+enum gfc_wsym_state
+{
+  UNREFERENCED = 0,
+  NEEDS_WRITE,
+  WRITTEN
+};
+
+typedef struct pointer_info
+{
+  BBT_HEADER (pointer_info);
+  int integer;
+  pointer_t type;
+
+  /* The first component of each member of the union is the pointer
+     being stored.  */
+
+  fixup_t *fixup;
+
+  union
+  {
+    void *pointer;	/* Member for doing pointer searches.  */
+
+    struct
+    {
+      gfc_symbol *sym;
+      char true_name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1];
+      enum gfc_rsym_state state;
+      int ns, referenced, renamed;
+      module_locus where;
+      fixup_t *stfixup;
+      gfc_symtree *symtree;
+      char binding_label[GFC_MAX_SYMBOL_LEN + 1];
+    }
+    rsym;
+
+    struct
+    {
+      gfc_symbol *sym;
+      enum gfc_wsym_state state;
+    }
+    wsym;
+  }
+  u;
+
+}
+pointer_info;
+
+#define gfc_get_pointer_info() XCNEW (pointer_info)
+
+
+/* Local variables */
+
+/* The FILE for the module we're reading or writing.  */
+static FILE *module_fp;
+
+/* MD5 context structure.  */
+static struct md5_ctx ctx;
+
+/* The name of the module we're reading (USE'ing) or writing.  */
+static char module_name[GFC_MAX_SYMBOL_LEN + 1];
+
+/* The way the module we're reading was specified.  */
+static bool specified_nonint, specified_int;
+
+static int module_line, module_column, only_flag;
+static enum
+{ IO_INPUT, IO_OUTPUT }
+iomode;
+
+static gfc_use_rename *gfc_rename_list;
+static pointer_info *pi_root;
+static int symbol_number;	/* Counter for assigning symbol numbers */
+
+/* Tells mio_expr_ref to make symbols for unused equivalence members.  */
+static bool in_load_equiv;
+
+static locus use_locus;
+
+
+
+/*****************************************************************/
+
+/* Pointer/integer conversion.  Pointers between structures are stored
+   as integers in the module file.  The next couple of subroutines
+   handle this translation for reading and writing.  */
+
+/* Recursively free the tree of pointer structures.  */
+
+static void
+free_pi_tree (pointer_info *p)
+{
+  if (p == NULL)
+    return;
+
+  if (p->fixup != NULL)
+    gfc_internal_error ("free_pi_tree(): Unresolved fixup");
+
+  free_pi_tree (p->left);
+  free_pi_tree (p->right);
+
+  gfc_free (p);
+}
+
+
+/* Compare pointers when searching by pointer.  Used when writing a
+   module.  */
+
+static int
+compare_pointers (void *_sn1, void *_sn2)
+{
+  pointer_info *sn1, *sn2;
+
+  sn1 = (pointer_info *) _sn1;
+  sn2 = (pointer_info *) _sn2;
+
+  if (sn1->u.pointer < sn2->u.pointer)
+    return -1;
+  if (sn1->u.pointer > sn2->u.pointer)
+    return 1;
+
+  return 0;
+}
+
+
+/* Compare integers when searching by integer.  Used when reading a
+   module.  */
+
+static int
+compare_integers (void *_sn1, void *_sn2)
+{
+  pointer_info *sn1, *sn2;
+
+  sn1 = (pointer_info *) _sn1;
+  sn2 = (pointer_info *) _sn2;
+
+  if (sn1->integer < sn2->integer)
+    return -1;
+  if (sn1->integer > sn2->integer)
+    return 1;
+
+  return 0;
+}
+
+
+/* Initialize the pointer_info tree.  */
+
+static void
+init_pi_tree (void)
+{
+  compare_fn compare;
+  pointer_info *p;
+
+  pi_root = NULL;
+  compare = (iomode == IO_INPUT) ? compare_integers : compare_pointers;
+
+  /* Pointer 0 is the NULL pointer.  */
+  p = gfc_get_pointer_info ();
+  p->u.pointer = NULL;
+  p->integer = 0;
+  p->type = P_OTHER;
+
+  gfc_insert_bbt (&pi_root, p, compare);
+
+  /* Pointer 1 is the current namespace.  */
+  p = gfc_get_pointer_info ();
+  p->u.pointer = gfc_current_ns;
+  p->integer = 1;
+  p->type = P_NAMESPACE;
+
+  gfc_insert_bbt (&pi_root, p, compare);
+
+  symbol_number = 2;
+}
+
+
+/* During module writing, call here with a pointer to something,
+   returning the pointer_info node.  */
+
+static pointer_info *
+find_pointer (void *gp)
+{
+  pointer_info *p;
+
+  p = pi_root;
+  while (p != NULL)
+    {
+      if (p->u.pointer == gp)
+	break;
+      p = (gp < p->u.pointer) ? p->left : p->right;
+    }
+
+  return p;
+}
+
+
+/* Given a pointer while writing, returns the pointer_info tree node,
+   creating it if it doesn't exist.  */
+
+static pointer_info *
+get_pointer (void *gp)
+{
+  pointer_info *p;
+
+  p = find_pointer (gp);
+  if (p != NULL)
+    return p;
+
+  /* Pointer doesn't have an integer.  Give it one.  */
+  p = gfc_get_pointer_info ();
+
+  p->u.pointer = gp;
+  p->integer = symbol_number++;
+
+  gfc_insert_bbt (&pi_root, p, compare_pointers);
+
+  return p;
+}
+
+
+/* Given an integer during reading, find it in the pointer_info tree,
+   creating the node if not found.  */
+
+static pointer_info *
+get_integer (int integer)
+{
+  pointer_info *p, t;
+  int c;
+
+  t.integer = integer;
+
+  p = pi_root;
+  while (p != NULL)
+    {
+      c = compare_integers (&t, p);
+      if (c == 0)
+	break;
+
+      p = (c < 0) ? p->left : p->right;
+    }
+
+  if (p != NULL)
+    return p;
+
+  p = gfc_get_pointer_info ();
+  p->integer = integer;
+  p->u.pointer = NULL;
+
+  gfc_insert_bbt (&pi_root, p, compare_integers);
+
+  return p;
+}
+
+
+/* Recursive function to find a pointer within a tree by brute force.  */
+
+static pointer_info *
+fp2 (pointer_info *p, const void *target)
+{
+  pointer_info *q;
+
+  if (p == NULL)
+    return NULL;
+
+  if (p->u.pointer == target)
+    return p;
+
+  q = fp2 (p->left, target);
+  if (q != NULL)
+    return q;
+
+  return fp2 (p->right, target);
+}
+
+
+/* During reading, find a pointer_info node from the pointer value.
+   This amounts to a brute-force search.  */
+
+static pointer_info *
+find_pointer2 (void *p)
+{
+  return fp2 (pi_root, p);
+}
+
+
+/* Resolve any fixups using a known pointer.  */
+
+static void
+resolve_fixups (fixup_t *f, void *gp)
+{
+  fixup_t *next;
+
+  for (; f; f = next)
+    {
+      next = f->next;
+      *(f->pointer) = gp;
+      gfc_free (f);
+    }
+}
+
+
+/* Call here during module reading when we know what pointer to
+   associate with an integer.  Any fixups that exist are resolved at
+   this time.  */
+
+static void
+associate_integer_pointer (pointer_info *p, void *gp)
+{
+  if (p->u.pointer != NULL)
+    gfc_internal_error ("associate_integer_pointer(): Already associated");
+
+  p->u.pointer = gp;
+
+  resolve_fixups (p->fixup, gp);
+
+  p->fixup = NULL;
+}
+
+
+/* During module reading, given an integer and a pointer to a pointer,
+   either store the pointer from an already-known value or create a
+   fixup structure in order to store things later.  Returns zero if
+   the reference has been actually stored, or nonzero if the reference
+   must be fixed later (i.e., associate_integer_pointer must be called
+   sometime later.  Returns the pointer_info structure.  */
+
+static pointer_info *
+add_fixup (int integer, void *gp)
+{
+  pointer_info *p;
+  fixup_t *f;
+  char **cp;
+
+  p = get_integer (integer);
+
+  if (p->integer == 0 || p->u.pointer != NULL)
+    {
+      cp = (char **) gp;
+      *cp = (char *) p->u.pointer;
+    }
+  else
+    {
+      f = XCNEW (fixup_t);
+
+      f->next = p->fixup;
+      p->fixup = f;
+
+      f->pointer = (void **) gp;
+    }
+
+  return p;
+}
+
+
+/*****************************************************************/
+
+/* Parser related subroutines */
+
+/* Free the rename list left behind by a USE statement.  */
+
+static void
+free_rename (void)
+{
+  gfc_use_rename *next;
+
+  for (; gfc_rename_list; gfc_rename_list = next)
+    {
+      next = gfc_rename_list->next;
+      gfc_free (gfc_rename_list);
+    }
+}
+
+
+/* Match a USE statement.  */
+
+match
+gfc_match_use (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1], module_nature[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_use_rename *tail = NULL, *new_use;
+  interface_type type, type2;
+  gfc_intrinsic_op op;
+  match m;
+
+  specified_int = false;
+  specified_nonint = false;
+
+  if (gfc_match (" , ") == MATCH_YES)
+    {
+      if ((m = gfc_match (" %n ::", module_nature)) == MATCH_YES)
+	{
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: module "
+			      "nature in USE statement at %C") == FAILURE)
+	    return MATCH_ERROR;
+
+	  if (strcmp (module_nature, "intrinsic") == 0)
+	    specified_int = true;
+	  else
+	    {
+	      if (strcmp (module_nature, "non_intrinsic") == 0)
+		specified_nonint = true;
+	      else
+		{
+		  gfc_error ("Module nature in USE statement at %C shall "
+			     "be either INTRINSIC or NON_INTRINSIC");
+		  return MATCH_ERROR;
+		}
+	    }
+	}
+      else
+	{
+	  /* Help output a better error message than "Unclassifiable
+	     statement".  */
+	  gfc_match (" %n", module_nature);
+	  if (strcmp (module_nature, "intrinsic") == 0
+	      || strcmp (module_nature, "non_intrinsic") == 0)
+	    gfc_error ("\"::\" was expected after module nature at %C "
+		       "but was not found");
+	  return m;
+	}
+    }
+  else
+    {
+      m = gfc_match (" ::");
+      if (m == MATCH_YES &&
+	  gfc_notify_std (GFC_STD_F2003, "Fortran 2003: "
+			  "\"USE :: module\" at %C") == FAILURE)
+	return MATCH_ERROR;
+
+      if (m != MATCH_YES)
+	{
+	  m = gfc_match ("% ");
+	  if (m != MATCH_YES)
+	    return m;
+	}
+    }
+
+  use_locus = gfc_current_locus;
+
+  m = gfc_match_name (module_name);
+  if (m != MATCH_YES)
+    return m;
+
+  free_rename ();
+  only_flag = 0;
+
+  if (gfc_match_eos () == MATCH_YES)
+    return MATCH_YES;
+  if (gfc_match_char (',') != MATCH_YES)
+    goto syntax;
+
+  if (gfc_match (" only :") == MATCH_YES)
+    only_flag = 1;
+
+  if (gfc_match_eos () == MATCH_YES)
+    return MATCH_YES;
+
+  for (;;)
+    {
+      /* Get a new rename struct and add it to the rename list.  */
+      new_use = gfc_get_use_rename ();
+      new_use->where = gfc_current_locus;
+      new_use->found = 0;
+
+      if (gfc_rename_list == NULL)
+	gfc_rename_list = new_use;
+      else
+	tail->next = new_use;
+      tail = new_use;
+
+      /* See what kind of interface we're dealing with.  Assume it is
+	 not an operator.  */
+      new_use->op = INTRINSIC_NONE;
+      if (gfc_match_generic_spec (&type, name, &op) == MATCH_ERROR)
+	goto cleanup;
+
+      switch (type)
+	{
+	case INTERFACE_NAMELESS:
+	  gfc_error ("Missing generic specification in USE statement at %C");
+	  goto cleanup;
+
+	case INTERFACE_USER_OP:
+	case INTERFACE_GENERIC:
+	  m = gfc_match (" =>");
+
+	  if (type == INTERFACE_USER_OP && m == MATCH_YES
+	      && (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Renaming "
+				  "operators in USE statements at %C")
+		 == FAILURE))
+	    goto cleanup;
+
+	  if (type == INTERFACE_USER_OP)
+	    new_use->op = INTRINSIC_USER;
+
+	  if (only_flag)
+	    {
+	      if (m != MATCH_YES)
+		strcpy (new_use->use_name, name);
+	      else
+		{
+		  strcpy (new_use->local_name, name);
+		  m = gfc_match_generic_spec (&type2, new_use->use_name, &op);
+		  if (type != type2)
+		    goto syntax;
+		  if (m == MATCH_NO)
+		    goto syntax;
+		  if (m == MATCH_ERROR)
+		    goto cleanup;
+		}
+	    }
+	  else
+	    {
+	      if (m != MATCH_YES)
+		goto syntax;
+	      strcpy (new_use->local_name, name);
+
+	      m = gfc_match_generic_spec (&type2, new_use->use_name, &op);
+	      if (type != type2)
+		goto syntax;
+	      if (m == MATCH_NO)
+		goto syntax;
+	      if (m == MATCH_ERROR)
+		goto cleanup;
+	    }
+
+	  if (strcmp (new_use->use_name, module_name) == 0
+	      || strcmp (new_use->local_name, module_name) == 0)
+	    {
+	      gfc_error ("The name '%s' at %C has already been used as "
+			 "an external module name.", module_name);
+	      goto cleanup;
+	    }
+	  break;
+
+	case INTERFACE_INTRINSIC_OP:
+	  new_use->op = op;
+	  break;
+
+	default:
+	  gcc_unreachable ();
+	}
+
+      if (gfc_match_eos () == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_syntax_error (ST_USE);
+
+cleanup:
+  free_rename ();
+  return MATCH_ERROR;
+ }
+
+
+/* Given a name and a number, inst, return the inst name
+   under which to load this symbol. Returns NULL if this
+   symbol shouldn't be loaded. If inst is zero, returns
+   the number of instances of this name. If interface is
+   true, a user-defined operator is sought, otherwise only
+   non-operators are sought.  */
+
+static const char *
+find_use_name_n (const char *name, int *inst, bool interface)
+{
+  gfc_use_rename *u;
+  int i;
+
+  i = 0;
+  for (u = gfc_rename_list; u; u = u->next)
+    {
+      if (strcmp (u->use_name, name) != 0
+	  || (u->op == INTRINSIC_USER && !interface)
+	  || (u->op != INTRINSIC_USER &&  interface))
+	continue;
+      if (++i == *inst)
+	break;
+    }
+
+  if (!*inst)
+    {
+      *inst = i;
+      return NULL;
+    }
+
+  if (u == NULL)
+    return only_flag ? NULL : name;
+
+  u->found = 1;
+
+  return (u->local_name[0] != '\0') ? u->local_name : name;
+}
+
+
+/* Given a name, return the name under which to load this symbol.
+   Returns NULL if this symbol shouldn't be loaded.  */
+
+static const char *
+find_use_name (const char *name, bool interface)
+{
+  int i = 1;
+  return find_use_name_n (name, &i, interface);
+}
+
+
+/* Given a real name, return the number of use names associated with it.  */
+
+static int
+number_use_names (const char *name, bool interface)
+{
+  int i = 0;
+  find_use_name_n (name, &i, interface);
+  return i;
+}
+
+
+/* Try to find the operator in the current list.  */
+
+static gfc_use_rename *
+find_use_operator (gfc_intrinsic_op op)
+{
+  gfc_use_rename *u;
+
+  for (u = gfc_rename_list; u; u = u->next)
+    if (u->op == op)
+      return u;
+
+  return NULL;
+}
+
+
+/*****************************************************************/
+
+/* The next couple of subroutines maintain a tree used to avoid a
+   brute-force search for a combination of true name and module name.
+   While symtree names, the name that a particular symbol is known by
+   can changed with USE statements, we still have to keep track of the
+   true names to generate the correct reference, and also avoid
+   loading the same real symbol twice in a program unit.
+
+   When we start reading, the true name tree is built and maintained
+   as symbols are read.  The tree is searched as we load new symbols
+   to see if it already exists someplace in the namespace.  */
+
+typedef struct true_name
+{
+  BBT_HEADER (true_name);
+  gfc_symbol *sym;
+}
+true_name;
+
+static true_name *true_name_root;
+
+
+/* Compare two true_name structures.  */
+
+static int
+compare_true_names (void *_t1, void *_t2)
+{
+  true_name *t1, *t2;
+  int c;
+
+  t1 = (true_name *) _t1;
+  t2 = (true_name *) _t2;
+
+  c = ((t1->sym->module > t2->sym->module)
+       - (t1->sym->module < t2->sym->module));
+  if (c != 0)
+    return c;
+
+  return strcmp (t1->sym->name, t2->sym->name);
+}
+
+
+/* Given a true name, search the true name tree to see if it exists
+   within the main namespace.  */
+
+static gfc_symbol *
+find_true_name (const char *name, const char *module)
+{
+  true_name t, *p;
+  gfc_symbol sym;
+  int c;
+
+  sym.name = gfc_get_string (name);
+  if (module != NULL)
+    sym.module = gfc_get_string (module);
+  else
+    sym.module = NULL;
+  t.sym = &sym;
+
+  p = true_name_root;
+  while (p != NULL)
+    {
+      c = compare_true_names ((void *) (&t), (void *) p);
+      if (c == 0)
+	return p->sym;
+
+      p = (c < 0) ? p->left : p->right;
+    }
+
+  return NULL;
+}
+
+
+/* Given a gfc_symbol pointer that is not in the true name tree, add it.  */
+
+static void
+add_true_name (gfc_symbol *sym)
+{
+  true_name *t;
+
+  t = XCNEW (true_name);
+  t->sym = sym;
+
+  gfc_insert_bbt (&true_name_root, t, compare_true_names);
+}
+
+
+/* Recursive function to build the initial true name tree by
+   recursively traversing the current namespace.  */
+
+static void
+build_tnt (gfc_symtree *st)
+{
+  if (st == NULL)
+    return;
+
+  build_tnt (st->left);
+  build_tnt (st->right);
+
+  if (find_true_name (st->n.sym->name, st->n.sym->module) != NULL)
+    return;
+
+  add_true_name (st->n.sym);
+}
+
+
+/* Initialize the true name tree with the current namespace.  */
+
+static void
+init_true_name_tree (void)
+{
+  true_name_root = NULL;
+  build_tnt (gfc_current_ns->sym_root);
+}
+
+
+/* Recursively free a true name tree node.  */
+
+static void
+free_true_name (true_name *t)
+{
+  if (t == NULL)
+    return;
+  free_true_name (t->left);
+  free_true_name (t->right);
+
+  gfc_free (t);
+}
+
+
+/*****************************************************************/
+
+/* Module reading and writing.  */
+
+typedef enum
+{
+  ATOM_NAME, ATOM_LPAREN, ATOM_RPAREN, ATOM_INTEGER, ATOM_STRING
+}
+atom_type;
+
+static atom_type last_atom;
+
+
+/* The name buffer must be at least as long as a symbol name.  Right
+   now it's not clear how we're going to store numeric constants--
+   probably as a hexadecimal string, since this will allow the exact
+   number to be preserved (this can't be done by a decimal
+   representation).  Worry about that later.  TODO!  */
+
+#define MAX_ATOM_SIZE 100
+
+static int atom_int;
+static char *atom_string, atom_name[MAX_ATOM_SIZE];
+
+
+/* Report problems with a module.  Error reporting is not very
+   elaborate, since this sorts of errors shouldn't really happen.
+   This subroutine never returns.  */
+
+static void bad_module (const char *) ATTRIBUTE_NORETURN;
+
+static void
+bad_module (const char *msgid)
+{
+  fclose (module_fp);
+
+  switch (iomode)
+    {
+    case IO_INPUT:
+      gfc_fatal_error ("Reading module %s at line %d column %d: %s",
+	  	       module_name, module_line, module_column, msgid);
+      break;
+    case IO_OUTPUT:
+      gfc_fatal_error ("Writing module %s at line %d column %d: %s",
+	  	       module_name, module_line, module_column, msgid);
+      break;
+    default:
+      gfc_fatal_error ("Module %s at line %d column %d: %s",
+	  	       module_name, module_line, module_column, msgid);
+      break;
+    }
+}
+
+
+/* Set the module's input pointer.  */
+
+static void
+set_module_locus (module_locus *m)
+{
+  module_column = m->column;
+  module_line = m->line;
+  fsetpos (module_fp, &m->pos);
+}
+
+
+/* Get the module's input pointer so that we can restore it later.  */
+
+static void
+get_module_locus (module_locus *m)
+{
+  m->column = module_column;
+  m->line = module_line;
+  fgetpos (module_fp, &m->pos);
+}
+
+
+/* Get the next character in the module, updating our reckoning of
+   where we are.  */
+
+static int
+module_char (void)
+{
+  int c;
+
+  c = getc (module_fp);
+
+  if (c == EOF)
+    bad_module ("Unexpected EOF");
+
+  if (c == '\n')
+    {
+      module_line++;
+      module_column = 0;
+    }
+
+  module_column++;
+  return c;
+}
+
+
+/* Parse a string constant.  The delimiter is guaranteed to be a
+   single quote.  */
+
+static void
+parse_string (void)
+{
+  module_locus start;
+  int len, c;
+  char *p;
+
+  get_module_locus (&start);
+
+  len = 0;
+
+  /* See how long the string is.  */
+  for ( ; ; )
+    {
+      c = module_char ();
+      if (c == EOF)
+	bad_module ("Unexpected end of module in string constant");
+
+      if (c != '\'')
+	{
+	  len++;
+	  continue;
+	}
+
+      c = module_char ();
+      if (c == '\'')
+	{
+	  len++;
+	  continue;
+	}
+
+      break;
+    }
+
+  set_module_locus (&start);
+
+  atom_string = p = XCNEWVEC (char, len + 1);
+
+  for (; len > 0; len--)
+    {
+      c = module_char ();
+      if (c == '\'')
+	module_char ();		/* Guaranteed to be another \'.  */
+      *p++ = c;
+    }
+
+  module_char ();		/* Terminating \'.  */
+  *p = '\0';			/* C-style string for debug purposes.  */
+}
+
+
+/* Parse a small integer.  */
+
+static void
+parse_integer (int c)
+{
+  module_locus m;
+
+  atom_int = c - '0';
+
+  for (;;)
+    {
+      get_module_locus (&m);
+
+      c = module_char ();
+      if (!ISDIGIT (c))
+	break;
+
+      atom_int = 10 * atom_int + c - '0';
+      if (atom_int > 99999999)
+	bad_module ("Integer overflow");
+    }
+
+  set_module_locus (&m);
+}
+
+
+/* Parse a name.  */
+
+static void
+parse_name (int c)
+{
+  module_locus m;
+  char *p;
+  int len;
+
+  p = atom_name;
+
+  *p++ = c;
+  len = 1;
+
+  get_module_locus (&m);
+
+  for (;;)
+    {
+      c = module_char ();
+      if (!ISALNUM (c) && c != '_' && c != '-')
+	break;
+
+      *p++ = c;
+      if (++len > GFC_MAX_SYMBOL_LEN)
+	bad_module ("Name too long");
+    }
+
+  *p = '\0';
+
+  fseek (module_fp, -1, SEEK_CUR);
+  module_column = m.column + len - 1;
+
+  if (c == '\n')
+    module_line--;
+}
+
+
+/* Read the next atom in the module's input stream.  */
+
+static atom_type
+parse_atom (void)
+{
+  int c;
+
+  do
+    {
+      c = module_char ();
+    }
+  while (c == ' ' || c == '\r' || c == '\n');
+
+  switch (c)
+    {
+    case '(':
+      return ATOM_LPAREN;
+
+    case ')':
+      return ATOM_RPAREN;
+
+    case '\'':
+      parse_string ();
+      return ATOM_STRING;
+
+    case '0':
+    case '1':
+    case '2':
+    case '3':
+    case '4':
+    case '5':
+    case '6':
+    case '7':
+    case '8':
+    case '9':
+      parse_integer (c);
+      return ATOM_INTEGER;
+
+    case 'a':
+    case 'b':
+    case 'c':
+    case 'd':
+    case 'e':
+    case 'f':
+    case 'g':
+    case 'h':
+    case 'i':
+    case 'j':
+    case 'k':
+    case 'l':
+    case 'm':
+    case 'n':
+    case 'o':
+    case 'p':
+    case 'q':
+    case 'r':
+    case 's':
+    case 't':
+    case 'u':
+    case 'v':
+    case 'w':
+    case 'x':
+    case 'y':
+    case 'z':
+    case 'A':
+    case 'B':
+    case 'C':
+    case 'D':
+    case 'E':
+    case 'F':
+    case 'G':
+    case 'H':
+    case 'I':
+    case 'J':
+    case 'K':
+    case 'L':
+    case 'M':
+    case 'N':
+    case 'O':
+    case 'P':
+    case 'Q':
+    case 'R':
+    case 'S':
+    case 'T':
+    case 'U':
+    case 'V':
+    case 'W':
+    case 'X':
+    case 'Y':
+    case 'Z':
+      parse_name (c);
+      return ATOM_NAME;
+
+    default:
+      bad_module ("Bad name");
+    }
+
+  /* Not reached.  */
+}
+
+
+/* Peek at the next atom on the input.  */
+
+static atom_type
+peek_atom (void)
+{
+  module_locus m;
+  atom_type a;
+
+  get_module_locus (&m);
+
+  a = parse_atom ();
+  if (a == ATOM_STRING)
+    gfc_free (atom_string);
+
+  set_module_locus (&m);
+  return a;
+}
+
+
+/* Read the next atom from the input, requiring that it be a
+   particular kind.  */
+
+static void
+require_atom (atom_type type)
+{
+  module_locus m;
+  atom_type t;
+  const char *p;
+
+  get_module_locus (&m);
+
+  t = parse_atom ();
+  if (t != type)
+    {
+      switch (type)
+	{
+	case ATOM_NAME:
+	  p = _("Expected name");
+	  break;
+	case ATOM_LPAREN:
+	  p = _("Expected left parenthesis");
+	  break;
+	case ATOM_RPAREN:
+	  p = _("Expected right parenthesis");
+	  break;
+	case ATOM_INTEGER:
+	  p = _("Expected integer");
+	  break;
+	case ATOM_STRING:
+	  p = _("Expected string");
+	  break;
+	default:
+	  gfc_internal_error ("require_atom(): bad atom type required");
+	}
+
+      set_module_locus (&m);
+      bad_module (p);
+    }
+}
+
+
+/* Given a pointer to an mstring array, require that the current input
+   be one of the strings in the array.  We return the enum value.  */
+
+static int
+find_enum (const mstring *m)
+{
+  int i;
+
+  i = gfc_string2code (m, atom_name);
+  if (i >= 0)
+    return i;
+
+  bad_module ("find_enum(): Enum not found");
+
+  /* Not reached.  */
+}
+
+
+/**************** Module output subroutines ***************************/
+
+/* Output a character to a module file.  */
+
+static void
+write_char (char out)
+{
+  if (putc (out, module_fp) == EOF)
+    gfc_fatal_error ("Error writing modules file: %s", xstrerror (errno));
+
+  /* Add this to our MD5.  */
+  md5_process_bytes (&out, sizeof (out), &ctx);
+  
+  if (out != '\n')
+    module_column++;
+  else
+    {
+      module_column = 1;
+      module_line++;
+    }
+}
+
+
+/* Write an atom to a module.  The line wrapping isn't perfect, but it
+   should work most of the time.  This isn't that big of a deal, since
+   the file really isn't meant to be read by people anyway.  */
+
+static void
+write_atom (atom_type atom, const void *v)
+{
+  char buffer[20];
+  int i, len;
+  const char *p;
+
+  switch (atom)
+    {
+    case ATOM_STRING:
+    case ATOM_NAME:
+      p = (const char *) v;
+      break;
+
+    case ATOM_LPAREN:
+      p = "(";
+      break;
+
+    case ATOM_RPAREN:
+      p = ")";
+      break;
+
+    case ATOM_INTEGER:
+      i = *((const int *) v);
+      if (i < 0)
+	gfc_internal_error ("write_atom(): Writing negative integer");
+
+      sprintf (buffer, "%d", i);
+      p = buffer;
+      break;
+
+    default:
+      gfc_internal_error ("write_atom(): Trying to write dab atom");
+
+    }
+
+  if(p == NULL || *p == '\0') 
+     len = 0;
+  else
+  len = strlen (p);
+
+  if (atom != ATOM_RPAREN)
+    {
+      if (module_column + len > 72)
+	write_char ('\n');
+      else
+	{
+
+	  if (last_atom != ATOM_LPAREN && module_column != 1)
+	    write_char (' ');
+	}
+    }
+
+  if (atom == ATOM_STRING)
+    write_char ('\'');
+
+  while (p != NULL && *p)
+    {
+      if (atom == ATOM_STRING && *p == '\'')
+	write_char ('\'');
+      write_char (*p++);
+    }
+
+  if (atom == ATOM_STRING)
+    write_char ('\'');
+
+  last_atom = atom;
+}
+
+
+
+/***************** Mid-level I/O subroutines *****************/
+
+/* These subroutines let their caller read or write atoms without
+   caring about which of the two is actually happening.  This lets a
+   subroutine concentrate on the actual format of the data being
+   written.  */
+
+static void mio_expr (gfc_expr **);
+pointer_info *mio_symbol_ref (gfc_symbol **);
+pointer_info *mio_interface_rest (gfc_interface **);
+static void mio_symtree_ref (gfc_symtree **);
+
+/* Read or write an enumerated value.  On writing, we return the input
+   value for the convenience of callers.  We avoid using an integer
+   pointer because enums are sometimes inside bitfields.  */
+
+static int
+mio_name (int t, const mstring *m)
+{
+  if (iomode == IO_OUTPUT)
+    write_atom (ATOM_NAME, gfc_code2string (m, t));
+  else
+    {
+      require_atom (ATOM_NAME);
+      t = find_enum (m);
+    }
+
+  return t;
+}
+
+/* Specialization of mio_name.  */
+
+#define DECL_MIO_NAME(TYPE) \
+ static inline TYPE \
+ MIO_NAME(TYPE) (TYPE t, const mstring *m) \
+ { \
+   return (TYPE) mio_name ((int) t, m); \
+ }
+#define MIO_NAME(TYPE) mio_name_##TYPE
+
+static void
+mio_lparen (void)
+{
+  if (iomode == IO_OUTPUT)
+    write_atom (ATOM_LPAREN, NULL);
+  else
+    require_atom (ATOM_LPAREN);
+}
+
+
+static void
+mio_rparen (void)
+{
+  if (iomode == IO_OUTPUT)
+    write_atom (ATOM_RPAREN, NULL);
+  else
+    require_atom (ATOM_RPAREN);
+}
+
+
+static void
+mio_integer (int *ip)
+{
+  if (iomode == IO_OUTPUT)
+    write_atom (ATOM_INTEGER, ip);
+  else
+    {
+      require_atom (ATOM_INTEGER);
+      *ip = atom_int;
+    }
+}
+
+
+/* Read or write a gfc_intrinsic_op value.  */
+
+static void
+mio_intrinsic_op (gfc_intrinsic_op* op)
+{
+  /* FIXME: Would be nicer to do this via the operators symbolic name.  */
+  if (iomode == IO_OUTPUT)
+    {
+      int converted = (int) *op;
+      write_atom (ATOM_INTEGER, &converted);
+    }
+  else
+    {
+      require_atom (ATOM_INTEGER);
+      *op = (gfc_intrinsic_op) atom_int;
+    }
+}
+
+
+/* Read or write a character pointer that points to a string on the heap.  */
+
+static const char *
+mio_allocated_string (const char *s)
+{
+  if (iomode == IO_OUTPUT)
+    {
+      write_atom (ATOM_STRING, s);
+      return s;
+    }
+  else
+    {
+      require_atom (ATOM_STRING);
+      return atom_string;
+    }
+}
+
+
+/* Functions for quoting and unquoting strings.  */
+
+static char *
+quote_string (const gfc_char_t *s, const size_t slength)
+{
+  const gfc_char_t *p;
+  char *res, *q;
+  size_t len = 0, i;
+
+  /* Calculate the length we'll need: a backslash takes two ("\\"),
+     non-printable characters take 10 ("\Uxxxxxxxx") and others take 1.  */
+  for (p = s, i = 0; i < slength; p++, i++)
+    {
+      if (*p == '\\')
+	len += 2;
+      else if (!gfc_wide_is_printable (*p))
+	len += 10;
+      else
+	len++;
+    }
+
+  q = res = XCNEWVEC (char, len + 1);
+  for (p = s, i = 0; i < slength; p++, i++)
+    {
+      if (*p == '\\')
+	*q++ = '\\', *q++ = '\\';
+      else if (!gfc_wide_is_printable (*p))
+	{
+	  sprintf (q, "\\U%08" HOST_WIDE_INT_PRINT "x",
+		   (unsigned HOST_WIDE_INT) *p);
+	  q += 10;
+	}
+      else
+	*q++ = (unsigned char) *p;
+    }
+
+  res[len] = '\0';
+  return res;
+}
+
+static gfc_char_t *
+unquote_string (const char *s)
+{
+  size_t len, i;
+  const char *p;
+  gfc_char_t *res;
+
+  for (p = s, len = 0; *p; p++, len++)
+    {
+      if (*p != '\\')
+	continue;
+	
+      if (p[1] == '\\')
+	p++;
+      else if (p[1] == 'U')
+	p += 9; /* That is a "\U????????". */
+      else
+	gfc_internal_error ("unquote_string(): got bad string");
+    }
+
+  res = gfc_get_wide_string (len + 1);
+  for (i = 0, p = s; i < len; i++, p++)
+    {
+      gcc_assert (*p);
+
+      if (*p != '\\')
+	res[i] = (unsigned char) *p;
+      else if (p[1] == '\\')
+	{
+	  res[i] = (unsigned char) '\\';
+	  p++;
+	}
+      else
+	{
+	  /* We read the 8-digits hexadecimal constant that follows.  */
+	  int j;
+	  unsigned n;
+	  gfc_char_t c = 0;
+
+	  gcc_assert (p[1] == 'U');
+	  for (j = 0; j < 8; j++)
+	    {
+	      c = c << 4;
+	      gcc_assert (sscanf (&p[j+2], "%01x", &n) == 1);
+	      c += n;
+	    }
+
+	  res[i] = c;
+	  p += 9;
+	}
+    }
+
+  res[len] = '\0';
+  return res;
+}
+
+
+/* Read or write a character pointer that points to a wide string on the
+   heap, performing quoting/unquoting of nonprintable characters using the
+   form \U???????? (where each ? is a hexadecimal digit).
+   Length is the length of the string, only known and used in output mode.  */
+
+static const gfc_char_t *
+mio_allocated_wide_string (const gfc_char_t *s, const size_t length)
+{
+  if (iomode == IO_OUTPUT)
+    {
+      char *quoted = quote_string (s, length);
+      write_atom (ATOM_STRING, quoted);
+      gfc_free (quoted);
+      return s;
+    }
+  else
+    {
+      gfc_char_t *unquoted;
+
+      require_atom (ATOM_STRING);
+      unquoted = unquote_string (atom_string);
+      gfc_free (atom_string);
+      return unquoted;
+    }
+}
+
+
+/* Read or write a string that is in static memory.  */
+
+static void
+mio_pool_string (const char **stringp)
+{
+  /* TODO: one could write the string only once, and refer to it via a
+     fixup pointer.  */
+
+  /* As a special case we have to deal with a NULL string.  This
+     happens for the 'module' member of 'gfc_symbol's that are not in a
+     module.  We read / write these as the empty string.  */
+  if (iomode == IO_OUTPUT)
+    {
+      const char *p = *stringp == NULL ? "" : *stringp;
+      write_atom (ATOM_STRING, p);
+    }
+  else
+    {
+      require_atom (ATOM_STRING);
+      *stringp = atom_string[0] == '\0' ? NULL : gfc_get_string (atom_string);
+      gfc_free (atom_string);
+    }
+}
+
+
+/* Read or write a string that is inside of some already-allocated
+   structure.  */
+
+static void
+mio_internal_string (char *string)
+{
+  if (iomode == IO_OUTPUT)
+    write_atom (ATOM_STRING, string);
+  else
+    {
+      require_atom (ATOM_STRING);
+      strcpy (string, atom_string);
+      gfc_free (atom_string);
+    }
+}
+
+
+typedef enum
+{ AB_ALLOCATABLE, AB_DIMENSION, AB_EXTERNAL, AB_INTRINSIC, AB_OPTIONAL,
+  AB_POINTER, AB_TARGET, AB_DUMMY, AB_RESULT, AB_DATA,
+  AB_IN_NAMELIST, AB_IN_COMMON, AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE,
+  AB_ELEMENTAL, AB_PURE, AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT,
+  AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE,
+  AB_ALLOC_COMP, AB_POINTER_COMP, AB_PROC_POINTER_COMP, AB_PRIVATE_COMP,
+  AB_VALUE, AB_VOLATILE, AB_PROTECTED,
+  AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT, AB_ZERO_COMP,
+  AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
+  AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER,
+  AB_IMPLICIT_PURE
+}
+ab_attribute;
+
+static const mstring attr_bits[] =
+{
+    minit ("ALLOCATABLE", AB_ALLOCATABLE),
+    minit ("ASYNCHRONOUS", AB_ASYNCHRONOUS),
+    minit ("DIMENSION", AB_DIMENSION),
+    minit ("CODIMENSION", AB_CODIMENSION),
+    minit ("CONTIGUOUS", AB_CONTIGUOUS),
+    minit ("EXTERNAL", AB_EXTERNAL),
+    minit ("INTRINSIC", AB_INTRINSIC),
+    minit ("OPTIONAL", AB_OPTIONAL),
+    minit ("POINTER", AB_POINTER),
+    minit ("VOLATILE", AB_VOLATILE),
+    minit ("TARGET", AB_TARGET),
+    minit ("THREADPRIVATE", AB_THREADPRIVATE),
+    minit ("DUMMY", AB_DUMMY),
+    minit ("RESULT", AB_RESULT),
+    minit ("DATA", AB_DATA),
+    minit ("IN_NAMELIST", AB_IN_NAMELIST),
+    minit ("IN_COMMON", AB_IN_COMMON),
+    minit ("FUNCTION", AB_FUNCTION),
+    minit ("SUBROUTINE", AB_SUBROUTINE),
+    minit ("SEQUENCE", AB_SEQUENCE),
+    minit ("ELEMENTAL", AB_ELEMENTAL),
+    minit ("PURE", AB_PURE),
+    minit ("RECURSIVE", AB_RECURSIVE),
+    minit ("GENERIC", AB_GENERIC),
+    minit ("ALWAYS_EXPLICIT", AB_ALWAYS_EXPLICIT),
+    minit ("CRAY_POINTER", AB_CRAY_POINTER),
+    minit ("CRAY_POINTEE", AB_CRAY_POINTEE),
+    minit ("IS_BIND_C", AB_IS_BIND_C),
+    minit ("IS_C_INTEROP", AB_IS_C_INTEROP),
+    minit ("IS_ISO_C", AB_IS_ISO_C),
+    minit ("VALUE", AB_VALUE),
+    minit ("ALLOC_COMP", AB_ALLOC_COMP),
+    minit ("COARRAY_COMP", AB_COARRAY_COMP),
+    minit ("POINTER_COMP", AB_POINTER_COMP),
+    minit ("PROC_POINTER_COMP", AB_PROC_POINTER_COMP),
+    minit ("PRIVATE_COMP", AB_PRIVATE_COMP),
+    minit ("ZERO_COMP", AB_ZERO_COMP),
+    minit ("PROTECTED", AB_PROTECTED),
+    minit ("ABSTRACT", AB_ABSTRACT),
+    minit ("IS_CLASS", AB_IS_CLASS),
+    minit ("PROCEDURE", AB_PROCEDURE),
+    minit ("PROC_POINTER", AB_PROC_POINTER),
+    minit ("VTYPE", AB_VTYPE),
+    minit ("VTAB", AB_VTAB),
+    minit ("CLASS_POINTER", AB_CLASS_POINTER),
+    minit ("IMPLICIT_PURE", AB_IMPLICIT_PURE),
+    minit (NULL, -1)
+};
+
+/* For binding attributes.  */
+static const mstring binding_passing[] =
+{
+    minit ("PASS", 0),
+    minit ("NOPASS", 1),
+    minit (NULL, -1)
+};
+static const mstring binding_overriding[] =
+{
+    minit ("OVERRIDABLE", 0),
+    minit ("NON_OVERRIDABLE", 1),
+    minit ("DEFERRED", 2),
+    minit (NULL, -1)
+};
+static const mstring binding_generic[] =
+{
+    minit ("SPECIFIC", 0),
+    minit ("GENERIC", 1),
+    minit (NULL, -1)
+};
+static const mstring binding_ppc[] =
+{
+    minit ("NO_PPC", 0),
+    minit ("PPC", 1),
+    minit (NULL, -1)
+};
+
+/* Specialization of mio_name.  */
+DECL_MIO_NAME (ab_attribute)
+DECL_MIO_NAME (ar_type)
+DECL_MIO_NAME (array_type)
+DECL_MIO_NAME (bt)
+DECL_MIO_NAME (expr_t)
+DECL_MIO_NAME (gfc_access)
+DECL_MIO_NAME (gfc_intrinsic_op)
+DECL_MIO_NAME (ifsrc)
+DECL_MIO_NAME (save_state)
+DECL_MIO_NAME (procedure_type)
+DECL_MIO_NAME (ref_type)
+DECL_MIO_NAME (sym_flavor)
+DECL_MIO_NAME (sym_intent)
+#undef DECL_MIO_NAME
+
+/* Symbol attributes are stored in list with the first three elements
+   being the enumerated fields, while the remaining elements (if any)
+   indicate the individual attribute bits.  The access field is not
+   saved-- it controls what symbols are exported when a module is
+   written.  */
+
+static void
+mio_symbol_attribute (symbol_attribute *attr)
+{
+  atom_type t;
+  unsigned ext_attr,extension_level;
+
+  mio_lparen ();
+
+  attr->flavor = MIO_NAME (sym_flavor) (attr->flavor, flavors);
+  attr->intent = MIO_NAME (sym_intent) (attr->intent, intents);
+  attr->proc = MIO_NAME (procedure_type) (attr->proc, procedures);
+  attr->if_source = MIO_NAME (ifsrc) (attr->if_source, ifsrc_types);
+  attr->save = MIO_NAME (save_state) (attr->save, save_status);
+  
+  ext_attr = attr->ext_attr;
+  mio_integer ((int *) &ext_attr);
+  attr->ext_attr = ext_attr;
+
+  extension_level = attr->extension;
+  mio_integer ((int *) &extension_level);
+  attr->extension = extension_level;
+
+  if (iomode == IO_OUTPUT)
+    {
+      if (attr->allocatable)
+	MIO_NAME (ab_attribute) (AB_ALLOCATABLE, attr_bits);
+      if (attr->asynchronous)
+	MIO_NAME (ab_attribute) (AB_ASYNCHRONOUS, attr_bits);
+      if (attr->dimension)
+	MIO_NAME (ab_attribute) (AB_DIMENSION, attr_bits);
+      if (attr->codimension)
+	MIO_NAME (ab_attribute) (AB_CODIMENSION, attr_bits);
+      if (attr->contiguous)
+	MIO_NAME (ab_attribute) (AB_CONTIGUOUS, attr_bits);
+      if (attr->external)
+	MIO_NAME (ab_attribute) (AB_EXTERNAL, attr_bits);
+      if (attr->intrinsic)
+	MIO_NAME (ab_attribute) (AB_INTRINSIC, attr_bits);
+      if (attr->optional)
+	MIO_NAME (ab_attribute) (AB_OPTIONAL, attr_bits);
+      if (attr->pointer)
+	MIO_NAME (ab_attribute) (AB_POINTER, attr_bits);
+      if (attr->class_pointer)
+	MIO_NAME (ab_attribute) (AB_CLASS_POINTER, attr_bits);
+      if (attr->is_protected)
+	MIO_NAME (ab_attribute) (AB_PROTECTED, attr_bits);
+      if (attr->value)
+	MIO_NAME (ab_attribute) (AB_VALUE, attr_bits);
+      if (attr->volatile_)
+	MIO_NAME (ab_attribute) (AB_VOLATILE, attr_bits);
+      if (attr->target)
+	MIO_NAME (ab_attribute) (AB_TARGET, attr_bits);
+      if (attr->threadprivate)
+	MIO_NAME (ab_attribute) (AB_THREADPRIVATE, attr_bits);
+      if (attr->dummy)
+	MIO_NAME (ab_attribute) (AB_DUMMY, attr_bits);
+      if (attr->result)
+	MIO_NAME (ab_attribute) (AB_RESULT, attr_bits);
+      /* We deliberately don't preserve the "entry" flag.  */
+
+      if (attr->data)
+	MIO_NAME (ab_attribute) (AB_DATA, attr_bits);
+      if (attr->in_namelist)
+	MIO_NAME (ab_attribute) (AB_IN_NAMELIST, attr_bits);
+      if (attr->in_common)
+	MIO_NAME (ab_attribute) (AB_IN_COMMON, attr_bits);
+
+      if (attr->function)
+	MIO_NAME (ab_attribute) (AB_FUNCTION, attr_bits);
+      if (attr->subroutine)
+	MIO_NAME (ab_attribute) (AB_SUBROUTINE, attr_bits);
+      if (attr->generic)
+	MIO_NAME (ab_attribute) (AB_GENERIC, attr_bits);
+      if (attr->abstract)
+	MIO_NAME (ab_attribute) (AB_ABSTRACT, attr_bits);
+
+      if (attr->sequence)
+	MIO_NAME (ab_attribute) (AB_SEQUENCE, attr_bits);
+      if (attr->elemental)
+	MIO_NAME (ab_attribute) (AB_ELEMENTAL, attr_bits);
+      if (attr->pure)
+	MIO_NAME (ab_attribute) (AB_PURE, attr_bits);
+      if (attr->implicit_pure)
+	MIO_NAME (ab_attribute) (AB_IMPLICIT_PURE, attr_bits);
+      if (attr->recursive)
+	MIO_NAME (ab_attribute) (AB_RECURSIVE, attr_bits);
+      if (attr->always_explicit)
+	MIO_NAME (ab_attribute) (AB_ALWAYS_EXPLICIT, attr_bits);
+      if (attr->cray_pointer)
+	MIO_NAME (ab_attribute) (AB_CRAY_POINTER, attr_bits);
+      if (attr->cray_pointee)
+	MIO_NAME (ab_attribute) (AB_CRAY_POINTEE, attr_bits);
+      if (attr->is_bind_c)
+	MIO_NAME(ab_attribute) (AB_IS_BIND_C, attr_bits);
+      if (attr->is_c_interop)
+	MIO_NAME(ab_attribute) (AB_IS_C_INTEROP, attr_bits);
+      if (attr->is_iso_c)
+	MIO_NAME(ab_attribute) (AB_IS_ISO_C, attr_bits);
+      if (attr->alloc_comp)
+	MIO_NAME (ab_attribute) (AB_ALLOC_COMP, attr_bits);
+      if (attr->pointer_comp)
+	MIO_NAME (ab_attribute) (AB_POINTER_COMP, attr_bits);
+      if (attr->proc_pointer_comp)
+	MIO_NAME (ab_attribute) (AB_PROC_POINTER_COMP, attr_bits);
+      if (attr->private_comp)
+	MIO_NAME (ab_attribute) (AB_PRIVATE_COMP, attr_bits);
+      if (attr->coarray_comp)
+	MIO_NAME (ab_attribute) (AB_COARRAY_COMP, attr_bits);
+      if (attr->zero_comp)
+	MIO_NAME (ab_attribute) (AB_ZERO_COMP, attr_bits);
+      if (attr->is_class)
+	MIO_NAME (ab_attribute) (AB_IS_CLASS, attr_bits);
+      if (attr->procedure)
+	MIO_NAME (ab_attribute) (AB_PROCEDURE, attr_bits);
+      if (attr->proc_pointer)
+	MIO_NAME (ab_attribute) (AB_PROC_POINTER, attr_bits);
+      if (attr->vtype)
+	MIO_NAME (ab_attribute) (AB_VTYPE, attr_bits);
+      if (attr->vtab)
+	MIO_NAME (ab_attribute) (AB_VTAB, attr_bits);
+
+      mio_rparen ();
+
+    }
+  else
+    {
+      for (;;)
+	{
+	  t = parse_atom ();
+	  if (t == ATOM_RPAREN)
+	    break;
+	  if (t != ATOM_NAME)
+	    bad_module ("Expected attribute bit name");
+
+	  switch ((ab_attribute) find_enum (attr_bits))
+	    {
+	    case AB_ALLOCATABLE:
+	      attr->allocatable = 1;
+	      break;
+	    case AB_ASYNCHRONOUS:
+	      attr->asynchronous = 1;
+	      break;
+	    case AB_DIMENSION:
+	      attr->dimension = 1;
+	      break;
+	    case AB_CODIMENSION:
+	      attr->codimension = 1;
+	      break;
+	    case AB_CONTIGUOUS:
+	      attr->contiguous = 1;
+	      break;
+	    case AB_EXTERNAL:
+	      attr->external = 1;
+	      break;
+	    case AB_INTRINSIC:
+	      attr->intrinsic = 1;
+	      break;
+	    case AB_OPTIONAL:
+	      attr->optional = 1;
+	      break;
+	    case AB_POINTER:
+	      attr->pointer = 1;
+	      break;
+	    case AB_CLASS_POINTER:
+	      attr->class_pointer = 1;
+	      break;
+	    case AB_PROTECTED:
+	      attr->is_protected = 1;
+	      break;
+	    case AB_VALUE:
+	      attr->value = 1;
+	      break;
+	    case AB_VOLATILE:
+	      attr->volatile_ = 1;
+	      break;
+	    case AB_TARGET:
+	      attr->target = 1;
+	      break;
+	    case AB_THREADPRIVATE:
+	      attr->threadprivate = 1;
+	      break;
+	    case AB_DUMMY:
+	      attr->dummy = 1;
+	      break;
+	    case AB_RESULT:
+	      attr->result = 1;
+	      break;
+	    case AB_DATA:
+	      attr->data = 1;
+	      break;
+	    case AB_IN_NAMELIST:
+	      attr->in_namelist = 1;
+	      break;
+	    case AB_IN_COMMON:
+	      attr->in_common = 1;
+	      break;
+	    case AB_FUNCTION:
+	      attr->function = 1;
+	      break;
+	    case AB_SUBROUTINE:
+	      attr->subroutine = 1;
+	      break;
+	    case AB_GENERIC:
+	      attr->generic = 1;
+	      break;
+	    case AB_ABSTRACT:
+	      attr->abstract = 1;
+	      break;
+	    case AB_SEQUENCE:
+	      attr->sequence = 1;
+	      break;
+	    case AB_ELEMENTAL:
+	      attr->elemental = 1;
+	      break;
+	    case AB_PURE:
+	      attr->pure = 1;
+	      break;
+	    case AB_IMPLICIT_PURE:
+	      attr->implicit_pure = 1;
+	      break;
+	    case AB_RECURSIVE:
+	      attr->recursive = 1;
+	      break;
+	    case AB_ALWAYS_EXPLICIT:
+	      attr->always_explicit = 1;
+	      break;
+	    case AB_CRAY_POINTER:
+	      attr->cray_pointer = 1;
+	      break;
+	    case AB_CRAY_POINTEE:
+	      attr->cray_pointee = 1;
+	      break;
+	    case AB_IS_BIND_C:
+	      attr->is_bind_c = 1;
+	      break;
+	    case AB_IS_C_INTEROP:
+	      attr->is_c_interop = 1;
+	      break;
+	    case AB_IS_ISO_C:
+	      attr->is_iso_c = 1;
+	      break;
+	    case AB_ALLOC_COMP:
+	      attr->alloc_comp = 1;
+	      break;
+	    case AB_COARRAY_COMP:
+	      attr->coarray_comp = 1;
+	      break;
+	    case AB_POINTER_COMP:
+	      attr->pointer_comp = 1;
+	      break;
+	    case AB_PROC_POINTER_COMP:
+	      attr->proc_pointer_comp = 1;
+	      break;
+	    case AB_PRIVATE_COMP:
+	      attr->private_comp = 1;
+	      break;
+	    case AB_ZERO_COMP:
+	      attr->zero_comp = 1;
+	      break;
+	    case AB_IS_CLASS:
+	      attr->is_class = 1;
+	      break;
+	    case AB_PROCEDURE:
+	      attr->procedure = 1;
+	      break;
+	    case AB_PROC_POINTER:
+	      attr->proc_pointer = 1;
+	      break;
+	    case AB_VTYPE:
+	      attr->vtype = 1;
+	      break;
+	    case AB_VTAB:
+	      attr->vtab = 1;
+	      break;
+	    }
+	}
+    }
+}
+
+
+static const mstring bt_types[] = {
+    minit ("INTEGER", BT_INTEGER),
+    minit ("REAL", BT_REAL),
+    minit ("COMPLEX", BT_COMPLEX),
+    minit ("LOGICAL", BT_LOGICAL),
+    minit ("CHARACTER", BT_CHARACTER),
+    minit ("DERIVED", BT_DERIVED),
+    minit ("CLASS", BT_CLASS),
+    minit ("PROCEDURE", BT_PROCEDURE),
+    minit ("UNKNOWN", BT_UNKNOWN),
+    minit ("VOID", BT_VOID),
+    minit (NULL, -1)
+};
+
+
+static void
+mio_charlen (gfc_charlen **clp)
+{
+  gfc_charlen *cl;
+
+  mio_lparen ();
+
+  if (iomode == IO_OUTPUT)
+    {
+      cl = *clp;
+      if (cl != NULL)
+	mio_expr (&cl->length);
+    }
+  else
+    {
+      if (peek_atom () != ATOM_RPAREN)
+	{
+	  cl = gfc_new_charlen (gfc_current_ns, NULL);
+	  mio_expr (&cl->length);
+	  *clp = cl;
+	}
+    }
+
+  mio_rparen ();
+}
+
+
+/* See if a name is a generated name.  */
+
+static int
+check_unique_name (const char *name)
+{
+  return *name == '@';
+}
+
+
+static void
+mio_typespec (gfc_typespec *ts)
+{
+  mio_lparen ();
+
+  ts->type = MIO_NAME (bt) (ts->type, bt_types);
+
+  if (ts->type != BT_DERIVED && ts->type != BT_CLASS)
+    mio_integer (&ts->kind);
+  else
+    mio_symbol_ref (&ts->u.derived);
+
+  /* Add info for C interop and is_iso_c.  */
+  mio_integer (&ts->is_c_interop);
+  mio_integer (&ts->is_iso_c);
+  
+  /* If the typespec is for an identifier either from iso_c_binding, or
+     a constant that was initialized to an identifier from it, use the
+     f90_type.  Otherwise, use the ts->type, since it shouldn't matter.  */
+  if (ts->is_iso_c)
+    ts->f90_type = MIO_NAME (bt) (ts->f90_type, bt_types);
+  else
+    ts->f90_type = MIO_NAME (bt) (ts->type, bt_types);
+
+  if (ts->type != BT_CHARACTER)
+    {
+      /* ts->u.cl is only valid for BT_CHARACTER.  */
+      mio_lparen ();
+      mio_rparen ();
+    }
+  else
+    mio_charlen (&ts->u.cl);
+
+  /* So as not to disturb the existing API, use an ATOM_NAME to
+     transmit deferred characteristic for characters (F2003).  */
+  if (iomode == IO_OUTPUT)
+    {
+      if (ts->type == BT_CHARACTER && ts->deferred)
+	write_atom (ATOM_NAME, "DEFERRED_CL");
+    }
+  else if (peek_atom () != ATOM_RPAREN)
+    {
+      if (parse_atom () != ATOM_NAME)
+	bad_module ("Expected string");
+      ts->deferred = 1;
+    }
+
+  mio_rparen ();
+}
+
+
+static const mstring array_spec_types[] = {
+    minit ("EXPLICIT", AS_EXPLICIT),
+    minit ("ASSUMED_SHAPE", AS_ASSUMED_SHAPE),
+    minit ("DEFERRED", AS_DEFERRED),
+    minit ("ASSUMED_SIZE", AS_ASSUMED_SIZE),
+    minit (NULL, -1)
+};
+
+
+static void
+mio_array_spec (gfc_array_spec **asp)
+{
+  gfc_array_spec *as;
+  int i;
+
+  mio_lparen ();
+
+  if (iomode == IO_OUTPUT)
+    {
+      if (*asp == NULL)
+	goto done;
+      as = *asp;
+    }
+  else
+    {
+      if (peek_atom () == ATOM_RPAREN)
+	{
+	  *asp = NULL;
+	  goto done;
+	}
+
+      *asp = as = gfc_get_array_spec ();
+    }
+
+  mio_integer (&as->rank);
+  mio_integer (&as->corank);
+  as->type = MIO_NAME (array_type) (as->type, array_spec_types);
+
+  for (i = 0; i < as->rank + as->corank; i++)
+    {
+      mio_expr (&as->lower[i]);
+      mio_expr (&as->upper[i]);
+    }
+
+done:
+  mio_rparen ();
+}
+
+
+/* Given a pointer to an array reference structure (which lives in a
+   gfc_ref structure), find the corresponding array specification
+   structure.  Storing the pointer in the ref structure doesn't quite
+   work when loading from a module. Generating code for an array
+   reference also needs more information than just the array spec.  */
+
+static const mstring array_ref_types[] = {
+    minit ("FULL", AR_FULL),
+    minit ("ELEMENT", AR_ELEMENT),
+    minit ("SECTION", AR_SECTION),
+    minit (NULL, -1)
+};
+
+
+static void
+mio_array_ref (gfc_array_ref *ar)
+{
+  int i;
+
+  mio_lparen ();
+  ar->type = MIO_NAME (ar_type) (ar->type, array_ref_types);
+  mio_integer (&ar->dimen);
+
+  switch (ar->type)
+    {
+    case AR_FULL:
+      break;
+
+    case AR_ELEMENT:
+      for (i = 0; i < ar->dimen; i++)
+	mio_expr (&ar->start[i]);
+
+      break;
+
+    case AR_SECTION:
+      for (i = 0; i < ar->dimen; i++)
+	{
+	  mio_expr (&ar->start[i]);
+	  mio_expr (&ar->end[i]);
+	  mio_expr (&ar->stride[i]);
+	}
+
+      break;
+
+    case AR_UNKNOWN:
+      gfc_internal_error ("mio_array_ref(): Unknown array ref");
+    }
+
+  /* Unfortunately, ar->dimen_type is an anonymous enumerated type so
+     we can't call mio_integer directly.  Instead loop over each element
+     and cast it to/from an integer.  */
+  if (iomode == IO_OUTPUT)
+    {
+      for (i = 0; i < ar->dimen; i++)
+	{
+	  int tmp = (int)ar->dimen_type[i];
+	  write_atom (ATOM_INTEGER, &tmp);
+	}
+    }
+  else
+    {
+      for (i = 0; i < ar->dimen; i++)
+	{
+	  require_atom (ATOM_INTEGER);
+	  ar->dimen_type[i] = (enum gfc_array_ref_dimen_type) atom_int;
+	}
+    }
+
+  if (iomode == IO_INPUT)
+    {
+      ar->where = gfc_current_locus;
+
+      for (i = 0; i < ar->dimen; i++)
+	ar->c_where[i] = gfc_current_locus;
+    }
+
+  mio_rparen ();
+}
+
+
+/* Saves or restores a pointer.  The pointer is converted back and
+   forth from an integer.  We return the pointer_info pointer so that
+   the caller can take additional action based on the pointer type.  */
+
+static pointer_info *
+mio_pointer_ref (void *gp)
+{
+  pointer_info *p;
+
+  if (iomode == IO_OUTPUT)
+    {
+      p = get_pointer (*((char **) gp));
+      write_atom (ATOM_INTEGER, &p->integer);
+    }
+  else
+    {
+      require_atom (ATOM_INTEGER);
+      p = add_fixup (atom_int, gp);
+    }
+
+  return p;
+}
+
+
+/* Save and load references to components that occur within
+   expressions.  We have to describe these references by a number and
+   by name.  The number is necessary for forward references during
+   reading, and the name is necessary if the symbol already exists in
+   the namespace and is not loaded again.  */
+
+static void
+mio_component_ref (gfc_component **cp, gfc_symbol *sym)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_component *q;
+  pointer_info *p;
+
+  p = mio_pointer_ref (cp);
+  if (p->type == P_UNKNOWN)
+    p->type = P_COMPONENT;
+
+  if (iomode == IO_OUTPUT)
+    mio_pool_string (&(*cp)->name);
+  else
+    {
+      mio_internal_string (name);
+
+      if (sym && sym->attr.is_class)
+	sym = sym->components->ts.u.derived;
+
+      /* It can happen that a component reference can be read before the
+	 associated derived type symbol has been loaded. Return now and
+	 wait for a later iteration of load_needed.  */
+      if (sym == NULL)
+	return;
+
+      if (sym->components != NULL && p->u.pointer == NULL)
+	{
+	  /* Symbol already loaded, so search by name.  */
+	  q = gfc_find_component (sym, name, true, true);
+
+	  if (q)
+	    associate_integer_pointer (p, q);
+	}
+
+      /* Make sure this symbol will eventually be loaded.  */
+      p = find_pointer2 (sym);
+      if (p->u.rsym.state == UNUSED)
+	p->u.rsym.state = NEEDED;
+    }
+}
+
+
+static void mio_namespace_ref (gfc_namespace **nsp);
+static void mio_formal_arglist (gfc_formal_arglist **formal);
+static void mio_typebound_proc (gfc_typebound_proc** proc);
+
+static void
+mio_component (gfc_component *c, int vtype)
+{
+  pointer_info *p;
+  int n;
+  gfc_formal_arglist *formal;
+
+  mio_lparen ();
+
+  if (iomode == IO_OUTPUT)
+    {
+      p = get_pointer (c);
+      mio_integer (&p->integer);
+    }
+  else
+    {
+      mio_integer (&n);
+      p = get_integer (n);
+      associate_integer_pointer (p, c);
+    }
+
+  if (p->type == P_UNKNOWN)
+    p->type = P_COMPONENT;
+
+  mio_pool_string (&c->name);
+  mio_typespec (&c->ts);
+  mio_array_spec (&c->as);
+
+  mio_symbol_attribute (&c->attr);
+  if (c->ts.type == BT_CLASS)
+    c->attr.class_ok = 1;
+  c->attr.access = MIO_NAME (gfc_access) (c->attr.access, access_types); 
+
+  if (!vtype)
+    mio_expr (&c->initializer);
+
+  if (c->attr.proc_pointer)
+    {
+      if (iomode == IO_OUTPUT)
+	{
+	  formal = c->formal;
+	  while (formal && !formal->sym)
+	    formal = formal->next;
+
+	  if (formal)
+	    mio_namespace_ref (&formal->sym->ns);
+	  else
+	    mio_namespace_ref (&c->formal_ns);
+	}
+      else
+	{
+	  mio_namespace_ref (&c->formal_ns);
+	  /* TODO: if (c->formal_ns)
+	    {
+	      c->formal_ns->proc_name = c;
+	      c->refs++;
+	    }*/
+	}
+
+      mio_formal_arglist (&c->formal);
+
+      mio_typebound_proc (&c->tb);
+    }
+
+  mio_rparen ();
+}
+
+
+static void
+mio_component_list (gfc_component **cp, int vtype)
+{
+  gfc_component *c, *tail;
+
+  mio_lparen ();
+
+  if (iomode == IO_OUTPUT)
+    {
+      for (c = *cp; c; c = c->next)
+	mio_component (c, vtype);
+    }
+  else
+    {
+      *cp = NULL;
+      tail = NULL;
+
+      for (;;)
+	{
+	  if (peek_atom () == ATOM_RPAREN)
+	    break;
+
+	  c = gfc_get_component ();
+	  mio_component (c, vtype);
+
+	  if (tail == NULL)
+	    *cp = c;
+	  else
+	    tail->next = c;
+
+	  tail = c;
+	}
+    }
+
+  mio_rparen ();
+}
+
+
+static void
+mio_actual_arg (gfc_actual_arglist *a)
+{
+  mio_lparen ();
+  mio_pool_string (&a->name);
+  mio_expr (&a->expr);
+  mio_rparen ();
+}
+
+
+static void
+mio_actual_arglist (gfc_actual_arglist **ap)
+{
+  gfc_actual_arglist *a, *tail;
+
+  mio_lparen ();
+
+  if (iomode == IO_OUTPUT)
+    {
+      for (a = *ap; a; a = a->next)
+	mio_actual_arg (a);
+
+    }
+  else
+    {
+      tail = NULL;
+
+      for (;;)
+	{
+	  if (peek_atom () != ATOM_LPAREN)
+	    break;
+
+	  a = gfc_get_actual_arglist ();
+
+	  if (tail == NULL)
+	    *ap = a;
+	  else
+	    tail->next = a;
+
+	  tail = a;
+	  mio_actual_arg (a);
+	}
+    }
+
+  mio_rparen ();
+}
+
+
+/* Read and write formal argument lists.  */
+
+static void
+mio_formal_arglist (gfc_formal_arglist **formal)
+{
+  gfc_formal_arglist *f, *tail;
+
+  mio_lparen ();
+
+  if (iomode == IO_OUTPUT)
+    {
+      for (f = *formal; f; f = f->next)
+	mio_symbol_ref (&f->sym);
+    }
+  else
+    {
+      *formal = tail = NULL;
+
+      while (peek_atom () != ATOM_RPAREN)
+	{
+	  f = gfc_get_formal_arglist ();
+	  mio_symbol_ref (&f->sym);
+
+	  if (*formal == NULL)
+	    *formal = f;
+	  else
+	    tail->next = f;
+
+	  tail = f;
+	}
+    }
+
+  mio_rparen ();
+}
+
+
+/* Save or restore a reference to a symbol node.  */
+
+pointer_info *
+mio_symbol_ref (gfc_symbol **symp)
+{
+  pointer_info *p;
+
+  p = mio_pointer_ref (symp);
+  if (p->type == P_UNKNOWN)
+    p->type = P_SYMBOL;
+
+  if (iomode == IO_OUTPUT)
+    {
+      if (p->u.wsym.state == UNREFERENCED)
+	p->u.wsym.state = NEEDS_WRITE;
+    }
+  else
+    {
+      if (p->u.rsym.state == UNUSED)
+	p->u.rsym.state = NEEDED;
+    }
+  return p;
+}
+
+
+/* Save or restore a reference to a symtree node.  */
+
+static void
+mio_symtree_ref (gfc_symtree **stp)
+{
+  pointer_info *p;
+  fixup_t *f;
+
+  if (iomode == IO_OUTPUT)
+    mio_symbol_ref (&(*stp)->n.sym);
+  else
+    {
+      require_atom (ATOM_INTEGER);
+      p = get_integer (atom_int);
+
+      /* An unused equivalence member; make a symbol and a symtree
+	 for it.  */
+      if (in_load_equiv && p->u.rsym.symtree == NULL)
+	{
+	  /* Since this is not used, it must have a unique name.  */
+	  p->u.rsym.symtree = gfc_get_unique_symtree (gfc_current_ns);
+
+	  /* Make the symbol.  */
+	  if (p->u.rsym.sym == NULL)
+	    {
+	      p->u.rsym.sym = gfc_new_symbol (p->u.rsym.true_name,
+					      gfc_current_ns);
+	      p->u.rsym.sym->module = gfc_get_string (p->u.rsym.module);
+	    }
+
+	  p->u.rsym.symtree->n.sym = p->u.rsym.sym;
+	  p->u.rsym.symtree->n.sym->refs++;
+	  p->u.rsym.referenced = 1;
+
+	  /* If the symbol is PRIVATE and in COMMON, load_commons will
+	     generate a fixup symbol, which must be associated.  */
+	  if (p->fixup)
+	    resolve_fixups (p->fixup, p->u.rsym.sym);
+	  p->fixup = NULL;
+	}
+      
+      if (p->type == P_UNKNOWN)
+	p->type = P_SYMBOL;
+
+      if (p->u.rsym.state == UNUSED)
+	p->u.rsym.state = NEEDED;
+
+      if (p->u.rsym.symtree != NULL)
+	{
+	  *stp = p->u.rsym.symtree;
+	}
+      else
+	{
+	  f = XCNEW (fixup_t);
+
+	  f->next = p->u.rsym.stfixup;
+	  p->u.rsym.stfixup = f;
+
+	  f->pointer = (void **) stp;
+	}
+    }
+}
+
+
+static void
+mio_iterator (gfc_iterator **ip)
+{
+  gfc_iterator *iter;
+
+  mio_lparen ();
+
+  if (iomode == IO_OUTPUT)
+    {
+      if (*ip == NULL)
+	goto done;
+    }
+  else
+    {
+      if (peek_atom () == ATOM_RPAREN)
+	{
+	  *ip = NULL;
+	  goto done;
+	}
+
+      *ip = gfc_get_iterator ();
+    }
+
+  iter = *ip;
+
+  mio_expr (&iter->var);
+  mio_expr (&iter->start);
+  mio_expr (&iter->end);
+  mio_expr (&iter->step);
+
+done:
+  mio_rparen ();
+}
+
+
+static void
+mio_constructor (gfc_constructor_base *cp)
+{
+  gfc_constructor *c;
+
+  mio_lparen ();
+
+  if (iomode == IO_OUTPUT)
+    {
+      for (c = gfc_constructor_first (*cp); c; c = gfc_constructor_next (c))
+	{
+	  mio_lparen ();
+	  mio_expr (&c->expr);
+	  mio_iterator (&c->iterator);
+	  mio_rparen ();
+	}
+    }
+  else
+    {
+      while (peek_atom () != ATOM_RPAREN)
+	{
+	  c = gfc_constructor_append_expr (cp, NULL, NULL);
+
+	  mio_lparen ();
+	  mio_expr (&c->expr);
+	  mio_iterator (&c->iterator);
+	  mio_rparen ();
+	}
+    }
+
+  mio_rparen ();
+}
+
+
+static const mstring ref_types[] = {
+    minit ("ARRAY", REF_ARRAY),
+    minit ("COMPONENT", REF_COMPONENT),
+    minit ("SUBSTRING", REF_SUBSTRING),
+    minit (NULL, -1)
+};
+
+
+static void
+mio_ref (gfc_ref **rp)
+{
+  gfc_ref *r;
+
+  mio_lparen ();
+
+  r = *rp;
+  r->type = MIO_NAME (ref_type) (r->type, ref_types);
+
+  switch (r->type)
+    {
+    case REF_ARRAY:
+      mio_array_ref (&r->u.ar);
+      break;
+
+    case REF_COMPONENT:
+      mio_symbol_ref (&r->u.c.sym);
+      mio_component_ref (&r->u.c.component, r->u.c.sym);
+      break;
+
+    case REF_SUBSTRING:
+      mio_expr (&r->u.ss.start);
+      mio_expr (&r->u.ss.end);
+      mio_charlen (&r->u.ss.length);
+      break;
+    }
+
+  mio_rparen ();
+}
+
+
+static void
+mio_ref_list (gfc_ref **rp)
+{
+  gfc_ref *ref, *head, *tail;
+
+  mio_lparen ();
+
+  if (iomode == IO_OUTPUT)
+    {
+      for (ref = *rp; ref; ref = ref->next)
+	mio_ref (&ref);
+    }
+  else
+    {
+      head = tail = NULL;
+
+      while (peek_atom () != ATOM_RPAREN)
+	{
+	  if (head == NULL)
+	    head = tail = gfc_get_ref ();
+	  else
+	    {
+	      tail->next = gfc_get_ref ();
+	      tail = tail->next;
+	    }
+
+	  mio_ref (&tail);
+	}
+
+      *rp = head;
+    }
+
+  mio_rparen ();
+}
+
+
+/* Read and write an integer value.  */
+
+static void
+mio_gmp_integer (mpz_t *integer)
+{
+  char *p;
+
+  if (iomode == IO_INPUT)
+    {
+      if (parse_atom () != ATOM_STRING)
+	bad_module ("Expected integer string");
+
+      mpz_init (*integer);
+      if (mpz_set_str (*integer, atom_string, 10))
+	bad_module ("Error converting integer");
+
+      gfc_free (atom_string);
+    }
+  else
+    {
+      p = mpz_get_str (NULL, 10, *integer);
+      write_atom (ATOM_STRING, p);
+      gfc_free (p);
+    }
+}
+
+
+static void
+mio_gmp_real (mpfr_t *real)
+{
+  mp_exp_t exponent;
+  char *p;
+
+  if (iomode == IO_INPUT)
+    {
+      if (parse_atom () != ATOM_STRING)
+	bad_module ("Expected real string");
+
+      mpfr_init (*real);
+      mpfr_set_str (*real, atom_string, 16, GFC_RND_MODE);
+      gfc_free (atom_string);
+    }
+  else
+    {
+      p = mpfr_get_str (NULL, &exponent, 16, 0, *real, GFC_RND_MODE);
+
+      if (mpfr_nan_p (*real) || mpfr_inf_p (*real))
+	{
+	  write_atom (ATOM_STRING, p);
+	  gfc_free (p);
+	  return;
+	}
+
+      atom_string = XCNEWVEC (char, strlen (p) + 20);
+
+      sprintf (atom_string, "0.%s@%ld", p, exponent);
+
+      /* Fix negative numbers.  */
+      if (atom_string[2] == '-')
+	{
+	  atom_string[0] = '-';
+	  atom_string[1] = '0';
+	  atom_string[2] = '.';
+	}
+
+      write_atom (ATOM_STRING, atom_string);
+
+      gfc_free (atom_string);
+      gfc_free (p);
+    }
+}
+
+
+/* Save and restore the shape of an array constructor.  */
+
+static void
+mio_shape (mpz_t **pshape, int rank)
+{
+  mpz_t *shape;
+  atom_type t;
+  int n;
+
+  /* A NULL shape is represented by ().  */
+  mio_lparen ();
+
+  if (iomode == IO_OUTPUT)
+    {
+      shape = *pshape;
+      if (!shape)
+	{
+	  mio_rparen ();
+	  return;
+	}
+    }
+  else
+    {
+      t = peek_atom ();
+      if (t == ATOM_RPAREN)
+	{
+	  *pshape = NULL;
+	  mio_rparen ();
+	  return;
+	}
+
+      shape = gfc_get_shape (rank);
+      *pshape = shape;
+    }
+
+  for (n = 0; n < rank; n++)
+    mio_gmp_integer (&shape[n]);
+
+  mio_rparen ();
+}
+
+
+static const mstring expr_types[] = {
+    minit ("OP", EXPR_OP),
+    minit ("FUNCTION", EXPR_FUNCTION),
+    minit ("CONSTANT", EXPR_CONSTANT),
+    minit ("VARIABLE", EXPR_VARIABLE),
+    minit ("SUBSTRING", EXPR_SUBSTRING),
+    minit ("STRUCTURE", EXPR_STRUCTURE),
+    minit ("ARRAY", EXPR_ARRAY),
+    minit ("NULL", EXPR_NULL),
+    minit ("COMPCALL", EXPR_COMPCALL),
+    minit (NULL, -1)
+};
+
+/* INTRINSIC_ASSIGN is missing because it is used as an index for
+   generic operators, not in expressions.  INTRINSIC_USER is also
+   replaced by the correct function name by the time we see it.  */
+
+static const mstring intrinsics[] =
+{
+    minit ("UPLUS", INTRINSIC_UPLUS),
+    minit ("UMINUS", INTRINSIC_UMINUS),
+    minit ("PLUS", INTRINSIC_PLUS),
+    minit ("MINUS", INTRINSIC_MINUS),
+    minit ("TIMES", INTRINSIC_TIMES),
+    minit ("DIVIDE", INTRINSIC_DIVIDE),
+    minit ("POWER", INTRINSIC_POWER),
+    minit ("CONCAT", INTRINSIC_CONCAT),
+    minit ("AND", INTRINSIC_AND),
+    minit ("OR", INTRINSIC_OR),
+    minit ("EQV", INTRINSIC_EQV),
+    minit ("NEQV", INTRINSIC_NEQV),
+    minit ("EQ_SIGN", INTRINSIC_EQ),
+    minit ("EQ", INTRINSIC_EQ_OS),
+    minit ("NE_SIGN", INTRINSIC_NE),
+    minit ("NE", INTRINSIC_NE_OS),
+    minit ("GT_SIGN", INTRINSIC_GT),
+    minit ("GT", INTRINSIC_GT_OS),
+    minit ("GE_SIGN", INTRINSIC_GE),
+    minit ("GE", INTRINSIC_GE_OS),
+    minit ("LT_SIGN", INTRINSIC_LT),
+    minit ("LT", INTRINSIC_LT_OS),
+    minit ("LE_SIGN", INTRINSIC_LE),
+    minit ("LE", INTRINSIC_LE_OS),
+    minit ("NOT", INTRINSIC_NOT),
+    minit ("PARENTHESES", INTRINSIC_PARENTHESES),
+    minit (NULL, -1)
+};
+
+
+/* Remedy a couple of situations where the gfc_expr's can be defective.  */
+ 
+static void
+fix_mio_expr (gfc_expr *e)
+{
+  gfc_symtree *ns_st = NULL;
+  const char *fname;
+
+  if (iomode != IO_OUTPUT)
+    return;
+
+  if (e->symtree)
+    {
+      /* If this is a symtree for a symbol that came from a contained module
+	 namespace, it has a unique name and we should look in the current
+	 namespace to see if the required, non-contained symbol is available
+	 yet. If so, the latter should be written.  */
+      if (e->symtree->n.sym && check_unique_name (e->symtree->name))
+	ns_st = gfc_find_symtree (gfc_current_ns->sym_root,
+				  e->symtree->n.sym->name);
+
+      /* On the other hand, if the existing symbol is the module name or the
+	 new symbol is a dummy argument, do not do the promotion.  */
+      if (ns_st && ns_st->n.sym
+	  && ns_st->n.sym->attr.flavor != FL_MODULE
+	  && !e->symtree->n.sym->attr.dummy)
+	e->symtree = ns_st;
+    }
+  else if (e->expr_type == EXPR_FUNCTION && e->value.function.name)
+    {
+      gfc_symbol *sym;
+
+      /* In some circumstances, a function used in an initialization
+	 expression, in one use associated module, can fail to be
+	 coupled to its symtree when used in a specification
+	 expression in another module.  */
+      fname = e->value.function.esym ? e->value.function.esym->name
+				     : e->value.function.isym->name;
+      e->symtree = gfc_find_symtree (gfc_current_ns->sym_root, fname);
+
+      if (e->symtree)
+	return;
+
+      /* This is probably a reference to a private procedure from another
+	 module.  To prevent a segfault, make a generic with no specific
+	 instances.  If this module is used, without the required
+	 specific coming from somewhere, the appropriate error message
+	 is issued.  */
+      gfc_get_symbol (fname, gfc_current_ns, &sym);
+      sym->attr.flavor = FL_PROCEDURE;
+      sym->attr.generic = 1;
+      e->symtree = gfc_find_symtree (gfc_current_ns->sym_root, fname);
+      gfc_commit_symbol (sym);
+    }
+}
+
+
+/* Read and write expressions.  The form "()" is allowed to indicate a
+   NULL expression.  */
+
+static void
+mio_expr (gfc_expr **ep)
+{
+  gfc_expr *e;
+  atom_type t;
+  int flag;
+
+  mio_lparen ();
+
+  if (iomode == IO_OUTPUT)
+    {
+      if (*ep == NULL)
+	{
+	  mio_rparen ();
+	  return;
+	}
+
+      e = *ep;
+      MIO_NAME (expr_t) (e->expr_type, expr_types);
+    }
+  else
+    {
+      t = parse_atom ();
+      if (t == ATOM_RPAREN)
+	{
+	  *ep = NULL;
+	  return;
+	}
+
+      if (t != ATOM_NAME)
+	bad_module ("Expected expression type");
+
+      e = *ep = gfc_get_expr ();
+      e->where = gfc_current_locus;
+      e->expr_type = (expr_t) find_enum (expr_types);
+    }
+
+  mio_typespec (&e->ts);
+  mio_integer (&e->rank);
+
+  fix_mio_expr (e);
+
+  switch (e->expr_type)
+    {
+    case EXPR_OP:
+      e->value.op.op
+	= MIO_NAME (gfc_intrinsic_op) (e->value.op.op, intrinsics);
+
+      switch (e->value.op.op)
+	{
+	case INTRINSIC_UPLUS:
+	case INTRINSIC_UMINUS:
+	case INTRINSIC_NOT:
+	case INTRINSIC_PARENTHESES:
+	  mio_expr (&e->value.op.op1);
+	  break;
+
+	case INTRINSIC_PLUS:
+	case INTRINSIC_MINUS:
+	case INTRINSIC_TIMES:
+	case INTRINSIC_DIVIDE:
+	case INTRINSIC_POWER:
+	case INTRINSIC_CONCAT:
+	case INTRINSIC_AND:
+	case INTRINSIC_OR:
+	case INTRINSIC_EQV:
+	case INTRINSIC_NEQV:
+	case INTRINSIC_EQ:
+	case INTRINSIC_EQ_OS:
+	case INTRINSIC_NE:
+	case INTRINSIC_NE_OS:
+	case INTRINSIC_GT:
+	case INTRINSIC_GT_OS:
+	case INTRINSIC_GE:
+	case INTRINSIC_GE_OS:
+	case INTRINSIC_LT:
+	case INTRINSIC_LT_OS:
+	case INTRINSIC_LE:
+	case INTRINSIC_LE_OS:
+	  mio_expr (&e->value.op.op1);
+	  mio_expr (&e->value.op.op2);
+	  break;
+
+	default:
+	  bad_module ("Bad operator");
+	}
+
+      break;
+
+    case EXPR_FUNCTION:
+      mio_symtree_ref (&e->symtree);
+      mio_actual_arglist (&e->value.function.actual);
+
+      if (iomode == IO_OUTPUT)
+	{
+	  e->value.function.name
+	    = mio_allocated_string (e->value.function.name);
+	  flag = e->value.function.esym != NULL;
+	  mio_integer (&flag);
+	  if (flag)
+	    mio_symbol_ref (&e->value.function.esym);
+	  else
+	    write_atom (ATOM_STRING, e->value.function.isym->name);
+	}
+      else
+	{
+	  require_atom (ATOM_STRING);
+	  e->value.function.name = gfc_get_string (atom_string);
+	  gfc_free (atom_string);
+
+	  mio_integer (&flag);
+	  if (flag)
+	    mio_symbol_ref (&e->value.function.esym);
+	  else
+	    {
+	      require_atom (ATOM_STRING);
+	      e->value.function.isym = gfc_find_function (atom_string);
+	      gfc_free (atom_string);
+	    }
+	}
+
+      break;
+
+    case EXPR_VARIABLE:
+      mio_symtree_ref (&e->symtree);
+      mio_ref_list (&e->ref);
+      break;
+
+    case EXPR_SUBSTRING:
+      e->value.character.string
+	= CONST_CAST (gfc_char_t *,
+		      mio_allocated_wide_string (e->value.character.string,
+						 e->value.character.length));
+      mio_ref_list (&e->ref);
+      break;
+
+    case EXPR_STRUCTURE:
+    case EXPR_ARRAY:
+      mio_constructor (&e->value.constructor);
+      mio_shape (&e->shape, e->rank);
+      break;
+
+    case EXPR_CONSTANT:
+      switch (e->ts.type)
+	{
+	case BT_INTEGER:
+	  mio_gmp_integer (&e->value.integer);
+	  break;
+
+	case BT_REAL:
+	  gfc_set_model_kind (e->ts.kind);
+	  mio_gmp_real (&e->value.real);
+	  break;
+
+	case BT_COMPLEX:
+	  gfc_set_model_kind (e->ts.kind);
+	  mio_gmp_real (&mpc_realref (e->value.complex));
+	  mio_gmp_real (&mpc_imagref (e->value.complex));
+	  break;
+
+	case BT_LOGICAL:
+	  mio_integer (&e->value.logical);
+	  break;
+
+	case BT_CHARACTER:
+	  mio_integer (&e->value.character.length);
+	  e->value.character.string
+	    = CONST_CAST (gfc_char_t *,
+			  mio_allocated_wide_string (e->value.character.string,
+						     e->value.character.length));
+	  break;
+
+	default:
+	  bad_module ("Bad type in constant expression");
+	}
+
+      break;
+
+    case EXPR_NULL:
+      break;
+
+    case EXPR_COMPCALL:
+    case EXPR_PPC:
+      gcc_unreachable ();
+      break;
+    }
+
+  mio_rparen ();
+}
+
+
+/* Read and write namelists.  */
+
+static void
+mio_namelist (gfc_symbol *sym)
+{
+  gfc_namelist *n, *m;
+  const char *check_name;
+
+  mio_lparen ();
+
+  if (iomode == IO_OUTPUT)
+    {
+      for (n = sym->namelist; n; n = n->next)
+	mio_symbol_ref (&n->sym);
+    }
+  else
+    {
+      /* This departure from the standard is flagged as an error.
+	 It does, in fact, work correctly. TODO: Allow it
+	 conditionally?  */
+      if (sym->attr.flavor == FL_NAMELIST)
+	{
+	  check_name = find_use_name (sym->name, false);
+	  if (check_name && strcmp (check_name, sym->name) != 0)
+	    gfc_error ("Namelist %s cannot be renamed by USE "
+		       "association to %s", sym->name, check_name);
+	}
+
+      m = NULL;
+      while (peek_atom () != ATOM_RPAREN)
+	{
+	  n = gfc_get_namelist ();
+	  mio_symbol_ref (&n->sym);
+
+	  if (sym->namelist == NULL)
+	    sym->namelist = n;
+	  else
+	    m->next = n;
+
+	  m = n;
+	}
+      sym->namelist_tail = m;
+    }
+
+  mio_rparen ();
+}
+
+
+/* Save/restore lists of gfc_interface structures.  When loading an
+   interface, we are really appending to the existing list of
+   interfaces.  Checking for duplicate and ambiguous interfaces has to
+   be done later when all symbols have been loaded.  */
+
+pointer_info *
+mio_interface_rest (gfc_interface **ip)
+{
+  gfc_interface *tail, *p;
+  pointer_info *pi = NULL;
+
+  if (iomode == IO_OUTPUT)
+    {
+      if (ip != NULL)
+	for (p = *ip; p; p = p->next)
+	  mio_symbol_ref (&p->sym);
+    }
+  else
+    {
+      if (*ip == NULL)
+	tail = NULL;
+      else
+	{
+	  tail = *ip;
+	  while (tail->next)
+	    tail = tail->next;
+	}
+
+      for (;;)
+	{
+	  if (peek_atom () == ATOM_RPAREN)
+	    break;
+
+	  p = gfc_get_interface ();
+	  p->where = gfc_current_locus;
+	  pi = mio_symbol_ref (&p->sym);
+
+	  if (tail == NULL)
+	    *ip = p;
+	  else
+	    tail->next = p;
+
+	  tail = p;
+	}
+    }
+
+  mio_rparen ();
+  return pi;
+}
+
+
+/* Save/restore a nameless operator interface.  */
+
+static void
+mio_interface (gfc_interface **ip)
+{
+  mio_lparen ();
+  mio_interface_rest (ip);
+}
+
+
+/* Save/restore a named operator interface.  */
+
+static void
+mio_symbol_interface (const char **name, const char **module,
+		      gfc_interface **ip)
+{
+  mio_lparen ();
+  mio_pool_string (name);
+  mio_pool_string (module);
+  mio_interface_rest (ip);
+}
+
+
+static void
+mio_namespace_ref (gfc_namespace **nsp)
+{
+  gfc_namespace *ns;
+  pointer_info *p;
+
+  p = mio_pointer_ref (nsp);
+
+  if (p->type == P_UNKNOWN)
+    p->type = P_NAMESPACE;
+
+  if (iomode == IO_INPUT && p->integer != 0)
+    {
+      ns = (gfc_namespace *) p->u.pointer;
+      if (ns == NULL)
+	{
+	  ns = gfc_get_namespace (NULL, 0);
+	  associate_integer_pointer (p, ns);
+	}
+      else
+	ns->refs++;
+    }
+}
+
+
+/* Save/restore the f2k_derived namespace of a derived-type symbol.  */
+
+static gfc_namespace* current_f2k_derived;
+
+static void
+mio_typebound_proc (gfc_typebound_proc** proc)
+{
+  int flag;
+  int overriding_flag;
+
+  if (iomode == IO_INPUT)
+    {
+      *proc = gfc_get_typebound_proc (NULL);
+      (*proc)->where = gfc_current_locus;
+    }
+  gcc_assert (*proc);
+
+  mio_lparen ();
+
+  (*proc)->access = MIO_NAME (gfc_access) ((*proc)->access, access_types);
+
+  /* IO the NON_OVERRIDABLE/DEFERRED combination.  */
+  gcc_assert (!((*proc)->deferred && (*proc)->non_overridable));
+  overriding_flag = ((*proc)->deferred << 1) | (*proc)->non_overridable;
+  overriding_flag = mio_name (overriding_flag, binding_overriding);
+  (*proc)->deferred = ((overriding_flag & 2) != 0);
+  (*proc)->non_overridable = ((overriding_flag & 1) != 0);
+  gcc_assert (!((*proc)->deferred && (*proc)->non_overridable));
+
+  (*proc)->nopass = mio_name ((*proc)->nopass, binding_passing);
+  (*proc)->is_generic = mio_name ((*proc)->is_generic, binding_generic);
+  (*proc)->ppc = mio_name((*proc)->ppc, binding_ppc);
+
+  mio_pool_string (&((*proc)->pass_arg));
+
+  flag = (int) (*proc)->pass_arg_num;
+  mio_integer (&flag);
+  (*proc)->pass_arg_num = (unsigned) flag;
+
+  if ((*proc)->is_generic)
+    {
+      gfc_tbp_generic* g;
+
+      mio_lparen ();
+
+      if (iomode == IO_OUTPUT)
+	for (g = (*proc)->u.generic; g; g = g->next)
+	  mio_allocated_string (g->specific_st->name);
+      else
+	{
+	  (*proc)->u.generic = NULL;
+	  while (peek_atom () != ATOM_RPAREN)
+	    {
+	      gfc_symtree** sym_root;
+
+	      g = gfc_get_tbp_generic ();
+	      g->specific = NULL;
+
+	      require_atom (ATOM_STRING);
+	      sym_root = &current_f2k_derived->tb_sym_root;
+	      g->specific_st = gfc_get_tbp_symtree (sym_root, atom_string);
+	      gfc_free (atom_string);
+
+	      g->next = (*proc)->u.generic;
+	      (*proc)->u.generic = g;
+	    }
+	}
+
+      mio_rparen ();
+    }
+  else if (!(*proc)->ppc)
+    mio_symtree_ref (&(*proc)->u.specific);
+
+  mio_rparen ();
+}
+
+/* Walker-callback function for this purpose.  */
+static void
+mio_typebound_symtree (gfc_symtree* st)
+{
+  if (iomode == IO_OUTPUT && !st->n.tb)
+    return;
+
+  if (iomode == IO_OUTPUT)
+    {
+      mio_lparen ();
+      mio_allocated_string (st->name);
+    }
+  /* For IO_INPUT, the above is done in mio_f2k_derived.  */
+
+  mio_typebound_proc (&st->n.tb);
+  mio_rparen ();
+}
+
+/* IO a full symtree (in all depth).  */
+static void
+mio_full_typebound_tree (gfc_symtree** root)
+{
+  mio_lparen ();
+
+  if (iomode == IO_OUTPUT)
+    gfc_traverse_symtree (*root, &mio_typebound_symtree);
+  else
+    {
+      while (peek_atom () == ATOM_LPAREN)
+	{
+	  gfc_symtree* st;
+
+	  mio_lparen (); 
+
+	  require_atom (ATOM_STRING);
+	  st = gfc_get_tbp_symtree (root, atom_string);
+	  gfc_free (atom_string);
+
+	  mio_typebound_symtree (st);
+	}
+    }
+
+  mio_rparen ();
+}
+
+static void
+mio_finalizer (gfc_finalizer **f)
+{
+  if (iomode == IO_OUTPUT)
+    {
+      gcc_assert (*f);
+      gcc_assert ((*f)->proc_tree); /* Should already be resolved.  */
+      mio_symtree_ref (&(*f)->proc_tree);
+    }
+  else
+    {
+      *f = gfc_get_finalizer ();
+      (*f)->where = gfc_current_locus; /* Value should not matter.  */
+      (*f)->next = NULL;
+
+      mio_symtree_ref (&(*f)->proc_tree);
+      (*f)->proc_sym = NULL;
+    }
+}
+
+static void
+mio_f2k_derived (gfc_namespace *f2k)
+{
+  current_f2k_derived = f2k;
+
+  /* Handle the list of finalizer procedures.  */
+  mio_lparen ();
+  if (iomode == IO_OUTPUT)
+    {
+      gfc_finalizer *f;
+      for (f = f2k->finalizers; f; f = f->next)
+	mio_finalizer (&f);
+    }
+  else
+    {
+      f2k->finalizers = NULL;
+      while (peek_atom () != ATOM_RPAREN)
+	{
+	  gfc_finalizer *cur = NULL;
+	  mio_finalizer (&cur);
+	  cur->next = f2k->finalizers;
+	  f2k->finalizers = cur;
+	}
+    }
+  mio_rparen ();
+
+  /* Handle type-bound procedures.  */
+  mio_full_typebound_tree (&f2k->tb_sym_root);
+
+  /* Type-bound user operators.  */
+  mio_full_typebound_tree (&f2k->tb_uop_root);
+
+  /* Type-bound intrinsic operators.  */
+  mio_lparen ();
+  if (iomode == IO_OUTPUT)
+    {
+      int op;
+      for (op = GFC_INTRINSIC_BEGIN; op != GFC_INTRINSIC_END; ++op)
+	{
+	  gfc_intrinsic_op realop;
+
+	  if (op == INTRINSIC_USER || !f2k->tb_op[op])
+	    continue;
+
+	  mio_lparen ();
+	  realop = (gfc_intrinsic_op) op;
+	  mio_intrinsic_op (&realop);
+	  mio_typebound_proc (&f2k->tb_op[op]);
+	  mio_rparen ();
+	}
+    }
+  else
+    while (peek_atom () != ATOM_RPAREN)
+      {
+	gfc_intrinsic_op op = GFC_INTRINSIC_BEGIN; /* Silence GCC.  */
+
+	mio_lparen ();
+	mio_intrinsic_op (&op);
+	mio_typebound_proc (&f2k->tb_op[op]);
+	mio_rparen ();
+      }
+  mio_rparen ();
+}
+
+static void
+mio_full_f2k_derived (gfc_symbol *sym)
+{
+  mio_lparen ();
+  
+  if (iomode == IO_OUTPUT)
+    {
+      if (sym->f2k_derived)
+	mio_f2k_derived (sym->f2k_derived);
+    }
+  else
+    {
+      if (peek_atom () != ATOM_RPAREN)
+	{
+	  sym->f2k_derived = gfc_get_namespace (NULL, 0);
+	  mio_f2k_derived (sym->f2k_derived);
+	}
+      else
+	gcc_assert (!sym->f2k_derived);
+    }
+
+  mio_rparen ();
+}
+
+
+/* Unlike most other routines, the address of the symbol node is already
+   fixed on input and the name/module has already been filled in.  */
+
+static void
+mio_symbol (gfc_symbol *sym)
+{
+  int intmod = INTMOD_NONE;
+  
+  mio_lparen ();
+
+  mio_symbol_attribute (&sym->attr);
+  mio_typespec (&sym->ts);
+  if (sym->ts.type == BT_CLASS)
+    sym->attr.class_ok = 1;
+
+  if (iomode == IO_OUTPUT)
+    mio_namespace_ref (&sym->formal_ns);
+  else
+    {
+      mio_namespace_ref (&sym->formal_ns);
+      if (sym->formal_ns)
+	{
+	  sym->formal_ns->proc_name = sym;
+	  sym->refs++;
+	}
+    }
+
+  /* Save/restore common block links.  */
+  mio_symbol_ref (&sym->common_next);
+
+  mio_formal_arglist (&sym->formal);
+
+  if (sym->attr.flavor == FL_PARAMETER)
+    mio_expr (&sym->value);
+
+  mio_array_spec (&sym->as);
+
+  mio_symbol_ref (&sym->result);
+
+  if (sym->attr.cray_pointee)
+    mio_symbol_ref (&sym->cp_pointer);
+
+  /* Note that components are always saved, even if they are supposed
+     to be private.  Component access is checked during searching.  */
+
+  mio_component_list (&sym->components, sym->attr.vtype);
+
+  if (sym->components != NULL)
+    sym->component_access
+      = MIO_NAME (gfc_access) (sym->component_access, access_types);
+
+  /* Load/save the f2k_derived namespace of a derived-type symbol.  */
+  mio_full_f2k_derived (sym);
+
+  mio_namelist (sym);
+
+  /* Add the fields that say whether this is from an intrinsic module,
+     and if so, what symbol it is within the module.  */
+/*   mio_integer (&(sym->from_intmod)); */
+  if (iomode == IO_OUTPUT)
+    {
+      intmod = sym->from_intmod;
+      mio_integer (&intmod);
+    }
+  else
+    {
+      mio_integer (&intmod);
+      sym->from_intmod = (intmod_id) intmod;
+    }
+  
+  mio_integer (&(sym->intmod_sym_id));
+
+  if (sym->attr.flavor == FL_DERIVED)
+    mio_integer (&(sym->hash_value));
+
+  mio_rparen ();
+}
+
+
+/************************* Top level subroutines *************************/
+
+/* Given a root symtree node and a symbol, try to find a symtree that
+   references the symbol that is not a unique name.  */
+
+static gfc_symtree *
+find_symtree_for_symbol (gfc_symtree *st, gfc_symbol *sym)
+{
+  gfc_symtree *s = NULL;
+
+  if (st == NULL)
+    return s;
+
+  s = find_symtree_for_symbol (st->right, sym);
+  if (s != NULL)
+    return s;
+  s = find_symtree_for_symbol (st->left, sym);
+  if (s != NULL)
+    return s;
+
+  if (st->n.sym == sym && !check_unique_name (st->name))
+    return st;
+
+  return s;
+}
+
+
+/* A recursive function to look for a specific symbol by name and by
+   module.  Whilst several symtrees might point to one symbol, its
+   is sufficient for the purposes here than one exist.  Note that
+   generic interfaces are distinguished as are symbols that have been
+   renamed in another module.  */
+static gfc_symtree *
+find_symbol (gfc_symtree *st, const char *name,
+	     const char *module, int generic)
+{
+  int c;
+  gfc_symtree *retval, *s;
+
+  if (st == NULL || st->n.sym == NULL)
+    return NULL;
+
+  c = strcmp (name, st->n.sym->name);
+  if (c == 0 && st->n.sym->module
+	     && strcmp (module, st->n.sym->module) == 0
+	     && !check_unique_name (st->name))
+    {
+      s = gfc_find_symtree (gfc_current_ns->sym_root, name);
+
+      /* Detect symbols that are renamed by use association in another
+	 module by the absence of a symtree and null attr.use_rename,
+	 since the latter is not transmitted in the module file.  */
+      if (((!generic && !st->n.sym->attr.generic)
+		|| (generic && st->n.sym->attr.generic))
+	    && !(s == NULL && !st->n.sym->attr.use_rename))
+	return st;
+    }
+
+  retval = find_symbol (st->left, name, module, generic);
+
+  if (retval == NULL)
+    retval = find_symbol (st->right, name, module, generic);
+
+  return retval;
+}
+
+
+/* Skip a list between balanced left and right parens.  */
+
+static void
+skip_list (void)
+{
+  int level;
+
+  level = 0;
+  do
+    {
+      switch (parse_atom ())
+	{
+	case ATOM_LPAREN:
+	  level++;
+	  break;
+
+	case ATOM_RPAREN:
+	  level--;
+	  break;
+
+	case ATOM_STRING:
+	  gfc_free (atom_string);
+	  break;
+
+	case ATOM_NAME:
+	case ATOM_INTEGER:
+	  break;
+	}
+    }
+  while (level > 0);
+}
+
+
+/* Load operator interfaces from the module.  Interfaces are unusual
+   in that they attach themselves to existing symbols.  */
+
+static void
+load_operator_interfaces (void)
+{
+  const char *p;
+  char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_user_op *uop;
+  pointer_info *pi = NULL;
+  int n, i;
+
+  mio_lparen ();
+
+  while (peek_atom () != ATOM_RPAREN)
+    {
+      mio_lparen ();
+
+      mio_internal_string (name);
+      mio_internal_string (module);
+
+      n = number_use_names (name, true);
+      n = n ? n : 1;
+
+      for (i = 1; i <= n; i++)
+	{
+	  /* Decide if we need to load this one or not.  */
+	  p = find_use_name_n (name, &i, true);
+
+	  if (p == NULL)
+	    {
+	      while (parse_atom () != ATOM_RPAREN);
+	      continue;
+	    }
+
+	  if (i == 1)
+	    {
+	      uop = gfc_get_uop (p);
+	      pi = mio_interface_rest (&uop->op);
+	    }
+	  else
+	    {
+	      if (gfc_find_uop (p, NULL))
+		continue;
+	      uop = gfc_get_uop (p);
+	      uop->op = gfc_get_interface ();
+	      uop->op->where = gfc_current_locus;
+	      add_fixup (pi->integer, &uop->op->sym);
+	    }
+	}
+    }
+
+  mio_rparen ();
+}
+
+
+/* Load interfaces from the module.  Interfaces are unusual in that
+   they attach themselves to existing symbols.  */
+
+static void
+load_generic_interfaces (void)
+{
+  const char *p;
+  char name[GFC_MAX_SYMBOL_LEN + 1], module[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symbol *sym;
+  gfc_interface *generic = NULL, *gen = NULL;
+  int n, i, renamed;
+  bool ambiguous_set = false;
+
+  mio_lparen ();
+
+  while (peek_atom () != ATOM_RPAREN)
+    {
+      mio_lparen ();
+
+      mio_internal_string (name);
+      mio_internal_string (module);
+
+      n = number_use_names (name, false);
+      renamed = n ? 1 : 0;
+      n = n ? n : 1;
+
+      for (i = 1; i <= n; i++)
+	{
+	  gfc_symtree *st;
+	  /* Decide if we need to load this one or not.  */
+	  p = find_use_name_n (name, &i, false);
+
+	  st = find_symbol (gfc_current_ns->sym_root,
+			    name, module_name, 1);
+
+	  if (!p || gfc_find_symbol (p, NULL, 0, &sym))
+	    {
+	      /* Skip the specific names for these cases.  */
+	      while (i == 1 && parse_atom () != ATOM_RPAREN);
+
+	      continue;
+	    }
+
+	  /* If the symbol exists already and is being USEd without being
+	     in an ONLY clause, do not load a new symtree(11.3.2).  */
+	  if (!only_flag && st)
+	    sym = st->n.sym;
+
+	  if (!sym)
+	    {
+	      /* Make the symbol inaccessible if it has been added by a USE
+		 statement without an ONLY(11.3.2).  */
+	      if (st && only_flag
+		     && !st->n.sym->attr.use_only
+		     && !st->n.sym->attr.use_rename
+		     && strcmp (st->n.sym->module, module_name) == 0)
+		{
+		  sym = st->n.sym;
+		  gfc_delete_symtree (&gfc_current_ns->sym_root, name);
+		  st = gfc_get_unique_symtree (gfc_current_ns);
+		  st->n.sym = sym;
+		  sym = NULL;
+		}
+	      else if (st)
+		{
+		  sym = st->n.sym;
+		  if (strcmp (st->name, p) != 0)
+		    {
+	              st = gfc_new_symtree (&gfc_current_ns->sym_root, p);
+		      st->n.sym = sym;
+		      sym->refs++;
+		    }
+		}
+
+	      /* Since we haven't found a valid generic interface, we had
+		 better make one.  */
+	      if (!sym)
+		{
+		  gfc_get_symbol (p, NULL, &sym);
+		  sym->name = gfc_get_string (name);
+		  sym->module = gfc_get_string (module_name);
+		  sym->attr.flavor = FL_PROCEDURE;
+		  sym->attr.generic = 1;
+		  sym->attr.use_assoc = 1;
+		}
+	    }
+	  else
+	    {
+	      /* Unless sym is a generic interface, this reference
+		 is ambiguous.  */
+	      if (st == NULL)
+	        st = gfc_find_symtree (gfc_current_ns->sym_root, p);
+
+	      sym = st->n.sym;
+
+	      if (st && !sym->attr.generic
+		     && !st->ambiguous
+		     && sym->module
+		     && strcmp(module, sym->module))
+		{
+		  ambiguous_set = true;
+		  st->ambiguous = 1;
+		}
+	    }
+
+	  sym->attr.use_only = only_flag;
+	  sym->attr.use_rename = renamed;
+
+	  if (i == 1)
+	    {
+	      mio_interface_rest (&sym->generic);
+	      generic = sym->generic;
+	    }
+	  else if (!sym->generic)
+	    {
+	      sym->generic = generic;
+	      sym->attr.generic_copy = 1;
+	    }
+
+	  /* If a procedure that is not generic has generic interfaces
+	     that include itself, it is generic! We need to take care
+	     to retain symbols ambiguous that were already so.  */
+	  if (sym->attr.use_assoc
+		&& !sym->attr.generic
+		&& sym->attr.flavor == FL_PROCEDURE)
+	    {
+	      for (gen = generic; gen; gen = gen->next)
+		{
+		  if (gen->sym == sym)
+		    {
+		      sym->attr.generic = 1;
+		      if (ambiguous_set)
+		        st->ambiguous = 0;
+		      break;
+		    }
+		}
+	    }
+
+	}
+    }
+
+  mio_rparen ();
+}
+
+
+/* Load common blocks.  */
+
+static void
+load_commons (void)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_common_head *p;
+
+  mio_lparen ();
+
+  while (peek_atom () != ATOM_RPAREN)
+    {
+      int flags;
+      mio_lparen ();
+      mio_internal_string (name);
+
+      p = gfc_get_common (name, 1);
+
+      mio_symbol_ref (&p->head);
+      mio_integer (&flags);
+      if (flags & 1)
+	p->saved = 1;
+      if (flags & 2)
+	p->threadprivate = 1;
+      p->use_assoc = 1;
+
+      /* Get whether this was a bind(c) common or not.  */
+      mio_integer (&p->is_bind_c);
+      /* Get the binding label.  */
+      mio_internal_string (p->binding_label);
+      
+      mio_rparen ();
+    }
+
+  mio_rparen ();
+}
+
+
+/* Load equivalences.  The flag in_load_equiv informs mio_expr_ref of this
+   so that unused variables are not loaded and so that the expression can
+   be safely freed.  */
+
+static void
+load_equiv (void)
+{
+  gfc_equiv *head, *tail, *end, *eq;
+  bool unused;
+
+  mio_lparen ();
+  in_load_equiv = true;
+
+  end = gfc_current_ns->equiv;
+  while (end != NULL && end->next != NULL)
+    end = end->next;
+
+  while (peek_atom () != ATOM_RPAREN) {
+    mio_lparen ();
+    head = tail = NULL;
+
+    while(peek_atom () != ATOM_RPAREN)
+      {
+	if (head == NULL)
+	  head = tail = gfc_get_equiv ();
+	else
+	  {
+	    tail->eq = gfc_get_equiv ();
+	    tail = tail->eq;
+	  }
+
+	mio_pool_string (&tail->module);
+	mio_expr (&tail->expr);
+      }
+
+    /* Unused equivalence members have a unique name.  In addition, it
+       must be checked that the symbols are from the same module.  */
+    unused = true;
+    for (eq = head; eq; eq = eq->eq)
+      {
+	if (eq->expr->symtree->n.sym->module
+	      && head->expr->symtree->n.sym->module
+	      && strcmp (head->expr->symtree->n.sym->module,
+			 eq->expr->symtree->n.sym->module) == 0
+	      && !check_unique_name (eq->expr->symtree->name))
+	  {
+	    unused = false;
+	    break;
+	  }
+      }
+
+    if (unused)
+      {
+	for (eq = head; eq; eq = head)
+	  {
+	    head = eq->eq;
+	    gfc_free_expr (eq->expr);
+	    gfc_free (eq);
+	  }
+      }
+
+    if (end == NULL)
+      gfc_current_ns->equiv = head;
+    else
+      end->next = head;
+
+    if (head != NULL)
+      end = head;
+
+    mio_rparen ();
+  }
+
+  mio_rparen ();
+  in_load_equiv = false;
+}
+
+
+/* This function loads the sym_root of f2k_derived with the extensions to
+   the derived type.  */
+static void
+load_derived_extensions (void)
+{
+  int symbol, j;
+  gfc_symbol *derived;
+  gfc_symbol *dt;
+  gfc_symtree *st;
+  pointer_info *info;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  char module[GFC_MAX_SYMBOL_LEN + 1];
+  const char *p;
+
+  mio_lparen ();
+  while (peek_atom () != ATOM_RPAREN)
+    {
+      mio_lparen ();
+      mio_integer (&symbol);
+      info = get_integer (symbol);
+      derived = info->u.rsym.sym;
+
+      /* This one is not being loaded.  */
+      if (!info || !derived)
+	{
+	  while (peek_atom () != ATOM_RPAREN)
+	    skip_list ();
+	  continue;
+	}
+
+      gcc_assert (derived->attr.flavor == FL_DERIVED);
+      if (derived->f2k_derived == NULL)
+	derived->f2k_derived = gfc_get_namespace (NULL, 0);
+
+      while (peek_atom () != ATOM_RPAREN)
+	{
+	  mio_lparen ();
+	  mio_internal_string (name);
+	  mio_internal_string (module);
+
+          /* Only use one use name to find the symbol.  */
+	  j = 1;
+	  p = find_use_name_n (name, &j, false);
+	  if (p)
+	    {
+	      st = gfc_find_symtree (gfc_current_ns->sym_root, p);
+	      dt = st->n.sym;
+	      st = gfc_find_symtree (derived->f2k_derived->sym_root, name);
+	      if (st == NULL)
+		{
+		  /* Only use the real name in f2k_derived to ensure a single
+		    symtree.  */
+		  st = gfc_new_symtree (&derived->f2k_derived->sym_root, name);
+		  st->n.sym = dt;
+		  st->n.sym->refs++;
+		}
+	    }
+	  mio_rparen ();
+	}
+      mio_rparen ();
+    }
+  mio_rparen ();
+}
+
+
+/* Recursive function to traverse the pointer_info tree and load a
+   needed symbol.  We return nonzero if we load a symbol and stop the
+   traversal, because the act of loading can alter the tree.  */
+
+static int
+load_needed (pointer_info *p)
+{
+  gfc_namespace *ns;
+  pointer_info *q;
+  gfc_symbol *sym;
+  int rv;
+
+  rv = 0;
+  if (p == NULL)
+    return rv;
+
+  rv |= load_needed (p->left);
+  rv |= load_needed (p->right);
+
+  if (p->type != P_SYMBOL || p->u.rsym.state != NEEDED)
+    return rv;
+
+  p->u.rsym.state = USED;
+
+  set_module_locus (&p->u.rsym.where);
+
+  sym = p->u.rsym.sym;
+  if (sym == NULL)
+    {
+      q = get_integer (p->u.rsym.ns);
+
+      ns = (gfc_namespace *) q->u.pointer;
+      if (ns == NULL)
+	{
+	  /* Create an interface namespace if necessary.  These are
+	     the namespaces that hold the formal parameters of module
+	     procedures.  */
+
+	  ns = gfc_get_namespace (NULL, 0);
+	  associate_integer_pointer (q, ns);
+	}
+
+      /* Use the module sym as 'proc_name' so that gfc_get_symbol_decl
+	 doesn't go pear-shaped if the symbol is used.  */
+      if (!ns->proc_name)
+	gfc_find_symbol (p->u.rsym.module, gfc_current_ns,
+				 1, &ns->proc_name);
+
+      sym = gfc_new_symbol (p->u.rsym.true_name, ns);
+      sym->module = gfc_get_string (p->u.rsym.module);
+      strcpy (sym->binding_label, p->u.rsym.binding_label);
+
+      associate_integer_pointer (p, sym);
+    }
+
+  mio_symbol (sym);
+  sym->attr.use_assoc = 1;
+  if (only_flag)
+    sym->attr.use_only = 1;
+  if (p->u.rsym.renamed)
+    sym->attr.use_rename = 1;
+
+  return 1;
+}
+
+
+/* Recursive function for cleaning up things after a module has been read.  */
+
+static void
+read_cleanup (pointer_info *p)
+{
+  gfc_symtree *st;
+  pointer_info *q;
+
+  if (p == NULL)
+    return;
+
+  read_cleanup (p->left);
+  read_cleanup (p->right);
+
+  if (p->type == P_SYMBOL && p->u.rsym.state == USED && !p->u.rsym.referenced)
+    {
+      gfc_namespace *ns;
+      /* Add hidden symbols to the symtree.  */
+      q = get_integer (p->u.rsym.ns);
+      ns = (gfc_namespace *) q->u.pointer;
+
+      if (!p->u.rsym.sym->attr.vtype
+	    && !p->u.rsym.sym->attr.vtab)
+	st = gfc_get_unique_symtree (ns);
+      else
+	{
+	  /* There is no reason to use 'unique_symtrees' for vtabs or
+	     vtypes - their name is fine for a symtree and reduces the
+	     namespace pollution.  */
+	  st = gfc_find_symtree (ns->sym_root, p->u.rsym.sym->name);
+	  if (!st)
+	    st = gfc_new_symtree (&ns->sym_root, p->u.rsym.sym->name);
+	}
+
+      st->n.sym = p->u.rsym.sym;
+      st->n.sym->refs++;
+
+      /* Fixup any symtree references.  */
+      p->u.rsym.symtree = st;
+      resolve_fixups (p->u.rsym.stfixup, st);
+      p->u.rsym.stfixup = NULL;
+    }
+
+  /* Free unused symbols.  */
+  if (p->type == P_SYMBOL && p->u.rsym.state == UNUSED)
+    gfc_free_symbol (p->u.rsym.sym);
+}
+
+
+/* It is not quite enough to check for ambiguity in the symbols by
+   the loaded symbol and the new symbol not being identical.  */
+static bool
+check_for_ambiguous (gfc_symbol *st_sym, pointer_info *info)
+{
+  gfc_symbol *rsym;
+  module_locus locus;
+  symbol_attribute attr;
+
+  rsym = info->u.rsym.sym;
+  if (st_sym == rsym)
+    return false;
+
+  if (st_sym->attr.vtab || st_sym->attr.vtype)
+    return false;
+
+  /* If the existing symbol is generic from a different module and
+     the new symbol is generic there can be no ambiguity.  */
+  if (st_sym->attr.generic
+	&& st_sym->module
+	&& strcmp (st_sym->module, module_name))
+    {
+      /* The new symbol's attributes have not yet been read.  Since
+	 we need attr.generic, read it directly.  */
+      get_module_locus (&locus);
+      set_module_locus (&info->u.rsym.where);
+      mio_lparen ();
+      attr.generic = 0;
+      mio_symbol_attribute (&attr);
+      set_module_locus (&locus);
+      if (attr.generic)
+	return false;
+    }
+
+  return true;
+}
+
+
+/* Read a module file.  */
+
+static void
+read_module (void)
+{
+  module_locus operator_interfaces, user_operators, extensions;
+  const char *p;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  int i;
+  int ambiguous, j, nuse, symbol;
+  pointer_info *info, *q;
+  gfc_use_rename *u;
+  gfc_symtree *st;
+  gfc_symbol *sym;
+
+  get_module_locus (&operator_interfaces);	/* Skip these for now.  */
+  skip_list ();
+
+  get_module_locus (&user_operators);
+  skip_list ();
+  skip_list ();
+
+  /* Skip commons, equivalences and derived type extensions for now.  */
+  skip_list ();
+  skip_list ();
+
+  get_module_locus (&extensions);
+  skip_list ();
+
+  mio_lparen ();
+
+  /* Create the fixup nodes for all the symbols.  */
+
+  while (peek_atom () != ATOM_RPAREN)
+    {
+      require_atom (ATOM_INTEGER);
+      info = get_integer (atom_int);
+
+      info->type = P_SYMBOL;
+      info->u.rsym.state = UNUSED;
+
+      mio_internal_string (info->u.rsym.true_name);
+      mio_internal_string (info->u.rsym.module);
+      mio_internal_string (info->u.rsym.binding_label);
+
+      
+      require_atom (ATOM_INTEGER);
+      info->u.rsym.ns = atom_int;
+
+      get_module_locus (&info->u.rsym.where);
+      skip_list ();
+
+      /* See if the symbol has already been loaded by a previous module.
+	 If so, we reference the existing symbol and prevent it from
+	 being loaded again.  This should not happen if the symbol being
+	 read is an index for an assumed shape dummy array (ns != 1).  */
+
+      sym = find_true_name (info->u.rsym.true_name, info->u.rsym.module);
+
+      if (sym == NULL
+	  || (sym->attr.flavor == FL_VARIABLE && info->u.rsym.ns !=1))
+	continue;
+
+      info->u.rsym.state = USED;
+      info->u.rsym.sym = sym;
+
+      /* Some symbols do not have a namespace (eg. formal arguments),
+	 so the automatic "unique symtree" mechanism must be suppressed
+	 by marking them as referenced.  */
+      q = get_integer (info->u.rsym.ns);
+      if (q->u.pointer == NULL)
+	{
+	  info->u.rsym.referenced = 1;
+	  continue;
+	}
+
+      /* If possible recycle the symtree that references the symbol.
+	 If a symtree is not found and the module does not import one,
+	 a unique-name symtree is found by read_cleanup.  */
+      st = find_symtree_for_symbol (gfc_current_ns->sym_root, sym);
+      if (st != NULL)
+	{
+	  info->u.rsym.symtree = st;
+	  info->u.rsym.referenced = 1;
+	}
+    }
+
+  mio_rparen ();
+
+  /* Parse the symtree lists.  This lets us mark which symbols need to
+     be loaded.  Renaming is also done at this point by replacing the
+     symtree name.  */
+
+  mio_lparen ();
+
+  while (peek_atom () != ATOM_RPAREN)
+    {
+      mio_internal_string (name);
+      mio_integer (&ambiguous);
+      mio_integer (&symbol);
+
+      info = get_integer (symbol);
+
+      /* See how many use names there are.  If none, go through the start
+	 of the loop at least once.  */
+      nuse = number_use_names (name, false);
+      info->u.rsym.renamed = nuse ? 1 : 0;
+
+      if (nuse == 0)
+	nuse = 1;
+
+      for (j = 1; j <= nuse; j++)
+	{
+	  /* Get the jth local name for this symbol.  */
+	  p = find_use_name_n (name, &j, false);
+
+	  if (p == NULL && strcmp (name, module_name) == 0)
+	    p = name;
+
+	  /* Exception: Always import vtabs & vtypes.  */
+	  if (p == NULL && (strncmp (name, "__vtab_", 5) == 0
+			    || strncmp (name, "__vtype_", 6) == 0))
+	    p = name;
+
+	  /* Skip symtree nodes not in an ONLY clause, unless there
+	     is an existing symtree loaded from another USE statement.  */
+	  if (p == NULL)
+	    {
+	      st = gfc_find_symtree (gfc_current_ns->sym_root, name);
+	      if (st != NULL
+		  && strcmp (st->n.sym->name, info->u.rsym.true_name) == 0
+		  && st->n.sym->module != NULL
+		  && strcmp (st->n.sym->module, info->u.rsym.module) == 0)
+		{
+		  info->u.rsym.symtree = st;
+		  info->u.rsym.sym = st->n.sym;
+		}
+	      continue;
+	    }
+
+	  /* If a symbol of the same name and module exists already,
+	     this symbol, which is not in an ONLY clause, must not be
+	     added to the namespace(11.3.2).  Note that find_symbol
+	     only returns the first occurrence that it finds.  */
+	  if (!only_flag && !info->u.rsym.renamed
+		&& strcmp (name, module_name) != 0
+		&& find_symbol (gfc_current_ns->sym_root, name,
+				module_name, 0))
+	    continue;
+
+	  st = gfc_find_symtree (gfc_current_ns->sym_root, p);
+
+	  if (st != NULL)
+	    {
+	      /* Check for ambiguous symbols.  */
+	      if (check_for_ambiguous (st->n.sym, info))
+		st->ambiguous = 1;
+	      else
+		info->u.rsym.symtree = st;
+	    }
+	  else
+	    {
+	      st = gfc_find_symtree (gfc_current_ns->sym_root, name);
+
+	      /* Delete the symtree if the symbol has been added by a USE
+		 statement without an ONLY(11.3.2).  Remember that the rsym
+		 will be the same as the symbol found in the symtree, for
+		 this case.  */
+	      if (st && (only_flag || info->u.rsym.renamed)
+		     && !st->n.sym->attr.use_only
+		     && !st->n.sym->attr.use_rename
+		     && info->u.rsym.sym == st->n.sym)
+		gfc_delete_symtree (&gfc_current_ns->sym_root, name);
+
+	      /* Create a symtree node in the current namespace for this
+		 symbol.  */
+	      st = check_unique_name (p)
+		   ? gfc_get_unique_symtree (gfc_current_ns)
+		   : gfc_new_symtree (&gfc_current_ns->sym_root, p);
+	      st->ambiguous = ambiguous;
+
+	      sym = info->u.rsym.sym;
+
+	      /* Create a symbol node if it doesn't already exist.  */
+	      if (sym == NULL)
+		{
+		  info->u.rsym.sym = gfc_new_symbol (info->u.rsym.true_name,
+						     gfc_current_ns);
+		  sym = info->u.rsym.sym;
+		  sym->module = gfc_get_string (info->u.rsym.module);
+
+		  /* TODO: hmm, can we test this?  Do we know it will be
+		     initialized to zeros?  */
+		  if (info->u.rsym.binding_label[0] != '\0')
+		    strcpy (sym->binding_label, info->u.rsym.binding_label);
+		}
+
+	      st->n.sym = sym;
+	      st->n.sym->refs++;
+
+	      if (strcmp (name, p) != 0)
+		sym->attr.use_rename = 1;
+
+	      /* We need to set the only_flag here so that symbols from the
+		 same USE...ONLY but earlier are not deleted from the tree in
+		 the gfc_delete_symtree above.  */
+	      sym->attr.use_only = only_flag;
+
+	      /* Store the symtree pointing to this symbol.  */
+	      info->u.rsym.symtree = st;
+
+	      if (info->u.rsym.state == UNUSED)
+		info->u.rsym.state = NEEDED;
+	      info->u.rsym.referenced = 1;
+	    }
+	}
+    }
+
+  mio_rparen ();
+
+  /* Load intrinsic operator interfaces.  */
+  set_module_locus (&operator_interfaces);
+  mio_lparen ();
+
+  for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++)
+    {
+      if (i == INTRINSIC_USER)
+	continue;
+
+      if (only_flag)
+	{
+	  u = find_use_operator ((gfc_intrinsic_op) i);
+
+	  if (u == NULL)
+	    {
+	      skip_list ();
+	      continue;
+	    }
+
+	  u->found = 1;
+	}
+
+      mio_interface (&gfc_current_ns->op[i]);
+    }
+
+  mio_rparen ();
+
+  /* Load generic and user operator interfaces.  These must follow the
+     loading of symtree because otherwise symbols can be marked as
+     ambiguous.  */
+
+  set_module_locus (&user_operators);
+
+  load_operator_interfaces ();
+  load_generic_interfaces ();
+
+  load_commons ();
+  load_equiv ();
+
+  /* At this point, we read those symbols that are needed but haven't
+     been loaded yet.  If one symbol requires another, the other gets
+     marked as NEEDED if its previous state was UNUSED.  */
+
+  while (load_needed (pi_root));
+
+  /* Make sure all elements of the rename-list were found in the module.  */
+
+  for (u = gfc_rename_list; u; u = u->next)
+    {
+      if (u->found)
+	continue;
+
+      if (u->op == INTRINSIC_NONE)
+	{
+	  gfc_error ("Symbol '%s' referenced at %L not found in module '%s'",
+		     u->use_name, &u->where, module_name);
+	  continue;
+	}
+
+      if (u->op == INTRINSIC_USER)
+	{
+	  gfc_error ("User operator '%s' referenced at %L not found "
+		     "in module '%s'", u->use_name, &u->where, module_name);
+	  continue;
+	}
+
+      gfc_error ("Intrinsic operator '%s' referenced at %L not found "
+		 "in module '%s'", gfc_op2string (u->op), &u->where,
+		 module_name);
+    }
+
+  /* Now we should be in a position to fill f2k_derived with derived type
+     extensions, since everything has been loaded.  */
+  set_module_locus (&extensions);
+  load_derived_extensions ();
+
+  /* Clean up symbol nodes that were never loaded, create references
+     to hidden symbols.  */
+
+  read_cleanup (pi_root);
+}
+
+
+/* Given an access type that is specific to an entity and the default
+   access, return nonzero if the entity is publicly accessible.  If the
+   element is declared as PUBLIC, then it is public; if declared 
+   PRIVATE, then private, and otherwise it is public unless the default
+   access in this context has been declared PRIVATE.  */
+
+static bool
+check_access (gfc_access specific_access, gfc_access default_access)
+{
+  if (specific_access == ACCESS_PUBLIC)
+    return TRUE;
+  if (specific_access == ACCESS_PRIVATE)
+    return FALSE;
+
+  if (gfc_option.flag_module_private)
+    return default_access == ACCESS_PUBLIC;
+  else
+    return default_access != ACCESS_PRIVATE;
+}
+
+
+bool
+gfc_check_symbol_access (gfc_symbol *sym)
+{
+  if (sym->attr.vtab || sym->attr.vtype)
+    return true;
+  else
+    return check_access (sym->attr.access, sym->ns->default_access);
+}
+
+
+/* A structure to remember which commons we've already written.  */
+
+struct written_common
+{
+  BBT_HEADER(written_common);
+  const char *name, *label;
+};
+
+static struct written_common *written_commons = NULL;
+
+/* Comparison function used for balancing the binary tree.  */
+
+static int
+compare_written_commons (void *a1, void *b1)
+{
+  const char *aname = ((struct written_common *) a1)->name;
+  const char *alabel = ((struct written_common *) a1)->label;
+  const char *bname = ((struct written_common *) b1)->name;
+  const char *blabel = ((struct written_common *) b1)->label;
+  int c = strcmp (aname, bname);
+
+  return (c != 0 ? c : strcmp (alabel, blabel));
+}
+
+/* Free a list of written commons.  */
+
+static void
+free_written_common (struct written_common *w)
+{
+  if (!w)
+    return;
+
+  if (w->left)
+    free_written_common (w->left);
+  if (w->right)
+    free_written_common (w->right);
+
+  gfc_free (w);
+}
+
+/* Write a common block to the module -- recursive helper function.  */
+
+static void
+write_common_0 (gfc_symtree *st, bool this_module)
+{
+  gfc_common_head *p;
+  const char * name;
+  int flags;
+  const char *label;
+  struct written_common *w;
+  bool write_me = true;
+	      
+  if (st == NULL)
+    return;
+
+  write_common_0 (st->left, this_module);
+
+  /* We will write out the binding label, or the name if no label given.  */
+  name = st->n.common->name;
+  p = st->n.common;
+  label = p->is_bind_c ? p->binding_label : p->name;
+
+  /* Check if we've already output this common.  */
+  w = written_commons;
+  while (w)
+    {
+      int c = strcmp (name, w->name);
+      c = (c != 0 ? c : strcmp (label, w->label));
+      if (c == 0)
+	write_me = false;
+
+      w = (c < 0) ? w->left : w->right;
+    }
+
+  if (this_module && p->use_assoc)
+    write_me = false;
+
+  if (write_me)
+    {
+      /* Write the common to the module.  */
+      mio_lparen ();
+      mio_pool_string (&name);
+
+      mio_symbol_ref (&p->head);
+      flags = p->saved ? 1 : 0;
+      if (p->threadprivate)
+	flags |= 2;
+      mio_integer (&flags);
+
+      /* Write out whether the common block is bind(c) or not.  */
+      mio_integer (&(p->is_bind_c));
+
+      mio_pool_string (&label);
+      mio_rparen ();
+
+      /* Record that we have written this common.  */
+      w = XCNEW (struct written_common);
+      w->name = p->name;
+      w->label = label;
+      gfc_insert_bbt (&written_commons, w, compare_written_commons);
+    }
+
+  write_common_0 (st->right, this_module);
+}
+
+
+/* Write a common, by initializing the list of written commons, calling
+   the recursive function write_common_0() and cleaning up afterwards.  */
+
+static void
+write_common (gfc_symtree *st)
+{
+  written_commons = NULL;
+  write_common_0 (st, true);
+  write_common_0 (st, false);
+  free_written_common (written_commons);
+  written_commons = NULL;
+}
+
+
+/* Write the blank common block to the module.  */
+
+static void
+write_blank_common (void)
+{
+  const char * name = BLANK_COMMON_NAME;
+  int saved;
+  /* TODO: Blank commons are not bind(c).  The F2003 standard probably says
+     this, but it hasn't been checked.  Just making it so for now.  */  
+  int is_bind_c = 0;  
+
+  if (gfc_current_ns->blank_common.head == NULL)
+    return;
+
+  mio_lparen ();
+
+  mio_pool_string (&name);
+
+  mio_symbol_ref (&gfc_current_ns->blank_common.head);
+  saved = gfc_current_ns->blank_common.saved;
+  mio_integer (&saved);
+
+  /* Write out whether the common block is bind(c) or not.  */
+  mio_integer (&is_bind_c);
+
+  /* Write out the binding label, which is BLANK_COMMON_NAME, though
+     it doesn't matter because the label isn't used.  */
+  mio_pool_string (&name);
+
+  mio_rparen ();
+}
+
+
+/* Write equivalences to the module.  */
+
+static void
+write_equiv (void)
+{
+  gfc_equiv *eq, *e;
+  int num;
+
+  num = 0;
+  for (eq = gfc_current_ns->equiv; eq; eq = eq->next)
+    {
+      mio_lparen ();
+
+      for (e = eq; e; e = e->eq)
+	{
+	  if (e->module == NULL)
+	    e->module = gfc_get_string ("%s.eq.%d", module_name, num);
+	  mio_allocated_string (e->module);
+	  mio_expr (&e->expr);
+	}
+
+      num++;
+      mio_rparen ();
+    }
+}
+
+
+/* Write derived type extensions to the module.  */
+
+static void
+write_dt_extensions (gfc_symtree *st)
+{
+  if (!gfc_check_symbol_access (st->n.sym))
+    return;
+  if (!(st->n.sym->ns && st->n.sym->ns->proc_name
+	&& st->n.sym->ns->proc_name->attr.flavor == FL_MODULE))
+    return;
+
+  mio_lparen ();
+  mio_pool_string (&st->n.sym->name);
+  if (st->n.sym->module != NULL)
+    mio_pool_string (&st->n.sym->module);
+  else
+    mio_internal_string (module_name);
+  mio_rparen ();
+}
+
+static void
+write_derived_extensions (gfc_symtree *st)
+{
+  if (!((st->n.sym->attr.flavor == FL_DERIVED)
+	  && (st->n.sym->f2k_derived != NULL)
+	  && (st->n.sym->f2k_derived->sym_root != NULL)))
+    return;
+
+  mio_lparen ();
+  mio_symbol_ref (&(st->n.sym));
+  gfc_traverse_symtree (st->n.sym->f2k_derived->sym_root,
+			write_dt_extensions);
+  mio_rparen ();
+}
+
+
+/* Write a symbol to the module.  */
+
+static void
+write_symbol (int n, gfc_symbol *sym)
+{
+  const char *label;
+
+  if (sym->attr.flavor == FL_UNKNOWN || sym->attr.flavor == FL_LABEL)
+    gfc_internal_error ("write_symbol(): bad module symbol '%s'", sym->name);
+
+  mio_integer (&n);
+  mio_pool_string (&sym->name);
+
+  mio_pool_string (&sym->module);
+  if (sym->attr.is_bind_c || sym->attr.is_iso_c)
+    {
+      label = sym->binding_label;
+      mio_pool_string (&label);
+    }
+  else
+    mio_pool_string (&sym->name);
+
+  mio_pointer_ref (&sym->ns);
+
+  mio_symbol (sym);
+  write_char ('\n');
+}
+
+
+/* Recursive traversal function to write the initial set of symbols to
+   the module.  We check to see if the symbol should be written
+   according to the access specification.  */
+
+static void
+write_symbol0 (gfc_symtree *st)
+{
+  gfc_symbol *sym;
+  pointer_info *p;
+  bool dont_write = false;
+
+  if (st == NULL)
+    return;
+
+  write_symbol0 (st->left);
+
+  sym = st->n.sym;
+  if (sym->module == NULL)
+    sym->module = gfc_get_string (module_name);
+
+  if (sym->attr.flavor == FL_PROCEDURE && sym->attr.generic
+      && !sym->attr.subroutine && !sym->attr.function)
+    dont_write = true;
+
+  if (!gfc_check_symbol_access (sym))
+    dont_write = true;
+
+  if (!dont_write)
+    {
+      p = get_pointer (sym);
+      if (p->type == P_UNKNOWN)
+	p->type = P_SYMBOL;
+
+      if (p->u.wsym.state != WRITTEN)
+	{
+	  write_symbol (p->integer, sym);
+	  p->u.wsym.state = WRITTEN;
+	}
+    }
+
+  write_symbol0 (st->right);
+}
+
+
+/* Recursive traversal function to write the secondary set of symbols
+   to the module file.  These are symbols that were not public yet are
+   needed by the public symbols or another dependent symbol.  The act
+   of writing a symbol can modify the pointer_info tree, so we cease
+   traversal if we find a symbol to write.  We return nonzero if a
+   symbol was written and pass that information upwards.  */
+
+static int
+write_symbol1 (pointer_info *p)
+{
+  int result;
+
+  if (!p)
+    return 0;
+
+  result = write_symbol1 (p->left);
+
+  if (!(p->type != P_SYMBOL || p->u.wsym.state != NEEDS_WRITE))
+    {
+      p->u.wsym.state = WRITTEN;
+      write_symbol (p->integer, p->u.wsym.sym);
+      result = 1;
+    }
+
+  result |= write_symbol1 (p->right);
+  return result;
+}
+
+
+/* Write operator interfaces associated with a symbol.  */
+
+static void
+write_operator (gfc_user_op *uop)
+{
+  static char nullstring[] = "";
+  const char *p = nullstring;
+
+  if (uop->op == NULL || !check_access (uop->access, uop->ns->default_access))
+    return;
+
+  mio_symbol_interface (&uop->name, &p, &uop->op);
+}
+
+
+/* Write generic interfaces from the namespace sym_root.  */
+
+static void
+write_generic (gfc_symtree *st)
+{
+  gfc_symbol *sym;
+
+  if (st == NULL)
+    return;
+
+  write_generic (st->left);
+  write_generic (st->right);
+
+  sym = st->n.sym;
+  if (!sym || check_unique_name (st->name))
+    return;
+
+  if (sym->generic == NULL || !gfc_check_symbol_access (sym))
+    return;
+
+  if (sym->module == NULL)
+    sym->module = gfc_get_string (module_name);
+
+  mio_symbol_interface (&st->name, &sym->module, &sym->generic);
+}
+
+
+static void
+write_symtree (gfc_symtree *st)
+{
+  gfc_symbol *sym;
+  pointer_info *p;
+
+  sym = st->n.sym;
+
+  /* A symbol in an interface body must not be visible in the
+     module file.  */
+  if (sym->ns != gfc_current_ns
+	&& sym->ns->proc_name
+	&& sym->ns->proc_name->attr.if_source == IFSRC_IFBODY)
+    return;
+
+  if (!gfc_check_symbol_access (sym)
+      || (sym->attr.flavor == FL_PROCEDURE && sym->attr.generic
+	  && !sym->attr.subroutine && !sym->attr.function))
+    return;
+
+  if (check_unique_name (st->name))
+    return;
+
+  p = find_pointer (sym);
+  if (p == NULL)
+    gfc_internal_error ("write_symtree(): Symbol not written");
+
+  mio_pool_string (&st->name);
+  mio_integer (&st->ambiguous);
+  mio_integer (&p->integer);
+}
+
+
+static void
+write_module (void)
+{
+  int i;
+
+  /* Write the operator interfaces.  */
+  mio_lparen ();
+
+  for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++)
+    {
+      if (i == INTRINSIC_USER)
+	continue;
+
+      mio_interface (check_access (gfc_current_ns->operator_access[i],
+				   gfc_current_ns->default_access)
+		     ? &gfc_current_ns->op[i] : NULL);
+    }
+
+  mio_rparen ();
+  write_char ('\n');
+  write_char ('\n');
+
+  mio_lparen ();
+  gfc_traverse_user_op (gfc_current_ns, write_operator);
+  mio_rparen ();
+  write_char ('\n');
+  write_char ('\n');
+
+  mio_lparen ();
+  write_generic (gfc_current_ns->sym_root);
+  mio_rparen ();
+  write_char ('\n');
+  write_char ('\n');
+
+  mio_lparen ();
+  write_blank_common ();
+  write_common (gfc_current_ns->common_root);
+  mio_rparen ();
+  write_char ('\n');
+  write_char ('\n');
+
+  mio_lparen ();
+  write_equiv ();
+  mio_rparen ();
+  write_char ('\n');
+  write_char ('\n');
+
+  mio_lparen ();
+  gfc_traverse_symtree (gfc_current_ns->sym_root,
+			write_derived_extensions);
+  mio_rparen ();
+  write_char ('\n');
+  write_char ('\n');
+
+  /* Write symbol information.  First we traverse all symbols in the
+     primary namespace, writing those that need to be written.
+     Sometimes writing one symbol will cause another to need to be
+     written.  A list of these symbols ends up on the write stack, and
+     we end by popping the bottom of the stack and writing the symbol
+     until the stack is empty.  */
+
+  mio_lparen ();
+
+  write_symbol0 (gfc_current_ns->sym_root);
+  while (write_symbol1 (pi_root))
+    /* Nothing.  */;
+
+  mio_rparen ();
+
+  write_char ('\n');
+  write_char ('\n');
+
+  mio_lparen ();
+  gfc_traverse_symtree (gfc_current_ns->sym_root, write_symtree);
+  mio_rparen ();
+}
+
+
+/* Read a MD5 sum from the header of a module file.  If the file cannot
+   be opened, or we have any other error, we return -1.  */
+
+static int
+read_md5_from_module_file (const char * filename, unsigned char md5[16])
+{
+  FILE *file;
+  char buf[1024];
+  int n;
+
+  /* Open the file.  */
+  if ((file = fopen (filename, "r")) == NULL)
+    return -1;
+
+  /* Read the first line.  */
+  if (fgets (buf, sizeof (buf) - 1, file) == NULL)
+    {
+      fclose (file);
+      return -1;
+    }
+
+  /* The file also needs to be overwritten if the version number changed.  */
+  n = strlen ("GFORTRAN module version '" MOD_VERSION "' created");
+  if (strncmp (buf, "GFORTRAN module version '" MOD_VERSION "' created", n) != 0)
+    {
+      fclose (file);
+      return -1;
+    }
+ 
+  /* Read a second line.  */
+  if (fgets (buf, sizeof (buf) - 1, file) == NULL)
+    {
+      fclose (file);
+      return -1;
+    }
+
+  /* Close the file.  */
+  fclose (file);
+
+  /* If the header is not what we expect, or is too short, bail out.  */
+  if (strncmp (buf, "MD5:", 4) != 0 || strlen (buf) < 4 + 16)
+    return -1;
+
+  /* Now, we have a real MD5, read it into the array.  */
+  for (n = 0; n < 16; n++)
+    {
+      unsigned int x;
+
+      if (sscanf (&(buf[4+2*n]), "%02x", &x) != 1)
+       return -1;
+
+      md5[n] = x;
+    }
+
+  return 0;
+}
+
+
+/* Given module, dump it to disk.  If there was an error while
+   processing the module, dump_flag will be set to zero and we delete
+   the module file, even if it was already there.  */
+
+void
+gfc_dump_module (const char *name, int dump_flag)
+{
+  int n;
+  char *filename, *filename_tmp, *p;
+  time_t now;
+  fpos_t md5_pos;
+  unsigned char md5_new[16], md5_old[16];
+
+  n = strlen (name) + strlen (MODULE_EXTENSION) + 1;
+  if (gfc_option.module_dir != NULL)
+    {
+      n += strlen (gfc_option.module_dir);
+      filename = (char *) alloca (n);
+      strcpy (filename, gfc_option.module_dir);
+      strcat (filename, name);
+    }
+  else
+    {
+      filename = (char *) alloca (n);
+      strcpy (filename, name);
+    }
+  strcat (filename, MODULE_EXTENSION);
+
+  /* Name of the temporary file used to write the module.  */
+  filename_tmp = (char *) alloca (n + 1);
+  strcpy (filename_tmp, filename);
+  strcat (filename_tmp, "0");
+
+  /* There was an error while processing the module.  We delete the
+     module file, even if it was already there.  */
+  if (!dump_flag)
+    {
+      unlink (filename);
+      return;
+    }
+
+  if (gfc_cpp_makedep ())
+    gfc_cpp_add_target (filename);
+
+  /* Write the module to the temporary file.  */
+  module_fp = fopen (filename_tmp, "w");
+  if (module_fp == NULL)
+    gfc_fatal_error ("Can't open module file '%s' for writing at %C: %s",
+		     filename_tmp, xstrerror (errno));
+
+  /* Write the header, including space reserved for the MD5 sum.  */
+  now = time (NULL);
+  p = ctime (&now);
+
+  *strchr (p, '\n') = '\0';
+
+  fprintf (module_fp, "GFORTRAN module version '%s' created from %s on %s\n"
+	   "MD5:", MOD_VERSION, gfc_source_file, p);
+  fgetpos (module_fp, &md5_pos);
+  fputs ("00000000000000000000000000000000 -- "
+	"If you edit this, you'll get what you deserve.\n\n", module_fp);
+
+  /* Initialize the MD5 context that will be used for output.  */
+  md5_init_ctx (&ctx);
+
+  /* Write the module itself.  */
+  iomode = IO_OUTPUT;
+  strcpy (module_name, name);
+
+  init_pi_tree ();
+
+  write_module ();
+
+  free_pi_tree (pi_root);
+  pi_root = NULL;
+
+  write_char ('\n');
+
+  /* Write the MD5 sum to the header of the module file.  */
+  md5_finish_ctx (&ctx, md5_new);
+  fsetpos (module_fp, &md5_pos);
+  for (n = 0; n < 16; n++)
+    fprintf (module_fp, "%02x", md5_new[n]);
+
+  if (fclose (module_fp))
+    gfc_fatal_error ("Error writing module file '%s' for writing: %s",
+		     filename_tmp, xstrerror (errno));
+
+  /* Read the MD5 from the header of the old module file and compare.  */
+  if (read_md5_from_module_file (filename, md5_old) != 0
+      || memcmp (md5_old, md5_new, sizeof (md5_old)) != 0)
+    {
+      /* Module file have changed, replace the old one.  */
+      if (unlink (filename) && errno != ENOENT)
+	gfc_fatal_error ("Can't delete module file '%s': %s", filename,
+			 xstrerror (errno));
+      if (rename (filename_tmp, filename))
+	gfc_fatal_error ("Can't rename module file '%s' to '%s': %s",
+			 filename_tmp, filename, xstrerror (errno));
+    }
+  else
+    {
+      if (unlink (filename_tmp))
+	gfc_fatal_error ("Can't delete temporary module file '%s': %s",
+			 filename_tmp, xstrerror (errno));
+    }
+}
+
+
+static void
+create_intrinsic_function (const char *name, gfc_isym_id id,
+			   const char *modname, intmod_id module)
+{
+  gfc_intrinsic_sym *isym;
+  gfc_symtree *tmp_symtree;
+  gfc_symbol *sym;
+
+  tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
+  if (tmp_symtree)
+    {
+      if (strcmp (modname, tmp_symtree->n.sym->module) == 0)
+        return;
+      gfc_error ("Symbol '%s' already declared", name);
+    }
+
+  gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
+  sym = tmp_symtree->n.sym;
+
+  isym = gfc_intrinsic_function_by_id (id);
+  gcc_assert (isym);
+
+  sym->attr.flavor = FL_PROCEDURE;
+  sym->attr.intrinsic = 1;
+
+  sym->module = gfc_get_string (modname);
+  sym->attr.use_assoc = 1;
+  sym->from_intmod = module;
+  sym->intmod_sym_id = id;
+}
+
+
+/* Import the intrinsic ISO_C_BINDING module, generating symbols in
+   the current namespace for all named constants, pointer types, and
+   procedures in the module unless the only clause was used or a rename
+   list was provided.  */
+
+static void
+import_iso_c_binding_module (void)
+{
+  gfc_symbol *mod_sym = NULL;
+  gfc_symtree *mod_symtree = NULL;
+  const char *iso_c_module_name = "__iso_c_binding";
+  gfc_use_rename *u;
+  int i;
+
+  /* Look only in the current namespace.  */
+  mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, iso_c_module_name);
+
+  if (mod_symtree == NULL)
+    {
+      /* symtree doesn't already exist in current namespace.  */
+      gfc_get_sym_tree (iso_c_module_name, gfc_current_ns, &mod_symtree,
+			false);
+      
+      if (mod_symtree != NULL)
+	mod_sym = mod_symtree->n.sym;
+      else
+	gfc_internal_error ("import_iso_c_binding_module(): Unable to "
+			    "create symbol for %s", iso_c_module_name);
+
+      mod_sym->attr.flavor = FL_MODULE;
+      mod_sym->attr.intrinsic = 1;
+      mod_sym->module = gfc_get_string (iso_c_module_name);
+      mod_sym->from_intmod = INTMOD_ISO_C_BINDING;
+    }
+
+  /* Generate the symbols for the named constants representing
+     the kinds for intrinsic data types.  */
+  for (i = 0; i < ISOCBINDING_NUMBER; i++)
+    {
+      bool found = false;
+      for (u = gfc_rename_list; u; u = u->next)
+	if (strcmp (c_interop_kinds_table[i].name, u->use_name) == 0)
+	  {
+	    u->found = 1;
+	    found = true;
+	    switch (i)
+	      {
+#define NAMED_FUNCTION(a,b,c,d) \
+	        case a: \
+		  create_intrinsic_function (u->local_name[0] ? u->local_name \
+							      : u->use_name, \
+					     (gfc_isym_id) c, \
+                                             iso_c_module_name, \
+                                             INTMOD_ISO_C_BINDING); \
+		  break;
+#include "iso-c-binding.def"
+#undef NAMED_FUNCTION
+
+		default:
+		  generate_isocbinding_symbol (iso_c_module_name,
+					       (iso_c_binding_symbol) i,
+					       u->local_name[0] ? u->local_name
+								: u->use_name);
+	      }
+	  }
+
+      if (!found && !only_flag)
+	switch (i)
+	  {
+#define NAMED_FUNCTION(a,b,c,d) \
+	    case a: \
+	      if ((gfc_option.allow_std & d) == 0) \
+		continue; \
+	      create_intrinsic_function (b, (gfc_isym_id) c, \
+					 iso_c_module_name, \
+					 INTMOD_ISO_C_BINDING); \
+		  break;
+#include "iso-c-binding.def"
+#undef NAMED_FUNCTION
+
+	    default:
+	      generate_isocbinding_symbol (iso_c_module_name,
+					   (iso_c_binding_symbol) i, NULL);
+	  }
+   }
+
+   for (u = gfc_rename_list; u; u = u->next)
+     {
+      if (u->found)
+	continue;
+
+      gfc_error ("Symbol '%s' referenced at %L not found in intrinsic "
+		 "module ISO_C_BINDING", u->use_name, &u->where);
+     }
+}
+
+
+/* Add an integer named constant from a given module.  */
+
+static void
+create_int_parameter (const char *name, int value, const char *modname,
+		      intmod_id module, int id)
+{
+  gfc_symtree *tmp_symtree;
+  gfc_symbol *sym;
+
+  tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
+  if (tmp_symtree != NULL)
+    {
+      if (strcmp (modname, tmp_symtree->n.sym->module) == 0)
+	return;
+      else
+	gfc_error ("Symbol '%s' already declared", name);
+    }
+
+  gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
+  sym = tmp_symtree->n.sym;
+
+  sym->module = gfc_get_string (modname);
+  sym->attr.flavor = FL_PARAMETER;
+  sym->ts.type = BT_INTEGER;
+  sym->ts.kind = gfc_default_integer_kind;
+  sym->value = gfc_get_int_expr (gfc_default_integer_kind, NULL, value);
+  sym->attr.use_assoc = 1;
+  sym->from_intmod = module;
+  sym->intmod_sym_id = id;
+}
+
+
+/* Value is already contained by the array constructor, but not
+   yet the shape.  */
+
+static void
+create_int_parameter_array (const char *name, int size, gfc_expr *value,
+			    const char *modname, intmod_id module, int id)
+{
+  gfc_symtree *tmp_symtree;
+  gfc_symbol *sym;
+
+  tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
+  if (tmp_symtree != NULL)
+    {
+      if (strcmp (modname, tmp_symtree->n.sym->module) == 0)
+	return;
+      else
+	gfc_error ("Symbol '%s' already declared", name);
+    }
+
+  gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
+  sym = tmp_symtree->n.sym;
+
+  sym->module = gfc_get_string (modname);
+  sym->attr.flavor = FL_PARAMETER;
+  sym->ts.type = BT_INTEGER;
+  sym->ts.kind = gfc_default_integer_kind;
+  sym->attr.use_assoc = 1;
+  sym->from_intmod = module;
+  sym->intmod_sym_id = id;
+  sym->attr.dimension = 1;
+  sym->as = gfc_get_array_spec ();
+  sym->as->rank = 1;
+  sym->as->type = AS_EXPLICIT;
+  sym->as->lower[0] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+  sym->as->upper[0] = gfc_get_int_expr (gfc_default_integer_kind, NULL, size); 
+
+  sym->value = value;
+  sym->value->shape = gfc_get_shape (1);
+  mpz_init_set_ui (sym->value->shape[0], size);
+}
+
+
+
+/* USE the ISO_FORTRAN_ENV intrinsic module.  */
+
+static void
+use_iso_fortran_env_module (void)
+{
+  static char mod[] = "iso_fortran_env";
+  gfc_use_rename *u;
+  gfc_symbol *mod_sym;
+  gfc_symtree *mod_symtree;
+  gfc_expr *expr;
+  int i, j;
+
+  intmod_sym symbol[] = {
+#define NAMED_INTCST(a,b,c,d) { a, b, 0, d },
+#include "iso-fortran-env.def"
+#undef NAMED_INTCST
+#define NAMED_KINDARRAY(a,b,c,d) { a, b, 0, d },
+#include "iso-fortran-env.def"
+#undef NAMED_KINDARRAY
+#define NAMED_FUNCTION(a,b,c,d) { a, b, c, d },
+#include "iso-fortran-env.def"
+#undef NAMED_FUNCTION
+    { ISOFORTRANENV_INVALID, NULL, -1234, 0 } };
+
+  i = 0;
+#define NAMED_INTCST(a,b,c,d) symbol[i++].value = c;
+#include "iso-fortran-env.def"
+#undef NAMED_INTCST
+
+  /* Generate the symbol for the module itself.  */
+  mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, mod);
+  if (mod_symtree == NULL)
+    {
+      gfc_get_sym_tree (mod, gfc_current_ns, &mod_symtree, false);
+      gcc_assert (mod_symtree);
+      mod_sym = mod_symtree->n.sym;
+
+      mod_sym->attr.flavor = FL_MODULE;
+      mod_sym->attr.intrinsic = 1;
+      mod_sym->module = gfc_get_string (mod);
+      mod_sym->from_intmod = INTMOD_ISO_FORTRAN_ENV;
+    }
+  else
+    if (!mod_symtree->n.sym->attr.intrinsic)
+      gfc_error ("Use of intrinsic module '%s' at %C conflicts with "
+		 "non-intrinsic module name used previously", mod);
+
+  /* Generate the symbols for the module integer named constants.  */
+
+  for (i = 0; symbol[i].name; i++)
+    {
+      bool found = false;
+      for (u = gfc_rename_list; u; u = u->next)
+	{
+	  if (strcmp (symbol[i].name, u->use_name) == 0)
+	    {
+	      found = true;
+	      u->found = 1;
+
+	      if (gfc_notify_std (symbol[i].standard, "The symbol '%s', "
+				  "referrenced at %C, is not in the selected "
+				  "standard", symbol[i].name) == FAILURE)
+	        continue;
+
+	      if ((gfc_option.flag_default_integer || gfc_option.flag_default_real)
+		  && symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE)
+		gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named "
+				 "constant from intrinsic module "
+				 "ISO_FORTRAN_ENV at %C is incompatible with "
+				 "option %s",
+				 gfc_option.flag_default_integer
+				   ? "-fdefault-integer-8"
+				   : "-fdefault-real-8");
+	      switch (symbol[i].id)
+		{
+#define NAMED_INTCST(a,b,c,d) \
+		case a:
+#include "iso-fortran-env.def"
+#undef NAMED_INTCST
+		  create_int_parameter (u->local_name[0] ? u->local_name
+							 : u->use_name,
+					symbol[i].value, mod,
+					INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
+		  break;
+
+#define NAMED_KINDARRAY(a,b,KINDS,d) \
+		case a:\
+		  expr = gfc_get_array_expr (BT_INTEGER, \
+					     gfc_default_integer_kind,\
+					     NULL); \
+		  for (j = 0; KINDS[j].kind != 0; j++) \
+		    gfc_constructor_append_expr (&expr->value.constructor, \
+			gfc_get_int_expr (gfc_default_integer_kind, NULL, \
+					  KINDS[j].kind), NULL); \
+		  create_int_parameter_array (u->local_name[0] ? u->local_name \
+							 : u->use_name, \
+					      j, expr, mod, \
+					      INTMOD_ISO_FORTRAN_ENV, \
+					      symbol[i].id); \
+		  break;
+#include "iso-fortran-env.def"
+#undef NAMED_KINDARRAY
+
+#define NAMED_FUNCTION(a,b,c,d) \
+		case a:
+#include "iso-fortran-env.def"
+#undef NAMED_FUNCTION
+		  create_intrinsic_function (u->local_name[0] ? u->local_name
+							      : u->use_name,
+					     (gfc_isym_id) symbol[i].value, mod,
+					     INTMOD_ISO_FORTRAN_ENV);
+		  break;
+
+		default:
+		  gcc_unreachable ();
+		}
+	    }
+	}
+
+      if (!found && !only_flag)
+	{
+	  if ((gfc_option.allow_std & symbol[i].standard) == 0)
+	    continue;
+
+	  if ((gfc_option.flag_default_integer || gfc_option.flag_default_real)
+	      && symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE)
+	    gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named constant "
+			     "from intrinsic module ISO_FORTRAN_ENV at %C is "
+			     "incompatible with option %s",
+			     gfc_option.flag_default_integer
+				? "-fdefault-integer-8" : "-fdefault-real-8");
+
+	  switch (symbol[i].id)
+	    {
+#define NAMED_INTCST(a,b,c,d) \
+	    case a:
+#include "iso-fortran-env.def"
+#undef NAMED_INTCST
+	      create_int_parameter (symbol[i].name, symbol[i].value, mod,
+				    INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
+	      break;
+
+#define NAMED_KINDARRAY(a,b,KINDS,d) \
+	    case a:\
+	      expr = gfc_get_array_expr (BT_INTEGER, gfc_default_integer_kind, \
+					 NULL); \
+	      for (j = 0; KINDS[j].kind != 0; j++) \
+		gfc_constructor_append_expr (&expr->value.constructor, \
+                      gfc_get_int_expr (gfc_default_integer_kind, NULL, \
+                                        KINDS[j].kind), NULL); \
+            create_int_parameter_array (symbol[i].name, j, expr, mod, \
+                                        INTMOD_ISO_FORTRAN_ENV, symbol[i].id);\
+            break;
+#include "iso-fortran-env.def"
+#undef NAMED_KINDARRAY
+
+#define NAMED_FUNCTION(a,b,c,d) \
+		case a:
+#include "iso-fortran-env.def"
+#undef NAMED_FUNCTION
+		  create_intrinsic_function (symbol[i].name,
+					     (gfc_isym_id) symbol[i].value, mod,
+					     INTMOD_ISO_FORTRAN_ENV);
+		  break;
+
+	  default:
+	    gcc_unreachable ();
+	  }
+	}
+    }
+
+  for (u = gfc_rename_list; u; u = u->next)
+    {
+      if (u->found)
+	continue;
+
+      gfc_error ("Symbol '%s' referenced at %L not found in intrinsic "
+		     "module ISO_FORTRAN_ENV", u->use_name, &u->where);
+    }
+}
+
+
+/* Process a USE directive.  */
+
+void
+gfc_use_module (void)
+{
+  char *filename;
+  gfc_state_data *p;
+  int c, line, start;
+  gfc_symtree *mod_symtree;
+  gfc_use_list *use_stmt;
+
+  filename = (char *) alloca (strlen (module_name) + strlen (MODULE_EXTENSION)
+			      + 1);
+  strcpy (filename, module_name);
+  strcat (filename, MODULE_EXTENSION);
+
+  /* First, try to find an non-intrinsic module, unless the USE statement
+     specified that the module is intrinsic.  */
+  module_fp = NULL;
+  if (!specified_int)
+    module_fp = gfc_open_included_file (filename, true, true);
+
+  /* Then, see if it's an intrinsic one, unless the USE statement
+     specified that the module is non-intrinsic.  */
+  if (module_fp == NULL && !specified_nonint)
+    {
+      if (strcmp (module_name, "iso_fortran_env") == 0
+	  && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ISO_FORTRAN_ENV "
+			     "intrinsic module at %C") != FAILURE)
+       {
+	 use_iso_fortran_env_module ();
+	 return;
+       }
+
+      if (strcmp (module_name, "iso_c_binding") == 0
+	  && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: "
+			     "ISO_C_BINDING module at %C") != FAILURE)
+	{
+	  import_iso_c_binding_module();
+	  return;
+	}
+
+      module_fp = gfc_open_intrinsic_module (filename);
+
+      if (module_fp == NULL && specified_int)
+	gfc_fatal_error ("Can't find an intrinsic module named '%s' at %C",
+			 module_name);
+    }
+
+  if (module_fp == NULL)
+    gfc_fatal_error ("Can't open module file '%s' for reading at %C: %s",
+		     filename, xstrerror (errno));
+
+  /* Check that we haven't already USEd an intrinsic module with the
+     same name.  */
+
+  mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, module_name);
+  if (mod_symtree && mod_symtree->n.sym->attr.intrinsic)
+    gfc_error ("Use of non-intrinsic module '%s' at %C conflicts with "
+	       "intrinsic module name used previously", module_name);
+
+  iomode = IO_INPUT;
+  module_line = 1;
+  module_column = 1;
+  start = 0;
+
+  /* Skip the first two lines of the module, after checking that this is
+     a gfortran module file.  */
+  line = 0;
+  while (line < 2)
+    {
+      c = module_char ();
+      if (c == EOF)
+	bad_module ("Unexpected end of module");
+      if (start++ < 3)
+	parse_name (c);
+      if ((start == 1 && strcmp (atom_name, "GFORTRAN") != 0)
+	  || (start == 2 && strcmp (atom_name, " module") != 0))
+	gfc_fatal_error ("File '%s' opened at %C is not a GFORTRAN module "
+			 "file", filename);
+      if (start == 3)
+	{
+	  if (strcmp (atom_name, " version") != 0
+	      || module_char () != ' '
+	      || parse_atom () != ATOM_STRING)
+	    gfc_fatal_error ("Parse error when checking module version"
+		    	     " for file '%s' opened at %C", filename);
+
+	  if (strcmp (atom_string, MOD_VERSION))
+	    {
+	      gfc_fatal_error ("Wrong module version '%s' (expected '%s') "
+			       "for file '%s' opened at %C", atom_string,
+			       MOD_VERSION, filename);
+	    }
+
+	  gfc_free (atom_string);
+	}
+
+      if (c == '\n')
+	line++;
+    }
+
+  /* Make sure we're not reading the same module that we may be building.  */
+  for (p = gfc_state_stack; p; p = p->previous)
+    if (p->state == COMP_MODULE && strcmp (p->sym->name, module_name) == 0)
+      gfc_fatal_error ("Can't USE the same module we're building!");
+
+  init_pi_tree ();
+  init_true_name_tree ();
+
+  read_module ();
+
+  free_true_name (true_name_root);
+  true_name_root = NULL;
+
+  free_pi_tree (pi_root);
+  pi_root = NULL;
+
+  fclose (module_fp);
+
+  use_stmt = gfc_get_use_list ();
+  use_stmt->module_name = gfc_get_string (module_name);
+  use_stmt->only_flag = only_flag;
+  use_stmt->rename = gfc_rename_list;
+  use_stmt->where = use_locus;
+  gfc_rename_list = NULL;
+  use_stmt->next = gfc_current_ns->use_stmts;
+  gfc_current_ns->use_stmts = use_stmt;
+}
+
+
+void
+gfc_free_use_stmts (gfc_use_list *use_stmts)
+{
+  gfc_use_list *next;
+  for (; use_stmts; use_stmts = next)
+    {
+      gfc_use_rename *next_rename;
+
+      for (; use_stmts->rename; use_stmts->rename = next_rename)
+	{
+	  next_rename = use_stmts->rename->next;
+	  gfc_free (use_stmts->rename);
+	}
+      next = use_stmts->next;
+      gfc_free (use_stmts);
+    }
+}
+
+
+void
+gfc_module_init_2 (void)
+{
+  last_atom = ATOM_LPAREN;
+}
+
+
+void
+gfc_module_done_2 (void)
+{
+  free_rename ();
+}
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
new file mode 100644
index 000000000..2b70c69a9
--- /dev/null
+++ b/gcc/fortran/openmp.c
@@ -0,0 +1,1586 @@
+/* OpenMP directive matching and resolving.
+   Copyright (C) 2005, 2006, 2007, 2008, 2010
+   Free Software Foundation, Inc.
+   Contributed by Jakub Jelinek
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "match.h"
+#include "parse.h"
+#include "pointer-set.h"
+
+/* Match an end of OpenMP directive.  End of OpenMP directive is optional
+   whitespace, followed by '\n' or comment '!'.  */
+
+match
+gfc_match_omp_eos (void)
+{
+  locus old_loc;
+  char c;
+
+  old_loc = gfc_current_locus;
+  gfc_gobble_whitespace ();
+
+  c = gfc_next_ascii_char ();
+  switch (c)
+    {
+    case '!':
+      do
+	c = gfc_next_ascii_char ();
+      while (c != '\n');
+      /* Fall through */
+
+    case '\n':
+      return MATCH_YES;
+    }
+
+  gfc_current_locus = old_loc;
+  return MATCH_NO;
+}
+
+/* Free an omp_clauses structure.  */
+
+void
+gfc_free_omp_clauses (gfc_omp_clauses *c)
+{
+  int i;
+  if (c == NULL)
+    return;
+
+  gfc_free_expr (c->if_expr);
+  gfc_free_expr (c->num_threads);
+  gfc_free_expr (c->chunk_size);
+  for (i = 0; i < OMP_LIST_NUM; i++)
+    gfc_free_namelist (c->lists[i]);
+  gfc_free (c);
+}
+
+/* Match a variable/common block list and construct a namelist from it.  */
+
+static match
+gfc_match_omp_variable_list (const char *str, gfc_namelist **list,
+			     bool allow_common)
+{
+  gfc_namelist *head, *tail, *p;
+  locus old_loc;
+  char n[GFC_MAX_SYMBOL_LEN+1];
+  gfc_symbol *sym;
+  match m;
+  gfc_symtree *st;
+
+  head = tail = NULL;
+
+  old_loc = gfc_current_locus;
+
+  m = gfc_match (str);
+  if (m != MATCH_YES)
+    return m;
+
+  for (;;)
+    {
+      m = gfc_match_symbol (&sym, 1);
+      switch (m)
+	{
+	case MATCH_YES:
+	  gfc_set_sym_referenced (sym);
+	  p = gfc_get_namelist ();
+	  if (head == NULL)
+	    head = tail = p;
+	  else
+	    {
+	      tail->next = p;
+	      tail = tail->next;
+	    }
+	  tail->sym = sym;
+	  goto next_item;
+	case MATCH_NO:
+	  break;
+	case MATCH_ERROR:
+	  goto cleanup;
+	}
+
+      if (!allow_common)
+	goto syntax;
+
+      m = gfc_match (" / %n /", n);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+
+      st = gfc_find_symtree (gfc_current_ns->common_root, n);
+      if (st == NULL)
+	{
+	  gfc_error ("COMMON block /%s/ not found at %C", n);
+	  goto cleanup;
+	}
+      for (sym = st->n.common->head; sym; sym = sym->common_next)
+	{
+	  gfc_set_sym_referenced (sym);
+	  p = gfc_get_namelist ();
+	  if (head == NULL)
+	    head = tail = p;
+	  else
+	    {
+	      tail->next = p;
+	      tail = tail->next;
+	    }
+	  tail->sym = sym;
+	}
+
+    next_item:
+      if (gfc_match_char (')') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  while (*list)
+    list = &(*list)->next;
+
+  *list = head;
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in OpenMP variable list at %C");
+
+cleanup:
+  gfc_free_namelist (head);
+  gfc_current_locus = old_loc;
+  return MATCH_ERROR;
+}
+
+#define OMP_CLAUSE_PRIVATE	(1 << 0)
+#define OMP_CLAUSE_FIRSTPRIVATE	(1 << 1)
+#define OMP_CLAUSE_LASTPRIVATE	(1 << 2)
+#define OMP_CLAUSE_COPYPRIVATE	(1 << 3)
+#define OMP_CLAUSE_SHARED	(1 << 4)
+#define OMP_CLAUSE_COPYIN	(1 << 5)
+#define OMP_CLAUSE_REDUCTION	(1 << 6)
+#define OMP_CLAUSE_IF		(1 << 7)
+#define OMP_CLAUSE_NUM_THREADS	(1 << 8)
+#define OMP_CLAUSE_SCHEDULE	(1 << 9)
+#define OMP_CLAUSE_DEFAULT	(1 << 10)
+#define OMP_CLAUSE_ORDERED	(1 << 11)
+#define OMP_CLAUSE_COLLAPSE	(1 << 12)
+#define OMP_CLAUSE_UNTIED	(1 << 13)
+
+/* Match OpenMP directive clauses. MASK is a bitmask of
+   clauses that are allowed for a particular directive.  */
+
+static match
+gfc_match_omp_clauses (gfc_omp_clauses **cp, int mask)
+{
+  gfc_omp_clauses *c = gfc_get_omp_clauses ();
+  locus old_loc;
+  bool needs_space = true, first = true;
+
+  *cp = NULL;
+  while (1)
+    {
+      if ((first || gfc_match_char (',') != MATCH_YES)
+	  && (needs_space && gfc_match_space () != MATCH_YES))
+	break;
+      needs_space = false;
+      first = false;
+      gfc_gobble_whitespace ();
+      if ((mask & OMP_CLAUSE_IF) && c->if_expr == NULL
+	  && gfc_match ("if ( %e )", &c->if_expr) == MATCH_YES)
+	continue;
+      if ((mask & OMP_CLAUSE_NUM_THREADS) && c->num_threads == NULL
+	  && gfc_match ("num_threads ( %e )", &c->num_threads) == MATCH_YES)
+	continue;
+      if ((mask & OMP_CLAUSE_PRIVATE)
+	  && gfc_match_omp_variable_list ("private (",
+					  &c->lists[OMP_LIST_PRIVATE], true)
+	     == MATCH_YES)
+	continue;
+      if ((mask & OMP_CLAUSE_FIRSTPRIVATE)
+	  && gfc_match_omp_variable_list ("firstprivate (",
+					  &c->lists[OMP_LIST_FIRSTPRIVATE],
+					  true)
+	     == MATCH_YES)
+	continue;
+      if ((mask & OMP_CLAUSE_LASTPRIVATE)
+	  && gfc_match_omp_variable_list ("lastprivate (",
+					  &c->lists[OMP_LIST_LASTPRIVATE],
+					  true)
+	     == MATCH_YES)
+	continue;
+      if ((mask & OMP_CLAUSE_COPYPRIVATE)
+	  && gfc_match_omp_variable_list ("copyprivate (",
+					  &c->lists[OMP_LIST_COPYPRIVATE],
+					  true)
+	     == MATCH_YES)
+	continue;
+      if ((mask & OMP_CLAUSE_SHARED)
+	  && gfc_match_omp_variable_list ("shared (",
+					  &c->lists[OMP_LIST_SHARED], true)
+	     == MATCH_YES)
+	continue;
+      if ((mask & OMP_CLAUSE_COPYIN)
+	  && gfc_match_omp_variable_list ("copyin (",
+					  &c->lists[OMP_LIST_COPYIN], true)
+	     == MATCH_YES)
+	continue;
+      old_loc = gfc_current_locus;
+      if ((mask & OMP_CLAUSE_REDUCTION)
+	  && gfc_match ("reduction ( ") == MATCH_YES)
+	{
+	  int reduction = OMP_LIST_NUM;
+	  char buffer[GFC_MAX_SYMBOL_LEN + 1];
+	  if (gfc_match_char ('+') == MATCH_YES)
+	    reduction = OMP_LIST_PLUS;
+	  else if (gfc_match_char ('*') == MATCH_YES)
+	    reduction = OMP_LIST_MULT;
+	  else if (gfc_match_char ('-') == MATCH_YES)
+	    reduction = OMP_LIST_SUB;
+	  else if (gfc_match (".and.") == MATCH_YES)
+	    reduction = OMP_LIST_AND;
+	  else if (gfc_match (".or.") == MATCH_YES)
+	    reduction = OMP_LIST_OR;
+	  else if (gfc_match (".eqv.") == MATCH_YES)
+	    reduction = OMP_LIST_EQV;
+	  else if (gfc_match (".neqv.") == MATCH_YES)
+	    reduction = OMP_LIST_NEQV;
+	  else if (gfc_match_name (buffer) == MATCH_YES)
+	    {
+	      gfc_symbol *sym;
+	      const char *n = buffer;
+
+	      gfc_find_symbol (buffer, NULL, 1, &sym);
+	      if (sym != NULL)
+		{
+		  if (sym->attr.intrinsic)
+		    n = sym->name;
+		  else if ((sym->attr.flavor != FL_UNKNOWN
+			    && sym->attr.flavor != FL_PROCEDURE)
+			   || sym->attr.external
+			   || sym->attr.generic
+			   || sym->attr.entry
+			   || sym->attr.result
+			   || sym->attr.dummy
+			   || sym->attr.subroutine
+			   || sym->attr.pointer
+			   || sym->attr.target
+			   || sym->attr.cray_pointer
+			   || sym->attr.cray_pointee
+			   || (sym->attr.proc != PROC_UNKNOWN
+			       && sym->attr.proc != PROC_INTRINSIC)
+			   || sym->attr.if_source != IFSRC_UNKNOWN
+			   || sym == sym->ns->proc_name)
+		    {
+		      gfc_error_now ("%s is not INTRINSIC procedure name "
+				     "at %C", buffer);
+		      sym = NULL;
+		    }
+		  else
+		    n = sym->name;
+		}
+	      if (strcmp (n, "max") == 0)
+		reduction = OMP_LIST_MAX;
+	      else if (strcmp (n, "min") == 0)
+		reduction = OMP_LIST_MIN;
+	      else if (strcmp (n, "iand") == 0)
+		reduction = OMP_LIST_IAND;
+	      else if (strcmp (n, "ior") == 0)
+		reduction = OMP_LIST_IOR;
+	      else if (strcmp (n, "ieor") == 0)
+		reduction = OMP_LIST_IEOR;
+	      if (reduction != OMP_LIST_NUM
+		  && sym != NULL
+		  && ! sym->attr.intrinsic
+		  && ! sym->attr.use_assoc
+		  && ((sym->attr.flavor == FL_UNKNOWN
+		       && gfc_add_flavor (&sym->attr, FL_PROCEDURE,
+					  sym->name, NULL) == FAILURE)
+		      || gfc_add_intrinsic (&sym->attr, NULL) == FAILURE))
+		{
+		  gfc_free_omp_clauses (c);
+		  return MATCH_ERROR;
+		}
+	    }
+	  if (reduction != OMP_LIST_NUM
+	      && gfc_match_omp_variable_list (" :", &c->lists[reduction],
+					      false)
+		 == MATCH_YES)
+	    continue;
+	  else
+	    gfc_current_locus = old_loc;
+	}
+      if ((mask & OMP_CLAUSE_DEFAULT)
+	  && c->default_sharing == OMP_DEFAULT_UNKNOWN)
+	{
+	  if (gfc_match ("default ( shared )") == MATCH_YES)
+	    c->default_sharing = OMP_DEFAULT_SHARED;
+	  else if (gfc_match ("default ( private )") == MATCH_YES)
+	    c->default_sharing = OMP_DEFAULT_PRIVATE;
+	  else if (gfc_match ("default ( none )") == MATCH_YES)
+	    c->default_sharing = OMP_DEFAULT_NONE;
+	  else if (gfc_match ("default ( firstprivate )") == MATCH_YES)
+	    c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE;
+	  if (c->default_sharing != OMP_DEFAULT_UNKNOWN)
+	    continue;
+	}
+      old_loc = gfc_current_locus;
+      if ((mask & OMP_CLAUSE_SCHEDULE)
+	  && c->sched_kind == OMP_SCHED_NONE
+	  && gfc_match ("schedule ( ") == MATCH_YES)
+	{
+	  if (gfc_match ("static") == MATCH_YES)
+	    c->sched_kind = OMP_SCHED_STATIC;
+	  else if (gfc_match ("dynamic") == MATCH_YES)
+	    c->sched_kind = OMP_SCHED_DYNAMIC;
+	  else if (gfc_match ("guided") == MATCH_YES)
+	    c->sched_kind = OMP_SCHED_GUIDED;
+	  else if (gfc_match ("runtime") == MATCH_YES)
+	    c->sched_kind = OMP_SCHED_RUNTIME;
+	  else if (gfc_match ("auto") == MATCH_YES)
+	    c->sched_kind = OMP_SCHED_AUTO;
+	  if (c->sched_kind != OMP_SCHED_NONE)
+	    {
+	      match m = MATCH_NO;
+	      if (c->sched_kind != OMP_SCHED_RUNTIME
+		  && c->sched_kind != OMP_SCHED_AUTO)
+		m = gfc_match (" , %e )", &c->chunk_size);
+	      if (m != MATCH_YES)
+		m = gfc_match_char (')');
+	      if (m != MATCH_YES)
+		c->sched_kind = OMP_SCHED_NONE;
+	    }
+	  if (c->sched_kind != OMP_SCHED_NONE)
+	    continue;
+	  else
+	    gfc_current_locus = old_loc;
+	}
+      if ((mask & OMP_CLAUSE_ORDERED) && !c->ordered
+	  && gfc_match ("ordered") == MATCH_YES)
+	{
+	  c->ordered = needs_space = true;
+	  continue;
+	}
+      if ((mask & OMP_CLAUSE_UNTIED) && !c->untied
+	  && gfc_match ("untied") == MATCH_YES)
+	{
+	  c->untied = needs_space = true;
+	  continue;
+	}
+      if ((mask & OMP_CLAUSE_COLLAPSE) && !c->collapse)
+	{
+	  gfc_expr *cexpr = NULL;
+	  match m = gfc_match ("collapse ( %e )", &cexpr);
+
+	  if (m == MATCH_YES)
+	    {
+	      int collapse;
+	      const char *p = gfc_extract_int (cexpr, &collapse);
+	      if (p)
+		{
+		  gfc_error_now (p);
+		  collapse = 1;
+		}
+	      else if (collapse <= 0)
+		{
+		  gfc_error_now ("COLLAPSE clause argument not"
+				 " constant positive integer at %C");
+		  collapse = 1;
+		}
+	      c->collapse = collapse;
+	      gfc_free_expr (cexpr);
+	      continue;
+	    }
+	}
+
+      break;
+    }
+
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_free_omp_clauses (c);
+      return MATCH_ERROR;
+    }
+
+  *cp = c;
+  return MATCH_YES;
+}
+
+#define OMP_PARALLEL_CLAUSES \
+  (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED	\
+   | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IF		\
+   | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT)
+#define OMP_DO_CLAUSES \
+  (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE				\
+   | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION			\
+   | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE)
+#define OMP_SECTIONS_CLAUSES \
+  (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE				\
+   | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+#define OMP_TASK_CLAUSES \
+  (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_SHARED	\
+   | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED)
+
+match
+gfc_match_omp_parallel (void)
+{
+  gfc_omp_clauses *c;
+  if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES) != MATCH_YES)
+    return MATCH_ERROR;
+  new_st.op = EXEC_OMP_PARALLEL;
+  new_st.ext.omp_clauses = c;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_task (void)
+{
+  gfc_omp_clauses *c;
+  if (gfc_match_omp_clauses (&c, OMP_TASK_CLAUSES) != MATCH_YES)
+    return MATCH_ERROR;
+  new_st.op = EXEC_OMP_TASK;
+  new_st.ext.omp_clauses = c;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_taskwait (void)
+{
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after TASKWAIT clause at %C");
+      return MATCH_ERROR;
+    }
+  new_st.op = EXEC_OMP_TASKWAIT;
+  new_st.ext.omp_clauses = NULL;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_critical (void)
+{
+  char n[GFC_MAX_SYMBOL_LEN+1];
+
+  if (gfc_match (" ( %n )", n) != MATCH_YES)
+    n[0] = '\0';
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after $OMP CRITICAL statement at %C");
+      return MATCH_ERROR;
+    }
+  new_st.op = EXEC_OMP_CRITICAL;
+  new_st.ext.omp_name = n[0] ? xstrdup (n) : NULL;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_do (void)
+{
+  gfc_omp_clauses *c;
+  if (gfc_match_omp_clauses (&c, OMP_DO_CLAUSES) != MATCH_YES)
+    return MATCH_ERROR;
+  new_st.op = EXEC_OMP_DO;
+  new_st.ext.omp_clauses = c;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_flush (void)
+{
+  gfc_namelist *list = NULL;
+  gfc_match_omp_variable_list (" (", &list, true);
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
+      gfc_free_namelist (list);
+      return MATCH_ERROR;
+    }
+  new_st.op = EXEC_OMP_FLUSH;
+  new_st.ext.omp_namelist = list;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_threadprivate (void)
+{
+  locus old_loc;
+  char n[GFC_MAX_SYMBOL_LEN+1];
+  gfc_symbol *sym;
+  match m;
+  gfc_symtree *st;
+
+  old_loc = gfc_current_locus;
+
+  m = gfc_match (" (");
+  if (m != MATCH_YES)
+    return m;
+
+  for (;;)
+    {
+      m = gfc_match_symbol (&sym, 0);
+      switch (m)
+	{
+	case MATCH_YES:
+	  if (sym->attr.in_common)
+	    gfc_error_now ("Threadprivate variable at %C is an element of "
+			   "a COMMON block");
+	  else if (gfc_add_threadprivate (&sym->attr, sym->name,
+		   &sym->declared_at) == FAILURE)
+	    goto cleanup;
+	  goto next_item;
+	case MATCH_NO:
+	  break;
+	case MATCH_ERROR:
+	  goto cleanup;
+	}
+
+      m = gfc_match (" / %n /", n);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO || n[0] == '\0')
+	goto syntax;
+
+      st = gfc_find_symtree (gfc_current_ns->common_root, n);
+      if (st == NULL)
+	{
+	  gfc_error ("COMMON block /%s/ not found at %C", n);
+	  goto cleanup;
+	}
+      st->n.common->threadprivate = 1;
+      for (sym = st->n.common->head; sym; sym = sym->common_next)
+	if (gfc_add_threadprivate (&sym->attr, sym->name,
+				   &sym->declared_at) == FAILURE)
+	  goto cleanup;
+
+    next_item:
+      if (gfc_match_char (')') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in !$OMP THREADPRIVATE list at %C");
+
+cleanup:
+  gfc_current_locus = old_loc;
+  return MATCH_ERROR;
+}
+
+
+match
+gfc_match_omp_parallel_do (void)
+{
+  gfc_omp_clauses *c;
+  if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES | OMP_DO_CLAUSES)
+      != MATCH_YES)
+    return MATCH_ERROR;
+  new_st.op = EXEC_OMP_PARALLEL_DO;
+  new_st.ext.omp_clauses = c;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_parallel_sections (void)
+{
+  gfc_omp_clauses *c;
+  if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES | OMP_SECTIONS_CLAUSES)
+      != MATCH_YES)
+    return MATCH_ERROR;
+  new_st.op = EXEC_OMP_PARALLEL_SECTIONS;
+  new_st.ext.omp_clauses = c;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_parallel_workshare (void)
+{
+  gfc_omp_clauses *c;
+  if (gfc_match_omp_clauses (&c, OMP_PARALLEL_CLAUSES) != MATCH_YES)
+    return MATCH_ERROR;
+  new_st.op = EXEC_OMP_PARALLEL_WORKSHARE;
+  new_st.ext.omp_clauses = c;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_sections (void)
+{
+  gfc_omp_clauses *c;
+  if (gfc_match_omp_clauses (&c, OMP_SECTIONS_CLAUSES) != MATCH_YES)
+    return MATCH_ERROR;
+  new_st.op = EXEC_OMP_SECTIONS;
+  new_st.ext.omp_clauses = c;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_single (void)
+{
+  gfc_omp_clauses *c;
+  if (gfc_match_omp_clauses (&c, OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE)
+      != MATCH_YES)
+    return MATCH_ERROR;
+  new_st.op = EXEC_OMP_SINGLE;
+  new_st.ext.omp_clauses = c;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_workshare (void)
+{
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after $OMP WORKSHARE statement at %C");
+      return MATCH_ERROR;
+    }
+  new_st.op = EXEC_OMP_WORKSHARE;
+  new_st.ext.omp_clauses = gfc_get_omp_clauses ();
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_master (void)
+{
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after $OMP MASTER statement at %C");
+      return MATCH_ERROR;
+    }
+  new_st.op = EXEC_OMP_MASTER;
+  new_st.ext.omp_clauses = NULL;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_ordered (void)
+{
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after $OMP ORDERED statement at %C");
+      return MATCH_ERROR;
+    }
+  new_st.op = EXEC_OMP_ORDERED;
+  new_st.ext.omp_clauses = NULL;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_atomic (void)
+{
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after $OMP ATOMIC statement at %C");
+      return MATCH_ERROR;
+    }
+  new_st.op = EXEC_OMP_ATOMIC;
+  new_st.ext.omp_clauses = NULL;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_barrier (void)
+{
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after $OMP BARRIER statement at %C");
+      return MATCH_ERROR;
+    }
+  new_st.op = EXEC_OMP_BARRIER;
+  new_st.ext.omp_clauses = NULL;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_end_nowait (void)
+{
+  bool nowait = false;
+  if (gfc_match ("% nowait") == MATCH_YES)
+    nowait = true;
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after NOWAIT clause at %C");
+      return MATCH_ERROR;
+    }
+  new_st.op = EXEC_OMP_END_NOWAIT;
+  new_st.ext.omp_bool = nowait;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_end_single (void)
+{
+  gfc_omp_clauses *c;
+  if (gfc_match ("% nowait") == MATCH_YES)
+    {
+      new_st.op = EXEC_OMP_END_NOWAIT;
+      new_st.ext.omp_bool = true;
+      return MATCH_YES;
+    }
+  if (gfc_match_omp_clauses (&c, OMP_CLAUSE_COPYPRIVATE) != MATCH_YES)
+    return MATCH_ERROR;
+  new_st.op = EXEC_OMP_END_SINGLE;
+  new_st.ext.omp_clauses = c;
+  return MATCH_YES;
+}
+
+
+/* OpenMP directive resolving routines.  */
+
+static void
+resolve_omp_clauses (gfc_code *code)
+{
+  gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
+  gfc_namelist *n;
+  int list;
+  static const char *clause_names[]
+    = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
+	"COPYIN", "REDUCTION" };
+
+  if (omp_clauses == NULL)
+    return;
+
+  if (omp_clauses->if_expr)
+    {
+      gfc_expr *expr = omp_clauses->if_expr;
+      if (gfc_resolve_expr (expr) == FAILURE
+	  || expr->ts.type != BT_LOGICAL || expr->rank != 0)
+	gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
+		   &expr->where);
+    }
+  if (omp_clauses->num_threads)
+    {
+      gfc_expr *expr = omp_clauses->num_threads;
+      if (gfc_resolve_expr (expr) == FAILURE
+	  || expr->ts.type != BT_INTEGER || expr->rank != 0)
+	gfc_error ("NUM_THREADS clause at %L requires a scalar "
+		   "INTEGER expression", &expr->where);
+    }
+  if (omp_clauses->chunk_size)
+    {
+      gfc_expr *expr = omp_clauses->chunk_size;
+      if (gfc_resolve_expr (expr) == FAILURE
+	  || expr->ts.type != BT_INTEGER || expr->rank != 0)
+	gfc_error ("SCHEDULE clause's chunk_size at %L requires "
+		   "a scalar INTEGER expression", &expr->where);
+    }
+
+  /* Check that no symbol appears on multiple clauses, except that
+     a symbol can appear on both firstprivate and lastprivate.  */
+  for (list = 0; list < OMP_LIST_NUM; list++)
+    for (n = omp_clauses->lists[list]; n; n = n->next)
+      {
+	n->sym->mark = 0;
+	if (n->sym->attr.flavor == FL_VARIABLE)
+	  continue;
+	if (n->sym->attr.flavor == FL_PROCEDURE
+	    && n->sym->result == n->sym
+	    && n->sym->attr.function)
+	  {
+	    if (gfc_current_ns->proc_name == n->sym
+		|| (gfc_current_ns->parent
+		    && gfc_current_ns->parent->proc_name == n->sym))
+	      continue;
+	    if (gfc_current_ns->proc_name->attr.entry_master)
+	      {
+		gfc_entry_list *el = gfc_current_ns->entries;
+		for (; el; el = el->next)
+		  if (el->sym == n->sym)
+		    break;
+		if (el)
+		  continue;
+	      }
+	    if (gfc_current_ns->parent
+		&& gfc_current_ns->parent->proc_name->attr.entry_master)
+	      {
+		gfc_entry_list *el = gfc_current_ns->parent->entries;
+		for (; el; el = el->next)
+		  if (el->sym == n->sym)
+		    break;
+		if (el)
+		  continue;
+	      }
+	    if (n->sym->attr.proc_pointer)
+	      continue;
+	  }
+	gfc_error ("Object '%s' is not a variable at %L", n->sym->name,
+		   &code->loc);
+      }
+
+  for (list = 0; list < OMP_LIST_NUM; list++)
+    if (list != OMP_LIST_FIRSTPRIVATE && list != OMP_LIST_LASTPRIVATE)
+      for (n = omp_clauses->lists[list]; n; n = n->next)
+	{
+	  if (n->sym->mark)
+	    gfc_error ("Symbol '%s' present on multiple clauses at %L",
+		       n->sym->name, &code->loc);
+	  else
+	    n->sym->mark = 1;
+	}
+
+  gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1);
+  for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; list++)
+    for (n = omp_clauses->lists[list]; n; n = n->next)
+      if (n->sym->mark)
+	{
+	  gfc_error ("Symbol '%s' present on multiple clauses at %L",
+		     n->sym->name, &code->loc);
+	  n->sym->mark = 0;
+	}
+
+  for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next)
+    {
+      if (n->sym->mark)
+	gfc_error ("Symbol '%s' present on multiple clauses at %L",
+		   n->sym->name, &code->loc);
+      else
+	n->sym->mark = 1;
+    }
+  for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
+    n->sym->mark = 0;
+
+  for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
+    {
+      if (n->sym->mark)
+	gfc_error ("Symbol '%s' present on multiple clauses at %L",
+		   n->sym->name, &code->loc);
+      else
+	n->sym->mark = 1;
+    }
+  for (list = 0; list < OMP_LIST_NUM; list++)
+    if ((n = omp_clauses->lists[list]) != NULL)
+      {
+	const char *name;
+
+	if (list < OMP_LIST_REDUCTION_FIRST)
+	  name = clause_names[list];
+	else if (list <= OMP_LIST_REDUCTION_LAST)
+	  name = clause_names[OMP_LIST_REDUCTION_FIRST];
+	else
+	  gcc_unreachable ();
+
+	switch (list)
+	  {
+	  case OMP_LIST_COPYIN:
+	    for (; n != NULL; n = n->next)
+	      {
+		if (!n->sym->attr.threadprivate)
+		  gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause"
+			     " at %L", n->sym->name, &code->loc);
+		if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)
+		  gfc_error ("COPYIN clause object '%s' at %L has ALLOCATABLE components",
+			     n->sym->name, &code->loc);
+	      }
+	    break;
+	  case OMP_LIST_COPYPRIVATE:
+	    for (; n != NULL; n = n->next)
+	      {
+		if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
+		  gfc_error ("Assumed size array '%s' in COPYPRIVATE clause "
+			     "at %L", n->sym->name, &code->loc);
+		if (n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)
+		  gfc_error ("COPYPRIVATE clause object '%s' at %L has ALLOCATABLE components",
+			     n->sym->name, &code->loc);
+	      }
+	    break;
+	  case OMP_LIST_SHARED:
+	    for (; n != NULL; n = n->next)
+	      {
+		if (n->sym->attr.threadprivate)
+		  gfc_error ("THREADPRIVATE object '%s' in SHARED clause at "
+			     "%L", n->sym->name, &code->loc);
+		if (n->sym->attr.cray_pointee)
+		  gfc_error ("Cray pointee '%s' in SHARED clause at %L",
+			    n->sym->name, &code->loc);
+	      }
+	    break;
+	  default:
+	    for (; n != NULL; n = n->next)
+	      {
+		if (n->sym->attr.threadprivate)
+		  gfc_error ("THREADPRIVATE object '%s' in %s clause at %L",
+			     n->sym->name, name, &code->loc);
+		if (n->sym->attr.cray_pointee)
+		  gfc_error ("Cray pointee '%s' in %s clause at %L",
+			    n->sym->name, name, &code->loc);
+		if (list != OMP_LIST_PRIVATE)
+		  {
+		    if (n->sym->attr.pointer)
+		      gfc_error ("POINTER object '%s' in %s clause at %L",
+				 n->sym->name, name, &code->loc);
+		    /* Variables in REDUCTION-clauses must be of intrinsic type (flagged below).  */
+		    if ((list < OMP_LIST_REDUCTION_FIRST || list > OMP_LIST_REDUCTION_LAST) &&
+		        n->sym->ts.type == BT_DERIVED && n->sym->ts.u.derived->attr.alloc_comp)
+		      gfc_error ("%s clause object '%s' has ALLOCATABLE components at %L",
+				 name, n->sym->name, &code->loc);
+		    if (n->sym->attr.cray_pointer)
+		      gfc_error ("Cray pointer '%s' in %s clause at %L",
+				 n->sym->name, name, &code->loc);
+		  }
+		if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
+		  gfc_error ("Assumed size array '%s' in %s clause at %L",
+			     n->sym->name, name, &code->loc);
+		if (n->sym->attr.in_namelist
+		    && (list < OMP_LIST_REDUCTION_FIRST
+			|| list > OMP_LIST_REDUCTION_LAST))
+		  gfc_error ("Variable '%s' in %s clause is used in "
+			     "NAMELIST statement at %L",
+			     n->sym->name, name, &code->loc);
+		switch (list)
+		  {
+		  case OMP_LIST_PLUS:
+		  case OMP_LIST_MULT:
+		  case OMP_LIST_SUB:
+		    if (!gfc_numeric_ts (&n->sym->ts))
+		      gfc_error ("%c REDUCTION variable '%s' at %L must be of numeric type, got %s",
+				 list == OMP_LIST_PLUS ? '+'
+				 : list == OMP_LIST_MULT ? '*' : '-',
+				 n->sym->name, &code->loc,
+				 gfc_typename (&n->sym->ts));
+		    break;
+		  case OMP_LIST_AND:
+		  case OMP_LIST_OR:
+		  case OMP_LIST_EQV:
+		  case OMP_LIST_NEQV:
+		    if (n->sym->ts.type != BT_LOGICAL)
+		      gfc_error ("%s REDUCTION variable '%s' must be LOGICAL "
+				 "at %L",
+				 list == OMP_LIST_AND ? ".AND."
+				 : list == OMP_LIST_OR ? ".OR."
+				 : list == OMP_LIST_EQV ? ".EQV." : ".NEQV.",
+				 n->sym->name, &code->loc);
+		    break;
+		  case OMP_LIST_MAX:
+		  case OMP_LIST_MIN:
+		    if (n->sym->ts.type != BT_INTEGER
+			&& n->sym->ts.type != BT_REAL)
+		      gfc_error ("%s REDUCTION variable '%s' must be "
+				 "INTEGER or REAL at %L",
+				 list == OMP_LIST_MAX ? "MAX" : "MIN",
+				 n->sym->name, &code->loc);
+		    break;
+		  case OMP_LIST_IAND:
+		  case OMP_LIST_IOR:
+		  case OMP_LIST_IEOR:
+		    if (n->sym->ts.type != BT_INTEGER)
+		      gfc_error ("%s REDUCTION variable '%s' must be INTEGER "
+				 "at %L",
+				 list == OMP_LIST_IAND ? "IAND"
+				 : list == OMP_LIST_MULT ? "IOR" : "IEOR",
+				 n->sym->name, &code->loc);
+		    break;
+		  /* Workaround for PR middle-end/26316, nothing really needs
+		     to be done here for OMP_LIST_PRIVATE.  */
+		  case OMP_LIST_PRIVATE:
+		    gcc_assert (code->op != EXEC_NOP);
+		  default:
+		    break;
+		  }
+	      }
+	    break;
+	  }
+      }
+}
+
+
+/* Return true if SYM is ever referenced in EXPR except in the SE node.  */
+
+static bool
+expr_references_sym (gfc_expr *e, gfc_symbol *s, gfc_expr *se)
+{
+  gfc_actual_arglist *arg;
+  if (e == NULL || e == se)
+    return false;
+  switch (e->expr_type)
+    {
+    case EXPR_CONSTANT:
+    case EXPR_NULL:
+    case EXPR_VARIABLE:
+    case EXPR_STRUCTURE:
+    case EXPR_ARRAY:
+      if (e->symtree != NULL
+	  && e->symtree->n.sym == s)
+	return true;
+      return false;
+    case EXPR_SUBSTRING:
+      if (e->ref != NULL
+	  && (expr_references_sym (e->ref->u.ss.start, s, se)
+	      || expr_references_sym (e->ref->u.ss.end, s, se)))
+	return true;
+      return false;
+    case EXPR_OP:
+      if (expr_references_sym (e->value.op.op2, s, se))
+	return true;
+      return expr_references_sym (e->value.op.op1, s, se);
+    case EXPR_FUNCTION:
+      for (arg = e->value.function.actual; arg; arg = arg->next)
+	if (expr_references_sym (arg->expr, s, se))
+	  return true;
+      return false;
+    default:
+      gcc_unreachable ();
+    }
+}
+
+
+/* If EXPR is a conversion function that widens the type
+   if WIDENING is true or narrows the type if WIDENING is false,
+   return the inner expression, otherwise return NULL.  */
+
+static gfc_expr *
+is_conversion (gfc_expr *expr, bool widening)
+{
+  gfc_typespec *ts1, *ts2;
+
+  if (expr->expr_type != EXPR_FUNCTION
+      || expr->value.function.isym == NULL
+      || expr->value.function.esym != NULL
+      || expr->value.function.isym->id != GFC_ISYM_CONVERSION)
+    return NULL;
+
+  if (widening)
+    {
+      ts1 = &expr->ts;
+      ts2 = &expr->value.function.actual->expr->ts;
+    }
+  else
+    {
+      ts1 = &expr->value.function.actual->expr->ts;
+      ts2 = &expr->ts;
+    }
+
+  if (ts1->type > ts2->type
+      || (ts1->type == ts2->type && ts1->kind > ts2->kind))
+    return expr->value.function.actual->expr;
+
+  return NULL;
+}
+
+
+static void
+resolve_omp_atomic (gfc_code *code)
+{
+  gfc_symbol *var;
+  gfc_expr *expr2;
+
+  code = code->block->next;
+  gcc_assert (code->op == EXEC_ASSIGN);
+  gcc_assert (code->next == NULL);
+
+  if (code->expr1->expr_type != EXPR_VARIABLE
+      || code->expr1->symtree == NULL
+      || code->expr1->rank != 0
+      || (code->expr1->ts.type != BT_INTEGER
+	  && code->expr1->ts.type != BT_REAL
+	  && code->expr1->ts.type != BT_COMPLEX
+	  && code->expr1->ts.type != BT_LOGICAL))
+    {
+      gfc_error ("!$OMP ATOMIC statement must set a scalar variable of "
+		 "intrinsic type at %L", &code->loc);
+      return;
+    }
+
+  var = code->expr1->symtree->n.sym;
+  expr2 = is_conversion (code->expr2, false);
+  if (expr2 == NULL)
+    expr2 = code->expr2;
+
+  if (expr2->expr_type == EXPR_OP)
+    {
+      gfc_expr *v = NULL, *e, *c;
+      gfc_intrinsic_op op = expr2->value.op.op;
+      gfc_intrinsic_op alt_op = INTRINSIC_NONE;
+
+      switch (op)
+	{
+	case INTRINSIC_PLUS:
+	  alt_op = INTRINSIC_MINUS;
+	  break;
+	case INTRINSIC_TIMES:
+	  alt_op = INTRINSIC_DIVIDE;
+	  break;
+	case INTRINSIC_MINUS:
+	  alt_op = INTRINSIC_PLUS;
+	  break;
+	case INTRINSIC_DIVIDE:
+	  alt_op = INTRINSIC_TIMES;
+	  break;
+	case INTRINSIC_AND:
+	case INTRINSIC_OR:
+	  break;
+	case INTRINSIC_EQV:
+	  alt_op = INTRINSIC_NEQV;
+	  break;
+	case INTRINSIC_NEQV:
+	  alt_op = INTRINSIC_EQV;
+	  break;
+	default:
+	  gfc_error ("!$OMP ATOMIC assignment operator must be "
+		     "+, *, -, /, .AND., .OR., .EQV. or .NEQV. at %L",
+		     &expr2->where);
+	  return;
+	}
+
+      /* Check for var = var op expr resp. var = expr op var where
+	 expr doesn't reference var and var op expr is mathematically
+	 equivalent to var op (expr) resp. expr op var equivalent to
+	 (expr) op var.  We rely here on the fact that the matcher
+	 for x op1 y op2 z where op1 and op2 have equal precedence
+	 returns (x op1 y) op2 z.  */
+      e = expr2->value.op.op2;
+      if (e->expr_type == EXPR_VARIABLE
+	  && e->symtree != NULL
+	  && e->symtree->n.sym == var)
+	v = e;
+      else if ((c = is_conversion (e, true)) != NULL
+	       && c->expr_type == EXPR_VARIABLE
+	       && c->symtree != NULL
+	       && c->symtree->n.sym == var)
+	v = c;
+      else
+	{
+	  gfc_expr **p = NULL, **q;
+	  for (q = &expr2->value.op.op1; (e = *q) != NULL; )
+	    if (e->expr_type == EXPR_VARIABLE
+		&& e->symtree != NULL
+		&& e->symtree->n.sym == var)
+	      {
+		v = e;
+		break;
+	      }
+	    else if ((c = is_conversion (e, true)) != NULL)
+	      q = &e->value.function.actual->expr;
+	    else if (e->expr_type != EXPR_OP
+		     || (e->value.op.op != op
+			 && e->value.op.op != alt_op)
+		     || e->rank != 0)
+	      break;
+	    else
+	      {
+		p = q;
+		q = &e->value.op.op1;
+	      }
+
+	  if (v == NULL)
+	    {
+	      gfc_error ("!$OMP ATOMIC assignment must be var = var op expr "
+			 "or var = expr op var at %L", &expr2->where);
+	      return;
+	    }
+
+	  if (p != NULL)
+	    {
+	      e = *p;
+	      switch (e->value.op.op)
+		{
+		case INTRINSIC_MINUS:
+		case INTRINSIC_DIVIDE:
+		case INTRINSIC_EQV:
+		case INTRINSIC_NEQV:
+		  gfc_error ("!$OMP ATOMIC var = var op expr not "
+			     "mathematically equivalent to var = var op "
+			     "(expr) at %L", &expr2->where);
+		  break;
+		default:
+		  break;
+		}
+
+	      /* Canonicalize into var = var op (expr).  */
+	      *p = e->value.op.op2;
+	      e->value.op.op2 = expr2;
+	      e->ts = expr2->ts;
+	      if (code->expr2 == expr2)
+		code->expr2 = expr2 = e;
+	      else
+		code->expr2->value.function.actual->expr = expr2 = e;
+
+	      if (!gfc_compare_types (&expr2->value.op.op1->ts, &expr2->ts))
+		{
+		  for (p = &expr2->value.op.op1; *p != v;
+		       p = &(*p)->value.function.actual->expr)
+		    ;
+		  *p = NULL;
+		  gfc_free_expr (expr2->value.op.op1);
+		  expr2->value.op.op1 = v;
+		  gfc_convert_type (v, &expr2->ts, 2);
+		}
+	    }
+	}
+
+      if (e->rank != 0 || expr_references_sym (code->expr2, var, v))
+	{
+	  gfc_error ("expr in !$OMP ATOMIC assignment var = var op expr "
+		     "must be scalar and cannot reference var at %L",
+		     &expr2->where);
+	  return;
+	}
+    }
+  else if (expr2->expr_type == EXPR_FUNCTION
+	   && expr2->value.function.isym != NULL
+	   && expr2->value.function.esym == NULL
+	   && expr2->value.function.actual != NULL
+	   && expr2->value.function.actual->next != NULL)
+    {
+      gfc_actual_arglist *arg, *var_arg;
+
+      switch (expr2->value.function.isym->id)
+	{
+	case GFC_ISYM_MIN:
+	case GFC_ISYM_MAX:
+	  break;
+	case GFC_ISYM_IAND:
+	case GFC_ISYM_IOR:
+	case GFC_ISYM_IEOR:
+	  if (expr2->value.function.actual->next->next != NULL)
+	    {
+	      gfc_error ("!$OMP ATOMIC assignment intrinsic IAND, IOR "
+			 "or IEOR must have two arguments at %L",
+			 &expr2->where);
+	      return;
+	    }
+	  break;
+	default:
+	  gfc_error ("!$OMP ATOMIC assignment intrinsic must be "
+		     "MIN, MAX, IAND, IOR or IEOR at %L",
+		     &expr2->where);
+	  return;
+	}
+
+      var_arg = NULL;
+      for (arg = expr2->value.function.actual; arg; arg = arg->next)
+	{
+	  if ((arg == expr2->value.function.actual
+	       || (var_arg == NULL && arg->next == NULL))
+	      && arg->expr->expr_type == EXPR_VARIABLE
+	      && arg->expr->symtree != NULL
+	      && arg->expr->symtree->n.sym == var)
+	    var_arg = arg;
+	  else if (expr_references_sym (arg->expr, var, NULL))
+	    gfc_error ("!$OMP ATOMIC intrinsic arguments except one must not "
+		       "reference '%s' at %L", var->name, &arg->expr->where);
+	  if (arg->expr->rank != 0)
+	    gfc_error ("!$OMP ATOMIC intrinsic arguments must be scalar "
+		       "at %L", &arg->expr->where);
+	}
+
+      if (var_arg == NULL)
+	{
+	  gfc_error ("First or last !$OMP ATOMIC intrinsic argument must "
+		     "be '%s' at %L", var->name, &expr2->where);
+	  return;
+	}
+
+      if (var_arg != expr2->value.function.actual)
+	{
+	  /* Canonicalize, so that var comes first.  */
+	  gcc_assert (var_arg->next == NULL);
+	  for (arg = expr2->value.function.actual;
+	       arg->next != var_arg; arg = arg->next)
+	    ;
+	  var_arg->next = expr2->value.function.actual;
+	  expr2->value.function.actual = var_arg;
+	  arg->next = NULL;
+	}
+    }
+  else
+    gfc_error ("!$OMP ATOMIC assignment must have an operator or intrinsic "
+	       "on right hand side at %L", &expr2->where);
+}
+
+
+struct omp_context
+{
+  gfc_code *code;
+  struct pointer_set_t *sharing_clauses;
+  struct pointer_set_t *private_iterators;
+  struct omp_context *previous;
+} *omp_current_ctx;
+static gfc_code *omp_current_do_code;
+static int omp_current_do_collapse;
+
+void
+gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns)
+{
+  if (code->block->next && code->block->next->op == EXEC_DO)
+    {
+      int i;
+      gfc_code *c;
+
+      omp_current_do_code = code->block->next;
+      omp_current_do_collapse = code->ext.omp_clauses->collapse;
+      for (i = 1, c = omp_current_do_code; i < omp_current_do_collapse; i++)
+	{
+	  c = c->block;
+	  if (c->op != EXEC_DO || c->next == NULL)
+	    break;
+	  c = c->next;
+	  if (c->op != EXEC_DO)
+	    break;
+	}
+      if (i < omp_current_do_collapse || omp_current_do_collapse <= 0)
+	omp_current_do_collapse = 1;
+    }
+  gfc_resolve_blocks (code->block, ns);
+  omp_current_do_collapse = 0;
+  omp_current_do_code = NULL;
+}
+
+
+void
+gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
+{
+  struct omp_context ctx;
+  gfc_omp_clauses *omp_clauses = code->ext.omp_clauses;
+  gfc_namelist *n;
+  int list;
+
+  ctx.code = code;
+  ctx.sharing_clauses = pointer_set_create ();
+  ctx.private_iterators = pointer_set_create ();
+  ctx.previous = omp_current_ctx;
+  omp_current_ctx = &ctx;
+
+  for (list = 0; list < OMP_LIST_NUM; list++)
+    for (n = omp_clauses->lists[list]; n; n = n->next)
+      pointer_set_insert (ctx.sharing_clauses, n->sym);
+
+  if (code->op == EXEC_OMP_PARALLEL_DO)
+    gfc_resolve_omp_do_blocks (code, ns);
+  else
+    gfc_resolve_blocks (code->block, ns);
+
+  omp_current_ctx = ctx.previous;
+  pointer_set_destroy (ctx.sharing_clauses);
+  pointer_set_destroy (ctx.private_iterators);
+}
+
+
+/* Save and clear openmp.c private state.  */
+
+void
+gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *state)
+{
+  state->ptrs[0] = omp_current_ctx;
+  state->ptrs[1] = omp_current_do_code;
+  state->ints[0] = omp_current_do_collapse;
+  omp_current_ctx = NULL;
+  omp_current_do_code = NULL;
+  omp_current_do_collapse = 0;
+}
+
+
+/* Restore openmp.c private state from the saved state.  */
+
+void
+gfc_omp_restore_state (struct gfc_omp_saved_state *state)
+{
+  omp_current_ctx = (struct omp_context *) state->ptrs[0];
+  omp_current_do_code = (gfc_code *) state->ptrs[1];
+  omp_current_do_collapse = state->ints[0];
+}
+
+
+/* Note a DO iterator variable.  This is special in !$omp parallel
+   construct, where they are predetermined private.  */
+
+void
+gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
+{
+  int i = omp_current_do_collapse;
+  gfc_code *c = omp_current_do_code;
+
+  if (sym->attr.threadprivate)
+    return;
+
+  /* !$omp do and !$omp parallel do iteration variable is predetermined
+     private just in the !$omp do resp. !$omp parallel do construct,
+     with no implications for the outer parallel constructs.  */
+
+  while (i-- >= 1)
+    {
+      if (code == c)
+	return;
+
+      c = c->block->next;
+    }
+
+  if (omp_current_ctx == NULL)
+    return;
+
+  if (pointer_set_contains (omp_current_ctx->sharing_clauses, sym))
+    return;
+
+  if (! pointer_set_insert (omp_current_ctx->private_iterators, sym))
+    {
+      gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses;
+      gfc_namelist *p;
+
+      p = gfc_get_namelist ();
+      p->sym = sym;
+      p->next = omp_clauses->lists[OMP_LIST_PRIVATE];
+      omp_clauses->lists[OMP_LIST_PRIVATE] = p;
+    }
+}
+
+
+static void
+resolve_omp_do (gfc_code *code)
+{
+  gfc_code *do_code, *c;
+  int list, i, collapse;
+  gfc_namelist *n;
+  gfc_symbol *dovar;
+
+  if (code->ext.omp_clauses)
+    resolve_omp_clauses (code);
+
+  do_code = code->block->next;
+  collapse = code->ext.omp_clauses->collapse;
+  if (collapse <= 0)
+    collapse = 1;
+  for (i = 1; i <= collapse; i++)
+    {
+      if (do_code->op == EXEC_DO_WHILE)
+	{
+	  gfc_error ("!$OMP DO cannot be a DO WHILE or DO without loop control "
+		     "at %L", &do_code->loc);
+	  break;
+	}
+      gcc_assert (do_code->op == EXEC_DO);
+      if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
+	gfc_error ("!$OMP DO iteration variable must be of type integer at %L",
+		   &do_code->loc);
+      dovar = do_code->ext.iterator->var->symtree->n.sym;
+      if (dovar->attr.threadprivate)
+	gfc_error ("!$OMP DO iteration variable must not be THREADPRIVATE "
+		   "at %L", &do_code->loc);
+      if (code->ext.omp_clauses)
+	for (list = 0; list < OMP_LIST_NUM; list++)
+	  if (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE)
+	    for (n = code->ext.omp_clauses->lists[list]; n; n = n->next)
+	      if (dovar == n->sym)
+		{
+		  gfc_error ("!$OMP DO iteration variable present on clause "
+			     "other than PRIVATE or LASTPRIVATE at %L",
+			     &do_code->loc);
+		  break;
+		}
+      if (i > 1)
+	{
+	  gfc_code *do_code2 = code->block->next;
+	  int j;
+
+	  for (j = 1; j < i; j++)
+	    {
+	      gfc_symbol *ivar = do_code2->ext.iterator->var->symtree->n.sym;
+	      if (dovar == ivar
+		  || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->start)
+		  || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->end)
+		  || gfc_find_sym_in_expr (ivar, do_code->ext.iterator->step))
+		{
+		  gfc_error ("!$OMP DO collapsed loops don't form rectangular iteration space at %L",
+			     &do_code->loc);
+		  break;
+		}
+	      if (j < i)
+		break;
+	      do_code2 = do_code2->block->next;
+	    }
+	}
+      if (i == collapse)
+	break;
+      for (c = do_code->next; c; c = c->next)
+	if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
+	  {
+	    gfc_error ("collapsed !$OMP DO loops not perfectly nested at %L",
+		       &c->loc);
+	    break;
+	  }
+      if (c)
+	break;
+      do_code = do_code->block;
+      if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)
+	{
+	  gfc_error ("not enough DO loops for collapsed !$OMP DO at %L",
+		     &code->loc);
+	  break;
+	}
+      do_code = do_code->next;
+      if (do_code == NULL
+	  || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE))
+	{
+	  gfc_error ("not enough DO loops for collapsed !$OMP DO at %L",
+		     &code->loc);
+	  break;
+	}
+    }
+}
+
+
+/* Resolve OpenMP directive clauses and check various requirements
+   of each directive.  */
+
+void
+gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
+{
+  if (code->op != EXEC_OMP_ATOMIC)
+    gfc_maybe_initialize_eh ();
+
+  switch (code->op)
+    {
+    case EXEC_OMP_DO:
+    case EXEC_OMP_PARALLEL_DO:
+      resolve_omp_do (code);
+      break;
+    case EXEC_OMP_WORKSHARE:
+    case EXEC_OMP_PARALLEL_WORKSHARE:
+    case EXEC_OMP_PARALLEL:
+    case EXEC_OMP_PARALLEL_SECTIONS:
+    case EXEC_OMP_SECTIONS:
+    case EXEC_OMP_SINGLE:
+    case EXEC_OMP_TASK:
+      if (code->ext.omp_clauses)
+	resolve_omp_clauses (code);
+      break;
+    case EXEC_OMP_ATOMIC:
+      resolve_omp_atomic (code);
+      break;
+    default:
+      break;
+    }
+}
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
new file mode 100644
index 000000000..70733886b
--- /dev/null
+++ b/gcc/fortran/options.c
@@ -0,0 +1,1075 @@
+/* Parse and display command line options.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "flags.h"
+#include "intl.h"
+#include "opts.h"
+#include "toplev.h"  /* For save_decoded_options.  */
+#include "options.h"
+#include "params.h"
+#include "tree-inline.h"
+#include "gfortran.h"
+#include "target.h"
+#include "cpp.h"
+#include "diagnostic-core.h"	/* For sorry.  */
+#include "tm.h"
+
+gfc_option_t gfc_option;
+
+
+/* Set flags that control warnings and errors for different
+   Fortran standards to their default values.  Keep in sync with
+   libgfortran/runtime/compile_options.c (init_compile_options).  */
+
+static void
+set_default_std_flags (void)
+{
+  gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
+    | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77
+    | GFC_STD_F2008_OBS | GFC_STD_GNU | GFC_STD_LEGACY;
+  gfc_option.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY;
+}
+
+
+/* Return language mask for Fortran options.  */
+
+unsigned int
+gfc_option_lang_mask (void)
+{
+  return CL_Fortran;
+}
+
+/* Initialize options structure OPTS.  */
+
+void
+gfc_init_options_struct (struct gcc_options *opts)
+{
+  opts->x_flag_errno_math = 0;
+  opts->x_flag_associative_math = -1;
+}
+
+/* Get ready for options handling. Keep in sync with
+   libgfortran/runtime/compile_options.c (init_compile_options). */
+
+void
+gfc_init_options (unsigned int decoded_options_count,
+		  struct cl_decoded_option *decoded_options)
+{
+  gfc_source_file = NULL;
+  gfc_option.module_dir = NULL;
+  gfc_option.source_form = FORM_UNKNOWN;
+  gfc_option.fixed_line_length = 72;
+  gfc_option.free_line_length = 132;
+  gfc_option.max_continue_fixed = 255;
+  gfc_option.max_continue_free = 255;
+  gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN;
+  gfc_option.max_subrecord_length = 0;
+  gfc_option.flag_max_array_constructor = 65535;
+  gfc_option.convert = GFC_CONVERT_NATIVE;
+  gfc_option.record_marker = 0;
+  gfc_option.dump_fortran_original = 0;
+  gfc_option.dump_fortran_optimized = 0;
+
+  gfc_option.warn_aliasing = 0;
+  gfc_option.warn_ampersand = 0;
+  gfc_option.warn_character_truncation = 0;
+  gfc_option.warn_array_temp = 0;
+  gfc_option.gfc_warn_conversion = 0;
+  gfc_option.warn_conversion_extra = 0;
+  gfc_option.warn_implicit_interface = 0;
+  gfc_option.warn_line_truncation = 0;
+  gfc_option.warn_surprising = 0;
+  gfc_option.warn_tabs = 1;
+  gfc_option.warn_underflow = 1;
+  gfc_option.warn_intrinsic_shadow = 0;
+  gfc_option.warn_intrinsics_std = 0;
+  gfc_option.warn_align_commons = 1;
+  gfc_option.warn_real_q_constant = 0;
+  gfc_option.warn_unused_dummy_argument = 0;
+  gfc_option.max_errors = 25;
+
+  gfc_option.flag_all_intrinsics = 0;
+  gfc_option.flag_default_double = 0;
+  gfc_option.flag_default_integer = 0;
+  gfc_option.flag_default_real = 0;
+  gfc_option.flag_dollar_ok = 0;
+  gfc_option.flag_underscoring = 1;
+  gfc_option.flag_whole_file = 1;
+  gfc_option.flag_f2c = 0;
+  gfc_option.flag_second_underscore = -1;
+  gfc_option.flag_implicit_none = 0;
+
+  /* Default value of flag_max_stack_var_size is set in gfc_post_options.  */
+  gfc_option.flag_max_stack_var_size = -2;
+
+  gfc_option.flag_range_check = 1;
+  gfc_option.flag_pack_derived = 0;
+  gfc_option.flag_repack_arrays = 0;
+  gfc_option.flag_preprocessed = 0;
+  gfc_option.flag_automatic = 1;
+  gfc_option.flag_backslash = 0;
+  gfc_option.flag_module_private = 0;
+  gfc_option.flag_backtrace = 0;
+  gfc_option.flag_allow_leading_underscore = 0;
+  gfc_option.flag_dump_core = 0;
+  gfc_option.flag_external_blas = 0;
+  gfc_option.blas_matmul_limit = 30;
+  gfc_option.flag_cray_pointer = 0;
+  gfc_option.flag_d_lines = -1;
+  gfc_option.gfc_flag_openmp = 0;
+  gfc_option.flag_sign_zero = 1;
+  gfc_option.flag_recursive = 0;
+  gfc_option.flag_init_integer = GFC_INIT_INTEGER_OFF;
+  gfc_option.flag_init_integer_value = 0;
+  gfc_option.flag_init_real = GFC_INIT_REAL_OFF;
+  gfc_option.flag_init_logical = GFC_INIT_LOGICAL_OFF;
+  gfc_option.flag_init_character = GFC_INIT_CHARACTER_OFF;
+  gfc_option.flag_init_character_value = (char)0;
+  gfc_option.flag_align_commons = 1;
+  gfc_option.flag_protect_parens = 1;
+  gfc_option.flag_realloc_lhs = -1;
+  
+  gfc_option.fpe = 0;
+  gfc_option.rtcheck = 0;
+  gfc_option.coarray = GFC_FCOARRAY_NONE;
+
+  set_default_std_flags ();
+
+  /* Initialize cpp-related options.  */
+  gfc_cpp_init_options (decoded_options_count, decoded_options);
+}
+
+
+/* Determine the source form from the filename extension.  We assume
+   case insensitivity.  */
+
+static gfc_source_form
+form_from_filename (const char *filename)
+{
+  static const struct
+  {
+    const char *extension;
+    gfc_source_form form;
+  }
+  exttype[] =
+  {
+    {
+    ".f90", FORM_FREE}
+    ,
+    {
+    ".f95", FORM_FREE}
+    ,
+    {
+    ".f03", FORM_FREE}
+    ,
+    {
+    ".f08", FORM_FREE}
+    ,
+    {
+    ".f", FORM_FIXED}
+    ,
+    {
+    ".for", FORM_FIXED}
+    ,
+    {
+    ".ftn", FORM_FIXED}
+    ,
+    {
+    "", FORM_UNKNOWN}
+  };		/* sentinel value */
+
+  gfc_source_form f_form;
+  const char *fileext;
+  int i;
+
+  /* Find end of file name.  Note, filename is either a NULL pointer or
+     a NUL terminated string.  */
+  i = 0;
+  while (filename[i] != '\0')
+    i++;
+
+  /* Find last period.  */
+  while (i >= 0 && (filename[i] != '.'))
+    i--;
+
+  /* Did we see a file extension?  */
+  if (i < 0)
+    return FORM_UNKNOWN; /* Nope  */
+
+  /* Get file extension and compare it to others.  */
+  fileext = &(filename[i]);
+
+  i = -1;
+  f_form = FORM_UNKNOWN;
+  do
+    {
+      i++;
+      if (strcasecmp (fileext, exttype[i].extension) == 0)
+	{
+	  f_form = exttype[i].form;
+	  break;
+	}
+    }
+  while (exttype[i].form != FORM_UNKNOWN);
+
+  return f_form;
+}
+
+
+/* Finalize commandline options.  */
+
+bool
+gfc_post_options (const char **pfilename)
+{
+  const char *filename = *pfilename, *canon_source_file = NULL;
+  char *source_path;
+  int i;
+
+  /* Excess precision other than "fast" requires front-end
+     support.  */
+  if (flag_excess_precision_cmdline == EXCESS_PRECISION_STANDARD
+      && TARGET_FLT_EVAL_METHOD_NON_DEFAULT)
+    sorry ("-fexcess-precision=standard for Fortran");
+  flag_excess_precision_cmdline = EXCESS_PRECISION_FAST;
+
+  /* Whole program needs whole file mode.  */
+  if (flag_whole_program)
+    gfc_option.flag_whole_file = 1;
+
+  /* Enable whole-file mode if LTO is in effect.  */
+  if (flag_lto)
+    gfc_option.flag_whole_file = 1;
+
+  /* Fortran allows associative math - but we cannot reassociate if
+     we want traps or signed zeros. Cf. also flag_protect_parens.  */
+  if (flag_associative_math == -1)
+    flag_associative_math = (!flag_trapping_math && !flag_signed_zeros);
+
+  /* By default, disable (re)allocation during assignment for -std=f95,
+     and enable it for F2003/F2008/GNU/Legacy. */
+  if (gfc_option.flag_realloc_lhs == -1)
+    {
+      if (gfc_option.allow_std & GFC_STD_F2003)
+	gfc_option.flag_realloc_lhs = 1;
+      else
+	gfc_option.flag_realloc_lhs = 0;
+    }
+
+  /* -fbounds-check is equivalent to -fcheck=bounds */
+  if (flag_bounds_check)
+    gfc_option.rtcheck |= GFC_RTCHECK_BOUNDS;
+
+  if (flag_compare_debug)
+    gfc_option.dump_fortran_original = 0;
+
+  /* Make -fmax-errors visible to gfortran's diagnostic machinery.  */
+  if (global_options_set.x_flag_max_errors)
+    gfc_option.max_errors = flag_max_errors;
+
+  /* Verify the input file name.  */
+  if (!filename || strcmp (filename, "-") == 0)
+    {
+      filename = "";
+    }
+
+  if (gfc_option.flag_preprocessed)
+    {
+      /* For preprocessed files, if the first tokens are of the form # NUM.
+	 handle the directives so we know the original file name.  */
+      gfc_source_file = gfc_read_orig_filename (filename, &canon_source_file);
+      if (gfc_source_file == NULL)
+	gfc_source_file = filename;
+      else
+	*pfilename = gfc_source_file;
+    }
+  else
+    gfc_source_file = filename;
+
+  if (canon_source_file == NULL)
+    canon_source_file = gfc_source_file;
+
+  /* Adds the path where the source file is to the list of include files.  */
+
+  i = strlen (canon_source_file);
+  while (i > 0 && !IS_DIR_SEPARATOR (canon_source_file[i]))
+    i--;
+
+  if (i != 0)
+    {
+      source_path = (char *) alloca (i + 1);
+      memcpy (source_path, canon_source_file, i);
+      source_path[i] = 0;
+      gfc_add_include_path (source_path, true, true);
+    }
+  else
+    gfc_add_include_path (".", true, true);
+
+  if (canon_source_file != gfc_source_file)
+    gfc_free (CONST_CAST (char *, canon_source_file));
+
+  /* Decide which form the file will be read in as.  */
+
+  if (gfc_option.source_form != FORM_UNKNOWN)
+    gfc_current_form = gfc_option.source_form;
+  else
+    {
+      gfc_current_form = form_from_filename (filename);
+
+      if (gfc_current_form == FORM_UNKNOWN)
+	{
+	  gfc_current_form = FORM_FREE;
+	  gfc_warning_now ("Reading file '%s' as free form", 
+			   (filename[0] == '\0') ? "<stdin>" : filename);
+	}
+    }
+
+  /* If the user specified -fd-lines-as-{code|comments} verify that we're
+     in fixed form.  */
+  if (gfc_current_form == FORM_FREE)
+    {
+      if (gfc_option.flag_d_lines == 0)
+	gfc_warning_now ("'-fd-lines-as-comments' has no effect "
+			 "in free form");
+      else if (gfc_option.flag_d_lines == 1)
+	gfc_warning_now ("'-fd-lines-as-code' has no effect in free form");
+    }
+
+  /* If -pedantic, warn about the use of GNU extensions.  */
+  if (pedantic && (gfc_option.allow_std & GFC_STD_GNU) != 0)
+    gfc_option.warn_std |= GFC_STD_GNU;
+  /* -std=legacy -pedantic is effectively -std=gnu.  */
+  if (pedantic && (gfc_option.allow_std & GFC_STD_LEGACY) != 0)
+    gfc_option.warn_std |= GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_LEGACY;
+
+  /* If the user didn't explicitly specify -f(no)-second-underscore we
+     use it if we're trying to be compatible with f2c, and not
+     otherwise.  */
+  if (gfc_option.flag_second_underscore == -1)
+    gfc_option.flag_second_underscore = gfc_option.flag_f2c;
+
+  if (!gfc_option.flag_automatic && gfc_option.flag_max_stack_var_size != -2
+      && gfc_option.flag_max_stack_var_size != 0)
+    gfc_warning_now ("Flag -fno-automatic overwrites -fmax-stack-var-size=%d",
+		     gfc_option.flag_max_stack_var_size);
+  else if (!gfc_option.flag_automatic && gfc_option.flag_recursive)
+    gfc_warning_now ("Flag -fno-automatic overwrites -frecursive");
+  else if (!gfc_option.flag_automatic && gfc_option.gfc_flag_openmp)
+    gfc_warning_now ("Flag -fno-automatic overwrites -frecursive implied by "
+		     "-fopenmp");
+  else if (gfc_option.flag_max_stack_var_size != -2
+	   && gfc_option.flag_recursive)
+    gfc_warning_now ("Flag -frecursive overwrites -fmax-stack-var-size=%d",
+		     gfc_option.flag_max_stack_var_size);
+  else if (gfc_option.flag_max_stack_var_size != -2
+	   && gfc_option.gfc_flag_openmp)
+    gfc_warning_now ("Flag -fmax-stack-var-size=%d overwrites -frecursive "
+		     "implied by -fopenmp", 
+		     gfc_option.flag_max_stack_var_size);
+
+  /* Implement -frecursive as -fmax-stack-var-size=-1.  */
+  if (gfc_option.flag_recursive)
+    gfc_option.flag_max_stack_var_size = -1;
+
+  /* Implied -frecursive; implemented as -fmax-stack-var-size=-1.  */
+  if (gfc_option.flag_max_stack_var_size == -2 && gfc_option.gfc_flag_openmp
+      && gfc_option.flag_automatic)
+    {
+      gfc_option.flag_recursive = 1;
+      gfc_option.flag_max_stack_var_size = -1;
+    }
+
+  /* Set default.  */
+  if (gfc_option.flag_max_stack_var_size == -2)
+    gfc_option.flag_max_stack_var_size = 32768;
+
+  /* Implement -fno-automatic as -fmax-stack-var-size=0.  */
+  if (!gfc_option.flag_automatic)
+    gfc_option.flag_max_stack_var_size = 0;
+  
+  if (pedantic)
+    { 
+      gfc_option.warn_ampersand = 1;
+      gfc_option.warn_tabs = 0;
+    }
+
+  if (pedantic && gfc_option.flag_whole_file)
+    gfc_option.flag_whole_file = 2;
+
+  gfc_cpp_post_options ();
+
+/* FIXME: return gfc_cpp_preprocess_only ();
+
+   The return value of this function indicates whether the
+   backend needs to be initialized. On -E, we don't need
+   the backend. However, if we return 'true' here, an
+   ICE occurs. Initializing the backend doesn't hurt much,
+   hence, for now we can live with it as is.  */
+  return false;
+}
+
+
+/* Set the options for -Wall.  */
+
+static void
+set_Wall (int setting)
+{
+  gfc_option.warn_aliasing = setting;
+  gfc_option.warn_ampersand = setting;
+  gfc_option.gfc_warn_conversion = setting;
+  gfc_option.warn_line_truncation = setting;
+  gfc_option.warn_surprising = setting;
+  gfc_option.warn_tabs = !setting;
+  gfc_option.warn_underflow = setting;
+  gfc_option.warn_intrinsic_shadow = setting;
+  gfc_option.warn_intrinsics_std = setting;
+  gfc_option.warn_character_truncation = setting;
+  gfc_option.warn_real_q_constant = setting;
+  gfc_option.warn_unused_dummy_argument = setting;
+
+  warn_unused = setting;
+  warn_return_type = setting;
+  warn_switch = setting;
+  warn_uninitialized = setting;
+}
+
+
+static void
+gfc_handle_module_path_options (const char *arg)
+{
+
+  if (gfc_option.module_dir != NULL)
+    gfc_fatal_error ("gfortran: Only one -J option allowed");
+
+  gfc_option.module_dir = (char *) gfc_getmem (strlen (arg) + 2);
+  strcpy (gfc_option.module_dir, arg);
+
+  gfc_add_include_path (gfc_option.module_dir, true, false);
+
+  strcat (gfc_option.module_dir, "/");
+}
+
+
+static void
+gfc_handle_fpe_trap_option (const char *arg)
+{
+  int result, pos = 0, n;
+  static const char * const exception[] = { "invalid", "denormal", "zero",
+					    "overflow", "underflow",
+					    "precision", NULL };
+  static const int opt_exception[] = { GFC_FPE_INVALID, GFC_FPE_DENORMAL,
+				       GFC_FPE_ZERO, GFC_FPE_OVERFLOW,
+				       GFC_FPE_UNDERFLOW, GFC_FPE_PRECISION,
+				       0 };
+ 
+  while (*arg)
+    {
+      while (*arg == ',')
+	arg++;
+
+      while (arg[pos] && arg[pos] != ',')
+	pos++;
+
+      result = 0;
+      for (n = 0; exception[n] != NULL; n++)
+	{
+	  if (exception[n] && strncmp (exception[n], arg, pos) == 0)
+	    {
+	      gfc_option.fpe |= opt_exception[n];
+	      arg += pos;
+	      pos = 0;
+	      result = 1;
+	      break;
+	    }
+	}
+      if (!result)
+	gfc_fatal_error ("Argument to -ffpe-trap is not valid: %s", arg);
+    }
+}
+
+
+static void
+gfc_handle_coarray_option (const char *arg)
+{
+  if (strcmp (arg, "none") == 0)
+    gfc_option.coarray = GFC_FCOARRAY_NONE;
+  else if (strcmp (arg, "single") == 0)
+    gfc_option.coarray = GFC_FCOARRAY_SINGLE;
+  else
+    gfc_fatal_error ("Argument to -fcoarray is not valid: %s", arg);
+}
+
+
+static void
+gfc_handle_runtime_check_option (const char *arg)
+{
+  int result, pos = 0, n;
+  static const char * const optname[] = { "all", "bounds", "array-temps",
+					  "recursion", "do", "pointer",
+					  "mem", NULL };
+  static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS,
+				 GFC_RTCHECK_ARRAY_TEMPS,
+				 GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO,
+				 GFC_RTCHECK_POINTER, GFC_RTCHECK_MEM,
+				 0 };
+ 
+  while (*arg)
+    {
+      while (*arg == ',')
+	arg++;
+
+      while (arg[pos] && arg[pos] != ',')
+	pos++;
+
+      result = 0;
+      for (n = 0; optname[n] != NULL; n++)
+	{
+	  if (optname[n] && strncmp (optname[n], arg, pos) == 0)
+	    {
+	      gfc_option.rtcheck |= optmask[n];
+	      arg += pos;
+	      pos = 0;
+	      result = 1;
+	      break;
+	    }
+	}
+      if (!result)
+	gfc_fatal_error ("Argument to -fcheck is not valid: %s", arg);
+    }
+}
+
+
+/* Handle command-line options.  Returns 0 if unrecognized, 1 if
+   recognized and handled.  */
+
+bool
+gfc_handle_option (size_t scode, const char *arg, int value,
+		   int kind ATTRIBUTE_UNUSED, location_t loc ATTRIBUTE_UNUSED,
+		   const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED)
+{
+  bool result = true;
+  enum opt_code code = (enum opt_code) scode;
+
+  if (gfc_cpp_handle_option (scode, arg, value) == 1)
+    return true;
+
+  switch (code)
+    {
+    default:
+      result = false;
+      break;
+
+    case OPT_Wall:
+      set_Wall (value);
+      break;
+
+    case OPT_Waliasing:
+      gfc_option.warn_aliasing = value;
+      break;
+
+    case OPT_Wampersand:
+      gfc_option.warn_ampersand = value;
+      break;
+
+    case OPT_Warray_temporaries:
+      gfc_option.warn_array_temp = value;
+      break;
+
+    case OPT_Wcharacter_truncation:
+      gfc_option.warn_character_truncation = value;
+      break;
+
+    case OPT_Wconversion:
+      gfc_option.gfc_warn_conversion = value;
+      break;
+
+    case OPT_Wconversion_extra:
+      gfc_option.warn_conversion_extra = value;
+      break;
+
+    case OPT_Wimplicit_interface:
+      gfc_option.warn_implicit_interface = value;
+      break;
+
+    case OPT_Wimplicit_procedure:
+      gfc_option.warn_implicit_procedure = value;
+      break;
+
+    case OPT_Wline_truncation:
+      gfc_option.warn_line_truncation = value;
+      break;
+
+    case OPT_Wreturn_type:
+      warn_return_type = value;
+      break;
+
+    case OPT_Wsurprising:
+      gfc_option.warn_surprising = value;
+      break;
+
+    case OPT_Wtabs:
+      gfc_option.warn_tabs = value;
+      break;
+
+    case OPT_Wunderflow:
+      gfc_option.warn_underflow = value;
+      break;
+
+    case OPT_Wintrinsic_shadow:
+      gfc_option.warn_intrinsic_shadow = value;
+      break;
+
+    case OPT_Walign_commons:
+      gfc_option.warn_align_commons = value;
+      break;
+
+    case OPT_Wreal_q_constant:
+      gfc_option.warn_real_q_constant = value;
+      break;
+
+    case OPT_Wunused_dummy_argument:
+      gfc_option.warn_unused_dummy_argument = value;
+      break;
+
+    case OPT_fall_intrinsics:
+      gfc_option.flag_all_intrinsics = 1;
+      break;
+
+    case OPT_fautomatic:
+      gfc_option.flag_automatic = value;
+      break;
+
+    case OPT_fallow_leading_underscore:
+      gfc_option.flag_allow_leading_underscore = value;
+      break;
+      
+    case OPT_fbackslash:
+      gfc_option.flag_backslash = value;
+      break;
+      
+    case OPT_fbacktrace:
+      gfc_option.flag_backtrace = value;
+      break;
+      
+    case OPT_fcheck_array_temporaries:
+      gfc_option.rtcheck |= GFC_RTCHECK_ARRAY_TEMPS;
+      break;
+      
+    case OPT_fdump_core:
+      gfc_option.flag_dump_core = value;
+      break;
+
+    case OPT_fcray_pointer:
+      gfc_option.flag_cray_pointer = value;
+      break;
+
+    case OPT_ff2c:
+      gfc_option.flag_f2c = value;
+      break;
+
+    case OPT_fdollar_ok:
+      gfc_option.flag_dollar_ok = value;
+      break;
+
+    case OPT_fexternal_blas:
+      gfc_option.flag_external_blas = value;
+      break;
+
+    case OPT_fblas_matmul_limit_:
+      gfc_option.blas_matmul_limit = value;
+      break;
+
+    case OPT_fd_lines_as_code:
+      gfc_option.flag_d_lines = 1;
+      break;
+
+    case OPT_fd_lines_as_comments:
+      gfc_option.flag_d_lines = 0;
+      break;
+
+    case OPT_fdump_fortran_original:
+    case OPT_fdump_parse_tree:
+      gfc_option.dump_fortran_original = value;
+      break;
+
+    case OPT_fdump_fortran_optimized:
+      gfc_option.dump_fortran_optimized = value;
+      break;
+
+    case OPT_ffixed_form:
+      gfc_option.source_form = FORM_FIXED;
+      break;
+
+    case OPT_ffixed_line_length_none:
+      gfc_option.fixed_line_length = 0;
+      break;
+
+    case OPT_ffixed_line_length_:
+      if (value != 0 && value < 7)
+	gfc_fatal_error ("Fixed line length must be at least seven.");
+      gfc_option.fixed_line_length = value;
+      break;
+
+    case OPT_ffree_form:
+      gfc_option.source_form = FORM_FREE;
+      break;
+
+    case OPT_fopenmp:
+      gfc_option.gfc_flag_openmp = value;
+      break;
+
+    case OPT_ffree_line_length_none:
+      gfc_option.free_line_length = 0;
+      break;
+
+    case OPT_ffree_line_length_:
+      if (value != 0 && value < 4)
+	gfc_fatal_error ("Free line length must be at least three.");
+      gfc_option.free_line_length = value;
+      break;
+
+    case OPT_funderscoring:
+      gfc_option.flag_underscoring = value;
+      break;
+
+    case OPT_fwhole_file:
+      gfc_option.flag_whole_file = value;
+      break;
+
+    case OPT_fsecond_underscore:
+      gfc_option.flag_second_underscore = value;
+      break;
+
+    case OPT_static_libgfortran:
+#ifndef HAVE_LD_STATIC_DYNAMIC
+      gfc_fatal_error ("-static-libgfortran is not supported in this "
+		       "configuration");
+#endif
+      break;
+
+    case OPT_fimplicit_none:
+      gfc_option.flag_implicit_none = value;
+      break;
+
+    case OPT_fintrinsic_modules_path:
+      gfc_add_include_path (arg, false, false);
+      gfc_add_intrinsic_modules_path (arg);
+      break;
+
+    case OPT_fmax_array_constructor_:
+      gfc_option.flag_max_array_constructor = value > 65535 ? value : 65535;
+      break;
+
+    case OPT_fmax_stack_var_size_:
+      gfc_option.flag_max_stack_var_size = value;
+      break;
+
+    case OPT_fmodule_private:
+      gfc_option.flag_module_private = value;
+      break;
+      
+    case OPT_frange_check:
+      gfc_option.flag_range_check = value;
+      break;
+
+    case OPT_fpack_derived:
+      gfc_option.flag_pack_derived = value;
+      break;
+
+    case OPT_frepack_arrays:
+      gfc_option.flag_repack_arrays = value;
+      break;
+
+    case OPT_fpreprocessed:
+      gfc_option.flag_preprocessed = value;
+      break;
+
+    case OPT_fmax_identifier_length_:
+      if (value > GFC_MAX_SYMBOL_LEN)
+	gfc_fatal_error ("Maximum supported identifier length is %d",
+			 GFC_MAX_SYMBOL_LEN);
+      gfc_option.max_identifier_length = value;
+      break;
+
+    case OPT_fdefault_integer_8:
+      gfc_option.flag_default_integer = value;
+      break;
+
+    case OPT_fdefault_real_8:
+      gfc_option.flag_default_real = value;
+      break;
+
+    case OPT_fdefault_double_8:
+      gfc_option.flag_default_double = value;
+      break;
+
+    case OPT_finit_local_zero:
+      gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
+      gfc_option.flag_init_integer_value = 0;
+      gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
+      gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
+      gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
+      gfc_option.flag_init_character_value = (char)0;
+      break;
+
+    case OPT_finit_logical_:
+      if (!strcasecmp (arg, "false"))
+	gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
+      else if (!strcasecmp (arg, "true"))
+	gfc_option.flag_init_logical = GFC_INIT_LOGICAL_TRUE;
+      else
+	gfc_fatal_error ("Unrecognized option to -finit-logical: %s",
+			 arg);
+      break;
+
+    case OPT_finit_real_:
+      if (!strcasecmp (arg, "zero"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
+      else if (!strcasecmp (arg, "nan"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_NAN;
+      else if (!strcasecmp (arg, "snan"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_SNAN;
+      else if (!strcasecmp (arg, "inf"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_INF;
+      else if (!strcasecmp (arg, "-inf"))
+	gfc_option.flag_init_real = GFC_INIT_REAL_NEG_INF;
+      else
+	gfc_fatal_error ("Unrecognized option to -finit-real: %s",
+			 arg);
+      break;
+
+    case OPT_finit_integer_:
+      gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
+      gfc_option.flag_init_integer_value = atoi (arg);
+      break;
+
+    case OPT_finit_character_:
+      if (value >= 0 && value <= 127)
+	{
+	  gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
+	  gfc_option.flag_init_character_value = (char)value;
+	}
+      else
+	gfc_fatal_error ("The value of n in -finit-character=n must be "
+			 "between 0 and 127");
+      break;
+
+    case OPT_I:
+      gfc_add_include_path (arg, true, false);
+      break;
+
+    case OPT_J:
+      gfc_handle_module_path_options (arg);
+      break;
+
+    case OPT_fsign_zero:
+      gfc_option.flag_sign_zero = value;
+      break;
+
+    case OPT_ffpe_trap_:
+      gfc_handle_fpe_trap_option (arg);
+      break;
+
+    case OPT_std_f95:
+      gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77
+			     | GFC_STD_F2008_OBS;
+      gfc_option.warn_std = GFC_STD_F95_OBS;
+      gfc_option.max_continue_fixed = 19;
+      gfc_option.max_continue_free = 39;
+      gfc_option.max_identifier_length = 31;
+      gfc_option.warn_ampersand = 1;
+      gfc_option.warn_tabs = 0;
+      break;
+
+    case OPT_std_f2003:
+      gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77 
+	| GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008_OBS;
+      gfc_option.warn_std = GFC_STD_F95_OBS;
+      gfc_option.max_identifier_length = 63;
+      gfc_option.warn_ampersand = 1;
+      gfc_option.warn_tabs = 0;
+      break;
+
+    case OPT_std_f2008:
+      gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77 
+	| GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008 | GFC_STD_F2008_OBS;
+      gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS;
+      gfc_option.max_identifier_length = 63;
+      gfc_option.warn_ampersand = 1;
+      gfc_option.warn_tabs = 0;
+      break;
+
+    case OPT_std_gnu:
+      set_default_std_flags ();
+      break;
+
+    case OPT_std_legacy:
+      set_default_std_flags ();
+      gfc_option.warn_std = 0;
+      break;
+
+    case OPT_Wintrinsics_std:
+      gfc_option.warn_intrinsics_std = value;
+      break;
+
+    case OPT_fshort_enums:
+      /* Handled in language-independent code.  */
+      break;
+
+    case OPT_fconvert_little_endian:
+      gfc_option.convert = GFC_CONVERT_LITTLE;
+      break;
+
+    case OPT_fconvert_big_endian:
+      gfc_option.convert = GFC_CONVERT_BIG;
+      break;
+
+    case OPT_fconvert_native:
+      gfc_option.convert = GFC_CONVERT_NATIVE;
+      break;
+
+    case OPT_fconvert_swap:
+      gfc_option.convert = GFC_CONVERT_SWAP;
+      break;
+
+    case OPT_frecord_marker_4:
+      gfc_option.record_marker = 4;
+      break;
+
+    case OPT_frecord_marker_8:
+      gfc_option.record_marker = 8;
+      break;
+
+    case OPT_fmax_subrecord_length_:
+      if (value > MAX_SUBRECORD_LENGTH)
+	gfc_fatal_error ("Maximum subrecord length cannot exceed %d",
+			 MAX_SUBRECORD_LENGTH);
+
+      gfc_option.max_subrecord_length = value;
+      break;
+
+    case OPT_frecursive:
+      gfc_option.flag_recursive = value;
+      break;
+
+    case OPT_falign_commons:
+      gfc_option.flag_align_commons = value;
+      break;
+
+    case OPT_fprotect_parens:
+      gfc_option.flag_protect_parens = value;
+      break;
+
+    case OPT_frealloc_lhs:
+      gfc_option.flag_realloc_lhs = value;
+      break;
+
+    case OPT_fcheck_:
+      gfc_handle_runtime_check_option (arg);
+      break;
+
+    case OPT_fcoarray_:
+      gfc_handle_coarray_option (arg);
+      break;
+    }
+
+  return result;
+}
+
+
+/* Return a string with the options passed to the compiler; used for
+   Fortran's compiler_options() intrinsic.  */
+
+char *
+gfc_get_option_string (void)
+{
+  unsigned j;
+  size_t len, pos;
+  char *result;
+
+  /* Determine required string length.  */
+
+  len = 0;
+  for (j = 1; j < save_decoded_options_count; j++)
+    {
+      switch (save_decoded_options[j].opt_index)
+        {
+        case OPT_o:
+        case OPT_d:
+        case OPT_dumpbase:
+        case OPT_dumpdir:
+        case OPT_auxbase:
+        case OPT_quiet:
+        case OPT_version:
+        case OPT_fintrinsic_modules_path:
+          /* Ignore these.  */
+          break;
+	default:
+	  /* Ignore file names. */
+	  if (save_decoded_options[j].orig_option_with_args_text[0] == '-')
+	    len += 1
+		 + strlen (save_decoded_options[j].orig_option_with_args_text);
+        }
+    }
+
+  result = (char *) gfc_getmem (len);
+
+  pos = 0; 
+  for (j = 1; j < save_decoded_options_count; j++)
+    {
+      switch (save_decoded_options[j].opt_index)
+        {
+        case OPT_o:
+        case OPT_d:
+        case OPT_dumpbase:
+        case OPT_dumpdir:
+        case OPT_auxbase:
+        case OPT_quiet:
+        case OPT_version:
+        case OPT_fintrinsic_modules_path:
+          /* Ignore these.  */
+	  continue;
+
+        case OPT_cpp_:
+	  /* Use "-cpp" rather than "-cpp=<temporary file>".  */
+	  len = 4;
+	  break;
+
+        default:
+	  /* Ignore file names. */
+	  if (save_decoded_options[j].orig_option_with_args_text[0] != '-')
+	    continue;
+
+	  len = strlen (save_decoded_options[j].orig_option_with_args_text);
+        }
+
+      memcpy (&result[pos], save_decoded_options[j].orig_option_with_args_text, len);
+      pos += len;
+      result[pos++] = ' ';
+    }
+
+  result[--pos] = '\0';
+  return result;
+}
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
new file mode 100644
index 000000000..fd340d430
--- /dev/null
+++ b/gcc/fortran/parse.c
@@ -0,0 +1,4498 @@
+/* Main parser.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2009, 2010, 2011
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include <setjmp.h>
+#include "gfortran.h"
+#include "match.h"
+#include "parse.h"
+#include "debug.h"
+
+/* Current statement label.  Zero means no statement label.  Because new_st
+   can get wiped during statement matching, we have to keep it separate.  */
+
+gfc_st_label *gfc_statement_label;
+
+static locus label_locus;
+static jmp_buf eof_buf;
+
+gfc_state_data *gfc_state_stack;
+
+/* TODO: Re-order functions to kill these forward decls.  */
+static void check_statement_label (gfc_statement);
+static void undo_new_statement (void);
+static void reject_statement (void);
+
+
+/* A sort of half-matching function.  We try to match the word on the
+   input with the passed string.  If this succeeds, we call the
+   keyword-dependent matching function that will match the rest of the
+   statement.  For single keywords, the matching subroutine is
+   gfc_match_eos().  */
+
+static match
+match_word (const char *str, match (*subr) (void), locus *old_locus)
+{
+  match m;
+
+  if (str != NULL)
+    {
+      m = gfc_match (str);
+      if (m != MATCH_YES)
+	return m;
+    }
+
+  m = (*subr) ();
+
+  if (m != MATCH_YES)
+    {
+      gfc_current_locus = *old_locus;
+      reject_statement ();
+    }
+
+  return m;
+}
+
+
+/* Figure out what the next statement is, (mostly) regardless of
+   proper ordering.  The do...while(0) is there to prevent if/else
+   ambiguity.  */
+
+#define match(keyword, subr, st)				\
+    do {							\
+      if (match_word(keyword, subr, &old_locus) == MATCH_YES)	\
+	return st;						\
+      else							\
+	undo_new_statement ();				  \
+    } while (0);
+
+
+/* This is a specialist version of decode_statement that is used
+   for the specification statements in a function, whose
+   characteristics are deferred into the specification statements.
+   eg.:  INTEGER (king = mykind) foo ()
+	 USE mymodule, ONLY mykind..... 
+   The KIND parameter needs a return after USE or IMPORT, whereas
+   derived type declarations can occur anywhere, up the executable
+   block.  ST_GET_FCN_CHARACTERISTICS is returned when we have run
+   out of the correct kind of specification statements.  */
+static gfc_statement
+decode_specification_statement (void)
+{
+  gfc_statement st;
+  locus old_locus;
+  char c;
+
+  if (gfc_match_eos () == MATCH_YES)
+    return ST_NONE;
+
+  old_locus = gfc_current_locus;
+
+  match ("import", gfc_match_import, ST_IMPORT);
+  match ("use", gfc_match_use, ST_USE);
+
+  if (gfc_current_block ()->result->ts.type != BT_DERIVED)
+    goto end_of_block;
+
+  match (NULL, gfc_match_st_function, ST_STATEMENT_FUNCTION);
+  match (NULL, gfc_match_data_decl, ST_DATA_DECL);
+  match (NULL, gfc_match_enumerator_def, ST_ENUMERATOR);
+
+  /* General statement matching: Instead of testing every possible
+     statement, we eliminate most possibilities by peeking at the
+     first character.  */
+
+  c = gfc_peek_ascii_char ();
+
+  switch (c)
+    {
+    case 'a':
+      match ("abstract% interface", gfc_match_abstract_interface,
+	     ST_INTERFACE);
+      match ("allocatable", gfc_match_asynchronous, ST_ATTR_DECL);
+      match ("asynchronous", gfc_match_asynchronous, ST_ATTR_DECL);
+      break;
+
+    case 'b':
+      match (NULL, gfc_match_bind_c_stmt, ST_ATTR_DECL);
+      break;
+
+    case 'c':
+      match ("codimension", gfc_match_codimension, ST_ATTR_DECL);
+      match ("contiguous", gfc_match_contiguous, ST_ATTR_DECL);
+      break;
+
+    case 'd':
+      match ("data", gfc_match_data, ST_DATA);
+      match ("dimension", gfc_match_dimension, ST_ATTR_DECL);
+      break;
+
+    case 'e':
+      match ("enum , bind ( c )", gfc_match_enum, ST_ENUM);
+      match ("entry% ", gfc_match_entry, ST_ENTRY);
+      match ("equivalence", gfc_match_equivalence, ST_EQUIVALENCE);
+      match ("external", gfc_match_external, ST_ATTR_DECL);
+      break;
+
+    case 'f':
+      match ("format", gfc_match_format, ST_FORMAT);
+      break;
+
+    case 'g':
+      break;
+
+    case 'i':
+      match ("implicit", gfc_match_implicit, ST_IMPLICIT);
+      match ("implicit% none", gfc_match_implicit_none, ST_IMPLICIT_NONE);
+      match ("interface", gfc_match_interface, ST_INTERFACE);
+      match ("intent", gfc_match_intent, ST_ATTR_DECL);
+      match ("intrinsic", gfc_match_intrinsic, ST_ATTR_DECL);
+      break;
+
+    case 'm':
+      break;
+
+    case 'n':
+      match ("namelist", gfc_match_namelist, ST_NAMELIST);
+      break;
+
+    case 'o':
+      match ("optional", gfc_match_optional, ST_ATTR_DECL);
+      break;
+
+    case 'p':
+      match ("parameter", gfc_match_parameter, ST_PARAMETER);
+      match ("pointer", gfc_match_pointer, ST_ATTR_DECL);
+      if (gfc_match_private (&st) == MATCH_YES)
+	return st;
+      match ("procedure", gfc_match_procedure, ST_PROCEDURE);
+      if (gfc_match_public (&st) == MATCH_YES)
+	return st;
+      match ("protected", gfc_match_protected, ST_ATTR_DECL);
+      break;
+
+    case 'r':
+      break;
+
+    case 's':
+      match ("save", gfc_match_save, ST_ATTR_DECL);
+      break;
+
+    case 't':
+      match ("target", gfc_match_target, ST_ATTR_DECL);
+      match ("type", gfc_match_derived_decl, ST_DERIVED_DECL);
+      break;
+
+    case 'u':
+      break;
+
+    case 'v':
+      match ("value", gfc_match_value, ST_ATTR_DECL);
+      match ("volatile", gfc_match_volatile, ST_ATTR_DECL);
+      break;
+
+    case 'w':
+      break;
+    }
+
+  /* This is not a specification statement.  See if any of the matchers
+     has stored an error message of some sort.  */
+
+end_of_block:
+  gfc_clear_error ();
+  gfc_buffer_error (0);
+  gfc_current_locus = old_locus;
+
+  return ST_GET_FCN_CHARACTERISTICS;
+}
+
+
+/* This is the primary 'decode_statement'.  */
+static gfc_statement
+decode_statement (void)
+{
+  gfc_statement st;
+  locus old_locus;
+  match m;
+  char c;
+
+  gfc_enforce_clean_symbol_state ();
+
+  gfc_clear_error ();	/* Clear any pending errors.  */
+  gfc_clear_warning ();	/* Clear any pending warnings.  */
+
+  gfc_matching_function = false;
+
+  if (gfc_match_eos () == MATCH_YES)
+    return ST_NONE;
+
+  if (gfc_current_state () == COMP_FUNCTION
+	&& gfc_current_block ()->result->ts.kind == -1)
+    return decode_specification_statement ();
+
+  old_locus = gfc_current_locus;
+
+  /* Try matching a data declaration or function declaration. The
+      input "REALFUNCTIONA(N)" can mean several things in different
+      contexts, so it (and its relatives) get special treatment.  */
+
+  if (gfc_current_state () == COMP_NONE
+      || gfc_current_state () == COMP_INTERFACE
+      || gfc_current_state () == COMP_CONTAINS)
+    {
+      gfc_matching_function = true;
+      m = gfc_match_function_decl ();
+      if (m == MATCH_YES)
+	return ST_FUNCTION;
+      else if (m == MATCH_ERROR)
+	reject_statement ();
+      else 
+	gfc_undo_symbols ();
+      gfc_current_locus = old_locus;
+    }
+  gfc_matching_function = false;
+
+
+  /* Match statements whose error messages are meant to be overwritten
+     by something better.  */
+
+  match (NULL, gfc_match_assignment, ST_ASSIGNMENT);
+  match (NULL, gfc_match_pointer_assignment, ST_POINTER_ASSIGNMENT);
+  match (NULL, gfc_match_st_function, ST_STATEMENT_FUNCTION);
+
+  match (NULL, gfc_match_data_decl, ST_DATA_DECL);
+  match (NULL, gfc_match_enumerator_def, ST_ENUMERATOR);
+
+  /* Try to match a subroutine statement, which has the same optional
+     prefixes that functions can have.  */
+
+  if (gfc_match_subroutine () == MATCH_YES)
+    return ST_SUBROUTINE;
+  gfc_undo_symbols ();
+  gfc_current_locus = old_locus;
+
+  /* Check for the IF, DO, SELECT, WHERE, FORALL, CRITICAL, BLOCK and ASSOCIATE
+     statements, which might begin with a block label.  The match functions for
+     these statements are unusual in that their keyword is not seen before
+     the matcher is called.  */
+
+  if (gfc_match_if (&st) == MATCH_YES)
+    return st;
+  gfc_undo_symbols ();
+  gfc_current_locus = old_locus;
+
+  if (gfc_match_where (&st) == MATCH_YES)
+    return st;
+  gfc_undo_symbols ();
+  gfc_current_locus = old_locus;
+
+  if (gfc_match_forall (&st) == MATCH_YES)
+    return st;
+  gfc_undo_symbols ();
+  gfc_current_locus = old_locus;
+
+  match (NULL, gfc_match_do, ST_DO);
+  match (NULL, gfc_match_block, ST_BLOCK);
+  match (NULL, gfc_match_associate, ST_ASSOCIATE);
+  match (NULL, gfc_match_critical, ST_CRITICAL);
+  match (NULL, gfc_match_select, ST_SELECT_CASE);
+  match (NULL, gfc_match_select_type, ST_SELECT_TYPE);
+
+  /* General statement matching: Instead of testing every possible
+     statement, we eliminate most possibilities by peeking at the
+     first character.  */
+
+  c = gfc_peek_ascii_char ();
+
+  switch (c)
+    {
+    case 'a':
+      match ("abstract% interface", gfc_match_abstract_interface,
+	     ST_INTERFACE);
+      match ("allocate", gfc_match_allocate, ST_ALLOCATE);
+      match ("allocatable", gfc_match_allocatable, ST_ATTR_DECL);
+      match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT);
+      match ("asynchronous", gfc_match_asynchronous, ST_ATTR_DECL);
+      break;
+
+    case 'b':
+      match ("backspace", gfc_match_backspace, ST_BACKSPACE);
+      match ("block data", gfc_match_block_data, ST_BLOCK_DATA);
+      match (NULL, gfc_match_bind_c_stmt, ST_ATTR_DECL);
+      break;
+
+    case 'c':
+      match ("call", gfc_match_call, ST_CALL);
+      match ("close", gfc_match_close, ST_CLOSE);
+      match ("continue", gfc_match_continue, ST_CONTINUE);
+      match ("contiguous", gfc_match_contiguous, ST_ATTR_DECL);
+      match ("cycle", gfc_match_cycle, ST_CYCLE);
+      match ("case", gfc_match_case, ST_CASE);
+      match ("common", gfc_match_common, ST_COMMON);
+      match ("contains", gfc_match_eos, ST_CONTAINS);
+      match ("class", gfc_match_class_is, ST_CLASS_IS);
+      match ("codimension", gfc_match_codimension, ST_ATTR_DECL);
+      break;
+
+    case 'd':
+      match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE);
+      match ("data", gfc_match_data, ST_DATA);
+      match ("dimension", gfc_match_dimension, ST_ATTR_DECL);
+      break;
+
+    case 'e':
+      match ("end file", gfc_match_endfile, ST_END_FILE);
+      match ("exit", gfc_match_exit, ST_EXIT);
+      match ("else", gfc_match_else, ST_ELSE);
+      match ("else where", gfc_match_elsewhere, ST_ELSEWHERE);
+      match ("else if", gfc_match_elseif, ST_ELSEIF);
+      match ("error stop", gfc_match_error_stop, ST_ERROR_STOP);
+      match ("enum , bind ( c )", gfc_match_enum, ST_ENUM);
+
+      if (gfc_match_end (&st) == MATCH_YES)
+	return st;
+
+      match ("entry% ", gfc_match_entry, ST_ENTRY);
+      match ("equivalence", gfc_match_equivalence, ST_EQUIVALENCE);
+      match ("external", gfc_match_external, ST_ATTR_DECL);
+      break;
+
+    case 'f':
+      match ("final", gfc_match_final_decl, ST_FINAL);
+      match ("flush", gfc_match_flush, ST_FLUSH);
+      match ("format", gfc_match_format, ST_FORMAT);
+      break;
+
+    case 'g':
+      match ("generic", gfc_match_generic, ST_GENERIC);
+      match ("go to", gfc_match_goto, ST_GOTO);
+      break;
+
+    case 'i':
+      match ("inquire", gfc_match_inquire, ST_INQUIRE);
+      match ("implicit", gfc_match_implicit, ST_IMPLICIT);
+      match ("implicit% none", gfc_match_implicit_none, ST_IMPLICIT_NONE);
+      match ("import", gfc_match_import, ST_IMPORT);
+      match ("interface", gfc_match_interface, ST_INTERFACE);
+      match ("intent", gfc_match_intent, ST_ATTR_DECL);
+      match ("intrinsic", gfc_match_intrinsic, ST_ATTR_DECL);
+      break;
+
+    case 'm':
+      match ("module% procedure", gfc_match_modproc, ST_MODULE_PROC);
+      match ("module", gfc_match_module, ST_MODULE);
+      break;
+
+    case 'n':
+      match ("nullify", gfc_match_nullify, ST_NULLIFY);
+      match ("namelist", gfc_match_namelist, ST_NAMELIST);
+      break;
+
+    case 'o':
+      match ("open", gfc_match_open, ST_OPEN);
+      match ("optional", gfc_match_optional, ST_ATTR_DECL);
+      break;
+
+    case 'p':
+      match ("print", gfc_match_print, ST_WRITE);
+      match ("parameter", gfc_match_parameter, ST_PARAMETER);
+      match ("pause", gfc_match_pause, ST_PAUSE);
+      match ("pointer", gfc_match_pointer, ST_ATTR_DECL);
+      if (gfc_match_private (&st) == MATCH_YES)
+	return st;
+      match ("procedure", gfc_match_procedure, ST_PROCEDURE);
+      match ("program", gfc_match_program, ST_PROGRAM);
+      if (gfc_match_public (&st) == MATCH_YES)
+	return st;
+      match ("protected", gfc_match_protected, ST_ATTR_DECL);
+      break;
+
+    case 'r':
+      match ("read", gfc_match_read, ST_READ);
+      match ("return", gfc_match_return, ST_RETURN);
+      match ("rewind", gfc_match_rewind, ST_REWIND);
+      break;
+
+    case 's':
+      match ("sequence", gfc_match_eos, ST_SEQUENCE);
+      match ("stop", gfc_match_stop, ST_STOP);
+      match ("save", gfc_match_save, ST_ATTR_DECL);
+      match ("sync all", gfc_match_sync_all, ST_SYNC_ALL);
+      match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
+      match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
+      break;
+
+    case 't':
+      match ("target", gfc_match_target, ST_ATTR_DECL);
+      match ("type", gfc_match_derived_decl, ST_DERIVED_DECL);
+      match ("type is", gfc_match_type_is, ST_TYPE_IS);
+      break;
+
+    case 'u':
+      match ("use", gfc_match_use, ST_USE);
+      break;
+
+    case 'v':
+      match ("value", gfc_match_value, ST_ATTR_DECL);
+      match ("volatile", gfc_match_volatile, ST_ATTR_DECL);
+      break;
+
+    case 'w':
+      match ("wait", gfc_match_wait, ST_WAIT);
+      match ("write", gfc_match_write, ST_WRITE);
+      break;
+    }
+
+  /* All else has failed, so give up.  See if any of the matchers has
+     stored an error message of some sort.  */
+
+  if (gfc_error_check () == 0)
+    gfc_error_now ("Unclassifiable statement at %C");
+
+  reject_statement ();
+
+  gfc_error_recovery ();
+
+  return ST_NONE;
+}
+
+static gfc_statement
+decode_omp_directive (void)
+{
+  locus old_locus;
+  char c;
+
+  gfc_enforce_clean_symbol_state ();
+
+  gfc_clear_error ();	/* Clear any pending errors.  */
+  gfc_clear_warning ();	/* Clear any pending warnings.  */
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error_now ("OpenMP directives at %C may not appear in PURE "
+		     "or ELEMENTAL procedures");
+      gfc_error_recovery ();
+      return ST_NONE;
+    }
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  old_locus = gfc_current_locus;
+
+  /* General OpenMP directive matching: Instead of testing every possible
+     statement, we eliminate most possibilities by peeking at the
+     first character.  */
+
+  c = gfc_peek_ascii_char ();
+
+  switch (c)
+    {
+    case 'a':
+      match ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC);
+      break;
+    case 'b':
+      match ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER);
+      break;
+    case 'c':
+      match ("critical", gfc_match_omp_critical, ST_OMP_CRITICAL);
+      break;
+    case 'd':
+      match ("do", gfc_match_omp_do, ST_OMP_DO);
+      break;
+    case 'e':
+      match ("end critical", gfc_match_omp_critical, ST_OMP_END_CRITICAL);
+      match ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO);
+      match ("end master", gfc_match_omp_eos, ST_OMP_END_MASTER);
+      match ("end ordered", gfc_match_omp_eos, ST_OMP_END_ORDERED);
+      match ("end parallel do", gfc_match_omp_eos, ST_OMP_END_PARALLEL_DO);
+      match ("end parallel sections", gfc_match_omp_eos,
+	     ST_OMP_END_PARALLEL_SECTIONS);
+      match ("end parallel workshare", gfc_match_omp_eos,
+	     ST_OMP_END_PARALLEL_WORKSHARE);
+      match ("end parallel", gfc_match_omp_eos, ST_OMP_END_PARALLEL);
+      match ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS);
+      match ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE);
+      match ("end task", gfc_match_omp_eos, ST_OMP_END_TASK);
+      match ("end workshare", gfc_match_omp_end_nowait,
+	     ST_OMP_END_WORKSHARE);
+      break;
+    case 'f':
+      match ("flush", gfc_match_omp_flush, ST_OMP_FLUSH);
+      break;
+    case 'm':
+      match ("master", gfc_match_omp_master, ST_OMP_MASTER);
+      break;
+    case 'o':
+      match ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED);
+      break;
+    case 'p':
+      match ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO);
+      match ("parallel sections", gfc_match_omp_parallel_sections,
+	     ST_OMP_PARALLEL_SECTIONS);
+      match ("parallel workshare", gfc_match_omp_parallel_workshare,
+	     ST_OMP_PARALLEL_WORKSHARE);
+      match ("parallel", gfc_match_omp_parallel, ST_OMP_PARALLEL);
+      break;
+    case 's':
+      match ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS);
+      match ("section", gfc_match_omp_eos, ST_OMP_SECTION);
+      match ("single", gfc_match_omp_single, ST_OMP_SINGLE);
+      break;
+    case 't':
+      match ("task", gfc_match_omp_task, ST_OMP_TASK);
+      match ("taskwait", gfc_match_omp_taskwait, ST_OMP_TASKWAIT);
+      match ("threadprivate", gfc_match_omp_threadprivate,
+	     ST_OMP_THREADPRIVATE);
+    case 'w':
+      match ("workshare", gfc_match_omp_workshare, ST_OMP_WORKSHARE);
+      break;
+    }
+
+  /* All else has failed, so give up.  See if any of the matchers has
+     stored an error message of some sort.  */
+
+  if (gfc_error_check () == 0)
+    gfc_error_now ("Unclassifiable OpenMP directive at %C");
+
+  reject_statement ();
+
+  gfc_error_recovery ();
+
+  return ST_NONE;
+}
+
+static gfc_statement
+decode_gcc_attribute (void)
+{
+  locus old_locus;
+
+  gfc_enforce_clean_symbol_state ();
+
+  gfc_clear_error ();	/* Clear any pending errors.  */
+  gfc_clear_warning ();	/* Clear any pending warnings.  */
+  old_locus = gfc_current_locus;
+
+  match ("attributes", gfc_match_gcc_attributes, ST_ATTR_DECL);
+
+  /* All else has failed, so give up.  See if any of the matchers has
+     stored an error message of some sort.  */
+
+  if (gfc_error_check () == 0)
+    gfc_error_now ("Unclassifiable GCC directive at %C");
+
+  reject_statement ();
+
+  gfc_error_recovery ();
+
+  return ST_NONE;
+}
+
+#undef match
+
+
+/* Get the next statement in free form source.  */
+
+static gfc_statement
+next_free (void)
+{
+  match m;
+  int i, cnt, at_bol;
+  char c;
+
+  at_bol = gfc_at_bol ();
+  gfc_gobble_whitespace ();
+
+  c = gfc_peek_ascii_char ();
+
+  if (ISDIGIT (c))
+    {
+      char d;
+
+      /* Found a statement label?  */
+      m = gfc_match_st_label (&gfc_statement_label);
+
+      d = gfc_peek_ascii_char ();
+      if (m != MATCH_YES || !gfc_is_whitespace (d))
+	{
+	  gfc_match_small_literal_int (&i, &cnt);
+
+	  if (cnt > 5)
+	    gfc_error_now ("Too many digits in statement label at %C");
+
+	  if (i == 0)
+	    gfc_error_now ("Zero is not a valid statement label at %C");
+
+	  do
+	    c = gfc_next_ascii_char ();
+	  while (ISDIGIT(c));
+
+	  if (!gfc_is_whitespace (c))
+	    gfc_error_now ("Non-numeric character in statement label at %C");
+
+	  return ST_NONE;
+	}
+      else
+	{
+	  label_locus = gfc_current_locus;
+
+	  gfc_gobble_whitespace ();
+
+	  if (at_bol && gfc_peek_ascii_char () == ';')
+	    {
+	      gfc_error_now ("Semicolon at %C needs to be preceded by "
+			     "statement");
+	      gfc_next_ascii_char (); /* Eat up the semicolon.  */
+	      return ST_NONE;
+	    }
+
+	  if (gfc_match_eos () == MATCH_YES)
+	    {
+	      gfc_warning_now ("Ignoring statement label in empty statement "
+			       "at %L", &label_locus);
+	      gfc_free_st_label (gfc_statement_label);
+	      gfc_statement_label = NULL;
+	      return ST_NONE;
+	    }
+	}
+    }
+  else if (c == '!')
+    {
+      /* Comments have already been skipped by the time we get here,
+	 except for GCC attributes and OpenMP directives.  */
+
+      gfc_next_ascii_char (); /* Eat up the exclamation sign.  */
+      c = gfc_peek_ascii_char ();
+
+      if (c == 'g')
+	{
+	  int i;
+
+	  c = gfc_next_ascii_char ();
+	  for (i = 0; i < 4; i++, c = gfc_next_ascii_char ())
+	    gcc_assert (c == "gcc$"[i]);
+
+	  gfc_gobble_whitespace ();
+	  return decode_gcc_attribute ();
+
+	}
+      else if (c == '$' && gfc_option.gfc_flag_openmp)
+	{
+	  int i;
+
+	  c = gfc_next_ascii_char ();
+	  for (i = 0; i < 4; i++, c = gfc_next_ascii_char ())
+	    gcc_assert (c == "$omp"[i]);
+
+	  gcc_assert (c == ' ' || c == '\t');
+	  gfc_gobble_whitespace ();
+	  return decode_omp_directive ();
+	}
+
+      gcc_unreachable (); 
+    }
+ 
+  if (at_bol && c == ';')
+    {
+      if (!(gfc_option.allow_std & GFC_STD_F2008))
+	gfc_error_now ("Fortran 2008: Semicolon at %C without preceding "
+		       "statement");
+      gfc_next_ascii_char (); /* Eat up the semicolon.  */
+      return ST_NONE;
+    }
+
+  return decode_statement ();
+}
+
+
+/* Get the next statement in fixed-form source.  */
+
+static gfc_statement
+next_fixed (void)
+{
+  int label, digit_flag, i;
+  locus loc;
+  gfc_char_t c;
+
+  if (!gfc_at_bol ())
+    return decode_statement ();
+
+  /* Skip past the current label field, parsing a statement label if
+     one is there.  This is a weird number parser, since the number is
+     contained within five columns and can have any kind of embedded
+     spaces.  We also check for characters that make the rest of the
+     line a comment.  */
+
+  label = 0;
+  digit_flag = 0;
+
+  for (i = 0; i < 5; i++)
+    {
+      c = gfc_next_char_literal (NONSTRING);
+
+      switch (c)
+	{
+	case ' ':
+	  break;
+
+	case '0':
+	case '1':
+	case '2':
+	case '3':
+	case '4':
+	case '5':
+	case '6':
+	case '7':
+	case '8':
+	case '9':
+	  label = label * 10 + ((unsigned char) c - '0');
+	  label_locus = gfc_current_locus;
+	  digit_flag = 1;
+	  break;
+
+	  /* Comments have already been skipped by the time we get
+	     here, except for GCC attributes and OpenMP directives.  */
+
+	case '*':
+	  c = gfc_next_char_literal (NONSTRING);
+	  
+	  if (TOLOWER (c) == 'g')
+	    {
+	      for (i = 0; i < 4; i++, c = gfc_next_char_literal (NONSTRING))
+		gcc_assert (TOLOWER (c) == "gcc$"[i]);
+
+	      return decode_gcc_attribute ();
+	    }
+	  else if (c == '$' && gfc_option.gfc_flag_openmp)
+	    {
+	      for (i = 0; i < 4; i++, c = gfc_next_char_literal (NONSTRING))
+		gcc_assert ((char) gfc_wide_tolower (c) == "$omp"[i]);
+
+	      if (c != ' ' && c != '0')
+		{
+		  gfc_buffer_error (0);
+		  gfc_error ("Bad continuation line at %C");
+		  return ST_NONE;
+		}
+
+	      return decode_omp_directive ();
+	    }
+	  /* FALLTHROUGH */
+
+	  /* Comments have already been skipped by the time we get
+	     here so don't bother checking for them.  */
+
+	default:
+	  gfc_buffer_error (0);
+	  gfc_error ("Non-numeric character in statement label at %C");
+	  return ST_NONE;
+	}
+    }
+
+  if (digit_flag)
+    {
+      if (label == 0)
+	gfc_warning_now ("Zero is not a valid statement label at %C");
+      else
+	{
+	  /* We've found a valid statement label.  */
+	  gfc_statement_label = gfc_get_st_label (label);
+	}
+    }
+
+  /* Since this line starts a statement, it cannot be a continuation
+     of a previous statement.  If we see something here besides a
+     space or zero, it must be a bad continuation line.  */
+
+  c = gfc_next_char_literal (NONSTRING);
+  if (c == '\n')
+    goto blank_line;
+
+  if (c != ' ' && c != '0')
+    {
+      gfc_buffer_error (0);
+      gfc_error ("Bad continuation line at %C");
+      return ST_NONE;
+    }
+
+  /* Now that we've taken care of the statement label columns, we have
+     to make sure that the first nonblank character is not a '!'.  If
+     it is, the rest of the line is a comment.  */
+
+  do
+    {
+      loc = gfc_current_locus;
+      c = gfc_next_char_literal (NONSTRING);
+    }
+  while (gfc_is_whitespace (c));
+
+  if (c == '!')
+    goto blank_line;
+  gfc_current_locus = loc;
+
+  if (c == ';')
+    {
+      if (digit_flag)
+	gfc_error_now ("Semicolon at %C needs to be preceded by statement");
+      else if (!(gfc_option.allow_std & GFC_STD_F2008))
+	gfc_error_now ("Fortran 2008: Semicolon at %C without preceding "
+		       "statement");
+      return ST_NONE;
+    }
+
+  if (gfc_match_eos () == MATCH_YES)
+    goto blank_line;
+
+  /* At this point, we've got a nonblank statement to parse.  */
+  return decode_statement ();
+
+blank_line:
+  if (digit_flag)
+    gfc_warning_now ("Ignoring statement label in empty statement at %L",
+		     &label_locus);
+    
+  gfc_current_locus.lb->truncated = 0;
+  gfc_advance_line ();
+  return ST_NONE;
+}
+
+
+/* Return the next non-ST_NONE statement to the caller.  We also worry
+   about including files and the ends of include files at this stage.  */
+
+static gfc_statement
+next_statement (void)
+{
+  gfc_statement st;
+  locus old_locus;
+
+  gfc_enforce_clean_symbol_state ();
+
+  gfc_new_block = NULL;
+
+  gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
+  gfc_current_ns->old_equiv = gfc_current_ns->equiv;
+  for (;;)
+    {
+      gfc_statement_label = NULL;
+      gfc_buffer_error (1);
+
+      if (gfc_at_eol ())
+	gfc_advance_line ();
+
+      gfc_skip_comments ();
+
+      if (gfc_at_end ())
+	{
+	  st = ST_NONE;
+	  break;
+	}
+
+      if (gfc_define_undef_line ())
+	continue;
+
+      old_locus = gfc_current_locus;
+
+      st = (gfc_current_form == FORM_FIXED) ? next_fixed () : next_free ();
+
+      if (st != ST_NONE)
+	break;
+    }
+
+  gfc_buffer_error (0);
+
+  if (st == ST_GET_FCN_CHARACTERISTICS && gfc_statement_label != NULL)
+    {
+      gfc_free_st_label (gfc_statement_label);
+      gfc_statement_label = NULL;
+      gfc_current_locus = old_locus;
+    }
+
+  if (st != ST_NONE)
+    check_statement_label (st);
+
+  return st;
+}
+
+
+/****************************** Parser ***********************************/
+
+/* The parser subroutines are of type 'try' that fail if the file ends
+   unexpectedly.  */
+
+/* Macros that expand to case-labels for various classes of
+   statements.  Start with executable statements that directly do
+   things.  */
+
+#define case_executable case ST_ALLOCATE: case ST_BACKSPACE: case ST_CALL: \
+  case ST_CLOSE: case ST_CONTINUE: case ST_DEALLOCATE: case ST_END_FILE: \
+  case ST_GOTO: case ST_INQUIRE: case ST_NULLIFY: case ST_OPEN: \
+  case ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: \
+  case ST_PAUSE: case ST_STOP: case ST_WAIT: case ST_WRITE: \
+  case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \
+  case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
+  case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
+  case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_ERROR_STOP: \
+  case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY
+
+/* Statements that mark other executable statements.  */
+
+#define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: \
+  case ST_IF_BLOCK: case ST_BLOCK: case ST_ASSOCIATE: \
+  case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_SELECT_TYPE: \
+  case ST_OMP_PARALLEL: \
+  case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \
+  case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
+  case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
+  case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
+  case ST_OMP_TASK: case ST_CRITICAL
+
+/* Declaration statements */
+
+#define case_decl case ST_ATTR_DECL: case ST_COMMON: case ST_DATA_DECL: \
+  case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \
+  case ST_TYPE: case ST_INTERFACE: case ST_OMP_THREADPRIVATE: \
+  case ST_PROCEDURE
+
+/* Block end statements.  Errors associated with interchanging these
+   are detected in gfc_match_end().  */
+
+#define case_end case ST_END_BLOCK_DATA: case ST_END_FUNCTION: \
+		 case ST_END_PROGRAM: case ST_END_SUBROUTINE: \
+		 case ST_END_BLOCK: case ST_END_ASSOCIATE
+
+
+/* Push a new state onto the stack.  */
+
+static void
+push_state (gfc_state_data *p, gfc_compile_state new_state, gfc_symbol *sym)
+{
+  p->state = new_state;
+  p->previous = gfc_state_stack;
+  p->sym = sym;
+  p->head = p->tail = NULL;
+  p->do_variable = NULL;
+
+  /* If this the state of a construct like BLOCK, DO or IF, the corresponding
+     construct statement was accepted right before pushing the state.  Thus,
+     the construct's gfc_code is available as tail of the parent state.  */
+  gcc_assert (gfc_state_stack);
+  p->construct = gfc_state_stack->tail;
+
+  gfc_state_stack = p;
+}
+
+
+/* Pop the current state.  */
+static void
+pop_state (void)
+{
+  gfc_state_stack = gfc_state_stack->previous;
+}
+
+
+/* Try to find the given state in the state stack.  */
+
+gfc_try
+gfc_find_state (gfc_compile_state state)
+{
+  gfc_state_data *p;
+
+  for (p = gfc_state_stack; p; p = p->previous)
+    if (p->state == state)
+      break;
+
+  return (p == NULL) ? FAILURE : SUCCESS;
+}
+
+
+/* Starts a new level in the statement list.  */
+
+static gfc_code *
+new_level (gfc_code *q)
+{
+  gfc_code *p;
+
+  p = q->block = gfc_get_code ();
+
+  gfc_state_stack->head = gfc_state_stack->tail = p;
+
+  return p;
+}
+
+
+/* Add the current new_st code structure and adds it to the current
+   program unit.  As a side-effect, it zeroes the new_st.  */
+
+static gfc_code *
+add_statement (void)
+{
+  gfc_code *p;
+
+  p = gfc_get_code ();
+  *p = new_st;
+
+  p->loc = gfc_current_locus;
+
+  if (gfc_state_stack->head == NULL)
+    gfc_state_stack->head = p;
+  else
+    gfc_state_stack->tail->next = p;
+
+  while (p->next != NULL)
+    p = p->next;
+
+  gfc_state_stack->tail = p;
+
+  gfc_clear_new_st ();
+
+  return p;
+}
+
+
+/* Frees everything associated with the current statement.  */
+
+static void
+undo_new_statement (void)
+{
+  gfc_free_statements (new_st.block);
+  gfc_free_statements (new_st.next);
+  gfc_free_statement (&new_st);
+  gfc_clear_new_st ();
+}
+
+
+/* If the current statement has a statement label, make sure that it
+   is allowed to, or should have one.  */
+
+static void
+check_statement_label (gfc_statement st)
+{
+  gfc_sl_type type;
+
+  if (gfc_statement_label == NULL)
+    {
+      if (st == ST_FORMAT)
+	gfc_error ("FORMAT statement at %L does not have a statement label",
+		   &new_st.loc);
+      return;
+    }
+
+  switch (st)
+    {
+    case ST_END_PROGRAM:
+    case ST_END_FUNCTION:
+    case ST_END_SUBROUTINE:
+    case ST_ENDDO:
+    case ST_ENDIF:
+    case ST_END_SELECT:
+    case ST_END_CRITICAL:
+    case_executable:
+    case_exec_markers:
+      type = ST_LABEL_TARGET;
+      break;
+
+    case ST_FORMAT:
+      type = ST_LABEL_FORMAT;
+      break;
+
+      /* Statement labels are not restricted from appearing on a
+	 particular line.  However, there are plenty of situations
+	 where the resulting label can't be referenced.  */
+
+    default:
+      type = ST_LABEL_BAD_TARGET;
+      break;
+    }
+
+  gfc_define_st_label (gfc_statement_label, type, &label_locus);
+
+  new_st.here = gfc_statement_label;
+}
+
+
+/* Figures out what the enclosing program unit is.  This will be a
+   function, subroutine, program, block data or module.  */
+
+gfc_state_data *
+gfc_enclosing_unit (gfc_compile_state * result)
+{
+  gfc_state_data *p;
+
+  for (p = gfc_state_stack; p; p = p->previous)
+    if (p->state == COMP_FUNCTION || p->state == COMP_SUBROUTINE
+	|| p->state == COMP_MODULE || p->state == COMP_BLOCK_DATA
+	|| p->state == COMP_PROGRAM)
+      {
+
+	if (result != NULL)
+	  *result = p->state;
+	return p;
+      }
+
+  if (result != NULL)
+    *result = COMP_PROGRAM;
+  return NULL;
+}
+
+
+/* Translate a statement enum to a string.  */
+
+const char *
+gfc_ascii_statement (gfc_statement st)
+{
+  const char *p;
+
+  switch (st)
+    {
+    case ST_ARITHMETIC_IF:
+      p = _("arithmetic IF");
+      break;
+    case ST_ALLOCATE:
+      p = "ALLOCATE";
+      break;
+    case ST_ASSOCIATE:
+      p = "ASSOCIATE";
+      break;
+    case ST_ATTR_DECL:
+      p = _("attribute declaration");
+      break;
+    case ST_BACKSPACE:
+      p = "BACKSPACE";
+      break;
+    case ST_BLOCK:
+      p = "BLOCK";
+      break;
+    case ST_BLOCK_DATA:
+      p = "BLOCK DATA";
+      break;
+    case ST_CALL:
+      p = "CALL";
+      break;
+    case ST_CASE:
+      p = "CASE";
+      break;
+    case ST_CLOSE:
+      p = "CLOSE";
+      break;
+    case ST_COMMON:
+      p = "COMMON";
+      break;
+    case ST_CONTINUE:
+      p = "CONTINUE";
+      break;
+    case ST_CONTAINS:
+      p = "CONTAINS";
+      break;
+    case ST_CRITICAL:
+      p = "CRITICAL";
+      break;
+    case ST_CYCLE:
+      p = "CYCLE";
+      break;
+    case ST_DATA_DECL:
+      p = _("data declaration");
+      break;
+    case ST_DATA:
+      p = "DATA";
+      break;
+    case ST_DEALLOCATE:
+      p = "DEALLOCATE";
+      break;
+    case ST_DERIVED_DECL:
+      p = _("derived type declaration");
+      break;
+    case ST_DO:
+      p = "DO";
+      break;
+    case ST_ELSE:
+      p = "ELSE";
+      break;
+    case ST_ELSEIF:
+      p = "ELSE IF";
+      break;
+    case ST_ELSEWHERE:
+      p = "ELSEWHERE";
+      break;
+    case ST_END_ASSOCIATE:
+      p = "END ASSOCIATE";
+      break;
+    case ST_END_BLOCK:
+      p = "END BLOCK";
+      break;
+    case ST_END_BLOCK_DATA:
+      p = "END BLOCK DATA";
+      break;
+    case ST_END_CRITICAL:
+      p = "END CRITICAL";
+      break;
+    case ST_ENDDO:
+      p = "END DO";
+      break;
+    case ST_END_FILE:
+      p = "END FILE";
+      break;
+    case ST_END_FORALL:
+      p = "END FORALL";
+      break;
+    case ST_END_FUNCTION:
+      p = "END FUNCTION";
+      break;
+    case ST_ENDIF:
+      p = "END IF";
+      break;
+    case ST_END_INTERFACE:
+      p = "END INTERFACE";
+      break;
+    case ST_END_MODULE:
+      p = "END MODULE";
+      break;
+    case ST_END_PROGRAM:
+      p = "END PROGRAM";
+      break;
+    case ST_END_SELECT:
+      p = "END SELECT";
+      break;
+    case ST_END_SUBROUTINE:
+      p = "END SUBROUTINE";
+      break;
+    case ST_END_WHERE:
+      p = "END WHERE";
+      break;
+    case ST_END_TYPE:
+      p = "END TYPE";
+      break;
+    case ST_ENTRY:
+      p = "ENTRY";
+      break;
+    case ST_EQUIVALENCE:
+      p = "EQUIVALENCE";
+      break;
+    case ST_ERROR_STOP:
+      p = "ERROR STOP";
+      break;
+    case ST_EXIT:
+      p = "EXIT";
+      break;
+    case ST_FLUSH:
+      p = "FLUSH";
+      break;
+    case ST_FORALL_BLOCK:	/* Fall through */
+    case ST_FORALL:
+      p = "FORALL";
+      break;
+    case ST_FORMAT:
+      p = "FORMAT";
+      break;
+    case ST_FUNCTION:
+      p = "FUNCTION";
+      break;
+    case ST_GENERIC:
+      p = "GENERIC";
+      break;
+    case ST_GOTO:
+      p = "GOTO";
+      break;
+    case ST_IF_BLOCK:
+      p = _("block IF");
+      break;
+    case ST_IMPLICIT:
+      p = "IMPLICIT";
+      break;
+    case ST_IMPLICIT_NONE:
+      p = "IMPLICIT NONE";
+      break;
+    case ST_IMPLIED_ENDDO:
+      p = _("implied END DO");
+      break;
+    case ST_IMPORT:
+      p = "IMPORT";
+      break;
+    case ST_INQUIRE:
+      p = "INQUIRE";
+      break;
+    case ST_INTERFACE:
+      p = "INTERFACE";
+      break;
+    case ST_PARAMETER:
+      p = "PARAMETER";
+      break;
+    case ST_PRIVATE:
+      p = "PRIVATE";
+      break;
+    case ST_PUBLIC:
+      p = "PUBLIC";
+      break;
+    case ST_MODULE:
+      p = "MODULE";
+      break;
+    case ST_PAUSE:
+      p = "PAUSE";
+      break;
+    case ST_MODULE_PROC:
+      p = "MODULE PROCEDURE";
+      break;
+    case ST_NAMELIST:
+      p = "NAMELIST";
+      break;
+    case ST_NULLIFY:
+      p = "NULLIFY";
+      break;
+    case ST_OPEN:
+      p = "OPEN";
+      break;
+    case ST_PROGRAM:
+      p = "PROGRAM";
+      break;
+    case ST_PROCEDURE:
+      p = "PROCEDURE";
+      break;
+    case ST_READ:
+      p = "READ";
+      break;
+    case ST_RETURN:
+      p = "RETURN";
+      break;
+    case ST_REWIND:
+      p = "REWIND";
+      break;
+    case ST_STOP:
+      p = "STOP";
+      break;
+    case ST_SYNC_ALL:
+      p = "SYNC ALL";
+      break;
+    case ST_SYNC_IMAGES:
+      p = "SYNC IMAGES";
+      break;
+    case ST_SYNC_MEMORY:
+      p = "SYNC MEMORY";
+      break;
+    case ST_SUBROUTINE:
+      p = "SUBROUTINE";
+      break;
+    case ST_TYPE:
+      p = "TYPE";
+      break;
+    case ST_USE:
+      p = "USE";
+      break;
+    case ST_WHERE_BLOCK:	/* Fall through */
+    case ST_WHERE:
+      p = "WHERE";
+      break;
+    case ST_WAIT:
+      p = "WAIT";
+      break;
+    case ST_WRITE:
+      p = "WRITE";
+      break;
+    case ST_ASSIGNMENT:
+      p = _("assignment");
+      break;
+    case ST_POINTER_ASSIGNMENT:
+      p = _("pointer assignment");
+      break;
+    case ST_SELECT_CASE:
+      p = "SELECT CASE";
+      break;
+    case ST_SELECT_TYPE:
+      p = "SELECT TYPE";
+      break;
+    case ST_TYPE_IS:
+      p = "TYPE IS";
+      break;
+    case ST_CLASS_IS:
+      p = "CLASS IS";
+      break;
+    case ST_SEQUENCE:
+      p = "SEQUENCE";
+      break;
+    case ST_SIMPLE_IF:
+      p = _("simple IF");
+      break;
+    case ST_STATEMENT_FUNCTION:
+      p = "STATEMENT FUNCTION";
+      break;
+    case ST_LABEL_ASSIGNMENT:
+      p = "LABEL ASSIGNMENT";
+      break;
+    case ST_ENUM:
+      p = "ENUM DEFINITION";
+      break;
+    case ST_ENUMERATOR:
+      p = "ENUMERATOR DEFINITION";
+      break;
+    case ST_END_ENUM:
+      p = "END ENUM";
+      break;
+    case ST_OMP_ATOMIC:
+      p = "!$OMP ATOMIC";
+      break;
+    case ST_OMP_BARRIER:
+      p = "!$OMP BARRIER";
+      break;
+    case ST_OMP_CRITICAL:
+      p = "!$OMP CRITICAL";
+      break;
+    case ST_OMP_DO:
+      p = "!$OMP DO";
+      break;
+    case ST_OMP_END_CRITICAL:
+      p = "!$OMP END CRITICAL";
+      break;
+    case ST_OMP_END_DO:
+      p = "!$OMP END DO";
+      break;
+    case ST_OMP_END_MASTER:
+      p = "!$OMP END MASTER";
+      break;
+    case ST_OMP_END_ORDERED:
+      p = "!$OMP END ORDERED";
+      break;
+    case ST_OMP_END_PARALLEL:
+      p = "!$OMP END PARALLEL";
+      break;
+    case ST_OMP_END_PARALLEL_DO:
+      p = "!$OMP END PARALLEL DO";
+      break;
+    case ST_OMP_END_PARALLEL_SECTIONS:
+      p = "!$OMP END PARALLEL SECTIONS";
+      break;
+    case ST_OMP_END_PARALLEL_WORKSHARE:
+      p = "!$OMP END PARALLEL WORKSHARE";
+      break;
+    case ST_OMP_END_SECTIONS:
+      p = "!$OMP END SECTIONS";
+      break;
+    case ST_OMP_END_SINGLE:
+      p = "!$OMP END SINGLE";
+      break;
+    case ST_OMP_END_TASK:
+      p = "!$OMP END TASK";
+      break;
+    case ST_OMP_END_WORKSHARE:
+      p = "!$OMP END WORKSHARE";
+      break;
+    case ST_OMP_FLUSH:
+      p = "!$OMP FLUSH";
+      break;
+    case ST_OMP_MASTER:
+      p = "!$OMP MASTER";
+      break;
+    case ST_OMP_ORDERED:
+      p = "!$OMP ORDERED";
+      break;
+    case ST_OMP_PARALLEL:
+      p = "!$OMP PARALLEL";
+      break;
+    case ST_OMP_PARALLEL_DO:
+      p = "!$OMP PARALLEL DO";
+      break;
+    case ST_OMP_PARALLEL_SECTIONS:
+      p = "!$OMP PARALLEL SECTIONS";
+      break;
+    case ST_OMP_PARALLEL_WORKSHARE:
+      p = "!$OMP PARALLEL WORKSHARE";
+      break;
+    case ST_OMP_SECTIONS:
+      p = "!$OMP SECTIONS";
+      break;
+    case ST_OMP_SECTION:
+      p = "!$OMP SECTION";
+      break;
+    case ST_OMP_SINGLE:
+      p = "!$OMP SINGLE";
+      break;
+    case ST_OMP_TASK:
+      p = "!$OMP TASK";
+      break;
+    case ST_OMP_TASKWAIT:
+      p = "!$OMP TASKWAIT";
+      break;
+    case ST_OMP_THREADPRIVATE:
+      p = "!$OMP THREADPRIVATE";
+      break;
+    case ST_OMP_WORKSHARE:
+      p = "!$OMP WORKSHARE";
+      break;
+    default:
+      gfc_internal_error ("gfc_ascii_statement(): Bad statement code");
+    }
+
+  return p;
+}
+
+
+/* Create a symbol for the main program and assign it to ns->proc_name.  */
+ 
+static void 
+main_program_symbol (gfc_namespace *ns, const char *name)
+{
+  gfc_symbol *main_program;
+  symbol_attribute attr;
+
+  gfc_get_symbol (name, ns, &main_program);
+  gfc_clear_attr (&attr);
+  attr.flavor = FL_PROGRAM;
+  attr.proc = PROC_UNKNOWN;
+  attr.subroutine = 1;
+  attr.access = ACCESS_PUBLIC;
+  attr.is_main_program = 1;
+  main_program->attr = attr;
+  main_program->declared_at = gfc_current_locus;
+  ns->proc_name = main_program;
+  gfc_commit_symbols ();
+}
+
+
+/* Do whatever is necessary to accept the last statement.  */
+
+static void
+accept_statement (gfc_statement st)
+{
+  switch (st)
+    {
+    case ST_USE:
+      gfc_use_module ();
+      break;
+
+    case ST_IMPLICIT_NONE:
+      gfc_set_implicit_none ();
+      break;
+
+    case ST_IMPLICIT:
+      break;
+
+    case ST_FUNCTION:
+    case ST_SUBROUTINE:
+    case ST_MODULE:
+      gfc_current_ns->proc_name = gfc_new_block;
+      break;
+
+      /* If the statement is the end of a block, lay down a special code
+	 that allows a branch to the end of the block from within the
+	 construct.  IF and SELECT are treated differently from DO
+	 (where EXEC_NOP is added inside the loop) for two
+	 reasons:
+         1. END DO has a meaning in the sense that after a GOTO to
+	    it, the loop counter must be increased.
+         2. IF blocks and SELECT blocks can consist of multiple
+	    parallel blocks (IF ... ELSE IF ... ELSE ... END IF).
+	    Putting the label before the END IF would make the jump
+	    from, say, the ELSE IF block to the END IF illegal.  */
+
+    case ST_ENDIF:
+    case ST_END_SELECT:
+    case ST_END_CRITICAL:
+      if (gfc_statement_label != NULL)
+	{
+	  new_st.op = EXEC_END_BLOCK;
+	  add_statement ();
+	}
+      break;
+
+      /* The end-of-program unit statements do not get the special
+	 marker and require a statement of some sort if they are a
+	 branch target.  */
+
+    case ST_END_PROGRAM:
+    case ST_END_FUNCTION:
+    case ST_END_SUBROUTINE:
+      if (gfc_statement_label != NULL)
+	{
+	  new_st.op = EXEC_RETURN;
+	  add_statement ();
+	}
+      else
+	{
+	  new_st.op = EXEC_END_PROCEDURE;
+	  add_statement ();
+	}
+
+      break;
+
+    case ST_ENTRY:
+    case_executable:
+    case_exec_markers:
+      add_statement ();
+      break;
+
+    default:
+      break;
+    }
+
+  gfc_commit_symbols ();
+  gfc_warning_check ();
+  gfc_clear_new_st ();
+}
+
+
+/* Undo anything tentative that has been built for the current
+   statement.  */
+
+static void
+reject_statement (void)
+{
+  /* Revert to the previous charlen chain.  */
+  gfc_free_charlen (gfc_current_ns->cl_list, gfc_current_ns->old_cl_list);
+  gfc_current_ns->cl_list = gfc_current_ns->old_cl_list;
+
+  gfc_free_equiv_until (gfc_current_ns->equiv, gfc_current_ns->old_equiv);
+  gfc_current_ns->equiv = gfc_current_ns->old_equiv;
+
+  gfc_new_block = NULL;
+  gfc_undo_symbols ();
+  gfc_clear_warning ();
+  undo_new_statement ();
+}
+
+
+/* Generic complaint about an out of order statement.  We also do
+   whatever is necessary to clean up.  */
+
+static void
+unexpected_statement (gfc_statement st)
+{
+  gfc_error ("Unexpected %s statement at %C", gfc_ascii_statement (st));
+
+  reject_statement ();
+}
+
+
+/* Given the next statement seen by the matcher, make sure that it is
+   in proper order with the last.  This subroutine is initialized by
+   calling it with an argument of ST_NONE.  If there is a problem, we
+   issue an error and return FAILURE.  Otherwise we return SUCCESS.
+
+   Individual parsers need to verify that the statements seen are
+   valid before calling here, i.e., ENTRY statements are not allowed in
+   INTERFACE blocks.  The following diagram is taken from the standard:
+
+	    +---------------------------------------+
+	    | program  subroutine  function  module |
+	    +---------------------------------------+
+	    |		 use		   |
+	    +---------------------------------------+
+	    |		 import		|
+	    +---------------------------------------+
+	    |	|	implicit none	 |
+	    |	+-----------+------------------+
+	    |	| parameter |  implicit	|
+	    |	+-----------+------------------+
+	    | format |	   |  derived type    |
+	    | entry  | parameter |  interface       |
+	    |	|   data    |  specification   |
+	    |	|	   |  statement func  |
+	    |	+-----------+------------------+
+	    |	|   data    |    executable    |
+	    +--------+-----------+------------------+
+	    |		contains	       |
+	    +---------------------------------------+
+	    |      internal module/subprogram       |
+	    +---------------------------------------+
+	    |		   end		 |
+	    +---------------------------------------+
+
+*/
+
+enum state_order
+{
+  ORDER_START,
+  ORDER_USE,
+  ORDER_IMPORT,
+  ORDER_IMPLICIT_NONE,
+  ORDER_IMPLICIT,
+  ORDER_SPEC,
+  ORDER_EXEC
+};
+
+typedef struct
+{
+  enum state_order state;
+  gfc_statement last_statement;
+  locus where;
+}
+st_state;
+
+static gfc_try
+verify_st_order (st_state *p, gfc_statement st, bool silent)
+{
+
+  switch (st)
+    {
+    case ST_NONE:
+      p->state = ORDER_START;
+      break;
+
+    case ST_USE:
+      if (p->state > ORDER_USE)
+	goto order;
+      p->state = ORDER_USE;
+      break;
+
+    case ST_IMPORT:
+      if (p->state > ORDER_IMPORT)
+	goto order;
+      p->state = ORDER_IMPORT;
+      break;
+
+    case ST_IMPLICIT_NONE:
+      if (p->state > ORDER_IMPLICIT_NONE)
+	goto order;
+
+      /* The '>' sign cannot be a '>=', because a FORMAT or ENTRY
+	 statement disqualifies a USE but not an IMPLICIT NONE.
+	 Duplicate IMPLICIT NONEs are caught when the implicit types
+	 are set.  */
+
+      p->state = ORDER_IMPLICIT_NONE;
+      break;
+
+    case ST_IMPLICIT:
+      if (p->state > ORDER_IMPLICIT)
+	goto order;
+      p->state = ORDER_IMPLICIT;
+      break;
+
+    case ST_FORMAT:
+    case ST_ENTRY:
+      if (p->state < ORDER_IMPLICIT_NONE)
+	p->state = ORDER_IMPLICIT_NONE;
+      break;
+
+    case ST_PARAMETER:
+      if (p->state >= ORDER_EXEC)
+	goto order;
+      if (p->state < ORDER_IMPLICIT)
+	p->state = ORDER_IMPLICIT;
+      break;
+
+    case ST_DATA:
+      if (p->state < ORDER_SPEC)
+	p->state = ORDER_SPEC;
+      break;
+
+    case ST_PUBLIC:
+    case ST_PRIVATE:
+    case ST_DERIVED_DECL:
+    case_decl:
+      if (p->state >= ORDER_EXEC)
+	goto order;
+      if (p->state < ORDER_SPEC)
+	p->state = ORDER_SPEC;
+      break;
+
+    case_executable:
+    case_exec_markers:
+      if (p->state < ORDER_EXEC)
+	p->state = ORDER_EXEC;
+      break;
+
+    default:
+      gfc_internal_error ("Unexpected %s statement in verify_st_order() at %C",
+			  gfc_ascii_statement (st));
+    }
+
+  /* All is well, record the statement in case we need it next time.  */
+  p->where = gfc_current_locus;
+  p->last_statement = st;
+  return SUCCESS;
+
+order:
+  if (!silent)
+    gfc_error ("%s statement at %C cannot follow %s statement at %L",
+	       gfc_ascii_statement (st),
+	       gfc_ascii_statement (p->last_statement), &p->where);
+
+  return FAILURE;
+}
+
+
+/* Handle an unexpected end of file.  This is a show-stopper...  */
+
+static void unexpected_eof (void) ATTRIBUTE_NORETURN;
+
+static void
+unexpected_eof (void)
+{
+  gfc_state_data *p;
+
+  gfc_error ("Unexpected end of file in '%s'", gfc_source_file);
+
+  /* Memory cleanup.  Move to "second to last".  */
+  for (p = gfc_state_stack; p && p->previous && p->previous->previous;
+       p = p->previous);
+
+  gfc_current_ns->code = (p && p->previous) ? p->head : NULL;
+  gfc_done_2 ();
+
+  longjmp (eof_buf, 1);
+}
+
+
+/* Parse the CONTAINS section of a derived type definition.  */
+
+gfc_access gfc_typebound_default_access;
+
+static bool
+parse_derived_contains (void)
+{
+  gfc_state_data s;
+  bool seen_private = false;
+  bool seen_comps = false;
+  bool error_flag = false;
+  bool to_finish;
+
+  gcc_assert (gfc_current_state () == COMP_DERIVED);
+  gcc_assert (gfc_current_block ());
+
+  /* Derived-types with SEQUENCE and/or BIND(C) must not have a CONTAINS
+     section.  */
+  if (gfc_current_block ()->attr.sequence)
+    gfc_error ("Derived-type '%s' with SEQUENCE must not have a CONTAINS"
+	       " section at %C", gfc_current_block ()->name);
+  if (gfc_current_block ()->attr.is_bind_c)
+    gfc_error ("Derived-type '%s' with BIND(C) must not have a CONTAINS"
+	       " section at %C", gfc_current_block ()->name);
+
+  accept_statement (ST_CONTAINS);
+  push_state (&s, COMP_DERIVED_CONTAINS, NULL);
+
+  gfc_typebound_default_access = ACCESS_PUBLIC;
+
+  to_finish = false;
+  while (!to_finish)
+    {
+      gfc_statement st;
+      st = next_statement ();
+      switch (st)
+	{
+	case ST_NONE:
+	  unexpected_eof ();
+	  break;
+
+	case ST_DATA_DECL:
+	  gfc_error ("Components in TYPE at %C must precede CONTAINS");
+	  goto error;
+
+	case ST_PROCEDURE:
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003:  Type-bound"
+					     " procedure at %C") == FAILURE)
+	    goto error;
+
+	  accept_statement (ST_PROCEDURE);
+	  seen_comps = true;
+	  break;
+
+	case ST_GENERIC:
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003:  GENERIC binding"
+					     " at %C") == FAILURE)
+	    goto error;
+
+	  accept_statement (ST_GENERIC);
+	  seen_comps = true;
+	  break;
+
+	case ST_FINAL:
+	  if (gfc_notify_std (GFC_STD_F2003,
+			      "Fortran 2003:  FINAL procedure declaration"
+			      " at %C") == FAILURE)
+	    goto error;
+
+	  accept_statement (ST_FINAL);
+	  seen_comps = true;
+	  break;
+
+	case ST_END_TYPE:
+	  to_finish = true;
+
+	  if (!seen_comps
+	      && (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type "
+				  "definition at %C with empty CONTAINS "
+				  "section") == FAILURE))
+	    goto error;
+
+	  /* ST_END_TYPE is accepted by parse_derived after return.  */
+	  break;
+
+	case ST_PRIVATE:
+	  if (gfc_find_state (COMP_MODULE) == FAILURE)
+	    {
+	      gfc_error ("PRIVATE statement in TYPE at %C must be inside "
+			 "a MODULE");
+	      goto error;
+	    }
+
+	  if (seen_comps)
+	    {
+	      gfc_error ("PRIVATE statement at %C must precede procedure"
+			 " bindings");
+	      goto error;
+	    }
+
+	  if (seen_private)
+	    {
+	      gfc_error ("Duplicate PRIVATE statement at %C");
+	      goto error;
+	    }
+
+	  accept_statement (ST_PRIVATE);
+	  gfc_typebound_default_access = ACCESS_PRIVATE;
+	  seen_private = true;
+	  break;
+
+	case ST_SEQUENCE:
+	  gfc_error ("SEQUENCE statement at %C must precede CONTAINS");
+	  goto error;
+
+	case ST_CONTAINS:
+	  gfc_error ("Already inside a CONTAINS block at %C");
+	  goto error;
+
+	default:
+	  unexpected_statement (st);
+	  break;
+	}
+
+      continue;
+
+error:
+      error_flag = true;
+      reject_statement ();
+    }
+
+  pop_state ();
+  gcc_assert (gfc_current_state () == COMP_DERIVED);
+
+  return error_flag;
+}
+
+
+/* Parse a derived type.  */
+
+static void
+parse_derived (void)
+{
+  int compiling_type, seen_private, seen_sequence, seen_component;
+  gfc_statement st;
+  gfc_state_data s;
+  gfc_symbol *sym;
+  gfc_component *c;
+
+  accept_statement (ST_DERIVED_DECL);
+  push_state (&s, COMP_DERIVED, gfc_new_block);
+
+  gfc_new_block->component_access = ACCESS_PUBLIC;
+  seen_private = 0;
+  seen_sequence = 0;
+  seen_component = 0;
+
+  compiling_type = 1;
+
+  while (compiling_type)
+    {
+      st = next_statement ();
+      switch (st)
+	{
+	case ST_NONE:
+	  unexpected_eof ();
+
+	case ST_DATA_DECL:
+	case ST_PROCEDURE:
+	  accept_statement (st);
+	  seen_component = 1;
+	  break;
+
+	case ST_FINAL:
+	  gfc_error ("FINAL declaration at %C must be inside CONTAINS");
+	  break;
+
+	case ST_END_TYPE:
+endType:
+	  compiling_type = 0;
+
+	  if (!seen_component)
+	    gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Derived type "
+			    "definition at %C without components");
+
+	  accept_statement (ST_END_TYPE);
+	  break;
+
+	case ST_PRIVATE:
+	  if (gfc_find_state (COMP_MODULE) == FAILURE)
+	    {
+	      gfc_error ("PRIVATE statement in TYPE at %C must be inside "
+			 "a MODULE");
+	      break;
+	    }
+
+	  if (seen_component)
+	    {
+	      gfc_error ("PRIVATE statement at %C must precede "
+			 "structure components");
+	      break;
+	    }
+
+	  if (seen_private)
+	    gfc_error ("Duplicate PRIVATE statement at %C");
+
+	  s.sym->component_access = ACCESS_PRIVATE;
+
+	  accept_statement (ST_PRIVATE);
+	  seen_private = 1;
+	  break;
+
+	case ST_SEQUENCE:
+	  if (seen_component)
+	    {
+	      gfc_error ("SEQUENCE statement at %C must precede "
+			 "structure components");
+	      break;
+	    }
+
+	  if (gfc_current_block ()->attr.sequence)
+	    gfc_warning ("SEQUENCE attribute at %C already specified in "
+			 "TYPE statement");
+
+	  if (seen_sequence)
+	    {
+	      gfc_error ("Duplicate SEQUENCE statement at %C");
+	    }
+
+	  seen_sequence = 1;
+	  gfc_add_sequence (&gfc_current_block ()->attr, 
+			    gfc_current_block ()->name, NULL);
+	  break;
+
+	case ST_CONTAINS:
+	  gfc_notify_std (GFC_STD_F2003,
+			  "Fortran 2003:  CONTAINS block in derived type"
+			  " definition at %C");
+
+	  accept_statement (ST_CONTAINS);
+	  parse_derived_contains ();
+	  goto endType;
+
+	default:
+	  unexpected_statement (st);
+	  break;
+	}
+    }
+
+  /* need to verify that all fields of the derived type are
+   * interoperable with C if the type is declared to be bind(c)
+   */
+  sym = gfc_current_block ();
+  for (c = sym->components; c; c = c->next)
+    {
+      /* Look for allocatable components.  */
+      if (c->attr.allocatable
+	  || (c->ts.type == BT_CLASS && c->attr.class_ok
+	      && CLASS_DATA (c)->attr.allocatable)
+	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.alloc_comp))
+	sym->attr.alloc_comp = 1;
+
+      /* Look for pointer components.  */
+      if (c->attr.pointer
+	  || (c->ts.type == BT_CLASS && c->attr.class_ok
+	      && CLASS_DATA (c)->attr.class_pointer)
+	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pointer_comp))
+	sym->attr.pointer_comp = 1;
+
+      /* Look for procedure pointer components.  */
+      if (c->attr.proc_pointer
+	  || (c->ts.type == BT_DERIVED
+	      && c->ts.u.derived->attr.proc_pointer_comp))
+	sym->attr.proc_pointer_comp = 1;
+
+      /* Looking for coarray components.  */
+      if (c->attr.codimension
+	  || (c->attr.coarray_comp && !c->attr.pointer && !c->attr.allocatable))
+	sym->attr.coarray_comp = 1;
+
+      /* Look for private components.  */
+      if (sym->component_access == ACCESS_PRIVATE
+	  || c->attr.access == ACCESS_PRIVATE
+	  || (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.private_comp))
+	sym->attr.private_comp = 1;
+    }
+
+  if (!seen_component)
+    sym->attr.zero_comp = 1;
+
+  pop_state ();
+}
+
+
+/* Parse an ENUM.  */
+ 
+static void
+parse_enum (void)
+{
+  gfc_statement st;
+  int compiling_enum;
+  gfc_state_data s;
+  int seen_enumerator = 0;
+
+  push_state (&s, COMP_ENUM, gfc_new_block);
+
+  compiling_enum = 1;
+
+  while (compiling_enum)
+    {
+      st = next_statement ();
+      switch (st)
+	{
+	case ST_NONE:
+	  unexpected_eof ();
+	  break;
+
+	case ST_ENUMERATOR:
+	  seen_enumerator = 1;
+	  accept_statement (st);
+	  break;
+
+	case ST_END_ENUM:
+	  compiling_enum = 0;
+	  if (!seen_enumerator)
+	    gfc_error ("ENUM declaration at %C has no ENUMERATORS");
+	  accept_statement (st);
+	  break;
+
+	default:
+	  gfc_free_enum_history ();
+	  unexpected_statement (st);
+	  break;
+	}
+    }
+  pop_state ();
+}
+
+
+/* Parse an interface.  We must be able to deal with the possibility
+   of recursive interfaces.  The parse_spec() subroutine is mutually
+   recursive with parse_interface().  */
+
+static gfc_statement parse_spec (gfc_statement);
+
+static void
+parse_interface (void)
+{
+  gfc_compile_state new_state = COMP_NONE, current_state;
+  gfc_symbol *prog_unit, *sym;
+  gfc_interface_info save;
+  gfc_state_data s1, s2;
+  gfc_statement st;
+  locus proc_locus;
+
+  accept_statement (ST_INTERFACE);
+
+  current_interface.ns = gfc_current_ns;
+  save = current_interface;
+
+  sym = (current_interface.type == INTERFACE_GENERIC
+	 || current_interface.type == INTERFACE_USER_OP)
+	? gfc_new_block : NULL;
+
+  push_state (&s1, COMP_INTERFACE, sym);
+  current_state = COMP_NONE;
+
+loop:
+  gfc_current_ns = gfc_get_namespace (current_interface.ns, 0);
+
+  st = next_statement ();
+  switch (st)
+    {
+    case ST_NONE:
+      unexpected_eof ();
+
+    case ST_SUBROUTINE:
+    case ST_FUNCTION:
+      if (st == ST_SUBROUTINE)
+	new_state = COMP_SUBROUTINE;
+      else if (st == ST_FUNCTION)
+	new_state = COMP_FUNCTION;
+      if (gfc_new_block->attr.pointer)
+	{
+	  gfc_new_block->attr.pointer = 0;
+	  gfc_new_block->attr.proc_pointer = 1;
+	}
+      if (gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
+				  gfc_new_block->formal, NULL) == FAILURE)
+	{
+	  reject_statement ();
+	  gfc_free_namespace (gfc_current_ns);
+	  goto loop;
+	}
+      break;
+
+    case ST_PROCEDURE:
+    case ST_MODULE_PROC:	/* The module procedure matcher makes
+				   sure the context is correct.  */
+      accept_statement (st);
+      gfc_free_namespace (gfc_current_ns);
+      goto loop;
+
+    case ST_END_INTERFACE:
+      gfc_free_namespace (gfc_current_ns);
+      gfc_current_ns = current_interface.ns;
+      goto done;
+
+    default:
+      gfc_error ("Unexpected %s statement in INTERFACE block at %C",
+		 gfc_ascii_statement (st));
+      reject_statement ();
+      gfc_free_namespace (gfc_current_ns);
+      goto loop;
+    }
+
+
+  /* Make sure that the generic name has the right attribute.  */
+  if (current_interface.type == INTERFACE_GENERIC
+      && current_state == COMP_NONE)
+    {
+      if (new_state == COMP_FUNCTION && sym)
+	gfc_add_function (&sym->attr, sym->name, NULL);
+      else if (new_state == COMP_SUBROUTINE && sym)
+	gfc_add_subroutine (&sym->attr, sym->name, NULL);
+
+      current_state = new_state;
+    }
+
+  if (current_interface.type == INTERFACE_ABSTRACT)
+    {
+      gfc_add_abstract (&gfc_new_block->attr, &gfc_current_locus);
+      if (gfc_is_intrinsic_typename (gfc_new_block->name))
+	gfc_error ("Name '%s' of ABSTRACT INTERFACE at %C "
+		   "cannot be the same as an intrinsic type",
+		   gfc_new_block->name);
+    }
+
+  push_state (&s2, new_state, gfc_new_block);
+  accept_statement (st);
+  prog_unit = gfc_new_block;
+  prog_unit->formal_ns = gfc_current_ns;
+  proc_locus = gfc_current_locus;
+
+decl:
+  /* Read data declaration statements.  */
+  st = parse_spec (ST_NONE);
+
+  /* Since the interface block does not permit an IMPLICIT statement,
+     the default type for the function or the result must be taken
+     from the formal namespace.  */
+  if (new_state == COMP_FUNCTION)
+    {
+	if (prog_unit->result == prog_unit
+	      && prog_unit->ts.type == BT_UNKNOWN)
+	  gfc_set_default_type (prog_unit, 1, prog_unit->formal_ns);
+	else if (prog_unit->result != prog_unit
+		   && prog_unit->result->ts.type == BT_UNKNOWN)
+	  gfc_set_default_type (prog_unit->result, 1,
+				prog_unit->formal_ns);
+    }
+
+  if (st != ST_END_SUBROUTINE && st != ST_END_FUNCTION)
+    {
+      gfc_error ("Unexpected %s statement at %C in INTERFACE body",
+		 gfc_ascii_statement (st));
+      reject_statement ();
+      goto decl;
+    }
+
+  /* Add EXTERNAL attribute to function or subroutine.  */
+  if (current_interface.type != INTERFACE_ABSTRACT && !prog_unit->attr.dummy)
+    gfc_add_external (&prog_unit->attr, &gfc_current_locus);
+
+  current_interface = save;
+  gfc_add_interface (prog_unit);
+  pop_state ();
+
+  if (current_interface.ns
+	&& current_interface.ns->proc_name
+	&& strcmp (current_interface.ns->proc_name->name,
+		   prog_unit->name) == 0)
+    gfc_error ("INTERFACE procedure '%s' at %L has the same name as the "
+	       "enclosing procedure", prog_unit->name, &proc_locus);
+
+  goto loop;
+
+done:
+  pop_state ();
+}
+
+
+/* Associate function characteristics by going back to the function
+   declaration and rematching the prefix.  */
+
+static match
+match_deferred_characteristics (gfc_typespec * ts)
+{
+  locus loc;
+  match m = MATCH_ERROR;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+
+  loc = gfc_current_locus;
+
+  gfc_current_locus = gfc_current_block ()->declared_at;
+
+  gfc_clear_error ();
+  gfc_buffer_error (1);
+  m = gfc_match_prefix (ts);
+  gfc_buffer_error (0);
+
+  if (ts->type == BT_DERIVED)
+    {
+      ts->kind = 0;
+
+      if (!ts->u.derived)
+	m = MATCH_ERROR;
+    }
+
+  /* Only permit one go at the characteristic association.  */
+  if (ts->kind == -1)
+    ts->kind = 0;
+
+  /* Set the function locus correctly.  If we have not found the
+     function name, there is an error.  */
+  if (m == MATCH_YES
+      && gfc_match ("function% %n", name) == MATCH_YES
+      && strcmp (name, gfc_current_block ()->name) == 0)
+    {
+      gfc_current_block ()->declared_at = gfc_current_locus;
+      gfc_commit_symbols ();
+    }
+  else
+    {
+      gfc_error_check ();
+      gfc_undo_symbols ();
+    }
+
+  gfc_current_locus =loc;
+  return m;
+}
+
+
+/* Check specification-expressions in the function result of the currently
+   parsed block and ensure they are typed (give an IMPLICIT type if necessary).
+   For return types specified in a FUNCTION prefix, the IMPLICIT rules of the
+   scope are not yet parsed so this has to be delayed up to parse_spec.  */
+
+static void
+check_function_result_typed (void)
+{
+  gfc_typespec* ts = &gfc_current_ns->proc_name->result->ts;
+
+  gcc_assert (gfc_current_state () == COMP_FUNCTION);
+  gcc_assert (ts->type != BT_UNKNOWN);
+
+  /* Check type-parameters, at the moment only CHARACTER lengths possible.  */
+  /* TODO:  Extend when KIND type parameters are implemented.  */
+  if (ts->type == BT_CHARACTER && ts->u.cl && ts->u.cl->length)
+    gfc_expr_check_typed (ts->u.cl->length, gfc_current_ns, true);
+}
+
+
+/* Parse a set of specification statements.  Returns the statement
+   that doesn't fit.  */
+
+static gfc_statement
+parse_spec (gfc_statement st)
+{
+  st_state ss;
+  bool function_result_typed = false;
+  bool bad_characteristic = false;
+  gfc_typespec *ts;
+
+  verify_st_order (&ss, ST_NONE, false);
+  if (st == ST_NONE)
+    st = next_statement ();
+
+  /* If we are not inside a function or don't have a result specified so far,
+     do nothing special about it.  */
+  if (gfc_current_state () != COMP_FUNCTION)
+    function_result_typed = true;
+  else
+    {
+      gfc_symbol* proc = gfc_current_ns->proc_name;
+      gcc_assert (proc);
+
+      if (proc->result->ts.type == BT_UNKNOWN)
+	function_result_typed = true;
+    }
+
+loop:
+
+  /* If we're inside a BLOCK construct, some statements are disallowed.
+     Check this here.  Attribute declaration statements like INTENT, OPTIONAL
+     or VALUE are also disallowed, but they don't have a particular ST_*
+     key so we have to check for them individually in their matcher routine.  */
+  if (gfc_current_state () == COMP_BLOCK)
+    switch (st)
+      {
+	case ST_IMPLICIT:
+	case ST_IMPLICIT_NONE:
+	case ST_NAMELIST:
+	case ST_COMMON:
+	case ST_EQUIVALENCE:
+	case ST_STATEMENT_FUNCTION:
+	  gfc_error ("%s statement is not allowed inside of BLOCK at %C",
+		     gfc_ascii_statement (st));
+	  reject_statement ();
+	  break;
+
+	default:
+	  break;
+      }
+  
+  /* If we find a statement that can not be followed by an IMPLICIT statement
+     (and thus we can expect to see none any further), type the function result
+     if it has not yet been typed.  Be careful not to give the END statement
+     to verify_st_order!  */
+  if (!function_result_typed && st != ST_GET_FCN_CHARACTERISTICS)
+    {
+      bool verify_now = false;
+
+      if (st == ST_END_FUNCTION || st == ST_CONTAINS)
+	verify_now = true;
+      else
+	{
+	  st_state dummyss;
+	  verify_st_order (&dummyss, ST_NONE, false);
+	  verify_st_order (&dummyss, st, false);
+
+	  if (verify_st_order (&dummyss, ST_IMPLICIT, true) == FAILURE)
+	    verify_now = true;
+	}
+
+      if (verify_now)
+	{
+	  check_function_result_typed ();
+	  function_result_typed = true;
+	}
+    }
+
+  switch (st)
+    {
+    case ST_NONE:
+      unexpected_eof ();
+
+    case ST_IMPLICIT_NONE:
+    case ST_IMPLICIT:
+      if (!function_result_typed)
+	{
+	  check_function_result_typed ();
+	  function_result_typed = true;
+	}
+      goto declSt;
+
+    case ST_FORMAT:
+    case ST_ENTRY:
+    case ST_DATA:	/* Not allowed in interfaces */
+      if (gfc_current_state () == COMP_INTERFACE)
+	break;
+
+      /* Fall through */
+
+    case ST_USE:
+    case ST_IMPORT:
+    case ST_PARAMETER:
+    case ST_PUBLIC:
+    case ST_PRIVATE:
+    case ST_DERIVED_DECL:
+    case_decl:
+declSt:
+      if (verify_st_order (&ss, st, false) == FAILURE)
+	{
+	  reject_statement ();
+	  st = next_statement ();
+	  goto loop;
+	}
+
+      switch (st)
+	{
+	case ST_INTERFACE:
+	  parse_interface ();
+	  break;
+
+	case ST_DERIVED_DECL:
+	  parse_derived ();
+	  break;
+
+	case ST_PUBLIC:
+	case ST_PRIVATE:
+	  if (gfc_current_state () != COMP_MODULE)
+	    {
+	      gfc_error ("%s statement must appear in a MODULE",
+			 gfc_ascii_statement (st));
+	      reject_statement ();
+	      break;
+	    }
+
+	  if (gfc_current_ns->default_access != ACCESS_UNKNOWN)
+	    {
+	      gfc_error ("%s statement at %C follows another accessibility "
+			 "specification", gfc_ascii_statement (st));
+	      reject_statement ();
+	      break;
+	    }
+
+	  gfc_current_ns->default_access = (st == ST_PUBLIC)
+	    ? ACCESS_PUBLIC : ACCESS_PRIVATE;
+
+	  break;
+
+	case ST_STATEMENT_FUNCTION:
+	  if (gfc_current_state () == COMP_MODULE)
+	    {
+	      unexpected_statement (st);
+	      break;
+	    }
+
+	default:
+	  break;
+	}
+
+      accept_statement (st);
+      st = next_statement ();
+      goto loop;
+
+    case ST_ENUM:
+      accept_statement (st);
+      parse_enum();
+      st = next_statement ();
+      goto loop;
+
+    case ST_GET_FCN_CHARACTERISTICS:
+      /* This statement triggers the association of a function's result
+	 characteristics.  */
+      ts = &gfc_current_block ()->result->ts;
+      if (match_deferred_characteristics (ts) != MATCH_YES)
+	bad_characteristic = true;
+
+      st = next_statement ();
+      goto loop;
+
+    default:
+      break;
+    }
+
+  /* If match_deferred_characteristics failed, then there is an error. */
+  if (bad_characteristic)
+    {
+      ts = &gfc_current_block ()->result->ts;
+      if (ts->type != BT_DERIVED)
+	gfc_error ("Bad kind expression for function '%s' at %L",
+		   gfc_current_block ()->name,
+		   &gfc_current_block ()->declared_at);
+      else
+	gfc_error ("The type for function '%s' at %L is not accessible",
+		   gfc_current_block ()->name,
+		   &gfc_current_block ()->declared_at);
+
+      gfc_current_block ()->ts.kind = 0;
+      /* Keep the derived type; if it's bad, it will be discovered later.  */
+      if (!(ts->type == BT_DERIVED && ts->u.derived))
+	ts->type = BT_UNKNOWN;
+    }
+
+  return st;
+}
+
+
+/* Parse a WHERE block, (not a simple WHERE statement).  */
+
+static void
+parse_where_block (void)
+{
+  int seen_empty_else;
+  gfc_code *top, *d;
+  gfc_state_data s;
+  gfc_statement st;
+
+  accept_statement (ST_WHERE_BLOCK);
+  top = gfc_state_stack->tail;
+
+  push_state (&s, COMP_WHERE, gfc_new_block);
+
+  d = add_statement ();
+  d->expr1 = top->expr1;
+  d->op = EXEC_WHERE;
+
+  top->expr1 = NULL;
+  top->block = d;
+
+  seen_empty_else = 0;
+
+  do
+    {
+      st = next_statement ();
+      switch (st)
+	{
+	case ST_NONE:
+	  unexpected_eof ();
+
+	case ST_WHERE_BLOCK:
+	  parse_where_block ();
+	  break;
+
+	case ST_ASSIGNMENT:
+	case ST_WHERE:
+	  accept_statement (st);
+	  break;
+
+	case ST_ELSEWHERE:
+	  if (seen_empty_else)
+	    {
+	      gfc_error ("ELSEWHERE statement at %C follows previous "
+			 "unmasked ELSEWHERE");
+	      reject_statement ();
+	      break;
+	    }
+
+	  if (new_st.expr1 == NULL)
+	    seen_empty_else = 1;
+
+	  d = new_level (gfc_state_stack->head);
+	  d->op = EXEC_WHERE;
+	  d->expr1 = new_st.expr1;
+
+	  accept_statement (st);
+
+	  break;
+
+	case ST_END_WHERE:
+	  accept_statement (st);
+	  break;
+
+	default:
+	  gfc_error ("Unexpected %s statement in WHERE block at %C",
+		     gfc_ascii_statement (st));
+	  reject_statement ();
+	  break;
+	}
+    }
+  while (st != ST_END_WHERE);
+
+  pop_state ();
+}
+
+
+/* Parse a FORALL block (not a simple FORALL statement).  */
+
+static void
+parse_forall_block (void)
+{
+  gfc_code *top, *d;
+  gfc_state_data s;
+  gfc_statement st;
+
+  accept_statement (ST_FORALL_BLOCK);
+  top = gfc_state_stack->tail;
+
+  push_state (&s, COMP_FORALL, gfc_new_block);
+
+  d = add_statement ();
+  d->op = EXEC_FORALL;
+  top->block = d;
+
+  do
+    {
+      st = next_statement ();
+      switch (st)
+	{
+
+	case ST_ASSIGNMENT:
+	case ST_POINTER_ASSIGNMENT:
+	case ST_WHERE:
+	case ST_FORALL:
+	  accept_statement (st);
+	  break;
+
+	case ST_WHERE_BLOCK:
+	  parse_where_block ();
+	  break;
+
+	case ST_FORALL_BLOCK:
+	  parse_forall_block ();
+	  break;
+
+	case ST_END_FORALL:
+	  accept_statement (st);
+	  break;
+
+	case ST_NONE:
+	  unexpected_eof ();
+
+	default:
+	  gfc_error ("Unexpected %s statement in FORALL block at %C",
+		     gfc_ascii_statement (st));
+
+	  reject_statement ();
+	  break;
+	}
+    }
+  while (st != ST_END_FORALL);
+
+  pop_state ();
+}
+
+
+static gfc_statement parse_executable (gfc_statement);
+
+/* parse the statements of an IF-THEN-ELSEIF-ELSE-ENDIF block.  */
+
+static void
+parse_if_block (void)
+{
+  gfc_code *top, *d;
+  gfc_statement st;
+  locus else_locus;
+  gfc_state_data s;
+  int seen_else;
+
+  seen_else = 0;
+  accept_statement (ST_IF_BLOCK);
+
+  top = gfc_state_stack->tail;
+  push_state (&s, COMP_IF, gfc_new_block);
+
+  new_st.op = EXEC_IF;
+  d = add_statement ();
+
+  d->expr1 = top->expr1;
+  top->expr1 = NULL;
+  top->block = d;
+
+  do
+    {
+      st = parse_executable (ST_NONE);
+
+      switch (st)
+	{
+	case ST_NONE:
+	  unexpected_eof ();
+
+	case ST_ELSEIF:
+	  if (seen_else)
+	    {
+	      gfc_error ("ELSE IF statement at %C cannot follow ELSE "
+			 "statement at %L", &else_locus);
+
+	      reject_statement ();
+	      break;
+	    }
+
+	  d = new_level (gfc_state_stack->head);
+	  d->op = EXEC_IF;
+	  d->expr1 = new_st.expr1;
+
+	  accept_statement (st);
+
+	  break;
+
+	case ST_ELSE:
+	  if (seen_else)
+	    {
+	      gfc_error ("Duplicate ELSE statements at %L and %C",
+			 &else_locus);
+	      reject_statement ();
+	      break;
+	    }
+
+	  seen_else = 1;
+	  else_locus = gfc_current_locus;
+
+	  d = new_level (gfc_state_stack->head);
+	  d->op = EXEC_IF;
+
+	  accept_statement (st);
+
+	  break;
+
+	case ST_ENDIF:
+	  break;
+
+	default:
+	  unexpected_statement (st);
+	  break;
+	}
+    }
+  while (st != ST_ENDIF);
+
+  pop_state ();
+  accept_statement (st);
+}
+
+
+/* Parse a SELECT block.  */
+
+static void
+parse_select_block (void)
+{
+  gfc_statement st;
+  gfc_code *cp;
+  gfc_state_data s;
+
+  accept_statement (ST_SELECT_CASE);
+
+  cp = gfc_state_stack->tail;
+  push_state (&s, COMP_SELECT, gfc_new_block);
+
+  /* Make sure that the next statement is a CASE or END SELECT.  */
+  for (;;)
+    {
+      st = next_statement ();
+      if (st == ST_NONE)
+	unexpected_eof ();
+      if (st == ST_END_SELECT)
+	{
+	  /* Empty SELECT CASE is OK.  */
+	  accept_statement (st);
+	  pop_state ();
+	  return;
+	}
+      if (st == ST_CASE)
+	break;
+
+      gfc_error ("Expected a CASE or END SELECT statement following SELECT "
+		 "CASE at %C");
+
+      reject_statement ();
+    }
+
+  /* At this point, we're got a nonempty select block.  */
+  cp = new_level (cp);
+  *cp = new_st;
+
+  accept_statement (st);
+
+  do
+    {
+      st = parse_executable (ST_NONE);
+      switch (st)
+	{
+	case ST_NONE:
+	  unexpected_eof ();
+
+	case ST_CASE:
+	  cp = new_level (gfc_state_stack->head);
+	  *cp = new_st;
+	  gfc_clear_new_st ();
+
+	  accept_statement (st);
+	  /* Fall through */
+
+	case ST_END_SELECT:
+	  break;
+
+	/* Can't have an executable statement because of
+	   parse_executable().  */
+	default:
+	  unexpected_statement (st);
+	  break;
+	}
+    }
+  while (st != ST_END_SELECT);
+
+  pop_state ();
+  accept_statement (st);
+}
+
+
+/* Pop the current selector from the SELECT TYPE stack.  */
+
+static void
+select_type_pop (void)
+{
+  gfc_select_type_stack *old = select_type_stack;
+  select_type_stack = old->prev;
+  gfc_free (old);
+}
+
+
+/* Parse a SELECT TYPE construct (F03:R821).  */
+
+static void
+parse_select_type_block (void)
+{
+  gfc_statement st;
+  gfc_code *cp;
+  gfc_state_data s;
+
+  accept_statement (ST_SELECT_TYPE);
+
+  cp = gfc_state_stack->tail;
+  push_state (&s, COMP_SELECT_TYPE, gfc_new_block);
+
+  /* Make sure that the next statement is a TYPE IS, CLASS IS, CLASS DEFAULT
+     or END SELECT.  */
+  for (;;)
+    {
+      st = next_statement ();
+      if (st == ST_NONE)
+	unexpected_eof ();
+      if (st == ST_END_SELECT)
+	/* Empty SELECT CASE is OK.  */
+	goto done;
+      if (st == ST_TYPE_IS || st == ST_CLASS_IS)
+	break;
+
+      gfc_error ("Expected TYPE IS, CLASS IS or END SELECT statement "
+		 "following SELECT TYPE at %C");
+
+      reject_statement ();
+    }
+
+  /* At this point, we're got a nonempty select block.  */
+  cp = new_level (cp);
+  *cp = new_st;
+
+  accept_statement (st);
+
+  do
+    {
+      st = parse_executable (ST_NONE);
+      switch (st)
+	{
+	case ST_NONE:
+	  unexpected_eof ();
+
+	case ST_TYPE_IS:
+	case ST_CLASS_IS:
+	  cp = new_level (gfc_state_stack->head);
+	  *cp = new_st;
+	  gfc_clear_new_st ();
+
+	  accept_statement (st);
+	  /* Fall through */
+
+	case ST_END_SELECT:
+	  break;
+
+	/* Can't have an executable statement because of
+	   parse_executable().  */
+	default:
+	  unexpected_statement (st);
+	  break;
+	}
+    }
+  while (st != ST_END_SELECT);
+
+done:
+  pop_state ();
+  accept_statement (st);
+  gfc_current_ns = gfc_current_ns->parent;
+  select_type_pop ();
+}
+
+
+/* Given a symbol, make sure it is not an iteration variable for a DO
+   statement.  This subroutine is called when the symbol is seen in a
+   context that causes it to become redefined.  If the symbol is an
+   iterator, we generate an error message and return nonzero.  */
+
+int 
+gfc_check_do_variable (gfc_symtree *st)
+{
+  gfc_state_data *s;
+
+  for (s=gfc_state_stack; s; s = s->previous)
+    if (s->do_variable == st)
+      {
+	gfc_error_now("Variable '%s' at %C cannot be redefined inside "
+		      "loop beginning at %L", st->name, &s->head->loc);
+	return 1;
+      }
+
+  return 0;
+}
+  
+
+/* Checks to see if the current statement label closes an enddo.
+   Returns 0 if not, 1 if closes an ENDDO correctly, or 2 (and issues
+   an error) if it incorrectly closes an ENDDO.  */
+
+static int
+check_do_closure (void)
+{
+  gfc_state_data *p;
+
+  if (gfc_statement_label == NULL)
+    return 0;
+
+  for (p = gfc_state_stack; p; p = p->previous)
+    if (p->state == COMP_DO)
+      break;
+
+  if (p == NULL)
+    return 0;		/* No loops to close */
+
+  if (p->ext.end_do_label == gfc_statement_label)
+    {
+      if (p == gfc_state_stack)
+	return 1;
+
+      gfc_error ("End of nonblock DO statement at %C is within another block");
+      return 2;
+    }
+
+  /* At this point, the label doesn't terminate the innermost loop.
+     Make sure it doesn't terminate another one.  */
+  for (; p; p = p->previous)
+    if (p->state == COMP_DO && p->ext.end_do_label == gfc_statement_label)
+      {
+	gfc_error ("End of nonblock DO statement at %C is interwoven "
+		   "with another DO loop");
+	return 2;
+      }
+
+  return 0;
+}
+
+
+/* Parse a series of contained program units.  */
+
+static void parse_progunit (gfc_statement);
+
+
+/* Parse a CRITICAL block.  */
+
+static void
+parse_critical_block (void)
+{
+  gfc_code *top, *d;
+  gfc_state_data s;
+  gfc_statement st;
+
+  s.ext.end_do_label = new_st.label1;
+
+  accept_statement (ST_CRITICAL);
+  top = gfc_state_stack->tail;
+
+  push_state (&s, COMP_CRITICAL, gfc_new_block);
+
+  d = add_statement ();
+  d->op = EXEC_CRITICAL;
+  top->block = d;
+
+  do
+    {
+      st = parse_executable (ST_NONE);
+
+      switch (st)
+	{
+	  case ST_NONE:
+	    unexpected_eof ();
+	    break;
+
+	  case ST_END_CRITICAL:
+	    if (s.ext.end_do_label != NULL
+		&& s.ext.end_do_label != gfc_statement_label)
+	      gfc_error_now ("Statement label in END CRITICAL at %C does not "
+			     "match CRITIAL label");
+
+	    if (gfc_statement_label != NULL)
+	      {
+		new_st.op = EXEC_NOP;
+		add_statement ();
+	      }
+	    break;
+
+	  default:
+	    unexpected_statement (st);
+	    break;
+	}
+    }
+  while (st != ST_END_CRITICAL);
+
+  pop_state ();
+  accept_statement (st);
+}
+
+
+/* Set up the local namespace for a BLOCK construct.  */
+
+gfc_namespace*
+gfc_build_block_ns (gfc_namespace *parent_ns)
+{
+  gfc_namespace* my_ns;
+
+  my_ns = gfc_get_namespace (parent_ns, 1);
+  my_ns->construct_entities = 1;
+
+  /* Give the BLOCK a symbol of flavor LABEL; this is later needed for correct
+     code generation (so it must not be NULL).
+     We set its recursive argument if our container procedure is recursive, so
+     that local variables are accordingly placed on the stack when it
+     will be necessary.  */
+  if (gfc_new_block)
+    my_ns->proc_name = gfc_new_block;
+  else
+    {
+      gfc_try t;
+
+      gfc_get_symbol ("block@", my_ns, &my_ns->proc_name);
+      t = gfc_add_flavor (&my_ns->proc_name->attr, FL_LABEL,
+			  my_ns->proc_name->name, NULL);
+      gcc_assert (t == SUCCESS);
+      gfc_commit_symbol (my_ns->proc_name);
+    }
+
+  if (parent_ns->proc_name)
+    my_ns->proc_name->attr.recursive = parent_ns->proc_name->attr.recursive;
+
+  return my_ns;
+}
+
+
+/* Parse a BLOCK construct.  */
+
+static void
+parse_block_construct (void)
+{
+  gfc_namespace* my_ns;
+  gfc_state_data s;
+
+  gfc_notify_std (GFC_STD_F2008, "Fortran 2008: BLOCK construct at %C");
+
+  my_ns = gfc_build_block_ns (gfc_current_ns);
+
+  new_st.op = EXEC_BLOCK;
+  new_st.ext.block.ns = my_ns;
+  new_st.ext.block.assoc = NULL;
+  accept_statement (ST_BLOCK);
+
+  push_state (&s, COMP_BLOCK, my_ns->proc_name);
+  gfc_current_ns = my_ns;
+
+  parse_progunit (ST_NONE);
+
+  gfc_current_ns = gfc_current_ns->parent;
+  pop_state ();
+}
+
+
+/* Parse an ASSOCIATE construct.  This is essentially a BLOCK construct
+   behind the scenes with compiler-generated variables.  */
+
+static void
+parse_associate (void)
+{
+  gfc_namespace* my_ns;
+  gfc_state_data s;
+  gfc_statement st;
+  gfc_association_list* a;
+
+  gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ASSOCIATE construct at %C");
+
+  my_ns = gfc_build_block_ns (gfc_current_ns);
+
+  new_st.op = EXEC_BLOCK;
+  new_st.ext.block.ns = my_ns;
+  gcc_assert (new_st.ext.block.assoc);
+
+  /* Add all associate-names as BLOCK variables.  Creating them is enough
+     for now, they'll get their values during trans-* phase.  */
+  gfc_current_ns = my_ns;
+  for (a = new_st.ext.block.assoc; a; a = a->next)
+    {
+      gfc_symbol* sym;
+
+      if (gfc_get_sym_tree (a->name, NULL, &a->st, false))
+	gcc_unreachable ();
+
+      sym = a->st->n.sym;
+      sym->attr.flavor = FL_VARIABLE;
+      sym->assoc = a;
+      sym->declared_at = a->where;
+      gfc_set_sym_referenced (sym);
+
+      /* Initialize the typespec.  It is not available in all cases,
+	 however, as it may only be set on the target during resolution.
+	 Still, sometimes it helps to have it right now -- especially
+	 for parsing component references on the associate-name
+	 in case of assication to a derived-type.  */
+      sym->ts = a->target->ts;
+    }
+
+  accept_statement (ST_ASSOCIATE);
+  push_state (&s, COMP_ASSOCIATE, my_ns->proc_name);
+
+loop:
+  st = parse_executable (ST_NONE);
+  switch (st)
+    {
+    case ST_NONE:
+      unexpected_eof ();
+
+    case_end:
+      accept_statement (st);
+      my_ns->code = gfc_state_stack->head;
+      break;
+
+    default:
+      unexpected_statement (st);
+      goto loop;
+    }
+
+  gfc_current_ns = gfc_current_ns->parent;
+  pop_state ();
+}
+
+
+/* Parse a DO loop.  Note that the ST_CYCLE and ST_EXIT statements are
+   handled inside of parse_executable(), because they aren't really
+   loop statements.  */
+
+static void
+parse_do_block (void)
+{
+  gfc_statement st;
+  gfc_code *top;
+  gfc_state_data s;
+  gfc_symtree *stree;
+
+  s.ext.end_do_label = new_st.label1;
+
+  if (new_st.ext.iterator != NULL)
+    stree = new_st.ext.iterator->var->symtree;
+  else
+    stree = NULL;
+
+  accept_statement (ST_DO);
+
+  top = gfc_state_stack->tail;
+  push_state (&s, COMP_DO, gfc_new_block);
+
+  s.do_variable = stree;
+
+  top->block = new_level (top);
+  top->block->op = EXEC_DO;
+
+loop:
+  st = parse_executable (ST_NONE);
+
+  switch (st)
+    {
+    case ST_NONE:
+      unexpected_eof ();
+
+    case ST_ENDDO:
+      if (s.ext.end_do_label != NULL
+	  && s.ext.end_do_label != gfc_statement_label)
+	gfc_error_now ("Statement label in ENDDO at %C doesn't match "
+		       "DO label");
+
+      if (gfc_statement_label != NULL)
+	{
+	  new_st.op = EXEC_NOP;
+	  add_statement ();
+	}
+      break;
+
+    case ST_IMPLIED_ENDDO:
+     /* If the do-stmt of this DO construct has a do-construct-name,
+	the corresponding end-do must be an end-do-stmt (with a matching
+	name, but in that case we must have seen ST_ENDDO first).
+	We only complain about this in pedantic mode.  */
+     if (gfc_current_block () != NULL)
+	gfc_error_now ("Named block DO at %L requires matching ENDDO name",
+		       &gfc_current_block()->declared_at);
+
+      break;
+
+    default:
+      unexpected_statement (st);
+      goto loop;
+    }
+
+  pop_state ();
+  accept_statement (st);
+}
+
+
+/* Parse the statements of OpenMP do/parallel do.  */
+
+static gfc_statement
+parse_omp_do (gfc_statement omp_st)
+{
+  gfc_statement st;
+  gfc_code *cp, *np;
+  gfc_state_data s;
+
+  accept_statement (omp_st);
+
+  cp = gfc_state_stack->tail;
+  push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
+  np = new_level (cp);
+  np->op = cp->op;
+  np->block = NULL;
+
+  for (;;)
+    {
+      st = next_statement ();
+      if (st == ST_NONE)
+	unexpected_eof ();
+      else if (st == ST_DO)
+	break;
+      else
+	unexpected_statement (st);
+    }
+
+  parse_do_block ();
+  if (gfc_statement_label != NULL
+      && gfc_state_stack->previous != NULL
+      && gfc_state_stack->previous->state == COMP_DO
+      && gfc_state_stack->previous->ext.end_do_label == gfc_statement_label)
+    {
+      /* In
+	 DO 100 I=1,10
+	   !$OMP DO
+	     DO J=1,10
+	     ...
+	     100 CONTINUE
+	 there should be no !$OMP END DO.  */
+      pop_state ();
+      return ST_IMPLIED_ENDDO;
+    }
+
+  check_do_closure ();
+  pop_state ();
+
+  st = next_statement ();
+  if (st == (omp_st == ST_OMP_DO ? ST_OMP_END_DO : ST_OMP_END_PARALLEL_DO))
+    {
+      if (new_st.op == EXEC_OMP_END_NOWAIT)
+	cp->ext.omp_clauses->nowait |= new_st.ext.omp_bool;
+      else
+	gcc_assert (new_st.op == EXEC_NOP);
+      gfc_clear_new_st ();
+      gfc_commit_symbols ();
+      gfc_warning_check ();
+      st = next_statement ();
+    }
+  return st;
+}
+
+
+/* Parse the statements of OpenMP atomic directive.  */
+
+static void
+parse_omp_atomic (void)
+{
+  gfc_statement st;
+  gfc_code *cp, *np;
+  gfc_state_data s;
+
+  accept_statement (ST_OMP_ATOMIC);
+
+  cp = gfc_state_stack->tail;
+  push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
+  np = new_level (cp);
+  np->op = cp->op;
+  np->block = NULL;
+
+  for (;;)
+    {
+      st = next_statement ();
+      if (st == ST_NONE)
+	unexpected_eof ();
+      else if (st == ST_ASSIGNMENT)
+	break;
+      else
+	unexpected_statement (st);
+    }
+
+  accept_statement (st);
+
+  pop_state ();
+}
+
+
+/* Parse the statements of an OpenMP structured block.  */
+
+static void
+parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
+{
+  gfc_statement st, omp_end_st;
+  gfc_code *cp, *np;
+  gfc_state_data s;
+
+  accept_statement (omp_st);
+
+  cp = gfc_state_stack->tail;
+  push_state (&s, COMP_OMP_STRUCTURED_BLOCK, NULL);
+  np = new_level (cp);
+  np->op = cp->op;
+  np->block = NULL;
+
+  switch (omp_st)
+    {
+    case ST_OMP_PARALLEL:
+      omp_end_st = ST_OMP_END_PARALLEL;
+      break;
+    case ST_OMP_PARALLEL_SECTIONS:
+      omp_end_st = ST_OMP_END_PARALLEL_SECTIONS;
+      break;
+    case ST_OMP_SECTIONS:
+      omp_end_st = ST_OMP_END_SECTIONS;
+      break;
+    case ST_OMP_ORDERED:
+      omp_end_st = ST_OMP_END_ORDERED;
+      break;
+    case ST_OMP_CRITICAL:
+      omp_end_st = ST_OMP_END_CRITICAL;
+      break;
+    case ST_OMP_MASTER:
+      omp_end_st = ST_OMP_END_MASTER;
+      break;
+    case ST_OMP_SINGLE:
+      omp_end_st = ST_OMP_END_SINGLE;
+      break;
+    case ST_OMP_TASK:
+      omp_end_st = ST_OMP_END_TASK;
+      break;
+    case ST_OMP_WORKSHARE:
+      omp_end_st = ST_OMP_END_WORKSHARE;
+      break;
+    case ST_OMP_PARALLEL_WORKSHARE:
+      omp_end_st = ST_OMP_END_PARALLEL_WORKSHARE;
+      break;
+    default:
+      gcc_unreachable ();
+    }
+
+  do
+    {
+      if (workshare_stmts_only)
+	{
+	  /* Inside of !$omp workshare, only
+	     scalar assignments
+	     array assignments
+	     where statements and constructs
+	     forall statements and constructs
+	     !$omp atomic
+	     !$omp critical
+	     !$omp parallel
+	     are allowed.  For !$omp critical these
+	     restrictions apply recursively.  */
+	  bool cycle = true;
+
+	  st = next_statement ();
+	  for (;;)
+	    {
+	      switch (st)
+		{
+		case ST_NONE:
+		  unexpected_eof ();
+
+		case ST_ASSIGNMENT:
+		case ST_WHERE:
+		case ST_FORALL:
+		  accept_statement (st);
+		  break;
+
+		case ST_WHERE_BLOCK:
+		  parse_where_block ();
+		  break;
+
+		case ST_FORALL_BLOCK:
+		  parse_forall_block ();
+		  break;
+
+		case ST_OMP_PARALLEL:
+		case ST_OMP_PARALLEL_SECTIONS:
+		  parse_omp_structured_block (st, false);
+		  break;
+
+		case ST_OMP_PARALLEL_WORKSHARE:
+		case ST_OMP_CRITICAL:
+		  parse_omp_structured_block (st, true);
+		  break;
+
+		case ST_OMP_PARALLEL_DO:
+		  st = parse_omp_do (st);
+		  continue;
+
+		case ST_OMP_ATOMIC:
+		  parse_omp_atomic ();
+		  break;
+
+		default:
+		  cycle = false;
+		  break;
+		}
+
+	      if (!cycle)
+		break;
+
+	      st = next_statement ();
+	    }
+	}
+      else
+	st = parse_executable (ST_NONE);
+      if (st == ST_NONE)
+	unexpected_eof ();
+      else if (st == ST_OMP_SECTION
+	       && (omp_st == ST_OMP_SECTIONS
+		   || omp_st == ST_OMP_PARALLEL_SECTIONS))
+	{
+	  np = new_level (np);
+	  np->op = cp->op;
+	  np->block = NULL;
+	}
+      else if (st != omp_end_st)
+	unexpected_statement (st);
+    }
+  while (st != omp_end_st);
+
+  switch (new_st.op)
+    {
+    case EXEC_OMP_END_NOWAIT:
+      cp->ext.omp_clauses->nowait |= new_st.ext.omp_bool;
+      break;
+    case EXEC_OMP_CRITICAL:
+      if (((cp->ext.omp_name == NULL) ^ (new_st.ext.omp_name == NULL))
+	  || (new_st.ext.omp_name != NULL
+	      && strcmp (cp->ext.omp_name, new_st.ext.omp_name) != 0))
+	gfc_error ("Name after !$omp critical and !$omp end critical does "
+		   "not match at %C");
+      gfc_free (CONST_CAST (char *, new_st.ext.omp_name));
+      break;
+    case EXEC_OMP_END_SINGLE:
+      cp->ext.omp_clauses->lists[OMP_LIST_COPYPRIVATE]
+	= new_st.ext.omp_clauses->lists[OMP_LIST_COPYPRIVATE];
+      new_st.ext.omp_clauses->lists[OMP_LIST_COPYPRIVATE] = NULL;
+      gfc_free_omp_clauses (new_st.ext.omp_clauses);
+      break;
+    case EXEC_NOP:
+      break;
+    default:
+      gcc_unreachable ();
+    }
+
+  gfc_clear_new_st ();
+  gfc_commit_symbols ();
+  gfc_warning_check ();
+  pop_state ();
+}
+
+
+/* Accept a series of executable statements.  We return the first
+   statement that doesn't fit to the caller.  Any block statements are
+   passed on to the correct handler, which usually passes the buck
+   right back here.  */
+
+static gfc_statement
+parse_executable (gfc_statement st)
+{
+  int close_flag;
+
+  if (st == ST_NONE)
+    st = next_statement ();
+
+  for (;;)
+    {
+      close_flag = check_do_closure ();
+      if (close_flag)
+	switch (st)
+	  {
+	  case ST_GOTO:
+	  case ST_END_PROGRAM:
+	  case ST_RETURN:
+	  case ST_EXIT:
+	  case ST_END_FUNCTION:
+	  case ST_CYCLE:
+	  case ST_PAUSE:
+	  case ST_STOP:
+	  case ST_ERROR_STOP:
+	  case ST_END_SUBROUTINE:
+
+	  case ST_DO:
+	  case ST_FORALL:
+	  case ST_WHERE:
+	  case ST_SELECT_CASE:
+	    gfc_error ("%s statement at %C cannot terminate a non-block "
+		       "DO loop", gfc_ascii_statement (st));
+	    break;
+
+	  default:
+	    break;
+	  }
+
+      switch (st)
+	{
+	case ST_NONE:
+	  unexpected_eof ();
+
+	case ST_FORMAT:
+	case ST_DATA:
+	case ST_ENTRY:
+	case_executable:
+	  accept_statement (st);
+	  if (close_flag == 1)
+	    return ST_IMPLIED_ENDDO;
+	  break;
+
+	case ST_BLOCK:
+	  parse_block_construct ();
+	  break;
+
+	case ST_ASSOCIATE:
+	  parse_associate ();
+	  break;
+
+	case ST_IF_BLOCK:
+	  parse_if_block ();
+	  break;
+
+	case ST_SELECT_CASE:
+	  parse_select_block ();
+	  break;
+
+	case ST_SELECT_TYPE:
+	  parse_select_type_block();
+	  break;
+
+	case ST_DO:
+	  parse_do_block ();
+	  if (check_do_closure () == 1)
+	    return ST_IMPLIED_ENDDO;
+	  break;
+
+	case ST_CRITICAL:
+	  parse_critical_block ();
+	  break;
+
+	case ST_WHERE_BLOCK:
+	  parse_where_block ();
+	  break;
+
+	case ST_FORALL_BLOCK:
+	  parse_forall_block ();
+	  break;
+
+	case ST_OMP_PARALLEL:
+	case ST_OMP_PARALLEL_SECTIONS:
+	case ST_OMP_SECTIONS:
+	case ST_OMP_ORDERED:
+	case ST_OMP_CRITICAL:
+	case ST_OMP_MASTER:
+	case ST_OMP_SINGLE:
+	case ST_OMP_TASK:
+	  parse_omp_structured_block (st, false);
+	  break;
+
+	case ST_OMP_WORKSHARE:
+	case ST_OMP_PARALLEL_WORKSHARE:
+	  parse_omp_structured_block (st, true);
+	  break;
+
+	case ST_OMP_DO:
+	case ST_OMP_PARALLEL_DO:
+	  st = parse_omp_do (st);
+	  if (st == ST_IMPLIED_ENDDO)
+	    return st;
+	  continue;
+
+	case ST_OMP_ATOMIC:
+	  parse_omp_atomic ();
+	  break;
+
+	default:
+	  return st;
+	}
+
+      st = next_statement ();
+    }
+}
+
+
+/* Fix the symbols for sibling functions.  These are incorrectly added to
+   the child namespace as the parser didn't know about this procedure.  */
+
+static void
+gfc_fixup_sibling_symbols (gfc_symbol *sym, gfc_namespace *siblings)
+{
+  gfc_namespace *ns;
+  gfc_symtree *st;
+  gfc_symbol *old_sym;
+
+  sym->attr.referenced = 1;
+  for (ns = siblings; ns; ns = ns->sibling)
+    {
+      st = gfc_find_symtree (ns->sym_root, sym->name);
+
+      if (!st || (st->n.sym->attr.dummy && ns == st->n.sym->ns))
+	goto fixup_contained;
+
+      old_sym = st->n.sym;
+      if (old_sym->ns == ns
+	    && !old_sym->attr.contained
+
+	    /* By 14.6.1.3, host association should be excluded
+	       for the following.  */
+	    && !(old_sym->attr.external
+		  || (old_sym->ts.type != BT_UNKNOWN
+			&& !old_sym->attr.implicit_type)
+		  || old_sym->attr.flavor == FL_PARAMETER
+		  || old_sym->attr.use_assoc
+		  || old_sym->attr.in_common
+		  || old_sym->attr.in_equivalence
+		  || old_sym->attr.data
+		  || old_sym->attr.dummy
+		  || old_sym->attr.result
+		  || old_sym->attr.dimension
+		  || old_sym->attr.allocatable
+		  || old_sym->attr.intrinsic
+		  || old_sym->attr.generic
+		  || old_sym->attr.flavor == FL_NAMELIST
+		  || old_sym->attr.proc == PROC_ST_FUNCTION))
+	{
+	  /* Replace it with the symbol from the parent namespace.  */
+	  st->n.sym = sym;
+	  sym->refs++;
+
+	  gfc_release_symbol (old_sym);
+	}
+
+fixup_contained:
+      /* Do the same for any contained procedures.  */
+      gfc_fixup_sibling_symbols (sym, ns->contained);
+    }
+}
+
+static void
+parse_contained (int module)
+{
+  gfc_namespace *ns, *parent_ns, *tmp;
+  gfc_state_data s1, s2;
+  gfc_statement st;
+  gfc_symbol *sym;
+  gfc_entry_list *el;
+  int contains_statements = 0;
+  int seen_error = 0;
+
+  push_state (&s1, COMP_CONTAINS, NULL);
+  parent_ns = gfc_current_ns;
+
+  do
+    {
+      gfc_current_ns = gfc_get_namespace (parent_ns, 1);
+
+      gfc_current_ns->sibling = parent_ns->contained;
+      parent_ns->contained = gfc_current_ns;
+
+ next:
+      /* Process the next available statement.  We come here if we got an error
+	 and rejected the last statement.  */
+      st = next_statement ();
+
+      switch (st)
+	{
+	case ST_NONE:
+	  unexpected_eof ();
+
+	case ST_FUNCTION:
+	case ST_SUBROUTINE:
+	  contains_statements = 1;
+	  accept_statement (st);
+
+	  push_state (&s2,
+		      (st == ST_FUNCTION) ? COMP_FUNCTION : COMP_SUBROUTINE,
+		      gfc_new_block);
+
+	  /* For internal procedures, create/update the symbol in the
+	     parent namespace.  */
+
+	  if (!module)
+	    {
+	      if (gfc_get_symbol (gfc_new_block->name, parent_ns, &sym))
+		gfc_error ("Contained procedure '%s' at %C is already "
+			   "ambiguous", gfc_new_block->name);
+	      else
+		{
+		  if (gfc_add_procedure (&sym->attr, PROC_INTERNAL, sym->name,
+					 &gfc_new_block->declared_at) ==
+		      SUCCESS)
+		    {
+		      if (st == ST_FUNCTION)
+			gfc_add_function (&sym->attr, sym->name,
+					  &gfc_new_block->declared_at);
+		      else
+			gfc_add_subroutine (&sym->attr, sym->name,
+					    &gfc_new_block->declared_at);
+		    }
+		}
+
+	      gfc_commit_symbols ();
+	    }
+	  else
+	    sym = gfc_new_block;
+
+	  /* Mark this as a contained function, so it isn't replaced
+	     by other module functions.  */
+	  sym->attr.contained = 1;
+	  sym->attr.referenced = 1;
+
+	  /* Set implicit_pure so that it can be reset if any of the
+	     tests for purity fail.  This is used for some optimisation
+	     during translation.  */
+	  if (!sym->attr.pure)
+	    sym->attr.implicit_pure = 1;
+
+	  parse_progunit (ST_NONE);
+
+	  /* Fix up any sibling functions that refer to this one.  */
+	  gfc_fixup_sibling_symbols (sym, gfc_current_ns);
+	  /* Or refer to any of its alternate entry points.  */
+	  for (el = gfc_current_ns->entries; el; el = el->next)
+	    gfc_fixup_sibling_symbols (el->sym, gfc_current_ns);
+
+	  gfc_current_ns->code = s2.head;
+	  gfc_current_ns = parent_ns;
+
+	  pop_state ();
+	  break;
+
+	/* These statements are associated with the end of the host unit.  */
+	case ST_END_FUNCTION:
+	case ST_END_MODULE:
+	case ST_END_PROGRAM:
+	case ST_END_SUBROUTINE:
+	  accept_statement (st);
+	  break;
+
+	default:
+	  gfc_error ("Unexpected %s statement in CONTAINS section at %C",
+		     gfc_ascii_statement (st));
+	  reject_statement ();
+	  seen_error = 1;
+	  goto next;
+	  break;
+	}
+    }
+  while (st != ST_END_FUNCTION && st != ST_END_SUBROUTINE
+	 && st != ST_END_MODULE && st != ST_END_PROGRAM);
+
+  /* The first namespace in the list is guaranteed to not have
+     anything (worthwhile) in it.  */
+  tmp = gfc_current_ns;
+  gfc_current_ns = parent_ns;
+  if (seen_error && tmp->refs > 1)
+    gfc_free_namespace (tmp);
+
+  ns = gfc_current_ns->contained;
+  gfc_current_ns->contained = ns->sibling;
+  gfc_free_namespace (ns);
+
+  pop_state ();
+  if (!contains_statements)
+    gfc_notify_std (GFC_STD_F2008, "Fortran 2008: CONTAINS statement without "
+		    "FUNCTION or SUBROUTINE statement at %C");
+}
+
+
+/* Parse a PROGRAM, SUBROUTINE, FUNCTION unit or BLOCK construct.  */
+
+static void
+parse_progunit (gfc_statement st)
+{
+  gfc_state_data *p;
+  int n;
+
+  st = parse_spec (st);
+  switch (st)
+    {
+    case ST_NONE:
+      unexpected_eof ();
+
+    case ST_CONTAINS:
+      /* This is not allowed within BLOCK!  */
+      if (gfc_current_state () != COMP_BLOCK)
+	goto contains;
+      break;
+
+    case_end:
+      accept_statement (st);
+      goto done;
+
+    default:
+      break;
+    }
+
+  if (gfc_current_state () == COMP_FUNCTION)
+    gfc_check_function_type (gfc_current_ns);
+
+loop:
+  for (;;)
+    {
+      st = parse_executable (st);
+
+      switch (st)
+	{
+	case ST_NONE:
+	  unexpected_eof ();
+
+	case ST_CONTAINS:
+	  /* This is not allowed within BLOCK!  */
+	  if (gfc_current_state () != COMP_BLOCK)
+	    goto contains;
+	  break;
+
+	case_end:
+	  accept_statement (st);
+	  goto done;
+
+	default:
+	  break;
+	}
+
+      unexpected_statement (st);
+      reject_statement ();
+      st = next_statement ();
+    }
+
+contains:
+  n = 0;
+
+  for (p = gfc_state_stack; p; p = p->previous)
+    if (p->state == COMP_CONTAINS)
+      n++;
+
+  if (gfc_find_state (COMP_MODULE) == SUCCESS)
+    n--;
+
+  if (n > 0)
+    {
+      gfc_error ("CONTAINS statement at %C is already in a contained "
+		 "program unit");
+      reject_statement ();
+      st = next_statement ();
+      goto loop;
+    }
+
+  parse_contained (0);
+
+done:
+  gfc_current_ns->code = gfc_state_stack->head;
+}
+
+
+/* Come here to complain about a global symbol already in use as
+   something else.  */
+
+void
+gfc_global_used (gfc_gsymbol *sym, locus *where)
+{
+  const char *name;
+
+  if (where == NULL)
+    where = &gfc_current_locus;
+
+  switch(sym->type)
+    {
+    case GSYM_PROGRAM:
+      name = "PROGRAM";
+      break;
+    case GSYM_FUNCTION:
+      name = "FUNCTION";
+      break;
+    case GSYM_SUBROUTINE:
+      name = "SUBROUTINE";
+      break;
+    case GSYM_COMMON:
+      name = "COMMON";
+      break;
+    case GSYM_BLOCK_DATA:
+      name = "BLOCK DATA";
+      break;
+    case GSYM_MODULE:
+      name = "MODULE";
+      break;
+    default:
+      gfc_internal_error ("gfc_global_used(): Bad type");
+      name = NULL;
+    }
+
+  gfc_error("Global name '%s' at %L is already being used as a %s at %L",
+	      sym->name, where, name, &sym->where);
+}
+
+
+/* Parse a block data program unit.  */
+
+static void
+parse_block_data (void)
+{
+  gfc_statement st;
+  static locus blank_locus;
+  static int blank_block=0;
+  gfc_gsymbol *s;
+
+  gfc_current_ns->proc_name = gfc_new_block;
+  gfc_current_ns->is_block_data = 1;
+
+  if (gfc_new_block == NULL)
+    {
+      if (blank_block)
+       gfc_error ("Blank BLOCK DATA at %C conflicts with "
+		  "prior BLOCK DATA at %L", &blank_locus);
+      else
+       {
+	 blank_block = 1;
+	 blank_locus = gfc_current_locus;
+       }
+    }
+  else
+    {
+      s = gfc_get_gsymbol (gfc_new_block->name);
+      if (s->defined
+	  || (s->type != GSYM_UNKNOWN && s->type != GSYM_BLOCK_DATA))
+       gfc_global_used(s, NULL);
+      else
+       {
+	 s->type = GSYM_BLOCK_DATA;
+	 s->where = gfc_current_locus;
+	 s->defined = 1;
+       }
+    }
+
+  st = parse_spec (ST_NONE);
+
+  while (st != ST_END_BLOCK_DATA)
+    {
+      gfc_error ("Unexpected %s statement in BLOCK DATA at %C",
+		 gfc_ascii_statement (st));
+      reject_statement ();
+      st = next_statement ();
+    }
+}
+
+
+/* Parse a module subprogram.  */
+
+static void
+parse_module (void)
+{
+  gfc_statement st;
+  gfc_gsymbol *s;
+  bool error;
+
+  s = gfc_get_gsymbol (gfc_new_block->name);
+  if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_MODULE))
+    gfc_global_used(s, NULL);
+  else
+    {
+      s->type = GSYM_MODULE;
+      s->where = gfc_current_locus;
+      s->defined = 1;
+    }
+
+  st = parse_spec (ST_NONE);
+
+  error = false;
+loop:
+  switch (st)
+    {
+    case ST_NONE:
+      unexpected_eof ();
+
+    case ST_CONTAINS:
+      parse_contained (1);
+      break;
+
+    case ST_END_MODULE:
+      accept_statement (st);
+      break;
+
+    default:
+      gfc_error ("Unexpected %s statement in MODULE at %C",
+		 gfc_ascii_statement (st));
+
+      error = true;
+      reject_statement ();
+      st = next_statement ();
+      goto loop;
+    }
+
+  /* Make sure not to free the namespace twice on error.  */
+  if (!error)
+    s->ns = gfc_current_ns;
+}
+
+
+/* Add a procedure name to the global symbol table.  */
+
+static void
+add_global_procedure (int sub)
+{
+  gfc_gsymbol *s;
+
+  s = gfc_get_gsymbol(gfc_new_block->name);
+
+  if (s->defined
+      || (s->type != GSYM_UNKNOWN
+	  && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION)))
+    gfc_global_used(s, NULL);
+  else
+    {
+      s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
+      s->where = gfc_current_locus;
+      s->defined = 1;
+      s->ns = gfc_current_ns;
+    }
+}
+
+
+/* Add a program to the global symbol table.  */
+
+static void
+add_global_program (void)
+{
+  gfc_gsymbol *s;
+
+  if (gfc_new_block == NULL)
+    return;
+  s = gfc_get_gsymbol (gfc_new_block->name);
+
+  if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_PROGRAM))
+    gfc_global_used(s, NULL);
+  else
+    {
+      s->type = GSYM_PROGRAM;
+      s->where = gfc_current_locus;
+      s->defined = 1;
+      s->ns = gfc_current_ns;
+    }
+}
+
+
+/* Resolve all the program units when whole file scope option
+   is active. */
+static void
+resolve_all_program_units (gfc_namespace *gfc_global_ns_list)
+{
+  gfc_free_dt_list ();
+  gfc_current_ns = gfc_global_ns_list;
+  for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
+    {
+      if (gfc_current_ns->proc_name
+	  && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
+	continue; /* Already resolved.  */
+
+      if (gfc_current_ns->proc_name)
+	gfc_current_locus = gfc_current_ns->proc_name->declared_at;
+      gfc_resolve (gfc_current_ns);
+      gfc_current_ns->derived_types = gfc_derived_types;
+      gfc_derived_types = NULL;
+    }
+}
+
+
+static void
+clean_up_modules (gfc_gsymbol *gsym)
+{
+  if (gsym == NULL)
+    return;
+
+  clean_up_modules (gsym->left);
+  clean_up_modules (gsym->right);
+
+  if (gsym->type != GSYM_MODULE || !gsym->ns)
+    return;
+
+  gfc_current_ns = gsym->ns;
+  gfc_derived_types = gfc_current_ns->derived_types;
+  gfc_done_2 ();
+  gsym->ns = NULL;
+  return;
+}
+
+
+/* Translate all the program units when whole file scope option
+   is active. This could be in a different order to resolution if
+   there are forward references in the file.  */
+static void
+translate_all_program_units (gfc_namespace *gfc_global_ns_list)
+{
+  int errors;
+
+  gfc_current_ns = gfc_global_ns_list;
+  gfc_get_errors (NULL, &errors);
+
+  /* We first translate all modules to make sure that later parts
+     of the program can use the decl. Then we translate the nonmodules.  */
+
+  for (; !errors && gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
+    {
+      if (!gfc_current_ns->proc_name
+	  || gfc_current_ns->proc_name->attr.flavor != FL_MODULE)
+	continue;
+
+      gfc_current_locus = gfc_current_ns->proc_name->declared_at;
+      gfc_derived_types = gfc_current_ns->derived_types;
+      gfc_generate_module_code (gfc_current_ns);
+      gfc_current_ns->translated = 1;
+    }
+
+  gfc_current_ns = gfc_global_ns_list;
+  for (; !errors && gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
+    {
+      if (gfc_current_ns->proc_name
+	  && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
+	continue;
+
+      gfc_current_locus = gfc_current_ns->proc_name->declared_at;
+      gfc_derived_types = gfc_current_ns->derived_types;
+      gfc_generate_code (gfc_current_ns);
+      gfc_current_ns->translated = 1;
+    }
+
+  /* Clean up all the namespaces after translation.  */
+  gfc_current_ns = gfc_global_ns_list;
+  for (;gfc_current_ns;)
+    {
+      gfc_namespace *ns;
+
+      if (gfc_current_ns->proc_name
+	  && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
+	{
+	  gfc_current_ns = gfc_current_ns->sibling;
+	  continue;
+	}
+
+      ns = gfc_current_ns->sibling;
+      gfc_derived_types = gfc_current_ns->derived_types;
+      gfc_done_2 ();
+      gfc_current_ns = ns;
+    }
+
+  clean_up_modules (gfc_gsym_root);
+}
+
+
+/* Top level parser.  */
+
+gfc_try
+gfc_parse_file (void)
+{
+  int seen_program, errors_before, errors;
+  gfc_state_data top, s;
+  gfc_statement st;
+  locus prog_locus;
+  gfc_namespace *next;
+
+  gfc_start_source_files ();
+
+  top.state = COMP_NONE;
+  top.sym = NULL;
+  top.previous = NULL;
+  top.head = top.tail = NULL;
+  top.do_variable = NULL;
+
+  gfc_state_stack = &top;
+
+  gfc_clear_new_st ();
+
+  gfc_statement_label = NULL;
+
+  if (setjmp (eof_buf))
+    return FAILURE;	/* Come here on unexpected EOF */
+
+  /* Prepare the global namespace that will contain the
+     program units.  */
+  gfc_global_ns_list = next = NULL;
+
+  seen_program = 0;
+
+  /* Exit early for empty files.  */
+  if (gfc_at_eof ())
+    goto done;
+
+loop:
+  gfc_init_2 ();
+  st = next_statement ();
+  switch (st)
+    {
+    case ST_NONE:
+      gfc_done_2 ();
+      goto done;
+
+    case ST_PROGRAM:
+      if (seen_program)
+	goto duplicate_main;
+      seen_program = 1;
+      prog_locus = gfc_current_locus;
+
+      push_state (&s, COMP_PROGRAM, gfc_new_block);
+      main_program_symbol(gfc_current_ns, gfc_new_block->name);
+      accept_statement (st);
+      add_global_program ();
+      parse_progunit (ST_NONE);
+      if (gfc_option.flag_whole_file)
+	goto prog_units;
+      break;
+
+    case ST_SUBROUTINE:
+      add_global_procedure (1);
+      push_state (&s, COMP_SUBROUTINE, gfc_new_block);
+      accept_statement (st);
+      parse_progunit (ST_NONE);
+      if (gfc_option.flag_whole_file)
+	goto prog_units;
+      break;
+
+    case ST_FUNCTION:
+      add_global_procedure (0);
+      push_state (&s, COMP_FUNCTION, gfc_new_block);
+      accept_statement (st);
+      parse_progunit (ST_NONE);
+      if (gfc_option.flag_whole_file)
+	goto prog_units;
+      break;
+
+    case ST_BLOCK_DATA:
+      push_state (&s, COMP_BLOCK_DATA, gfc_new_block);
+      accept_statement (st);
+      parse_block_data ();
+      break;
+
+    case ST_MODULE:
+      push_state (&s, COMP_MODULE, gfc_new_block);
+      accept_statement (st);
+
+      gfc_get_errors (NULL, &errors_before);
+      parse_module ();
+      break;
+
+    /* Anything else starts a nameless main program block.  */
+    default:
+      if (seen_program)
+	goto duplicate_main;
+      seen_program = 1;
+      prog_locus = gfc_current_locus;
+
+      push_state (&s, COMP_PROGRAM, gfc_new_block);
+      main_program_symbol (gfc_current_ns, "MAIN__");
+      parse_progunit (st);
+      if (gfc_option.flag_whole_file)
+	goto prog_units;
+      break;
+    }
+
+  /* Handle the non-program units.  */
+  gfc_current_ns->code = s.head;
+
+  gfc_resolve (gfc_current_ns);
+
+  /* Dump the parse tree if requested.  */
+  if (gfc_option.dump_fortran_original)
+    gfc_dump_parse_tree (gfc_current_ns, stdout);
+
+  gfc_get_errors (NULL, &errors);
+  if (s.state == COMP_MODULE)
+    {
+      gfc_dump_module (s.sym->name, errors_before == errors);
+      if (!gfc_option.flag_whole_file)
+	{
+	  if (errors == 0)
+	    gfc_generate_module_code (gfc_current_ns);
+	  pop_state ();
+	  gfc_done_2 ();
+	}
+      else
+	{
+	  gfc_current_ns->derived_types = gfc_derived_types;
+	  gfc_derived_types = NULL;
+	  goto prog_units;
+	}
+    }
+  else
+    {
+      if (errors == 0)
+	gfc_generate_code (gfc_current_ns);
+      pop_state ();
+      gfc_done_2 ();
+    }
+
+  goto loop;
+
+prog_units:
+  /* The main program and non-contained procedures are put
+     in the global namespace list, so that they can be processed
+     later and all their interfaces resolved.  */
+  gfc_current_ns->code = s.head;
+  if (next)
+    {
+      for (; next->sibling; next = next->sibling)
+	;
+      next->sibling = gfc_current_ns;
+    }
+  else
+    gfc_global_ns_list = gfc_current_ns;
+
+  next = gfc_current_ns;
+
+  pop_state ();
+  goto loop;
+
+  done:
+
+  if (!gfc_option.flag_whole_file)
+    goto termination;
+
+  /* Do the resolution.  */
+  resolve_all_program_units (gfc_global_ns_list);
+
+  /* Do the parse tree dump.  */ 
+  gfc_current_ns
+	= gfc_option.dump_fortran_original ? gfc_global_ns_list : NULL;
+
+  for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling)
+    if (!gfc_current_ns->proc_name
+	|| gfc_current_ns->proc_name->attr.flavor != FL_MODULE)
+      {
+	gfc_dump_parse_tree (gfc_current_ns, stdout);
+	fputs ("------------------------------------------\n\n", stdout);
+      }
+
+  /* Do the translation.  */
+  translate_all_program_units (gfc_global_ns_list);
+
+termination:
+
+  gfc_end_source_files ();
+  return SUCCESS;
+
+duplicate_main:
+  /* If we see a duplicate main program, shut down.  If the second
+     instance is an implied main program, i.e. data decls or executable
+     statements, we're in for lots of errors.  */
+  gfc_error ("Two main PROGRAMs at %L and %C", &prog_locus);
+  reject_statement ();
+  gfc_done_2 ();
+  return SUCCESS;
+}
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
new file mode 100644
index 000000000..b18056c1c
--- /dev/null
+++ b/gcc/fortran/parse.h
@@ -0,0 +1,72 @@
+/* Parser header
+   Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Steven Bosscher
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+#ifndef GFC_PARSE_H
+#define GFC_PARSE_H
+
+/* Enum for what the compiler is currently doing.  */
+typedef enum
+{
+  COMP_NONE, COMP_PROGRAM, COMP_MODULE, COMP_SUBROUTINE, COMP_FUNCTION,
+  COMP_BLOCK_DATA, COMP_INTERFACE, COMP_DERIVED, COMP_DERIVED_CONTAINS,
+  COMP_BLOCK, COMP_ASSOCIATE, COMP_IF,
+  COMP_DO, COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM,
+  COMP_SELECT_TYPE, COMP_OMP_STRUCTURED_BLOCK, COMP_CRITICAL
+}
+gfc_compile_state;
+
+/* Stack element for the current compilation state.  These structures
+   are allocated as automatic variables.  */
+typedef struct gfc_state_data
+{
+  gfc_compile_state state;
+  gfc_symbol *sym;              /* Block name associated with this level */
+  gfc_symtree *do_variable;     /* For DO blocks the iterator variable.  */
+
+  struct gfc_code *construct;
+  struct gfc_code *head, *tail;
+  struct gfc_state_data *previous;
+
+  /* Block-specific state data.  */
+  union
+  {
+    gfc_st_label *end_do_label;
+  }
+  ext;
+}
+gfc_state_data;
+
+extern gfc_state_data *gfc_state_stack;
+
+#define gfc_current_block() (gfc_state_stack->sym)
+#define gfc_current_state() (gfc_state_stack->state)
+
+int gfc_check_do_variable (gfc_symtree *);
+gfc_try gfc_find_state (gfc_compile_state);
+gfc_state_data *gfc_enclosing_unit (gfc_compile_state *);
+const char *gfc_ascii_statement (gfc_statement);
+match gfc_match_enum (void);
+match gfc_match_enumerator_def (void);
+void gfc_free_enum_history (void);
+extern bool gfc_matching_function;
+match gfc_match_prefix (gfc_typespec *);
+#endif  /* GFC_PARSE_H  */
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
new file mode 100644
index 000000000..7a8e9e14e
--- /dev/null
+++ b/gcc/fortran/primary.c
@@ -0,0 +1,3185 @@
+/* Primary expression subroutines
+   Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "arith.h"
+#include "match.h"
+#include "parse.h"
+#include "constructor.h"
+
+int matching_actual_arglist = 0;
+
+/* Matches a kind-parameter expression, which is either a named
+   symbolic constant or a nonnegative integer constant.  If
+   successful, sets the kind value to the correct integer.
+   The argument 'is_iso_c' signals whether the kind is an ISO_C_BINDING
+   symbol like e.g. 'c_int'.  */
+
+static match
+match_kind_param (int *kind, int *is_iso_c)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symbol *sym;
+  const char *p;
+  match m;
+
+  *is_iso_c = 0;
+
+  m = gfc_match_small_literal_int (kind, NULL);
+  if (m != MATCH_NO)
+    return m;
+
+  m = gfc_match_name (name);
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_find_symbol (name, NULL, 1, &sym))
+    return MATCH_ERROR;
+
+  if (sym == NULL)
+    return MATCH_NO;
+
+  *is_iso_c = sym->attr.is_iso_c;
+
+  if (sym->attr.flavor != FL_PARAMETER)
+    return MATCH_NO;
+
+  if (sym->value == NULL)
+    return MATCH_NO;
+
+  p = gfc_extract_int (sym->value, kind);
+  if (p != NULL)
+    return MATCH_NO;
+
+  gfc_set_sym_referenced (sym);
+
+  if (*kind < 0)
+    return MATCH_NO;
+
+  return MATCH_YES;
+}
+
+
+/* Get a trailing kind-specification for non-character variables.
+   Returns:
+     * the integer kind value or
+     * -1 if an error was generated,
+     * -2 if no kind was found.
+   The argument 'is_iso_c' signals whether the kind is an ISO_C_BINDING
+   symbol like e.g. 'c_int'.  */
+
+static int
+get_kind (int *is_iso_c)
+{
+  int kind;
+  match m;
+
+  *is_iso_c = 0;
+
+  if (gfc_match_char ('_') != MATCH_YES)
+    return -2;
+
+  m = match_kind_param (&kind, is_iso_c);
+  if (m == MATCH_NO)
+    gfc_error ("Missing kind-parameter at %C");
+
+  return (m == MATCH_YES) ? kind : -1;
+}
+
+
+/* Given a character and a radix, see if the character is a valid
+   digit in that radix.  */
+
+int
+gfc_check_digit (char c, int radix)
+{
+  int r;
+
+  switch (radix)
+    {
+    case 2:
+      r = ('0' <= c && c <= '1');
+      break;
+
+    case 8:
+      r = ('0' <= c && c <= '7');
+      break;
+
+    case 10:
+      r = ('0' <= c && c <= '9');
+      break;
+
+    case 16:
+      r = ISXDIGIT (c);
+      break;
+
+    default:
+      gfc_internal_error ("gfc_check_digit(): bad radix");
+    }
+
+  return r;
+}
+
+
+/* Match the digit string part of an integer if signflag is not set,
+   the signed digit string part if signflag is set.  If the buffer 
+   is NULL, we just count characters for the resolution pass.  Returns 
+   the number of characters matched, -1 for no match.  */
+
+static int
+match_digits (int signflag, int radix, char *buffer)
+{
+  locus old_loc;
+  int length;
+  char c;
+
+  length = 0;
+  c = gfc_next_ascii_char ();
+
+  if (signflag && (c == '+' || c == '-'))
+    {
+      if (buffer != NULL)
+	*buffer++ = c;
+      gfc_gobble_whitespace ();
+      c = gfc_next_ascii_char ();
+      length++;
+    }
+
+  if (!gfc_check_digit (c, radix))
+    return -1;
+
+  length++;
+  if (buffer != NULL)
+    *buffer++ = c;
+
+  for (;;)
+    {
+      old_loc = gfc_current_locus;
+      c = gfc_next_ascii_char ();
+
+      if (!gfc_check_digit (c, radix))
+	break;
+
+      if (buffer != NULL)
+	*buffer++ = c;
+      length++;
+    }
+
+  gfc_current_locus = old_loc;
+
+  return length;
+}
+
+
+/* Match an integer (digit string and optional kind).  
+   A sign will be accepted if signflag is set.  */
+
+static match
+match_integer_constant (gfc_expr **result, int signflag)
+{
+  int length, kind, is_iso_c;
+  locus old_loc;
+  char *buffer;
+  gfc_expr *e;
+
+  old_loc = gfc_current_locus;
+  gfc_gobble_whitespace ();
+
+  length = match_digits (signflag, 10, NULL);
+  gfc_current_locus = old_loc;
+  if (length == -1)
+    return MATCH_NO;
+
+  buffer = (char *) alloca (length + 1);
+  memset (buffer, '\0', length + 1);
+
+  gfc_gobble_whitespace ();
+
+  match_digits (signflag, 10, buffer);
+
+  kind = get_kind (&is_iso_c);
+  if (kind == -2)
+    kind = gfc_default_integer_kind;
+  if (kind == -1)
+    return MATCH_ERROR;
+
+  if (gfc_validate_kind (BT_INTEGER, kind, true) < 0)
+    {
+      gfc_error ("Integer kind %d at %C not available", kind);
+      return MATCH_ERROR;
+    }
+
+  e = gfc_convert_integer (buffer, kind, 10, &gfc_current_locus);
+  e->ts.is_c_interop = is_iso_c;
+
+  if (gfc_range_check (e) != ARITH_OK)
+    {
+      gfc_error ("Integer too big for its kind at %C. This check can be "
+		 "disabled with the option -fno-range-check");
+
+      gfc_free_expr (e);
+      return MATCH_ERROR;
+    }
+
+  *result = e;
+  return MATCH_YES;
+}
+
+
+/* Match a Hollerith constant.  */
+
+static match
+match_hollerith_constant (gfc_expr **result)
+{
+  locus old_loc;
+  gfc_expr *e = NULL;
+  const char *msg;
+  int num, pad;
+  int i;  
+
+  old_loc = gfc_current_locus;
+  gfc_gobble_whitespace ();
+
+  if (match_integer_constant (&e, 0) == MATCH_YES
+      && gfc_match_char ('h') == MATCH_YES)
+    {
+      if (gfc_notify_std (GFC_STD_LEGACY, "Extension: Hollerith constant "
+			  "at %C") == FAILURE)
+	goto cleanup;
+
+      msg = gfc_extract_int (e, &num);
+      if (msg != NULL)
+	{
+	  gfc_error (msg);
+	  goto cleanup;
+	}
+      if (num == 0)
+	{
+	  gfc_error ("Invalid Hollerith constant: %L must contain at least "
+		     "one character", &old_loc);
+	  goto cleanup;
+	}
+      if (e->ts.kind != gfc_default_integer_kind)
+	{
+	  gfc_error ("Invalid Hollerith constant: Integer kind at %L "
+		     "should be default", &old_loc);
+	  goto cleanup;
+	}
+      else
+	{
+	  gfc_free_expr (e);
+	  e = gfc_get_constant_expr (BT_HOLLERITH, gfc_default_character_kind,
+				     &gfc_current_locus);
+
+	  /* Calculate padding needed to fit default integer memory.  */
+	  pad = gfc_default_integer_kind - (num % gfc_default_integer_kind);
+
+	  e->representation.string = XCNEWVEC (char, num + pad + 1);
+
+	  for (i = 0; i < num; i++)
+	    {
+	      gfc_char_t c = gfc_next_char_literal (INSTRING_WARN);
+	      if (! gfc_wide_fits_in_byte (c))
+		{
+		  gfc_error ("Invalid Hollerith constant at %L contains a "
+			     "wide character", &old_loc);
+		  goto cleanup;
+		}
+
+	      e->representation.string[i] = (unsigned char) c;
+	    }
+
+	  /* Now pad with blanks and end with a null char.  */
+	  for (i = 0; i < pad; i++)
+	    e->representation.string[num + i] = ' ';
+
+	  e->representation.string[num + i] = '\0';
+	  e->representation.length = num + pad;
+	  e->ts.u.pad = pad;
+
+	  *result = e;
+	  return MATCH_YES;
+	}
+    }
+
+  gfc_free_expr (e);
+  gfc_current_locus = old_loc;
+  return MATCH_NO;
+
+cleanup:
+  gfc_free_expr (e);
+  return MATCH_ERROR;
+}
+
+
+/* Match a binary, octal or hexadecimal constant that can be found in
+   a DATA statement.  The standard permits b'010...', o'73...', and
+   z'a1...' where b, o, and z can be capital letters.  This function
+   also accepts postfixed forms of the constants: '01...'b, '73...'o,
+   and 'a1...'z.  An additional extension is the use of x for z.  */
+
+static match
+match_boz_constant (gfc_expr **result)
+{
+  int radix, length, x_hex, kind;
+  locus old_loc, start_loc;
+  char *buffer, post, delim;
+  gfc_expr *e;
+
+  start_loc = old_loc = gfc_current_locus;
+  gfc_gobble_whitespace ();
+
+  x_hex = 0;
+  switch (post = gfc_next_ascii_char ())
+    {
+    case 'b':
+      radix = 2;
+      post = 0;
+      break;
+    case 'o':
+      radix = 8;
+      post = 0;
+      break;
+    case 'x':
+      x_hex = 1;
+      /* Fall through.  */
+    case 'z':
+      radix = 16;
+      post = 0;
+      break;
+    case '\'':
+      /* Fall through.  */
+    case '\"':
+      delim = post;
+      post = 1;
+      radix = 16;  /* Set to accept any valid digit string.  */
+      break;
+    default:
+      goto backup;
+    }
+
+  /* No whitespace allowed here.  */
+
+  if (post == 0)
+    delim = gfc_next_ascii_char ();
+
+  if (delim != '\'' && delim != '\"')
+    goto backup;
+
+  if (x_hex
+      && (gfc_notify_std (GFC_STD_GNU, "Extension: Hexadecimal "
+			  "constant at %C uses non-standard syntax")
+	  == FAILURE))
+      return MATCH_ERROR;
+
+  old_loc = gfc_current_locus;
+
+  length = match_digits (0, radix, NULL);
+  if (length == -1)
+    {
+      gfc_error ("Empty set of digits in BOZ constant at %C");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_next_ascii_char () != delim)
+    {
+      gfc_error ("Illegal character in BOZ constant at %C");
+      return MATCH_ERROR;
+    }
+
+  if (post == 1)
+    {
+      switch (gfc_next_ascii_char ())
+	{
+	case 'b':
+	  radix = 2;
+	  break;
+	case 'o':
+	  radix = 8;
+	  break;
+	case 'x':
+	  /* Fall through.  */
+	case 'z':
+	  radix = 16;
+	  break;
+	default:
+	  goto backup;
+	}
+
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: BOZ constant "
+			  "at %C uses non-standard postfix syntax")
+	  == FAILURE)
+	return MATCH_ERROR;
+    }
+
+  gfc_current_locus = old_loc;
+
+  buffer = (char *) alloca (length + 1);
+  memset (buffer, '\0', length + 1);
+
+  match_digits (0, radix, buffer);
+  gfc_next_ascii_char ();    /* Eat delimiter.  */
+  if (post == 1)
+    gfc_next_ascii_char ();  /* Eat postfixed b, o, z, or x.  */
+
+  /* In section 5.2.5 and following C567 in the Fortran 2003 standard, we find
+     "If a data-stmt-constant is a boz-literal-constant, the corresponding
+     variable shall be of type integer.  The boz-literal-constant is treated
+     as if it were an int-literal-constant with a kind-param that specifies
+     the representation method with the largest decimal exponent range
+     supported by the processor."  */
+
+  kind = gfc_max_integer_kind;
+  e = gfc_convert_integer (buffer, kind, radix, &gfc_current_locus);
+
+  /* Mark as boz variable.  */
+  e->is_boz = 1;
+
+  if (gfc_range_check (e) != ARITH_OK)
+    {
+      gfc_error ("Integer too big for integer kind %i at %C", kind);
+      gfc_free_expr (e);
+      return MATCH_ERROR;
+    }
+
+  if (!gfc_in_match_data ()
+      && (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BOZ used outside a DATA "
+			  "statement at %C")
+	  == FAILURE))
+      return MATCH_ERROR;
+
+  *result = e;
+  return MATCH_YES;
+
+backup:
+  gfc_current_locus = start_loc;
+  return MATCH_NO;
+}
+
+
+/* Match a real constant of some sort.  Allow a signed constant if signflag
+   is nonzero.  */
+
+static match
+match_real_constant (gfc_expr **result, int signflag)
+{
+  int kind, count, seen_dp, seen_digits, is_iso_c;
+  locus old_loc, temp_loc;
+  char *p, *buffer, c, exp_char;
+  gfc_expr *e;
+  bool negate;
+
+  old_loc = gfc_current_locus;
+  gfc_gobble_whitespace ();
+
+  e = NULL;
+
+  count = 0;
+  seen_dp = 0;
+  seen_digits = 0;
+  exp_char = ' ';
+  negate = FALSE;
+
+  c = gfc_next_ascii_char ();
+  if (signflag && (c == '+' || c == '-'))
+    {
+      if (c == '-')
+	negate = TRUE;
+
+      gfc_gobble_whitespace ();
+      c = gfc_next_ascii_char ();
+    }
+
+  /* Scan significand.  */
+  for (;; c = gfc_next_ascii_char (), count++)
+    {
+      if (c == '.')
+	{
+	  if (seen_dp)
+	    goto done;
+
+	  /* Check to see if "." goes with a following operator like 
+	     ".eq.".  */
+	  temp_loc = gfc_current_locus;
+	  c = gfc_next_ascii_char ();
+
+	  if (c == 'e' || c == 'd' || c == 'q')
+	    {
+	      c = gfc_next_ascii_char ();
+	      if (c == '.')
+		goto done;	/* Operator named .e. or .d.  */
+	    }
+
+	  if (ISALPHA (c))
+	    goto done;		/* Distinguish 1.e9 from 1.eq.2 */
+
+	  gfc_current_locus = temp_loc;
+	  seen_dp = 1;
+	  continue;
+	}
+
+      if (ISDIGIT (c))
+	{
+	  seen_digits = 1;
+	  continue;
+	}
+
+      break;
+    }
+
+  if (!seen_digits || (c != 'e' && c != 'd' && c != 'q'))
+    goto done;
+  exp_char = c;
+
+
+  if (c == 'q')
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: exponent-letter 'q' in "
+			 "real-literal-constant at %C") == FAILURE)
+	return MATCH_ERROR;
+      else if (gfc_option.warn_real_q_constant)
+	gfc_warning("Extension: exponent-letter 'q' in real-literal-constant "
+		    "at %C");
+    }
+
+  /* Scan exponent.  */
+  c = gfc_next_ascii_char ();
+  count++;
+
+  if (c == '+' || c == '-')
+    {				/* optional sign */
+      c = gfc_next_ascii_char ();
+      count++;
+    }
+
+  if (!ISDIGIT (c))
+    {
+      gfc_error ("Missing exponent in real number at %C");
+      return MATCH_ERROR;
+    }
+
+  while (ISDIGIT (c))
+    {
+      c = gfc_next_ascii_char ();
+      count++;
+    }
+
+done:
+  /* Check that we have a numeric constant.  */
+  if (!seen_digits || (!seen_dp && exp_char == ' '))
+    {
+      gfc_current_locus = old_loc;
+      return MATCH_NO;
+    }
+
+  /* Convert the number.  */
+  gfc_current_locus = old_loc;
+  gfc_gobble_whitespace ();
+
+  buffer = (char *) alloca (count + 1);
+  memset (buffer, '\0', count + 1);
+
+  p = buffer;
+  c = gfc_next_ascii_char ();
+  if (c == '+' || c == '-')
+    {
+      gfc_gobble_whitespace ();
+      c = gfc_next_ascii_char ();
+    }
+
+  /* Hack for mpfr_set_str().  */
+  for (;;)
+    {
+      if (c == 'd' || c == 'q')
+	*p = 'e';
+      else
+	*p = c;
+      p++;
+      if (--count == 0)
+	break;
+
+      c = gfc_next_ascii_char ();
+    }
+
+  kind = get_kind (&is_iso_c);
+  if (kind == -1)
+    goto cleanup;
+
+  switch (exp_char)
+    {
+    case 'd':
+      if (kind != -2)
+	{
+	  gfc_error ("Real number at %C has a 'd' exponent and an explicit "
+		     "kind");
+	  goto cleanup;
+	}
+      kind = gfc_default_double_kind;
+      break;
+
+    case 'q':
+      if (kind != -2)
+	{
+	  gfc_error ("Real number at %C has a 'q' exponent and an explicit "
+		     "kind");
+	  goto cleanup;
+	}
+
+      /* The maximum possible real kind type parameter is 16.  First, try
+	 that for the kind, then fallback to trying kind=10 (Intel 80 bit)
+	 extended precision.  If neither value works, just given up.  */
+      kind = 16;
+      if (gfc_validate_kind (BT_REAL, kind, true) < 0)
+	{
+	  kind = 10;
+          if (gfc_validate_kind (BT_REAL, kind, true) < 0)
+	    {
+	      gfc_error ("Invalid exponent-letter 'q' in "
+			 "real-literal-constant at %C");
+	      goto cleanup;
+	    }
+	}
+      break;
+
+    default:
+      if (kind == -2)
+	kind = gfc_default_real_kind;
+
+      if (gfc_validate_kind (BT_REAL, kind, true) < 0)
+	{
+	  gfc_error ("Invalid real kind %d at %C", kind);
+	  goto cleanup;
+	}
+    }
+
+  e = gfc_convert_real (buffer, kind, &gfc_current_locus);
+  if (negate)
+    mpfr_neg (e->value.real, e->value.real, GFC_RND_MODE);
+  e->ts.is_c_interop = is_iso_c;
+
+  switch (gfc_range_check (e))
+    {
+    case ARITH_OK:
+      break;
+    case ARITH_OVERFLOW:
+      gfc_error ("Real constant overflows its kind at %C");
+      goto cleanup;
+
+    case ARITH_UNDERFLOW:
+      if (gfc_option.warn_underflow)
+	gfc_warning ("Real constant underflows its kind at %C");
+      mpfr_set_ui (e->value.real, 0, GFC_RND_MODE);
+      break;
+
+    default:
+      gfc_internal_error ("gfc_range_check() returned bad value");
+    }
+
+  *result = e;
+  return MATCH_YES;
+
+cleanup:
+  gfc_free_expr (e);
+  return MATCH_ERROR;
+}
+
+
+/* Match a substring reference.  */
+
+static match
+match_substring (gfc_charlen *cl, int init, gfc_ref **result)
+{
+  gfc_expr *start, *end;
+  locus old_loc;
+  gfc_ref *ref;
+  match m;
+
+  start = NULL;
+  end = NULL;
+
+  old_loc = gfc_current_locus;
+
+  m = gfc_match_char ('(');
+  if (m != MATCH_YES)
+    return MATCH_NO;
+
+  if (gfc_match_char (':') != MATCH_YES)
+    {
+      if (init)
+	m = gfc_match_init_expr (&start);
+      else
+	m = gfc_match_expr (&start);
+
+      if (m != MATCH_YES)
+	{
+	  m = MATCH_NO;
+	  goto cleanup;
+	}
+
+      m = gfc_match_char (':');
+      if (m != MATCH_YES)
+	goto cleanup;
+    }
+
+  if (gfc_match_char (')') != MATCH_YES)
+    {
+      if (init)
+	m = gfc_match_init_expr (&end);
+      else
+	m = gfc_match_expr (&end);
+
+      if (m == MATCH_NO)
+	goto syntax;
+      if (m == MATCH_ERROR)
+	goto cleanup;
+
+      m = gfc_match_char (')');
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+  /* Optimize away the (:) reference.  */
+  if (start == NULL && end == NULL)
+    ref = NULL;
+  else
+    {
+      ref = gfc_get_ref ();
+
+      ref->type = REF_SUBSTRING;
+      if (start == NULL)
+	start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+      ref->u.ss.start = start;
+      if (end == NULL && cl)
+	end = gfc_copy_expr (cl->length);
+      ref->u.ss.end = end;
+      ref->u.ss.length = cl;
+    }
+
+  *result = ref;
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in SUBSTRING specification at %C");
+  m = MATCH_ERROR;
+
+cleanup:
+  gfc_free_expr (start);
+  gfc_free_expr (end);
+
+  gfc_current_locus = old_loc;
+  return m;
+}
+
+
+/* Reads the next character of a string constant, taking care to
+   return doubled delimiters on the input as a single instance of
+   the delimiter.
+
+   Special return values for "ret" argument are:
+     -1   End of the string, as determined by the delimiter
+     -2   Unterminated string detected
+
+   Backslash codes are also expanded at this time.  */
+
+static gfc_char_t
+next_string_char (gfc_char_t delimiter, int *ret)
+{
+  locus old_locus;
+  gfc_char_t c;
+
+  c = gfc_next_char_literal (INSTRING_WARN);
+  *ret = 0;
+
+  if (c == '\n')
+    {
+      *ret = -2;
+      return 0;
+    }
+
+  if (gfc_option.flag_backslash && c == '\\')
+    {
+      old_locus = gfc_current_locus;
+
+      if (gfc_match_special_char (&c) == MATCH_NO)
+	gfc_current_locus = old_locus;
+
+      if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings)
+	gfc_warning ("Extension: backslash character at %C");
+    }
+
+  if (c != delimiter)
+    return c;
+
+  old_locus = gfc_current_locus;
+  c = gfc_next_char_literal (NONSTRING);
+
+  if (c == delimiter)
+    return c;
+  gfc_current_locus = old_locus;
+
+  *ret = -1;
+  return 0;
+}
+
+
+/* Special case of gfc_match_name() that matches a parameter kind name
+   before a string constant.  This takes case of the weird but legal
+   case of:
+
+     kind_____'string'
+
+   where kind____ is a parameter. gfc_match_name() will happily slurp
+   up all the underscores, which leads to problems.  If we return
+   MATCH_YES, the parse pointer points to the final underscore, which
+   is not part of the name.  We never return MATCH_ERROR-- errors in
+   the name will be detected later.  */
+
+static match
+match_charkind_name (char *name)
+{
+  locus old_loc;
+  char c, peek;
+  int len;
+
+  gfc_gobble_whitespace ();
+  c = gfc_next_ascii_char ();
+  if (!ISALPHA (c))
+    return MATCH_NO;
+
+  *name++ = c;
+  len = 1;
+
+  for (;;)
+    {
+      old_loc = gfc_current_locus;
+      c = gfc_next_ascii_char ();
+
+      if (c == '_')
+	{
+	  peek = gfc_peek_ascii_char ();
+
+	  if (peek == '\'' || peek == '\"')
+	    {
+	      gfc_current_locus = old_loc;
+	      *name = '\0';
+	      return MATCH_YES;
+	    }
+	}
+
+      if (!ISALNUM (c)
+	  && c != '_'
+	  && (c != '$' || !gfc_option.flag_dollar_ok))
+	break;
+
+      *name++ = c;
+      if (++len > GFC_MAX_SYMBOL_LEN)
+	break;
+    }
+
+  return MATCH_NO;
+}
+
+
+/* See if the current input matches a character constant.  Lots of
+   contortions have to be done to match the kind parameter which comes
+   before the actual string.  The main consideration is that we don't
+   want to error out too quickly.  For example, we don't actually do
+   any validation of the kinds until we have actually seen a legal
+   delimiter.  Using match_kind_param() generates errors too quickly.  */
+
+static match
+match_string_constant (gfc_expr **result)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1], peek;
+  int i, kind, length, warn_ampersand, ret;
+  locus old_locus, start_locus;
+  gfc_symbol *sym;
+  gfc_expr *e;
+  const char *q;
+  match m;
+  gfc_char_t c, delimiter, *p;
+
+  old_locus = gfc_current_locus;
+
+  gfc_gobble_whitespace ();
+
+  c = gfc_next_char ();
+  if (c == '\'' || c == '"')
+    {
+      kind = gfc_default_character_kind;
+      start_locus = gfc_current_locus;
+      goto got_delim;
+    }
+
+  if (gfc_wide_is_digit (c))
+    {
+      kind = 0;
+
+      while (gfc_wide_is_digit (c))
+	{
+	  kind = kind * 10 + c - '0';
+	  if (kind > 9999999)
+	    goto no_match;
+	  c = gfc_next_char ();
+	}
+
+    }
+  else
+    {
+      gfc_current_locus = old_locus;
+
+      m = match_charkind_name (name);
+      if (m != MATCH_YES)
+	goto no_match;
+
+      if (gfc_find_symbol (name, NULL, 1, &sym)
+	  || sym == NULL
+	  || sym->attr.flavor != FL_PARAMETER)
+	goto no_match;
+
+      kind = -1;
+      c = gfc_next_char ();
+    }
+
+  if (c == ' ')
+    {
+      gfc_gobble_whitespace ();
+      c = gfc_next_char ();
+    }
+
+  if (c != '_')
+    goto no_match;
+
+  gfc_gobble_whitespace ();
+
+  c = gfc_next_char ();
+  if (c != '\'' && c != '"')
+    goto no_match;
+
+  start_locus = gfc_current_locus;
+
+  if (kind == -1)
+    {
+      q = gfc_extract_int (sym->value, &kind);
+      if (q != NULL)
+	{
+	  gfc_error (q);
+	  return MATCH_ERROR;
+	}
+      gfc_set_sym_referenced (sym);
+    }
+
+  if (gfc_validate_kind (BT_CHARACTER, kind, true) < 0)
+    {
+      gfc_error ("Invalid kind %d for CHARACTER constant at %C", kind);
+      return MATCH_ERROR;
+    }
+
+got_delim:
+  /* Scan the string into a block of memory by first figuring out how
+     long it is, allocating the structure, then re-reading it.  This
+     isn't particularly efficient, but string constants aren't that
+     common in most code.  TODO: Use obstacks?  */
+
+  delimiter = c;
+  length = 0;
+
+  for (;;)
+    {
+      c = next_string_char (delimiter, &ret);
+      if (ret == -1)
+	break;
+      if (ret == -2)
+	{
+	  gfc_current_locus = start_locus;
+	  gfc_error ("Unterminated character constant beginning at %C");
+	  return MATCH_ERROR;
+	}
+
+      length++;
+    }
+
+  /* Peek at the next character to see if it is a b, o, z, or x for the
+     postfixed BOZ literal constants.  */
+  peek = gfc_peek_ascii_char ();
+  if (peek == 'b' || peek == 'o' || peek =='z' || peek == 'x')
+    goto no_match;
+
+  e = gfc_get_character_expr (kind, &start_locus, NULL, length);
+  e->ref = NULL;
+  e->ts.is_c_interop = 0;
+  e->ts.is_iso_c = 0;
+
+  gfc_current_locus = start_locus;
+
+  /* We disable the warning for the following loop as the warning has already
+     been printed in the loop above.  */
+  warn_ampersand = gfc_option.warn_ampersand;
+  gfc_option.warn_ampersand = 0;
+
+  p = e->value.character.string;
+  for (i = 0; i < length; i++)
+    {
+      c = next_string_char (delimiter, &ret);
+
+      if (!gfc_check_character_range (c, kind))
+	{
+	  gfc_error ("Character '%s' in string at %C is not representable "
+		     "in character kind %d", gfc_print_wide_char (c), kind);
+	  return MATCH_ERROR;
+	}
+
+      *p++ = c;
+    }
+
+  *p = '\0';	/* TODO: C-style string is for development/debug purposes.  */
+  gfc_option.warn_ampersand = warn_ampersand;
+
+  next_string_char (delimiter, &ret);
+  if (ret != -1)
+    gfc_internal_error ("match_string_constant(): Delimiter not found");
+
+  if (match_substring (NULL, 0, &e->ref) != MATCH_NO)
+    e->expr_type = EXPR_SUBSTRING;
+
+  *result = e;
+
+  return MATCH_YES;
+
+no_match:
+  gfc_current_locus = old_locus;
+  return MATCH_NO;
+}
+
+
+/* Match a .true. or .false.  Returns 1 if a .true. was found,
+   0 if a .false. was found, and -1 otherwise.  */
+static int
+match_logical_constant_string (void)
+{
+  locus orig_loc = gfc_current_locus;
+
+  gfc_gobble_whitespace ();
+  if (gfc_next_ascii_char () == '.')
+    {
+      char ch = gfc_next_ascii_char ();
+      if (ch == 'f')
+	{
+	  if (gfc_next_ascii_char () == 'a'
+	      && gfc_next_ascii_char () == 'l'
+	      && gfc_next_ascii_char () == 's'
+	      && gfc_next_ascii_char () == 'e'
+	      && gfc_next_ascii_char () == '.')
+	    /* Matched ".false.".  */
+	    return 0;
+	}
+      else if (ch == 't')
+	{
+	  if (gfc_next_ascii_char () == 'r'
+	      && gfc_next_ascii_char () == 'u'
+	      && gfc_next_ascii_char () == 'e'
+	      && gfc_next_ascii_char () == '.')
+	    /* Matched ".true.".  */
+	    return 1;
+	}
+    }
+  gfc_current_locus = orig_loc;
+  return -1;
+}
+
+/* Match a .true. or .false.  */
+
+static match
+match_logical_constant (gfc_expr **result)
+{
+  gfc_expr *e;
+  int i, kind, is_iso_c;
+
+  i = match_logical_constant_string ();
+  if (i == -1)
+    return MATCH_NO;
+
+  kind = get_kind (&is_iso_c);
+  if (kind == -1)
+    return MATCH_ERROR;
+  if (kind == -2)
+    kind = gfc_default_logical_kind;
+
+  if (gfc_validate_kind (BT_LOGICAL, kind, true) < 0)
+    {
+      gfc_error ("Bad kind for logical constant at %C");
+      return MATCH_ERROR;
+    }
+
+  e = gfc_get_logical_expr (kind, &gfc_current_locus, i);
+  e->ts.is_c_interop = is_iso_c;
+  e->ts.is_iso_c = 0;
+
+  *result = e;
+  return MATCH_YES;
+}
+
+
+/* Match a real or imaginary part of a complex constant that is a
+   symbolic constant.  */
+
+static match
+match_sym_complex_part (gfc_expr **result)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symbol *sym;
+  gfc_expr *e;
+  match m;
+
+  m = gfc_match_name (name);
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_find_symbol (name, NULL, 1, &sym) || sym == NULL)
+    return MATCH_NO;
+
+  if (sym->attr.flavor != FL_PARAMETER)
+    {
+      gfc_error ("Expected PARAMETER symbol in complex constant at %C");
+      return MATCH_ERROR;
+    }
+
+  if (!gfc_numeric_ts (&sym->value->ts))
+    {
+      gfc_error ("Numeric PARAMETER required in complex constant at %C");
+      return MATCH_ERROR;
+    }
+
+  if (sym->value->rank != 0)
+    {
+      gfc_error ("Scalar PARAMETER required in complex constant at %C");
+      return MATCH_ERROR;
+    }
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PARAMETER symbol in "
+		      "complex constant at %C") == FAILURE)
+    return MATCH_ERROR;
+
+  switch (sym->value->ts.type)
+    {
+    case BT_REAL:
+      e = gfc_copy_expr (sym->value);
+      break;
+
+    case BT_COMPLEX:
+      e = gfc_complex2real (sym->value, sym->value->ts.kind);
+      if (e == NULL)
+	goto error;
+      break;
+
+    case BT_INTEGER:
+      e = gfc_int2real (sym->value, gfc_default_real_kind);
+      if (e == NULL)
+	goto error;
+      break;
+
+    default:
+      gfc_internal_error ("gfc_match_sym_complex_part(): Bad type");
+    }
+
+  *result = e;		/* e is a scalar, real, constant expression.  */
+  return MATCH_YES;
+
+error:
+  gfc_error ("Error converting PARAMETER constant in complex constant at %C");
+  return MATCH_ERROR;
+}
+
+
+/* Match a real or imaginary part of a complex number.  */
+
+static match
+match_complex_part (gfc_expr **result)
+{
+  match m;
+
+  m = match_sym_complex_part (result);
+  if (m != MATCH_NO)
+    return m;
+
+  m = match_real_constant (result, 1);
+  if (m != MATCH_NO)
+    return m;
+
+  return match_integer_constant (result, 1);
+}
+
+
+/* Try to match a complex constant.  */
+
+static match
+match_complex_constant (gfc_expr **result)
+{
+  gfc_expr *e, *real, *imag;
+  gfc_error_buf old_error;
+  gfc_typespec target;
+  locus old_loc;
+  int kind;
+  match m;
+
+  old_loc = gfc_current_locus;
+  real = imag = e = NULL;
+
+  m = gfc_match_char ('(');
+  if (m != MATCH_YES)
+    return m;
+
+  gfc_push_error (&old_error);
+
+  m = match_complex_part (&real);
+  if (m == MATCH_NO)
+    {
+      gfc_free_error (&old_error);
+      goto cleanup;
+    }
+
+  if (gfc_match_char (',') == MATCH_NO)
+    {
+      gfc_pop_error (&old_error);
+      m = MATCH_NO;
+      goto cleanup;
+    }
+
+  /* If m is error, then something was wrong with the real part and we
+     assume we have a complex constant because we've seen the ','.  An
+     ambiguous case here is the start of an iterator list of some
+     sort. These sort of lists are matched prior to coming here.  */
+
+  if (m == MATCH_ERROR)
+    {
+      gfc_free_error (&old_error);
+      goto cleanup;
+    }
+  gfc_pop_error (&old_error);
+
+  m = match_complex_part (&imag);
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  m = gfc_match_char (')');
+  if (m == MATCH_NO)
+    {
+      /* Give the matcher for implied do-loops a chance to run.  This
+	 yields a much saner error message for (/ (i, 4=i, 6) /).  */
+      if (gfc_peek_ascii_char () == '=')
+	{
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+      else
+    goto syntax;
+    }
+
+  if (m == MATCH_ERROR)
+    goto cleanup;
+
+  /* Decide on the kind of this complex number.  */
+  if (real->ts.type == BT_REAL)
+    {
+      if (imag->ts.type == BT_REAL)
+	kind = gfc_kind_max (real, imag);
+      else
+	kind = real->ts.kind;
+    }
+  else
+    {
+      if (imag->ts.type == BT_REAL)
+	kind = imag->ts.kind;
+      else
+	kind = gfc_default_real_kind;
+    }
+  target.type = BT_REAL;
+  target.kind = kind;
+  target.is_c_interop = 0;
+  target.is_iso_c = 0;
+
+  if (real->ts.type != BT_REAL || kind != real->ts.kind)
+    gfc_convert_type (real, &target, 2);
+  if (imag->ts.type != BT_REAL || kind != imag->ts.kind)
+    gfc_convert_type (imag, &target, 2);
+
+  e = gfc_convert_complex (real, imag, kind);
+  e->where = gfc_current_locus;
+
+  gfc_free_expr (real);
+  gfc_free_expr (imag);
+
+  *result = e;
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in COMPLEX constant at %C");
+  m = MATCH_ERROR;
+
+cleanup:
+  gfc_free_expr (e);
+  gfc_free_expr (real);
+  gfc_free_expr (imag);
+  gfc_current_locus = old_loc;
+
+  return m;
+}
+
+
+/* Match constants in any of several forms.  Returns nonzero for a
+   match, zero for no match.  */
+
+match
+gfc_match_literal_constant (gfc_expr **result, int signflag)
+{
+  match m;
+
+  m = match_complex_constant (result);
+  if (m != MATCH_NO)
+    return m;
+
+  m = match_string_constant (result);
+  if (m != MATCH_NO)
+    return m;
+
+  m = match_boz_constant (result);
+  if (m != MATCH_NO)
+    return m;
+
+  m = match_real_constant (result, signflag);
+  if (m != MATCH_NO)
+    return m;
+
+  m = match_hollerith_constant (result);
+  if (m != MATCH_NO)
+    return m;
+
+  m = match_integer_constant (result, signflag);
+  if (m != MATCH_NO)
+    return m;
+
+  m = match_logical_constant (result);
+  if (m != MATCH_NO)
+    return m;
+
+  return MATCH_NO;
+}
+
+
+/* This checks if a symbol is the return value of an encompassing function.
+   Function nesting can be maximally two levels deep, but we may have
+   additional local namespaces like BLOCK etc.  */
+
+bool
+gfc_is_function_return_value (gfc_symbol *sym, gfc_namespace *ns)
+{
+  if (!sym->attr.function || (sym->result != sym))
+    return false;
+  while (ns)
+    {
+      if (ns->proc_name == sym)
+	return true;
+      ns = ns->parent;
+    }
+  return false;
+}
+
+
+/* Match a single actual argument value.  An actual argument is
+   usually an expression, but can also be a procedure name.  If the
+   argument is a single name, it is not always possible to tell
+   whether the name is a dummy procedure or not.  We treat these cases
+   by creating an argument that looks like a dummy procedure and
+   fixing things later during resolution.  */
+
+static match
+match_actual_arg (gfc_expr **result)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_symtree *symtree;
+  locus where, w;
+  gfc_expr *e;
+  char c;
+
+  gfc_gobble_whitespace ();
+  where = gfc_current_locus;
+
+  switch (gfc_match_name (name))
+    {
+    case MATCH_ERROR:
+      return MATCH_ERROR;
+
+    case MATCH_NO:
+      break;
+
+    case MATCH_YES:
+      w = gfc_current_locus;
+      gfc_gobble_whitespace ();
+      c = gfc_next_ascii_char ();
+      gfc_current_locus = w;
+
+      if (c != ',' && c != ')')
+	break;
+
+      if (gfc_find_sym_tree (name, NULL, 1, &symtree))
+	break;
+      /* Handle error elsewhere.  */
+
+      /* Eliminate a couple of common cases where we know we don't
+	 have a function argument.  */
+      if (symtree == NULL)
+	{
+	  gfc_get_sym_tree (name, NULL, &symtree, false);
+	  gfc_set_sym_referenced (symtree->n.sym);
+	}
+      else
+	{
+	  gfc_symbol *sym;
+
+	  sym = symtree->n.sym;
+	  gfc_set_sym_referenced (sym);
+	  if (sym->attr.flavor != FL_PROCEDURE
+	      && sym->attr.flavor != FL_UNKNOWN)
+	    break;
+
+	  if (sym->attr.in_common && !sym->attr.proc_pointer)
+	    {
+	      gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name,
+			      &sym->declared_at);
+	      break;
+	    }
+
+	  /* If the symbol is a function with itself as the result and
+	     is being defined, then we have a variable.  */
+	  if (sym->attr.function && sym->result == sym)
+	    {
+	      if (gfc_is_function_return_value (sym, gfc_current_ns))
+		break;
+
+	      if (sym->attr.entry
+		  && (sym->ns == gfc_current_ns
+		      || sym->ns == gfc_current_ns->parent))
+		{
+		  gfc_entry_list *el = NULL;
+
+		  for (el = sym->ns->entries; el; el = el->next)
+		    if (sym == el->sym)
+		      break;
+
+		  if (el)
+		    break;
+		}
+	    }
+	}
+
+      e = gfc_get_expr ();	/* Leave it unknown for now */
+      e->symtree = symtree;
+      e->expr_type = EXPR_VARIABLE;
+      e->ts.type = BT_PROCEDURE;
+      e->where = where;
+
+      *result = e;
+      return MATCH_YES;
+    }
+
+  gfc_current_locus = where;
+  return gfc_match_expr (result);
+}
+
+
+/* Match a keyword argument.  */
+
+static match
+match_keyword_arg (gfc_actual_arglist *actual, gfc_actual_arglist *base)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_actual_arglist *a;
+  locus name_locus;
+  match m;
+
+  name_locus = gfc_current_locus;
+  m = gfc_match_name (name);
+
+  if (m != MATCH_YES)
+    goto cleanup;
+  if (gfc_match_char ('=') != MATCH_YES)
+    {
+      m = MATCH_NO;
+      goto cleanup;
+    }
+
+  m = match_actual_arg (&actual->expr);
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  /* Make sure this name has not appeared yet.  */
+
+  if (name[0] != '\0')
+    {
+      for (a = base; a; a = a->next)
+	if (a->name != NULL && strcmp (a->name, name) == 0)
+	  {
+	    gfc_error ("Keyword '%s' at %C has already appeared in the "
+		       "current argument list", name);
+	    return MATCH_ERROR;
+	  }
+    }
+
+  actual->name = gfc_get_string (name);
+  return MATCH_YES;
+
+cleanup:
+  gfc_current_locus = name_locus;
+  return m;
+}
+
+
+/* Match an argument list function, such as %VAL.  */
+
+static match
+match_arg_list_function (gfc_actual_arglist *result)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  locus old_locus;
+  match m;
+
+  old_locus = gfc_current_locus;
+
+  if (gfc_match_char ('%') != MATCH_YES)
+    {
+      m = MATCH_NO;
+      goto cleanup;
+    }
+
+  m = gfc_match ("%n (", name);
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  if (name[0] != '\0')
+    {
+      switch (name[0])
+	{
+	case 'l':
+	  if (strncmp (name, "loc", 3) == 0)
+	    {
+	      result->name = "%LOC";
+	      break;
+	    }
+	case 'r':
+	  if (strncmp (name, "ref", 3) == 0)
+	    {
+	      result->name = "%REF";
+	      break;
+	    }
+	case 'v':
+	  if (strncmp (name, "val", 3) == 0)
+	    {
+	      result->name = "%VAL";
+	      break;
+	    }
+	default:
+	  m = MATCH_ERROR;
+	  goto cleanup;
+	}
+    }
+
+  if (gfc_notify_std (GFC_STD_GNU, "Extension: argument list "
+		      "function at %C") == FAILURE)
+    {
+      m = MATCH_ERROR;
+      goto cleanup;
+    }
+
+  m = match_actual_arg (&result->expr);
+  if (m != MATCH_YES)
+    goto cleanup;
+
+  if (gfc_match_char (')') != MATCH_YES)
+    {
+      m = MATCH_NO;
+      goto cleanup;
+    }
+
+  return MATCH_YES;
+
+cleanup:
+  gfc_current_locus = old_locus;
+  return m;
+}
+
+
+/* Matches an actual argument list of a function or subroutine, from
+   the opening parenthesis to the closing parenthesis.  The argument
+   list is assumed to allow keyword arguments because we don't know if
+   the symbol associated with the procedure has an implicit interface
+   or not.  We make sure keywords are unique. If sub_flag is set,
+   we're matching the argument list of a subroutine.  */
+
+match
+gfc_match_actual_arglist (int sub_flag, gfc_actual_arglist **argp)
+{
+  gfc_actual_arglist *head, *tail;
+  int seen_keyword;
+  gfc_st_label *label;
+  locus old_loc;
+  match m;
+
+  *argp = tail = NULL;
+  old_loc = gfc_current_locus;
+
+  seen_keyword = 0;
+
+  if (gfc_match_char ('(') == MATCH_NO)
+    return (sub_flag) ? MATCH_YES : MATCH_NO;
+
+  if (gfc_match_char (')') == MATCH_YES)
+    return MATCH_YES;
+  head = NULL;
+
+  matching_actual_arglist++;
+
+  for (;;)
+    {
+      if (head == NULL)
+	head = tail = gfc_get_actual_arglist ();
+      else
+	{
+	  tail->next = gfc_get_actual_arglist ();
+	  tail = tail->next;
+	}
+
+      if (sub_flag && gfc_match_char ('*') == MATCH_YES)
+	{
+	  m = gfc_match_st_label (&label);
+	  if (m == MATCH_NO)
+	    gfc_error ("Expected alternate return label at %C");
+	  if (m != MATCH_YES)
+	    goto cleanup;
+
+	  tail->label = label;
+	  goto next;
+	}
+
+      /* After the first keyword argument is seen, the following
+	 arguments must also have keywords.  */
+      if (seen_keyword)
+	{
+	  m = match_keyword_arg (tail, head);
+
+	  if (m == MATCH_ERROR)
+	    goto cleanup;
+	  if (m == MATCH_NO)
+	    {
+	      gfc_error ("Missing keyword name in actual argument list at %C");
+	      goto cleanup;
+	    }
+
+	}
+      else
+	{
+	  /* Try an argument list function, like %VAL.  */
+	  m = match_arg_list_function (tail);
+	  if (m == MATCH_ERROR)
+	    goto cleanup;
+
+	  /* See if we have the first keyword argument.  */
+	  if (m == MATCH_NO)
+	    {
+	      m = match_keyword_arg (tail, head);
+	      if (m == MATCH_YES)
+		seen_keyword = 1;
+	      if (m == MATCH_ERROR)
+		goto cleanup;
+	    }
+
+	  if (m == MATCH_NO)
+	    {
+	      /* Try for a non-keyword argument.  */
+	      m = match_actual_arg (&tail->expr);
+	      if (m == MATCH_ERROR)
+		goto cleanup;
+	      if (m == MATCH_NO)
+		goto syntax;
+	    }
+	}
+
+
+    next:
+      if (gfc_match_char (')') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+    }
+
+  *argp = head;
+  matching_actual_arglist--;
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in argument list at %C");
+
+cleanup:
+  gfc_free_actual_arglist (head);
+  gfc_current_locus = old_loc;
+  matching_actual_arglist--;
+  return MATCH_ERROR;
+}
+
+
+/* Used by gfc_match_varspec() to extend the reference list by one
+   element.  */
+
+static gfc_ref *
+extend_ref (gfc_expr *primary, gfc_ref *tail)
+{
+  if (primary->ref == NULL)
+    primary->ref = tail = gfc_get_ref ();
+  else
+    {
+      if (tail == NULL)
+	gfc_internal_error ("extend_ref(): Bad tail");
+      tail->next = gfc_get_ref ();
+      tail = tail->next;
+    }
+
+  return tail;
+}
+
+
+/* Match any additional specifications associated with the current
+   variable like member references or substrings.  If equiv_flag is
+   set we only match stuff that is allowed inside an EQUIVALENCE
+   statement.  sub_flag tells whether we expect a type-bound procedure found
+   to be a subroutine as part of CALL or a FUNCTION. For procedure pointer
+   components, 'ppc_arg' determines whether the PPC may be called (with an
+   argument list), or whether it may just be referred to as a pointer.  */
+
+match
+gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
+		   bool ppc_arg)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_ref *substring, *tail;
+  gfc_component *component;
+  gfc_symbol *sym = primary->symtree->n.sym;
+  match m;
+  bool unknown;
+
+  tail = NULL;
+
+  gfc_gobble_whitespace ();
+
+  if (gfc_peek_ascii_char () == '[')
+    {
+      if (sym->attr.dimension)
+	{
+	  gfc_error ("Array section designator, e.g. '(:)', is required "
+		     "besides the coarray designator '[...]' at %C");
+	  return MATCH_ERROR;
+	}
+      if (!sym->attr.codimension)
+	{
+	  gfc_error ("Coarray designator at %C but '%s' is not a coarray",
+		     sym->name);
+	  return MATCH_ERROR;
+	}
+    }
+
+  /* For associate names, we may not yet know whether they are arrays or not.
+     Thus if we have one and parentheses follow, we have to assume that it
+     actually is one for now.  The final decision will be made at
+     resolution time, of course.  */
+  if (sym->assoc && gfc_peek_ascii_char () == '(')
+    sym->attr.dimension = 1;
+
+  if ((equiv_flag && gfc_peek_ascii_char () == '(')
+      || gfc_peek_ascii_char () == '[' || sym->attr.codimension
+      || (sym->attr.dimension && sym->ts.type != BT_CLASS
+	  && !sym->attr.proc_pointer && !gfc_is_proc_ptr_comp (primary, NULL)
+	  && !(gfc_matching_procptr_assignment
+	       && sym->attr.flavor == FL_PROCEDURE))
+      || (sym->ts.type == BT_CLASS && sym->attr.class_ok
+	  && CLASS_DATA (sym)->attr.dimension))
+    {
+      /* In EQUIVALENCE, we don't know yet whether we are seeing
+	 an array, character variable or array of character
+	 variables.  We'll leave the decision till resolve time.  */
+      tail = extend_ref (primary, tail);
+      tail->type = REF_ARRAY;
+
+      m = gfc_match_array_ref (&tail->u.ar, equiv_flag ? NULL : sym->as,
+			       equiv_flag,
+			       sym->ts.type == BT_CLASS
+			       ? (CLASS_DATA (sym)->as
+				  ? CLASS_DATA (sym)->as->corank : 0)
+			       : (sym->as ? sym->as->corank : 0));
+      if (m != MATCH_YES)
+	return m;
+
+      gfc_gobble_whitespace ();
+      if (equiv_flag && gfc_peek_ascii_char () == '(')
+	{
+	  tail = extend_ref (primary, tail);
+	  tail->type = REF_ARRAY;
+
+	  m = gfc_match_array_ref (&tail->u.ar, NULL, equiv_flag, 0);
+	  if (m != MATCH_YES)
+	    return m;
+	}
+    }
+
+  primary->ts = sym->ts;
+
+  if (equiv_flag)
+    return MATCH_YES;
+
+  if (sym->ts.type == BT_UNKNOWN && gfc_peek_ascii_char () == '%'
+      && gfc_get_default_type (sym->name, sym->ns)->type == BT_DERIVED)
+    gfc_set_default_type (sym, 0, sym->ns);
+
+  if ((sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
+      || gfc_match_char ('%') != MATCH_YES)
+    goto check_substring;
+
+  sym = sym->ts.u.derived;
+
+  for (;;)
+    {
+      gfc_try t;
+      gfc_symtree *tbp;
+
+      m = gfc_match_name (name);
+      if (m == MATCH_NO)
+	gfc_error ("Expected structure component name at %C");
+      if (m != MATCH_YES)
+	return MATCH_ERROR;
+
+      if (sym->f2k_derived)
+	tbp = gfc_find_typebound_proc (sym, &t, name, false, &gfc_current_locus);
+      else
+	tbp = NULL;
+
+      if (tbp)
+	{
+	  gfc_symbol* tbp_sym;
+
+	  if (t == FAILURE)
+	    return MATCH_ERROR;
+
+	  gcc_assert (!tail || !tail->next);
+	  gcc_assert (primary->expr_type == EXPR_VARIABLE
+		      || (primary->expr_type == EXPR_STRUCTURE
+			  && primary->symtree && primary->symtree->n.sym
+			  && primary->symtree->n.sym->attr.flavor));
+
+	  if (tbp->n.tb->is_generic)
+	    tbp_sym = NULL;
+	  else
+	    tbp_sym = tbp->n.tb->u.specific->n.sym;
+
+	  primary->expr_type = EXPR_COMPCALL;
+	  primary->value.compcall.tbp = tbp->n.tb;
+	  primary->value.compcall.name = tbp->name;
+	  primary->value.compcall.ignore_pass = 0;
+	  primary->value.compcall.assign = 0;
+	  primary->value.compcall.base_object = NULL;
+	  gcc_assert (primary->symtree->n.sym->attr.referenced);
+	  if (tbp_sym)
+	    primary->ts = tbp_sym->ts;
+
+	  m = gfc_match_actual_arglist (tbp->n.tb->subroutine,
+					&primary->value.compcall.actual);
+	  if (m == MATCH_ERROR)
+	    return MATCH_ERROR;
+	  if (m == MATCH_NO)
+	    {
+	      if (sub_flag)
+		primary->value.compcall.actual = NULL;
+	      else
+		{
+		  gfc_error ("Expected argument list at %C");
+		  return MATCH_ERROR;
+		}
+	    }
+
+	  break;
+	}
+
+      component = gfc_find_component (sym, name, false, false);
+      if (component == NULL)
+	return MATCH_ERROR;
+
+      tail = extend_ref (primary, tail);
+      tail->type = REF_COMPONENT;
+
+      tail->u.c.component = component;
+      tail->u.c.sym = sym;
+
+      primary->ts = component->ts;
+
+      if (component->attr.proc_pointer && ppc_arg
+	  && !gfc_matching_procptr_assignment)
+	{
+	  /* Procedure pointer component call: Look for argument list.  */
+	  m = gfc_match_actual_arglist (sub_flag,
+					&primary->value.compcall.actual);
+	  if (m == MATCH_ERROR)
+	    return MATCH_ERROR;
+
+	  if (m == MATCH_NO && !gfc_matching_ptr_assignment
+	      && !matching_actual_arglist)
+	    {
+	      gfc_error ("Procedure pointer component '%s' requires an "
+			 "argument list at %C", component->name);
+	      return MATCH_ERROR;
+	    }
+
+	  if (m == MATCH_YES)
+	    primary->expr_type = EXPR_PPC;
+
+          break;
+	}
+
+      if (component->as != NULL && !component->attr.proc_pointer)
+	{
+	  tail = extend_ref (primary, tail);
+	  tail->type = REF_ARRAY;
+
+	  m = gfc_match_array_ref (&tail->u.ar, component->as, equiv_flag,
+			  component->as->corank);
+	  if (m != MATCH_YES)
+	    return m;
+	}
+      else if (component->ts.type == BT_CLASS
+	       && CLASS_DATA (component)->as != NULL
+	       && !component->attr.proc_pointer)
+	{
+	  tail = extend_ref (primary, tail);
+	  tail->type = REF_ARRAY;
+
+	  m = gfc_match_array_ref (&tail->u.ar, CLASS_DATA (component)->as,
+				   equiv_flag,
+				   CLASS_DATA (component)->as->corank);
+	  if (m != MATCH_YES)
+	    return m;
+	}
+
+      if ((component->ts.type != BT_DERIVED && component->ts.type != BT_CLASS)
+	  || gfc_match_char ('%') != MATCH_YES)
+	break;
+
+      sym = component->ts.u.derived;
+    }
+
+check_substring:
+  unknown = false;
+  if (primary->ts.type == BT_UNKNOWN && sym->attr.flavor != FL_DERIVED)
+    {
+      if (gfc_get_default_type (sym->name, sym->ns)->type == BT_CHARACTER)
+       {
+	 gfc_set_default_type (sym, 0, sym->ns);
+	 primary->ts = sym->ts;
+	 unknown = true;
+       }
+    }
+
+  if (primary->ts.type == BT_CHARACTER)
+    {
+      switch (match_substring (primary->ts.u.cl, equiv_flag, &substring))
+	{
+	case MATCH_YES:
+	  if (tail == NULL)
+	    primary->ref = substring;
+	  else
+	    tail->next = substring;
+
+	  if (primary->expr_type == EXPR_CONSTANT)
+	    primary->expr_type = EXPR_SUBSTRING;
+
+	  if (substring)
+	    primary->ts.u.cl = NULL;
+
+	  break;
+
+	case MATCH_NO:
+	  if (unknown)
+	    {
+	      gfc_clear_ts (&primary->ts);
+	      gfc_clear_ts (&sym->ts);
+	    }
+	  break;
+
+	case MATCH_ERROR:
+	  return MATCH_ERROR;
+	}
+    }
+
+  /* F2008, C727.  */
+  if (primary->expr_type == EXPR_PPC && gfc_is_coindexed (primary))
+    {
+      gfc_error ("Coindexed procedure-pointer component at %C");
+      return MATCH_ERROR;
+    }
+
+  return MATCH_YES;
+}
+
+
+/* Given an expression that is a variable, figure out what the
+   ultimate variable's type and attribute is, traversing the reference
+   structures if necessary.
+
+   This subroutine is trickier than it looks.  We start at the base
+   symbol and store the attribute.  Component references load a
+   completely new attribute.
+
+   A couple of rules come into play.  Subobjects of targets are always
+   targets themselves.  If we see a component that goes through a
+   pointer, then the expression must also be a target, since the
+   pointer is associated with something (if it isn't core will soon be
+   dumped).  If we see a full part or section of an array, the
+   expression is also an array.
+
+   We can have at most one full array reference.  */
+
+symbol_attribute
+gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
+{
+  int dimension, pointer, allocatable, target;
+  symbol_attribute attr;
+  gfc_ref *ref;
+  gfc_symbol *sym;
+  gfc_component *comp;
+
+  if (expr->expr_type != EXPR_VARIABLE && expr->expr_type != EXPR_FUNCTION)
+    gfc_internal_error ("gfc_variable_attr(): Expression isn't a variable");
+
+  sym = expr->symtree->n.sym;
+  attr = sym->attr;
+
+  if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
+    {
+      dimension = CLASS_DATA (sym)->attr.dimension;
+      pointer = CLASS_DATA (sym)->attr.class_pointer;
+      allocatable = CLASS_DATA (sym)->attr.allocatable;
+    }
+  else
+    {
+      dimension = attr.dimension;
+      pointer = attr.pointer;
+      allocatable = attr.allocatable;
+    }
+
+  target = attr.target;
+  if (pointer || attr.proc_pointer)
+    target = 1;
+
+  if (ts != NULL && expr->ts.type == BT_UNKNOWN)
+    *ts = sym->ts;
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    switch (ref->type)
+      {
+      case REF_ARRAY:
+
+	switch (ref->u.ar.type)
+	  {
+	  case AR_FULL:
+	    dimension = 1;
+	    break;
+
+	  case AR_SECTION:
+	    allocatable = pointer = 0;
+	    dimension = 1;
+	    break;
+
+	  case AR_ELEMENT:
+	    /* Handle coarrays.  */
+	    if (ref->u.ar.dimen > 0)
+	      allocatable = pointer = 0;
+	    break;
+
+	  case AR_UNKNOWN:
+	    gfc_internal_error ("gfc_variable_attr(): Bad array reference");
+	  }
+
+	break;
+
+      case REF_COMPONENT:
+	comp = ref->u.c.component;
+	attr = comp->attr;
+	if (ts != NULL)
+	  {
+	    *ts = comp->ts;
+	    /* Don't set the string length if a substring reference
+	       follows.  */
+	    if (ts->type == BT_CHARACTER
+		&& ref->next && ref->next->type == REF_SUBSTRING)
+		ts->u.cl = NULL;
+	  }
+
+	if (comp->ts.type == BT_CLASS)
+	  {
+	    pointer = CLASS_DATA (comp)->attr.class_pointer;
+	    allocatable = CLASS_DATA (comp)->attr.allocatable;
+	  }
+	else
+	  {
+	    pointer = comp->attr.pointer;
+	    allocatable = comp->attr.allocatable;
+	  }
+	if (pointer || attr.proc_pointer)
+	  target = 1;
+
+	break;
+
+      case REF_SUBSTRING:
+	allocatable = pointer = 0;
+	break;
+      }
+
+  attr.dimension = dimension;
+  attr.pointer = pointer;
+  attr.allocatable = allocatable;
+  attr.target = target;
+  attr.save = sym->attr.save;
+
+  return attr;
+}
+
+
+/* Return the attribute from a general expression.  */
+
+symbol_attribute
+gfc_expr_attr (gfc_expr *e)
+{
+  symbol_attribute attr;
+
+  switch (e->expr_type)
+    {
+    case EXPR_VARIABLE:
+      attr = gfc_variable_attr (e, NULL);
+      break;
+
+    case EXPR_FUNCTION:
+      gfc_clear_attr (&attr);
+
+      if (e->value.function.esym != NULL)
+	{
+	  gfc_symbol *sym = e->value.function.esym->result;
+	  attr = sym->attr;
+	  if (sym->ts.type == BT_CLASS)
+	    {
+	      attr.dimension = CLASS_DATA (sym)->attr.dimension;
+	      attr.pointer = CLASS_DATA (sym)->attr.class_pointer;
+	      attr.allocatable = CLASS_DATA (sym)->attr.allocatable;
+	    }
+	}
+      else
+	attr = gfc_variable_attr (e, NULL);
+
+      /* TODO: NULL() returns pointers.  May have to take care of this
+	 here.  */
+
+      break;
+
+    default:
+      gfc_clear_attr (&attr);
+      break;
+    }
+
+  return attr;
+}
+
+
+/* Match a structure constructor.  The initial symbol has already been
+   seen.  */
+
+typedef struct gfc_structure_ctor_component
+{
+  char* name;
+  gfc_expr* val;
+  locus where;
+  struct gfc_structure_ctor_component* next;
+}
+gfc_structure_ctor_component;
+
+#define gfc_get_structure_ctor_component() XCNEW (gfc_structure_ctor_component)
+
+static void
+gfc_free_structure_ctor_component (gfc_structure_ctor_component *comp)
+{
+  gfc_free (comp->name);
+  gfc_free_expr (comp->val);
+  gfc_free (comp);
+}
+
+
+/* Translate the component list into the actual constructor by sorting it in
+   the order required; this also checks along the way that each and every
+   component actually has an initializer and handles default initializers
+   for components without explicit value given.  */
+static gfc_try
+build_actual_constructor (gfc_structure_ctor_component **comp_head,
+			  gfc_constructor_base *ctor_head, gfc_symbol *sym)
+{
+  gfc_structure_ctor_component *comp_iter;
+  gfc_component *comp;
+
+  for (comp = sym->components; comp; comp = comp->next)
+    {
+      gfc_structure_ctor_component **next_ptr;
+      gfc_expr *value = NULL;
+
+      /* Try to find the initializer for the current component by name.  */
+      next_ptr = comp_head;
+      for (comp_iter = *comp_head; comp_iter; comp_iter = comp_iter->next)
+	{
+	  if (!strcmp (comp_iter->name, comp->name))
+	    break;
+	  next_ptr = &comp_iter->next;
+	}
+
+      /* If an extension, try building the parent derived type by building
+	 a value expression for the parent derived type and calling self.  */
+      if (!comp_iter && comp == sym->components && sym->attr.extension)
+	{
+	  value = gfc_get_structure_constructor_expr (comp->ts.type,
+						      comp->ts.kind,
+						      &gfc_current_locus);
+	  value->ts = comp->ts;
+
+	  if (build_actual_constructor (comp_head, &value->value.constructor,
+					comp->ts.u.derived) == FAILURE)
+	    {
+	      gfc_free_expr (value);
+	      return FAILURE;
+	    }
+
+	  gfc_constructor_append_expr (ctor_head, value, NULL);
+	  continue;
+	}
+
+      /* If it was not found, try the default initializer if there's any;
+	 otherwise, it's an error.  */
+      if (!comp_iter)
+	{
+	  if (comp->initializer)
+	    {
+	      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Structure"
+				  " constructor with missing optional arguments"
+				  " at %C") == FAILURE)
+		return FAILURE;
+	      value = gfc_copy_expr (comp->initializer);
+	    }
+	  else
+	    {
+	      gfc_error ("No initializer for component '%s' given in the"
+			 " structure constructor at %C!", comp->name);
+	      return FAILURE;
+	    }
+	}
+      else
+	value = comp_iter->val;
+
+      /* Add the value to the constructor chain built.  */
+      gfc_constructor_append_expr (ctor_head, value, NULL);
+
+      /* Remove the entry from the component list.  We don't want the expression
+	 value to be free'd, so set it to NULL.  */
+      if (comp_iter)
+	{
+	  *next_ptr = comp_iter->next;
+	  comp_iter->val = NULL;
+	  gfc_free_structure_ctor_component (comp_iter);
+	}
+    }
+  return SUCCESS;
+}
+
+match
+gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result,
+				 bool parent)
+{
+  gfc_structure_ctor_component *comp_tail, *comp_head, *comp_iter;
+  gfc_constructor_base ctor_head = NULL;
+  gfc_component *comp; /* Is set NULL when named component is first seen */
+  gfc_expr *e;
+  locus where;
+  match m;
+  const char* last_name = NULL;
+
+  comp_tail = comp_head = NULL;
+
+  if (!parent && gfc_match_char ('(') != MATCH_YES)
+    goto syntax;
+
+  where = gfc_current_locus;
+
+  gfc_find_component (sym, NULL, false, true);
+
+  /* Check that we're not about to construct an ABSTRACT type.  */
+  if (!parent && sym->attr.abstract)
+    {
+      gfc_error ("Can't construct ABSTRACT type '%s' at %C", sym->name);
+      return MATCH_ERROR;
+    }
+
+  /* Match the component list and store it in a list together with the
+     corresponding component names.  Check for empty argument list first.  */
+  if (gfc_match_char (')') != MATCH_YES)
+    {
+      comp = sym->components;
+      do
+	{
+	  gfc_component *this_comp = NULL;
+
+	  if (comp == sym->components && sym->attr.extension
+	      && comp->ts.type == BT_DERIVED
+	      && comp->ts.u.derived->attr.zero_comp)
+	    /* Skip empty parents.  */ 
+	    comp = comp->next;
+
+	  if (!comp_head)
+	    comp_tail = comp_head = gfc_get_structure_ctor_component ();
+	  else
+	    {
+	      comp_tail->next = gfc_get_structure_ctor_component ();
+	      comp_tail = comp_tail->next;
+	    }
+	  comp_tail->name = XCNEWVEC (char, GFC_MAX_SYMBOL_LEN + 1);
+	  comp_tail->val = NULL;
+	  comp_tail->where = gfc_current_locus;
+
+	  /* Try matching a component name.  */
+	  if (gfc_match_name (comp_tail->name) == MATCH_YES 
+	      && gfc_match_char ('=') == MATCH_YES)
+	    {
+	      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Structure"
+				  " constructor with named arguments at %C")
+		  == FAILURE)
+		goto cleanup;
+
+	      last_name = comp_tail->name;
+	      comp = NULL;
+	    }
+	  else
+	    {
+	      /* Components without name are not allowed after the first named
+		 component initializer!  */
+	      if (!comp)
+		{
+		  if (last_name)
+		    gfc_error ("Component initializer without name after"
+			       " component named %s at %C!", last_name);
+		  else if (!parent)
+		    gfc_error ("Too many components in structure constructor at"
+			       " %C!");
+		  goto cleanup;
+		}
+
+	      gfc_current_locus = comp_tail->where;
+	      strncpy (comp_tail->name, comp->name, GFC_MAX_SYMBOL_LEN + 1);
+	    }
+
+	  /* Find the current component in the structure definition and check
+	     its access is not private.  */
+	  if (comp)
+	    this_comp = gfc_find_component (sym, comp->name, false, false);
+	  else
+	    {
+	      this_comp = gfc_find_component (sym,
+					      (const char *)comp_tail->name,
+					      false, false);
+	      comp = NULL; /* Reset needed!  */
+	    }
+
+	  /* Here we can check if a component name is given which does not
+	     correspond to any component of the defined structure.  */
+	  if (!this_comp)
+	    goto cleanup;
+
+	  /* Check if this component is already given a value.  */
+	  for (comp_iter = comp_head; comp_iter != comp_tail; 
+	       comp_iter = comp_iter->next)
+	    {
+	      gcc_assert (comp_iter);
+	      if (!strcmp (comp_iter->name, comp_tail->name))
+		{
+		  gfc_error ("Component '%s' is initialized twice in the"
+			     " structure constructor at %C!", comp_tail->name);
+		  goto cleanup;
+		}
+	    }
+
+	  /* Match the current initializer expression.  */
+	  m = gfc_match_expr (&comp_tail->val);
+	  if (m == MATCH_NO)
+	    goto syntax;
+	  if (m == MATCH_ERROR)
+	    goto cleanup;
+
+	  /* F2008, R457/C725, for PURE C1283.  */
+          if (this_comp->attr.pointer && gfc_is_coindexed (comp_tail->val))
+	    {
+	      gfc_error ("Coindexed expression to pointer component '%s' in "
+			 "structure constructor at %C!", comp_tail->name);
+	      goto cleanup;
+ 	    }
+
+
+	  /* If not explicitly a parent constructor, gather up the components
+	     and build one.  */
+	  if (comp && comp == sym->components
+		&& sym->attr.extension
+		&& (comp_tail->val->ts.type != BT_DERIVED
+		      ||
+		    comp_tail->val->ts.u.derived != this_comp->ts.u.derived))
+	    {
+	      gfc_current_locus = where;
+	      gfc_free_expr (comp_tail->val);
+	      comp_tail->val = NULL;
+
+	      m = gfc_match_structure_constructor (comp->ts.u.derived, 
+						   &comp_tail->val, true);
+	      if (m == MATCH_NO)
+		goto syntax;
+	      if (m == MATCH_ERROR)
+		goto cleanup;
+	    }
+
+ 	  if (comp)
+	    comp = comp->next;
+
+	  if (parent && !comp)
+	    break;
+	}
+
+      while (gfc_match_char (',') == MATCH_YES);
+
+      if (!parent && gfc_match_char (')') != MATCH_YES)
+	goto syntax;
+    }
+
+  if (build_actual_constructor (&comp_head, &ctor_head, sym) == FAILURE)
+    goto cleanup;
+
+  /* No component should be left, as this should have caused an error in the
+     loop constructing the component-list (name that does not correspond to any
+     component in the structure definition).  */
+  if (comp_head)
+    {
+      gcc_assert (sym->attr.extension);
+      for (comp_iter = comp_head; comp_iter; comp_iter = comp_iter->next)
+	{
+	  gfc_error ("component '%s' at %L has already been set by a "
+		     "parent derived type constructor", comp_iter->name,
+		     &comp_iter->where);
+	}
+      goto cleanup;
+    }
+
+  e = gfc_get_structure_constructor_expr (BT_DERIVED, 0, &where);
+  e->ts.u.derived = sym;
+  e->value.constructor = ctor_head;
+
+  *result = e;
+  return MATCH_YES;
+
+syntax:
+  gfc_error ("Syntax error in structure constructor at %C");
+
+cleanup:
+  for (comp_iter = comp_head; comp_iter; )
+    {
+      gfc_structure_ctor_component *next = comp_iter->next;
+      gfc_free_structure_ctor_component (comp_iter);
+      comp_iter = next;
+    }
+  gfc_constructor_free (ctor_head);
+  return MATCH_ERROR;
+}
+
+
+/* If the symbol is an implicit do loop index and implicitly typed,
+   it should not be host associated.  Provide a symtree from the
+   current namespace.  */
+static match
+check_for_implicit_index (gfc_symtree **st, gfc_symbol **sym)
+{
+  if ((*sym)->attr.flavor == FL_VARIABLE
+      && (*sym)->ns != gfc_current_ns
+      && (*sym)->attr.implied_index
+      && (*sym)->attr.implicit_type
+      && !(*sym)->attr.use_assoc)
+    {
+      int i;
+      i = gfc_get_sym_tree ((*sym)->name, NULL, st, false);
+      if (i)
+	return MATCH_ERROR;
+      *sym = (*st)->n.sym;
+    }
+  return MATCH_YES;
+}
+
+
+/* Procedure pointer as function result: Replace the function symbol by the
+   auto-generated hidden result variable named "ppr@".  */
+
+static gfc_try
+replace_hidden_procptr_result (gfc_symbol **sym, gfc_symtree **st)
+{
+  /* Check for procedure pointer result variable.  */
+  if ((*sym)->attr.function && !(*sym)->attr.external
+      && (*sym)->result && (*sym)->result != *sym
+      && (*sym)->result->attr.proc_pointer
+      && (*sym) == gfc_current_ns->proc_name
+      && (*sym) == (*sym)->result->ns->proc_name
+      && strcmp ("ppr@", (*sym)->result->name) == 0)
+    {
+      /* Automatic replacement with "hidden" result variable.  */
+      (*sym)->result->attr.referenced = (*sym)->attr.referenced;
+      *sym = (*sym)->result;
+      *st = gfc_find_symtree ((*sym)->ns->sym_root, (*sym)->name);
+      return SUCCESS;
+    }
+  return FAILURE;
+}
+
+
+/* Matches a variable name followed by anything that might follow it--
+   array reference, argument list of a function, etc.  */
+
+match
+gfc_match_rvalue (gfc_expr **result)
+{
+  gfc_actual_arglist *actual_arglist;
+  char name[GFC_MAX_SYMBOL_LEN + 1], argname[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_state_data *st;
+  gfc_symbol *sym;
+  gfc_symtree *symtree;
+  locus where, old_loc;
+  gfc_expr *e;
+  match m, m2;
+  int i;
+  gfc_typespec *ts;
+  bool implicit_char;
+  gfc_ref *ref;
+
+  m = gfc_match_name (name);
+  if (m != MATCH_YES)
+    return m;
+
+  if (gfc_find_state (COMP_INTERFACE) == SUCCESS
+      && !gfc_current_ns->has_import_set)
+    i = gfc_get_sym_tree (name, NULL, &symtree, false);
+  else
+    i = gfc_get_ha_sym_tree (name, &symtree);
+
+  if (i)
+    return MATCH_ERROR;
+
+  sym = symtree->n.sym;
+  e = NULL;
+  where = gfc_current_locus;
+
+  replace_hidden_procptr_result (&sym, &symtree);
+
+  /* If this is an implicit do loop index and implicitly typed,
+     it should not be host associated.  */
+  m = check_for_implicit_index (&symtree, &sym);
+  if (m != MATCH_YES)
+    return m;
+
+  gfc_set_sym_referenced (sym);
+  sym->attr.implied_index = 0;
+
+  if (sym->attr.function && sym->result == sym)
+    {
+      /* See if this is a directly recursive function call.  */
+      gfc_gobble_whitespace ();
+      if (sym->attr.recursive
+	  && gfc_peek_ascii_char () == '('
+	  && gfc_current_ns->proc_name == sym
+	  && !sym->attr.dimension)
+	{
+	  gfc_error ("'%s' at %C is the name of a recursive function "
+		     "and so refers to the result variable. Use an "
+		     "explicit RESULT variable for direct recursion "
+		     "(12.5.2.1)", sym->name);
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_is_function_return_value (sym, gfc_current_ns))
+	goto variable;
+
+      if (sym->attr.entry
+	  && (sym->ns == gfc_current_ns
+	      || sym->ns == gfc_current_ns->parent))
+	{
+	  gfc_entry_list *el = NULL;
+	  
+	  for (el = sym->ns->entries; el; el = el->next)
+	    if (sym == el->sym)
+	      goto variable;
+	}
+    }
+
+  if (gfc_matching_procptr_assignment)
+    goto procptr0;
+
+  if (sym->attr.function || sym->attr.external || sym->attr.intrinsic)
+    goto function0;
+
+  if (sym->attr.generic)
+    goto generic_function;
+
+  switch (sym->attr.flavor)
+    {
+    case FL_VARIABLE:
+    variable:
+      e = gfc_get_expr ();
+
+      e->expr_type = EXPR_VARIABLE;
+      e->symtree = symtree;
+
+      m = gfc_match_varspec (e, 0, false, true);
+      break;
+
+    case FL_PARAMETER:
+      /* A statement of the form "REAL, parameter :: a(0:10) = 1" will
+	 end up here.  Unfortunately, sym->value->expr_type is set to 
+	 EXPR_CONSTANT, and so the if () branch would be followed without
+	 the !sym->as check.  */
+      if (sym->value && sym->value->expr_type != EXPR_ARRAY && !sym->as)
+	e = gfc_copy_expr (sym->value);
+      else
+	{
+	  e = gfc_get_expr ();
+	  e->expr_type = EXPR_VARIABLE;
+	}
+
+      e->symtree = symtree;
+      m = gfc_match_varspec (e, 0, false, true);
+
+      if (sym->ts.is_c_interop || sym->ts.is_iso_c)
+	break;
+
+      /* Variable array references to derived type parameters cause
+	 all sorts of headaches in simplification. Treating such
+	 expressions as variable works just fine for all array
+	 references.  */
+      if (sym->value && sym->ts.type == BT_DERIVED && e->ref)
+	{
+	  for (ref = e->ref; ref; ref = ref->next)
+	    if (ref->type == REF_ARRAY)
+	      break;
+
+	  if (ref == NULL || ref->u.ar.type == AR_FULL)
+	    break;
+
+	  ref = e->ref;
+	  e->ref = NULL;
+	  gfc_free_expr (e);
+	  e = gfc_get_expr ();
+	  e->expr_type = EXPR_VARIABLE;
+	  e->symtree = symtree;
+	  e->ref = ref;
+	}
+
+      break;
+
+    case FL_DERIVED:
+      sym = gfc_use_derived (sym);
+      if (sym == NULL)
+	m = MATCH_ERROR;
+      else
+	m = gfc_match_structure_constructor (sym, &e, false);
+      break;
+
+    /* If we're here, then the name is known to be the name of a
+       procedure, yet it is not sure to be the name of a function.  */
+    case FL_PROCEDURE:
+
+    /* Procedure Pointer Assignments. */
+    procptr0:
+      if (gfc_matching_procptr_assignment)
+	{
+	  gfc_gobble_whitespace ();
+	  if (!sym->attr.dimension && gfc_peek_ascii_char () == '(')
+	    /* Parse functions returning a procptr.  */
+	    goto function0;
+
+	  if (gfc_is_intrinsic (sym, 0, gfc_current_locus)
+	      || gfc_is_intrinsic (sym, 1, gfc_current_locus))
+	    sym->attr.intrinsic = 1;
+	  e = gfc_get_expr ();
+	  e->expr_type = EXPR_VARIABLE;
+	  e->symtree = symtree;
+	  m = gfc_match_varspec (e, 0, false, true);
+	  break;
+	}
+
+      if (sym->attr.subroutine)
+	{
+	  gfc_error ("Unexpected use of subroutine name '%s' at %C",
+		     sym->name);
+	  m = MATCH_ERROR;
+	  break;
+	}
+
+      /* At this point, the name has to be a non-statement function.
+	 If the name is the same as the current function being
+	 compiled, then we have a variable reference (to the function
+	 result) if the name is non-recursive.  */
+
+      st = gfc_enclosing_unit (NULL);
+
+      if (st != NULL && st->state == COMP_FUNCTION
+	  && st->sym == sym
+	  && !sym->attr.recursive)
+	{
+	  e = gfc_get_expr ();
+	  e->symtree = symtree;
+	  e->expr_type = EXPR_VARIABLE;
+
+	  m = gfc_match_varspec (e, 0, false, true);
+	  break;
+	}
+
+    /* Match a function reference.  */
+    function0:
+      m = gfc_match_actual_arglist (0, &actual_arglist);
+      if (m == MATCH_NO)
+	{
+	  if (sym->attr.proc == PROC_ST_FUNCTION)
+	    gfc_error ("Statement function '%s' requires argument list at %C",
+		       sym->name);
+	  else
+	    gfc_error ("Function '%s' requires an argument list at %C",
+		       sym->name);
+
+	  m = MATCH_ERROR;
+	  break;
+	}
+
+      if (m != MATCH_YES)
+	{
+	  m = MATCH_ERROR;
+	  break;
+	}
+
+      gfc_get_ha_sym_tree (name, &symtree);	/* Can't fail */
+      sym = symtree->n.sym;
+
+      replace_hidden_procptr_result (&sym, &symtree);
+
+      e = gfc_get_expr ();
+      e->symtree = symtree;
+      e->expr_type = EXPR_FUNCTION;
+      e->value.function.actual = actual_arglist;
+      e->where = gfc_current_locus;
+
+      if (sym->as != NULL)
+	e->rank = sym->as->rank;
+
+      if (!sym->attr.function
+	  && gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
+	{
+	  m = MATCH_ERROR;
+	  break;
+	}
+
+      /* Check here for the existence of at least one argument for the
+         iso_c_binding functions C_LOC, C_FUNLOC, and C_ASSOCIATED.  The
+         argument(s) given will be checked in gfc_iso_c_func_interface,
+         during resolution of the function call.  */
+      if (sym->attr.is_iso_c == 1
+	  && (sym->from_intmod == INTMOD_ISO_C_BINDING
+	      && (sym->intmod_sym_id == ISOCBINDING_LOC
+		  || sym->intmod_sym_id == ISOCBINDING_FUNLOC
+		  || sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)))
+        {
+          /* make sure we were given a param */
+          if (actual_arglist == NULL)
+            {
+              gfc_error ("Missing argument to '%s' at %C", sym->name);
+              m = MATCH_ERROR;
+              break;
+            }
+        }
+
+      if (sym->result == NULL)
+	sym->result = sym;
+
+      m = MATCH_YES;
+      break;
+
+    case FL_UNKNOWN:
+
+      /* Special case for derived type variables that get their types
+	 via an IMPLICIT statement.  This can't wait for the
+	 resolution phase.  */
+
+      if (gfc_peek_ascii_char () == '%'
+	  && sym->ts.type == BT_UNKNOWN
+	  && gfc_get_default_type (sym->name, sym->ns)->type == BT_DERIVED)
+	gfc_set_default_type (sym, 0, sym->ns);
+
+      /* If the symbol has a dimension attribute, the expression is a
+	 variable.  */
+
+      if (sym->attr.dimension)
+	{
+	  if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
+			      sym->name, NULL) == FAILURE)
+	    {
+	      m = MATCH_ERROR;
+	      break;
+	    }
+
+	  e = gfc_get_expr ();
+	  e->symtree = symtree;
+	  e->expr_type = EXPR_VARIABLE;
+	  m = gfc_match_varspec (e, 0, false, true);
+	  break;
+	}
+
+      /* Name is not an array, so we peek to see if a '(' implies a
+	 function call or a substring reference.  Otherwise the
+	 variable is just a scalar.  */
+
+      gfc_gobble_whitespace ();
+      if (gfc_peek_ascii_char () != '(')
+	{
+	  /* Assume a scalar variable */
+	  e = gfc_get_expr ();
+	  e->symtree = symtree;
+	  e->expr_type = EXPR_VARIABLE;
+
+	  if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
+			      sym->name, NULL) == FAILURE)
+	    {
+	      m = MATCH_ERROR;
+	      break;
+	    }
+
+	  /*FIXME:??? gfc_match_varspec does set this for us: */
+	  e->ts = sym->ts;
+	  m = gfc_match_varspec (e, 0, false, true);
+	  break;
+	}
+
+      /* See if this is a function reference with a keyword argument
+	 as first argument. We do this because otherwise a spurious
+	 symbol would end up in the symbol table.  */
+
+      old_loc = gfc_current_locus;
+      m2 = gfc_match (" ( %n =", argname);
+      gfc_current_locus = old_loc;
+
+      e = gfc_get_expr ();
+      e->symtree = symtree;
+
+      if (m2 != MATCH_YES)
+	{
+	  /* Try to figure out whether we're dealing with a character type.
+	     We're peeking ahead here, because we don't want to call 
+	     match_substring if we're dealing with an implicitly typed
+	     non-character variable.  */
+	  implicit_char = false;
+	  if (sym->ts.type == BT_UNKNOWN)
+	    {
+	      ts = gfc_get_default_type (sym->name, NULL);
+	      if (ts->type == BT_CHARACTER)
+		implicit_char = true;
+	    }
+
+	  /* See if this could possibly be a substring reference of a name
+	     that we're not sure is a variable yet.  */
+
+	  if ((implicit_char || sym->ts.type == BT_CHARACTER)
+	      && match_substring (sym->ts.u.cl, 0, &e->ref) == MATCH_YES)
+	    {
+
+	      e->expr_type = EXPR_VARIABLE;
+
+	      if (sym->attr.flavor != FL_VARIABLE
+		  && gfc_add_flavor (&sym->attr, FL_VARIABLE,
+				     sym->name, NULL) == FAILURE)
+		{
+		  m = MATCH_ERROR;
+		  break;
+		}
+
+	      if (sym->ts.type == BT_UNKNOWN
+		  && gfc_set_default_type (sym, 1, NULL) == FAILURE)
+		{
+		  m = MATCH_ERROR;
+		  break;
+		}
+
+	      e->ts = sym->ts;
+	      if (e->ref)
+		e->ts.u.cl = NULL;
+	      m = MATCH_YES;
+	      break;
+	    }
+	}
+
+      /* Give up, assume we have a function.  */
+
+      gfc_get_sym_tree (name, NULL, &symtree, false);	/* Can't fail */
+      sym = symtree->n.sym;
+      e->expr_type = EXPR_FUNCTION;
+
+      if (!sym->attr.function
+	  && gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
+	{
+	  m = MATCH_ERROR;
+	  break;
+	}
+
+      sym->result = sym;
+
+      m = gfc_match_actual_arglist (0, &e->value.function.actual);
+      if (m == MATCH_NO)
+	gfc_error ("Missing argument list in function '%s' at %C", sym->name);
+
+      if (m != MATCH_YES)
+	{
+	  m = MATCH_ERROR;
+	  break;
+	}
+
+      /* If our new function returns a character, array or structure
+	 type, it might have subsequent references.  */
+
+      m = gfc_match_varspec (e, 0, false, true);
+      if (m == MATCH_NO)
+	m = MATCH_YES;
+
+      break;
+
+    generic_function:
+      gfc_get_sym_tree (name, NULL, &symtree, false);	/* Can't fail */
+
+      e = gfc_get_expr ();
+      e->symtree = symtree;
+      e->expr_type = EXPR_FUNCTION;
+
+      m = gfc_match_actual_arglist (0, &e->value.function.actual);
+      break;
+
+    default:
+      gfc_error ("Symbol at %C is not appropriate for an expression");
+      return MATCH_ERROR;
+    }
+
+  if (m == MATCH_YES)
+    {
+      e->where = where;
+      *result = e;
+    }
+  else
+    gfc_free_expr (e);
+
+  return m;
+}
+
+
+/* Match a variable, i.e. something that can be assigned to.  This
+   starts as a symbol, can be a structure component or an array
+   reference.  It can be a function if the function doesn't have a
+   separate RESULT variable.  If the symbol has not been previously
+   seen, we assume it is a variable.
+
+   This function is called by two interface functions:
+   gfc_match_variable, which has host_flag = 1, and
+   gfc_match_equiv_variable, with host_flag = 0, to restrict the
+   match of the symbol to the local scope.  */
+
+static match
+match_variable (gfc_expr **result, int equiv_flag, int host_flag)
+{
+  gfc_symbol *sym;
+  gfc_symtree *st;
+  gfc_expr *expr;
+  locus where;
+  match m;
+
+  /* Since nothing has any business being an lvalue in a module
+     specification block, an interface block or a contains section,
+     we force the changed_symbols mechanism to work by setting
+     host_flag to 0. This prevents valid symbols that have the name
+     of keywords, such as 'end', being turned into variables by
+     failed matching to assignments for, e.g., END INTERFACE.  */
+  if (gfc_current_state () == COMP_MODULE
+      || gfc_current_state () == COMP_INTERFACE
+      || gfc_current_state () == COMP_CONTAINS)
+    host_flag = 0;
+
+  where = gfc_current_locus;
+  m = gfc_match_sym_tree (&st, host_flag);
+  if (m != MATCH_YES)
+    return m;
+
+  sym = st->n.sym;
+
+  /* If this is an implicit do loop index and implicitly typed,
+     it should not be host associated.  */
+  m = check_for_implicit_index (&st, &sym);
+  if (m != MATCH_YES)
+    return m;
+
+  sym->attr.implied_index = 0;
+
+  gfc_set_sym_referenced (sym);
+  switch (sym->attr.flavor)
+    {
+    case FL_VARIABLE:
+      /* Everything is alright.  */
+      break;
+
+    case FL_UNKNOWN:
+      {
+	sym_flavor flavor = FL_UNKNOWN;
+
+	gfc_gobble_whitespace ();
+
+	if (sym->attr.external || sym->attr.procedure
+	    || sym->attr.function || sym->attr.subroutine)
+	  flavor = FL_PROCEDURE;
+
+	/* If it is not a procedure, is not typed and is host associated,
+	   we cannot give it a flavor yet.  */
+	else if (sym->ns == gfc_current_ns->parent
+		   && sym->ts.type == BT_UNKNOWN)
+	  break;
+
+	/* These are definitive indicators that this is a variable.  */
+	else if (gfc_peek_ascii_char () != '(' || sym->ts.type != BT_UNKNOWN
+		 || sym->attr.pointer || sym->as != NULL)
+	  flavor = FL_VARIABLE;
+
+	if (flavor != FL_UNKNOWN
+	    && gfc_add_flavor (&sym->attr, flavor, sym->name, NULL) == FAILURE)
+	  return MATCH_ERROR;
+      }
+      break;
+
+    case FL_PARAMETER:
+      if (equiv_flag)
+	{
+	  gfc_error ("Named constant at %C in an EQUIVALENCE");
+	  return MATCH_ERROR;
+	}
+      /* Otherwise this is checked for and an error given in the
+	 variable definition context checks.  */
+      break;
+
+    case FL_PROCEDURE:
+      /* Check for a nonrecursive function result variable.  */
+      if (sym->attr.function
+	  && !sym->attr.external
+	  && sym->result == sym
+	  && (gfc_is_function_return_value (sym, gfc_current_ns)
+	      || (sym->attr.entry
+		  && sym->ns == gfc_current_ns)
+	      || (sym->attr.entry
+		  && sym->ns == gfc_current_ns->parent)))
+	{
+	  /* If a function result is a derived type, then the derived
+	     type may still have to be resolved.  */
+
+	  if (sym->ts.type == BT_DERIVED
+	      && gfc_use_derived (sym->ts.u.derived) == NULL)
+	    return MATCH_ERROR;
+	  break;
+	}
+
+      if (sym->attr.proc_pointer
+	  || replace_hidden_procptr_result (&sym, &st) == SUCCESS)
+	break;
+
+      /* Fall through to error */
+
+    default:
+      gfc_error ("'%s' at %C is not a variable", sym->name);
+      return MATCH_ERROR;
+    }
+
+  /* Special case for derived type variables that get their types
+     via an IMPLICIT statement.  This can't wait for the
+     resolution phase.  */
+
+    {
+      gfc_namespace * implicit_ns;
+
+      if (gfc_current_ns->proc_name == sym)
+	implicit_ns = gfc_current_ns;
+      else
+	implicit_ns = sym->ns;
+	
+      if (gfc_peek_ascii_char () == '%'
+	  && sym->ts.type == BT_UNKNOWN
+	  && gfc_get_default_type (sym->name, implicit_ns)->type == BT_DERIVED)
+	gfc_set_default_type (sym, 0, implicit_ns);
+    }
+
+  expr = gfc_get_expr ();
+
+  expr->expr_type = EXPR_VARIABLE;
+  expr->symtree = st;
+  expr->ts = sym->ts;
+  expr->where = where;
+
+  /* Now see if we have to do more.  */
+  m = gfc_match_varspec (expr, equiv_flag, false, false);
+  if (m != MATCH_YES)
+    {
+      gfc_free_expr (expr);
+      return m;
+    }
+
+  *result = expr;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_variable (gfc_expr **result, int equiv_flag)
+{
+  return match_variable (result, equiv_flag, 1);
+}
+
+
+match
+gfc_match_equiv_variable (gfc_expr **result)
+{
+  return match_variable (result, 1, 0);
+}
+
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
new file mode 100644
index 000000000..9ba9455af
--- /dev/null
+++ b/gcc/fortran/resolve.c
@@ -0,0 +1,13696 @@
+/* Perform type resolution on the various structures.
+   Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+   2010, 2011
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "obstack.h"
+#include "bitmap.h"
+#include "arith.h"  /* For gfc_compare_expr().  */
+#include "dependency.h"
+#include "data.h"
+#include "target-memory.h" /* for gfc_simplify_transfer */
+#include "constructor.h"
+
+/* Types used in equivalence statements.  */
+
+typedef enum seq_type
+{
+  SEQ_NONDEFAULT, SEQ_NUMERIC, SEQ_CHARACTER, SEQ_MIXED
+}
+seq_type;
+
+/* Stack to keep track of the nesting of blocks as we move through the
+   code.  See resolve_branch() and resolve_code().  */
+
+typedef struct code_stack
+{
+  struct gfc_code *head, *current;
+  struct code_stack *prev;
+
+  /* This bitmap keeps track of the targets valid for a branch from
+     inside this block except for END {IF|SELECT}s of enclosing
+     blocks.  */
+  bitmap reachable_labels;
+}
+code_stack;
+
+static code_stack *cs_base = NULL;
+
+
+/* Nonzero if we're inside a FORALL block.  */
+
+static int forall_flag;
+
+/* Nonzero if we're inside a OpenMP WORKSHARE or PARALLEL WORKSHARE block.  */
+
+static int omp_workshare_flag;
+
+/* Nonzero if we are processing a formal arglist. The corresponding function
+   resets the flag each time that it is read.  */
+static int formal_arg_flag = 0;
+
+/* True if we are resolving a specification expression.  */
+static int specification_expr = 0;
+
+/* The id of the last entry seen.  */
+static int current_entry_id;
+
+/* We use bitmaps to determine if a branch target is valid.  */
+static bitmap_obstack labels_obstack;
+
+/* True when simplifying a EXPR_VARIABLE argument to an inquiry function.  */
+static bool inquiry_argument = false;
+
+int
+gfc_is_formal_arg (void)
+{
+  return formal_arg_flag;
+}
+
+/* Is the symbol host associated?  */
+static bool
+is_sym_host_assoc (gfc_symbol *sym, gfc_namespace *ns)
+{
+  for (ns = ns->parent; ns; ns = ns->parent)
+    {      
+      if (sym->ns == ns)
+	return true;
+    }
+
+  return false;
+}
+
+/* Ensure a typespec used is valid; for instance, TYPE(t) is invalid if t is
+   an ABSTRACT derived-type.  If where is not NULL, an error message with that
+   locus is printed, optionally using name.  */
+
+static gfc_try
+resolve_typespec_used (gfc_typespec* ts, locus* where, const char* name)
+{
+  if (ts->type == BT_DERIVED && ts->u.derived->attr.abstract)
+    {
+      if (where)
+	{
+	  if (name)
+	    gfc_error ("'%s' at %L is of the ABSTRACT type '%s'",
+		       name, where, ts->u.derived->name);
+	  else
+	    gfc_error ("ABSTRACT type '%s' used at %L",
+		       ts->u.derived->name, where);
+	}
+
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+static void resolve_symbol (gfc_symbol *sym);
+static gfc_try resolve_intrinsic (gfc_symbol *sym, locus *loc);
+
+
+/* Resolve the interface for a PROCEDURE declaration or procedure pointer.  */
+
+static gfc_try
+resolve_procedure_interface (gfc_symbol *sym)
+{
+  if (sym->ts.interface == sym)
+    {
+      gfc_error ("PROCEDURE '%s' at %L may not be used as its own interface",
+		 sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+  if (sym->ts.interface->attr.procedure)
+    {
+      gfc_error ("Interface '%s', used by procedure '%s' at %L, is declared "
+		 "in a later PROCEDURE statement", sym->ts.interface->name,
+		 sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+
+  /* Get the attributes from the interface (now resolved).  */
+  if (sym->ts.interface->attr.if_source || sym->ts.interface->attr.intrinsic)
+    {
+      gfc_symbol *ifc = sym->ts.interface;
+      resolve_symbol (ifc);
+
+      if (ifc->attr.intrinsic)
+	resolve_intrinsic (ifc, &ifc->declared_at);
+
+      if (ifc->result)
+	{
+	  sym->ts = ifc->result->ts;
+	  sym->result = sym;
+	}
+      else   
+	sym->ts = ifc->ts;
+      sym->ts.interface = ifc;
+      sym->attr.function = ifc->attr.function;
+      sym->attr.subroutine = ifc->attr.subroutine;
+      gfc_copy_formal_args (sym, ifc);
+
+      sym->attr.allocatable = ifc->attr.allocatable;
+      sym->attr.pointer = ifc->attr.pointer;
+      sym->attr.pure = ifc->attr.pure;
+      sym->attr.elemental = ifc->attr.elemental;
+      sym->attr.dimension = ifc->attr.dimension;
+      sym->attr.contiguous = ifc->attr.contiguous;
+      sym->attr.recursive = ifc->attr.recursive;
+      sym->attr.always_explicit = ifc->attr.always_explicit;
+      sym->attr.ext_attr |= ifc->attr.ext_attr;
+      sym->attr.is_bind_c = ifc->attr.is_bind_c;
+      /* Copy array spec.  */
+      sym->as = gfc_copy_array_spec (ifc->as);
+      if (sym->as)
+	{
+	  int i;
+	  for (i = 0; i < sym->as->rank; i++)
+	    {
+	      gfc_expr_replace_symbols (sym->as->lower[i], sym);
+	      gfc_expr_replace_symbols (sym->as->upper[i], sym);
+	    }
+	}
+      /* Copy char length.  */
+      if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl)
+	{
+	  sym->ts.u.cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
+	  gfc_expr_replace_symbols (sym->ts.u.cl->length, sym);
+	  if (sym->ts.u.cl->length && !sym->ts.u.cl->resolved
+	      && gfc_resolve_expr (sym->ts.u.cl->length) == FAILURE)
+	    return FAILURE;
+	}
+    }
+  else if (sym->ts.interface->name[0] != '\0')
+    {
+      gfc_error ("Interface '%s' of procedure '%s' at %L must be explicit",
+		 sym->ts.interface->name, sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Resolve types of formal argument lists.  These have to be done early so that
+   the formal argument lists of module procedures can be copied to the
+   containing module before the individual procedures are resolved
+   individually.  We also resolve argument lists of procedures in interface
+   blocks because they are self-contained scoping units.
+
+   Since a dummy argument cannot be a non-dummy procedure, the only
+   resort left for untyped names are the IMPLICIT types.  */
+
+static void
+resolve_formal_arglist (gfc_symbol *proc)
+{
+  gfc_formal_arglist *f;
+  gfc_symbol *sym;
+  int i;
+
+  if (proc->result != NULL)
+    sym = proc->result;
+  else
+    sym = proc;
+
+  if (gfc_elemental (proc)
+      || sym->attr.pointer || sym->attr.allocatable
+      || (sym->as && sym->as->rank > 0))
+    {
+      proc->attr.always_explicit = 1;
+      sym->attr.always_explicit = 1;
+    }
+
+  formal_arg_flag = 1;
+
+  for (f = proc->formal; f; f = f->next)
+    {
+      sym = f->sym;
+
+      if (sym == NULL)
+	{
+	  /* Alternate return placeholder.  */
+	  if (gfc_elemental (proc))
+	    gfc_error ("Alternate return specifier in elemental subroutine "
+		       "'%s' at %L is not allowed", proc->name,
+		       &proc->declared_at);
+	  if (proc->attr.function)
+	    gfc_error ("Alternate return specifier in function "
+		       "'%s' at %L is not allowed", proc->name,
+		       &proc->declared_at);
+	  continue;
+	}
+      else if (sym->attr.procedure && sym->ts.interface
+	       && sym->attr.if_source != IFSRC_DECL)
+	resolve_procedure_interface (sym);
+
+      if (sym->attr.if_source != IFSRC_UNKNOWN)
+	resolve_formal_arglist (sym);
+
+      if (sym->attr.subroutine || sym->attr.external || sym->attr.intrinsic)
+	{
+	  if (gfc_pure (proc) && !gfc_pure (sym))
+	    {
+	      gfc_error ("Dummy procedure '%s' of PURE procedure at %L must "
+			 "also be PURE", sym->name, &sym->declared_at);
+	      continue;
+	    }
+
+	  if (proc->attr.implicit_pure && !gfc_pure(sym))
+	    proc->attr.implicit_pure = 0;
+
+	  if (gfc_elemental (proc))
+	    {
+	      gfc_error ("Dummy procedure at %L not allowed in ELEMENTAL "
+			 "procedure", &sym->declared_at);
+	      continue;
+	    }
+
+	  if (sym->attr.function
+		&& sym->ts.type == BT_UNKNOWN
+		&& sym->attr.intrinsic)
+	    {
+	      gfc_intrinsic_sym *isym;
+	      isym = gfc_find_function (sym->name);
+	      if (isym == NULL || !isym->specific)
+		{
+		  gfc_error ("Unable to find a specific INTRINSIC procedure "
+			     "for the reference '%s' at %L", sym->name,
+			     &sym->declared_at);
+		}
+	      sym->ts = isym->ts;
+	    }
+
+	  continue;
+	}
+
+      if (sym->ts.type == BT_UNKNOWN && !proc->attr.intrinsic
+	  && (!sym->attr.function || sym->result == sym))
+	gfc_set_default_type (sym, 1, sym->ns);
+
+      gfc_resolve_array_spec (sym->as, 0);
+
+      /* We can't tell if an array with dimension (:) is assumed or deferred
+	 shape until we know if it has the pointer or allocatable attributes.
+      */
+      if (sym->as && sym->as->rank > 0 && sym->as->type == AS_DEFERRED
+	  && !(sym->attr.pointer || sym->attr.allocatable)
+	  && sym->attr.flavor != FL_PROCEDURE)
+	{
+	  sym->as->type = AS_ASSUMED_SHAPE;
+	  for (i = 0; i < sym->as->rank; i++)
+	    sym->as->lower[i] = gfc_get_int_expr (gfc_default_integer_kind,
+						  NULL, 1);
+	}
+
+      if ((sym->as && sym->as->rank > 0 && sym->as->type == AS_ASSUMED_SHAPE)
+	  || sym->attr.pointer || sym->attr.allocatable || sym->attr.target
+	  || sym->attr.optional)
+	{
+	  proc->attr.always_explicit = 1;
+	  if (proc->result)
+	    proc->result->attr.always_explicit = 1;
+	}
+
+      /* If the flavor is unknown at this point, it has to be a variable.
+	 A procedure specification would have already set the type.  */
+
+      if (sym->attr.flavor == FL_UNKNOWN)
+	gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, &sym->declared_at);
+
+      if (gfc_pure (proc) && !sym->attr.pointer
+	  && sym->attr.flavor != FL_PROCEDURE)
+	{
+	  if (proc->attr.function && sym->attr.intent != INTENT_IN)
+	    {
+	      if (sym->attr.value)
+		gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Argument '%s' "
+				"of pure function '%s' at %L with VALUE "
+				"attribute but without INTENT(IN)", sym->name,
+				proc->name, &sym->declared_at);
+	      else
+		gfc_error ("Argument '%s' of pure function '%s' at %L must be "
+			   "INTENT(IN) or VALUE", sym->name, proc->name,
+			   &sym->declared_at);
+	    }
+
+	  if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN)
+	    {
+	      if (sym->attr.value)
+		gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Argument '%s' "
+				"of pure subroutine '%s' at %L with VALUE "
+				"attribute but without INTENT", sym->name,
+				proc->name, &sym->declared_at);
+	      else
+		gfc_error ("Argument '%s' of pure subroutine '%s' at %L must "
+		       "have its INTENT specified or have the VALUE "
+		       "attribute", sym->name, proc->name, &sym->declared_at);
+	    }
+	}
+
+      if (proc->attr.implicit_pure && !sym->attr.pointer
+	  && sym->attr.flavor != FL_PROCEDURE)
+	{
+	  if (proc->attr.function && sym->attr.intent != INTENT_IN)
+	    proc->attr.implicit_pure = 0;
+
+	  if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN)
+	    proc->attr.implicit_pure = 0;
+	}
+
+      if (gfc_elemental (proc))
+	{
+	  /* F2008, C1289.  */
+	  if (sym->attr.codimension)
+	    {
+	      gfc_error ("Coarray dummy argument '%s' at %L to elemental "
+			 "procedure", sym->name, &sym->declared_at);
+	      continue;
+	    }
+
+	  if (sym->as != NULL)
+	    {
+	      gfc_error ("Argument '%s' of elemental procedure at %L must "
+			 "be scalar", sym->name, &sym->declared_at);
+	      continue;
+	    }
+
+	  if (sym->attr.allocatable)
+	    {
+	      gfc_error ("Argument '%s' of elemental procedure at %L cannot "
+			 "have the ALLOCATABLE attribute", sym->name,
+			 &sym->declared_at);
+	      continue;
+	    }
+
+	  if (sym->attr.pointer)
+	    {
+	      gfc_error ("Argument '%s' of elemental procedure at %L cannot "
+			 "have the POINTER attribute", sym->name,
+			 &sym->declared_at);
+	      continue;
+	    }
+
+	  if (sym->attr.flavor == FL_PROCEDURE)
+	    {
+	      gfc_error ("Dummy procedure '%s' not allowed in elemental "
+			 "procedure '%s' at %L", sym->name, proc->name,
+			 &sym->declared_at);
+	      continue;
+	    }
+
+	  if (sym->attr.intent == INTENT_UNKNOWN)
+	    {
+	      gfc_error ("Argument '%s' of elemental procedure '%s' at %L must "
+			 "have its INTENT specified", sym->name, proc->name,
+			 &sym->declared_at);
+	      continue;
+	    }
+	}
+
+      /* Each dummy shall be specified to be scalar.  */
+      if (proc->attr.proc == PROC_ST_FUNCTION)
+	{
+	  if (sym->as != NULL)
+	    {
+	      gfc_error ("Argument '%s' of statement function at %L must "
+			 "be scalar", sym->name, &sym->declared_at);
+	      continue;
+	    }
+
+	  if (sym->ts.type == BT_CHARACTER)
+	    {
+	      gfc_charlen *cl = sym->ts.u.cl;
+	      if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
+		{
+		  gfc_error ("Character-valued argument '%s' of statement "
+			     "function at %L must have constant length",
+			     sym->name, &sym->declared_at);
+		  continue;
+		}
+	    }
+	}
+    }
+  formal_arg_flag = 0;
+}
+
+
+/* Work function called when searching for symbols that have argument lists
+   associated with them.  */
+
+static void
+find_arglists (gfc_symbol *sym)
+{
+  if (sym->attr.if_source == IFSRC_UNKNOWN || sym->ns != gfc_current_ns)
+    return;
+
+  resolve_formal_arglist (sym);
+}
+
+
+/* Given a namespace, resolve all formal argument lists within the namespace.
+ */
+
+static void
+resolve_formal_arglists (gfc_namespace *ns)
+{
+  if (ns == NULL)
+    return;
+
+  gfc_traverse_ns (ns, find_arglists);
+}
+
+
+static void
+resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns)
+{
+  gfc_try t;
+
+  /* If this namespace is not a function or an entry master function,
+     ignore it.  */
+  if (! sym || !(sym->attr.function || sym->attr.flavor == FL_VARIABLE)
+      || sym->attr.entry_master)
+    return;
+
+  /* Try to find out of what the return type is.  */
+  if (sym->result->ts.type == BT_UNKNOWN && sym->result->ts.interface == NULL)
+    {
+      t = gfc_set_default_type (sym->result, 0, ns);
+
+      if (t == FAILURE && !sym->result->attr.untyped)
+	{
+	  if (sym->result == sym)
+	    gfc_error ("Contained function '%s' at %L has no IMPLICIT type",
+		       sym->name, &sym->declared_at);
+	  else if (!sym->result->attr.proc_pointer)
+	    gfc_error ("Result '%s' of contained function '%s' at %L has "
+		       "no IMPLICIT type", sym->result->name, sym->name,
+		       &sym->result->declared_at);
+	  sym->result->attr.untyped = 1;
+	}
+    }
+
+  /* Fortran 95 Draft Standard, page 51, Section 5.1.1.5, on the Character 
+     type, lists the only ways a character length value of * can be used:
+     dummy arguments of procedures, named constants, and function results
+     in external functions.  Internal function results and results of module
+     procedures are not on this list, ergo, not permitted.  */
+
+  if (sym->result->ts.type == BT_CHARACTER)
+    {
+      gfc_charlen *cl = sym->result->ts.u.cl;
+      if ((!cl || !cl->length) && !sym->result->ts.deferred)
+	{
+	  /* See if this is a module-procedure and adapt error message
+	     accordingly.  */
+	  bool module_proc;
+	  gcc_assert (ns->parent && ns->parent->proc_name);
+	  module_proc = (ns->parent->proc_name->attr.flavor == FL_MODULE);
+
+	  gfc_error ("Character-valued %s '%s' at %L must not be"
+		     " assumed length",
+		     module_proc ? _("module procedure")
+				 : _("internal function"),
+		     sym->name, &sym->declared_at);
+	}
+    }
+}
+
+
+/* Add NEW_ARGS to the formal argument list of PROC, taking care not to
+   introduce duplicates.  */
+
+static void
+merge_argument_lists (gfc_symbol *proc, gfc_formal_arglist *new_args)
+{
+  gfc_formal_arglist *f, *new_arglist;
+  gfc_symbol *new_sym;
+
+  for (; new_args != NULL; new_args = new_args->next)
+    {
+      new_sym = new_args->sym;
+      /* See if this arg is already in the formal argument list.  */
+      for (f = proc->formal; f; f = f->next)
+	{
+	  if (new_sym == f->sym)
+	    break;
+	}
+
+      if (f)
+	continue;
+
+      /* Add a new argument.  Argument order is not important.  */
+      new_arglist = gfc_get_formal_arglist ();
+      new_arglist->sym = new_sym;
+      new_arglist->next = proc->formal;
+      proc->formal  = new_arglist;
+    }
+}
+
+
+/* Flag the arguments that are not present in all entries.  */
+
+static void
+check_argument_lists (gfc_symbol *proc, gfc_formal_arglist *new_args)
+{
+  gfc_formal_arglist *f, *head;
+  head = new_args;
+
+  for (f = proc->formal; f; f = f->next)
+    {
+      if (f->sym == NULL)
+	continue;
+
+      for (new_args = head; new_args; new_args = new_args->next)
+	{
+	  if (new_args->sym == f->sym)
+	    break;
+	}
+
+      if (new_args)
+	continue;
+
+      f->sym->attr.not_always_present = 1;
+    }
+}
+
+
+/* Resolve alternate entry points.  If a symbol has multiple entry points we
+   create a new master symbol for the main routine, and turn the existing
+   symbol into an entry point.  */
+
+static void
+resolve_entries (gfc_namespace *ns)
+{
+  gfc_namespace *old_ns;
+  gfc_code *c;
+  gfc_symbol *proc;
+  gfc_entry_list *el;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  static int master_count = 0;
+
+  if (ns->proc_name == NULL)
+    return;
+
+  /* No need to do anything if this procedure doesn't have alternate entry
+     points.  */
+  if (!ns->entries)
+    return;
+
+  /* We may already have resolved alternate entry points.  */
+  if (ns->proc_name->attr.entry_master)
+    return;
+
+  /* If this isn't a procedure something has gone horribly wrong.  */
+  gcc_assert (ns->proc_name->attr.flavor == FL_PROCEDURE);
+
+  /* Remember the current namespace.  */
+  old_ns = gfc_current_ns;
+
+  gfc_current_ns = ns;
+
+  /* Add the main entry point to the list of entry points.  */
+  el = gfc_get_entry_list ();
+  el->sym = ns->proc_name;
+  el->id = 0;
+  el->next = ns->entries;
+  ns->entries = el;
+  ns->proc_name->attr.entry = 1;
+
+  /* If it is a module function, it needs to be in the right namespace
+     so that gfc_get_fake_result_decl can gather up the results. The
+     need for this arose in get_proc_name, where these beasts were
+     left in their own namespace, to keep prior references linked to
+     the entry declaration.*/
+  if (ns->proc_name->attr.function
+      && ns->parent && ns->parent->proc_name->attr.flavor == FL_MODULE)
+    el->sym->ns = ns;
+
+  /* Do the same for entries where the master is not a module
+     procedure.  These are retained in the module namespace because
+     of the module procedure declaration.  */
+  for (el = el->next; el; el = el->next)
+    if (el->sym->ns->proc_name->attr.flavor == FL_MODULE
+	  && el->sym->attr.mod_proc)
+      el->sym->ns = ns;
+  el = ns->entries;
+
+  /* Add an entry statement for it.  */
+  c = gfc_get_code ();
+  c->op = EXEC_ENTRY;
+  c->ext.entry = el;
+  c->next = ns->code;
+  ns->code = c;
+
+  /* Create a new symbol for the master function.  */
+  /* Give the internal function a unique name (within this file).
+     Also include the function name so the user has some hope of figuring
+     out what is going on.  */
+  snprintf (name, GFC_MAX_SYMBOL_LEN, "master.%d.%s",
+	    master_count++, ns->proc_name->name);
+  gfc_get_ha_symbol (name, &proc);
+  gcc_assert (proc != NULL);
+
+  gfc_add_procedure (&proc->attr, PROC_INTERNAL, proc->name, NULL);
+  if (ns->proc_name->attr.subroutine)
+    gfc_add_subroutine (&proc->attr, proc->name, NULL);
+  else
+    {
+      gfc_symbol *sym;
+      gfc_typespec *ts, *fts;
+      gfc_array_spec *as, *fas;
+      gfc_add_function (&proc->attr, proc->name, NULL);
+      proc->result = proc;
+      fas = ns->entries->sym->as;
+      fas = fas ? fas : ns->entries->sym->result->as;
+      fts = &ns->entries->sym->result->ts;
+      if (fts->type == BT_UNKNOWN)
+	fts = gfc_get_default_type (ns->entries->sym->result->name, NULL);
+      for (el = ns->entries->next; el; el = el->next)
+	{
+	  ts = &el->sym->result->ts;
+	  as = el->sym->as;
+	  as = as ? as : el->sym->result->as;
+	  if (ts->type == BT_UNKNOWN)
+	    ts = gfc_get_default_type (el->sym->result->name, NULL);
+
+	  if (! gfc_compare_types (ts, fts)
+	      || (el->sym->result->attr.dimension
+		  != ns->entries->sym->result->attr.dimension)
+	      || (el->sym->result->attr.pointer
+		  != ns->entries->sym->result->attr.pointer))
+	    break;
+	  else if (as && fas && ns->entries->sym->result != el->sym->result
+		      && gfc_compare_array_spec (as, fas) == 0)
+	    gfc_error ("Function %s at %L has entries with mismatched "
+		       "array specifications", ns->entries->sym->name,
+		       &ns->entries->sym->declared_at);
+	  /* The characteristics need to match and thus both need to have
+	     the same string length, i.e. both len=*, or both len=4.
+	     Having both len=<variable> is also possible, but difficult to
+	     check at compile time.  */
+	  else if (ts->type == BT_CHARACTER && ts->u.cl && fts->u.cl
+		   && (((ts->u.cl->length && !fts->u.cl->length)
+			||(!ts->u.cl->length && fts->u.cl->length))
+		       || (ts->u.cl->length
+			   && ts->u.cl->length->expr_type
+			      != fts->u.cl->length->expr_type)
+		       || (ts->u.cl->length
+			   && ts->u.cl->length->expr_type == EXPR_CONSTANT
+		           && mpz_cmp (ts->u.cl->length->value.integer,
+				       fts->u.cl->length->value.integer) != 0)))
+	    gfc_notify_std (GFC_STD_GNU, "Extension: Function %s at %L with "
+			    "entries returning variables of different "
+			    "string lengths", ns->entries->sym->name,
+			    &ns->entries->sym->declared_at);
+	}
+
+      if (el == NULL)
+	{
+	  sym = ns->entries->sym->result;
+	  /* All result types the same.  */
+	  proc->ts = *fts;
+	  if (sym->attr.dimension)
+	    gfc_set_array_spec (proc, gfc_copy_array_spec (sym->as), NULL);
+	  if (sym->attr.pointer)
+	    gfc_add_pointer (&proc->attr, NULL);
+	}
+      else
+	{
+	  /* Otherwise the result will be passed through a union by
+	     reference.  */
+	  proc->attr.mixed_entry_master = 1;
+	  for (el = ns->entries; el; el = el->next)
+	    {
+	      sym = el->sym->result;
+	      if (sym->attr.dimension)
+		{
+		  if (el == ns->entries)
+		    gfc_error ("FUNCTION result %s can't be an array in "
+			       "FUNCTION %s at %L", sym->name,
+			       ns->entries->sym->name, &sym->declared_at);
+		  else
+		    gfc_error ("ENTRY result %s can't be an array in "
+			       "FUNCTION %s at %L", sym->name,
+			       ns->entries->sym->name, &sym->declared_at);
+		}
+	      else if (sym->attr.pointer)
+		{
+		  if (el == ns->entries)
+		    gfc_error ("FUNCTION result %s can't be a POINTER in "
+			       "FUNCTION %s at %L", sym->name,
+			       ns->entries->sym->name, &sym->declared_at);
+		  else
+		    gfc_error ("ENTRY result %s can't be a POINTER in "
+			       "FUNCTION %s at %L", sym->name,
+			       ns->entries->sym->name, &sym->declared_at);
+		}
+	      else
+		{
+		  ts = &sym->ts;
+		  if (ts->type == BT_UNKNOWN)
+		    ts = gfc_get_default_type (sym->name, NULL);
+		  switch (ts->type)
+		    {
+		    case BT_INTEGER:
+		      if (ts->kind == gfc_default_integer_kind)
+			sym = NULL;
+		      break;
+		    case BT_REAL:
+		      if (ts->kind == gfc_default_real_kind
+			  || ts->kind == gfc_default_double_kind)
+			sym = NULL;
+		      break;
+		    case BT_COMPLEX:
+		      if (ts->kind == gfc_default_complex_kind)
+			sym = NULL;
+		      break;
+		    case BT_LOGICAL:
+		      if (ts->kind == gfc_default_logical_kind)
+			sym = NULL;
+		      break;
+		    case BT_UNKNOWN:
+		      /* We will issue error elsewhere.  */
+		      sym = NULL;
+		      break;
+		    default:
+		      break;
+		    }
+		  if (sym)
+		    {
+		      if (el == ns->entries)
+			gfc_error ("FUNCTION result %s can't be of type %s "
+				   "in FUNCTION %s at %L", sym->name,
+				   gfc_typename (ts), ns->entries->sym->name,
+				   &sym->declared_at);
+		      else
+			gfc_error ("ENTRY result %s can't be of type %s "
+				   "in FUNCTION %s at %L", sym->name,
+				   gfc_typename (ts), ns->entries->sym->name,
+				   &sym->declared_at);
+		    }
+		}
+	    }
+	}
+    }
+  proc->attr.access = ACCESS_PRIVATE;
+  proc->attr.entry_master = 1;
+
+  /* Merge all the entry point arguments.  */
+  for (el = ns->entries; el; el = el->next)
+    merge_argument_lists (proc, el->sym->formal);
+
+  /* Check the master formal arguments for any that are not
+     present in all entry points.  */
+  for (el = ns->entries; el; el = el->next)
+    check_argument_lists (proc, el->sym->formal);
+
+  /* Use the master function for the function body.  */
+  ns->proc_name = proc;
+
+  /* Finalize the new symbols.  */
+  gfc_commit_symbols ();
+
+  /* Restore the original namespace.  */
+  gfc_current_ns = old_ns;
+}
+
+
+/* Resolve common variables.  */
+static void
+resolve_common_vars (gfc_symbol *sym, bool named_common)
+{
+  gfc_symbol *csym = sym;
+
+  for (; csym; csym = csym->common_next)
+    {
+      if (csym->value || csym->attr.data)
+	{
+	  if (!csym->ns->is_block_data)
+	    gfc_notify_std (GFC_STD_GNU, "Variable '%s' at %L is in COMMON "
+			    "but only in BLOCK DATA initialization is "
+			    "allowed", csym->name, &csym->declared_at);
+	  else if (!named_common)
+	    gfc_notify_std (GFC_STD_GNU, "Initialized variable '%s' at %L is "
+			    "in a blank COMMON but initialization is only "
+			    "allowed in named common blocks", csym->name,
+			    &csym->declared_at);
+	}
+
+      if (csym->ts.type != BT_DERIVED)
+	continue;
+
+      if (!(csym->ts.u.derived->attr.sequence
+	    || csym->ts.u.derived->attr.is_bind_c))
+	gfc_error_now ("Derived type variable '%s' in COMMON at %L "
+		       "has neither the SEQUENCE nor the BIND(C) "
+		       "attribute", csym->name, &csym->declared_at);
+      if (csym->ts.u.derived->attr.alloc_comp)
+	gfc_error_now ("Derived type variable '%s' in COMMON at %L "
+		       "has an ultimate component that is "
+		       "allocatable", csym->name, &csym->declared_at);
+      if (gfc_has_default_initializer (csym->ts.u.derived))
+	gfc_error_now ("Derived type variable '%s' in COMMON at %L "
+		       "may not have default initializer", csym->name,
+		       &csym->declared_at);
+
+      if (csym->attr.flavor == FL_UNKNOWN && !csym->attr.proc_pointer)
+	gfc_add_flavor (&csym->attr, FL_VARIABLE, csym->name, &csym->declared_at);
+    }
+}
+
+/* Resolve common blocks.  */
+static void
+resolve_common_blocks (gfc_symtree *common_root)
+{
+  gfc_symbol *sym;
+
+  if (common_root == NULL)
+    return;
+
+  if (common_root->left)
+    resolve_common_blocks (common_root->left);
+  if (common_root->right)
+    resolve_common_blocks (common_root->right);
+
+  resolve_common_vars (common_root->n.common->head, true);
+
+  gfc_find_symbol (common_root->name, gfc_current_ns, 0, &sym);
+  if (sym == NULL)
+    return;
+
+  if (sym->attr.flavor == FL_PARAMETER)
+    gfc_error ("COMMON block '%s' at %L is used as PARAMETER at %L",
+	       sym->name, &common_root->n.common->where, &sym->declared_at);
+
+  if (sym->attr.intrinsic)
+    gfc_error ("COMMON block '%s' at %L is also an intrinsic procedure",
+	       sym->name, &common_root->n.common->where);
+  else if (sym->attr.result
+	   || gfc_is_function_return_value (sym, gfc_current_ns))
+    gfc_notify_std (GFC_STD_F2003, "Fortran 2003: COMMON block '%s' at %L "
+		    "that is also a function result", sym->name,
+		    &common_root->n.common->where);
+  else if (sym->attr.flavor == FL_PROCEDURE && sym->attr.proc != PROC_INTERNAL
+	   && sym->attr.proc != PROC_ST_FUNCTION)
+    gfc_notify_std (GFC_STD_F2003, "Fortran 2003: COMMON block '%s' at %L "
+		    "that is also a global procedure", sym->name,
+		    &common_root->n.common->where);
+}
+
+
+/* Resolve contained function types.  Because contained functions can call one
+   another, they have to be worked out before any of the contained procedures
+   can be resolved.
+
+   The good news is that if a function doesn't already have a type, the only
+   way it can get one is through an IMPLICIT type or a RESULT variable, because
+   by definition contained functions are contained namespace they're contained
+   in, not in a sibling or parent namespace.  */
+
+static void
+resolve_contained_functions (gfc_namespace *ns)
+{
+  gfc_namespace *child;
+  gfc_entry_list *el;
+
+  resolve_formal_arglists (ns);
+
+  for (child = ns->contained; child; child = child->sibling)
+    {
+      /* Resolve alternate entry points first.  */
+      resolve_entries (child);
+
+      /* Then check function return types.  */
+      resolve_contained_fntype (child->proc_name, child);
+      for (el = child->entries; el; el = el->next)
+	resolve_contained_fntype (el->sym, child);
+    }
+}
+
+
+static gfc_try resolve_fl_derived0 (gfc_symbol *sym);
+
+
+/* Resolve all of the elements of a structure constructor and make sure that
+   the types are correct. The 'init' flag indicates that the given
+   constructor is an initializer.  */
+
+static gfc_try
+resolve_structure_cons (gfc_expr *expr, int init)
+{
+  gfc_constructor *cons;
+  gfc_component *comp;
+  gfc_try t;
+  symbol_attribute a;
+
+  t = SUCCESS;
+
+  if (expr->ts.type == BT_DERIVED)
+    resolve_fl_derived0 (expr->ts.u.derived);
+
+  cons = gfc_constructor_first (expr->value.constructor);
+  /* A constructor may have references if it is the result of substituting a
+     parameter variable.  In this case we just pull out the component we
+     want.  */
+  if (expr->ref)
+    comp = expr->ref->u.c.sym->components;
+  else
+    comp = expr->ts.u.derived->components;
+
+  /* See if the user is trying to invoke a structure constructor for one of
+     the iso_c_binding derived types.  */
+  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived
+      && expr->ts.u.derived->ts.is_iso_c && cons
+      && (cons->expr == NULL || cons->expr->expr_type != EXPR_NULL))
+    {
+      gfc_error ("Components of structure constructor '%s' at %L are PRIVATE",
+		 expr->ts.u.derived->name, &(expr->where));
+      return FAILURE;
+    }
+
+  /* Return if structure constructor is c_null_(fun)prt.  */
+  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived
+      && expr->ts.u.derived->ts.is_iso_c && cons
+      && cons->expr && cons->expr->expr_type == EXPR_NULL)
+    return SUCCESS;
+
+  for (; comp && cons; comp = comp->next, cons = gfc_constructor_next (cons))
+    {
+      int rank;
+
+      if (!cons->expr)
+	continue;
+
+      if (gfc_resolve_expr (cons->expr) == FAILURE)
+	{
+	  t = FAILURE;
+	  continue;
+	}
+
+      rank = comp->as ? comp->as->rank : 0;
+      if (cons->expr->expr_type != EXPR_NULL && rank != cons->expr->rank
+	  && (comp->attr.allocatable || cons->expr->rank))
+	{
+	  gfc_error ("The rank of the element in the derived type "
+		     "constructor at %L does not match that of the "
+		     "component (%d/%d)", &cons->expr->where,
+		     cons->expr->rank, rank);
+	  t = FAILURE;
+	}
+
+      /* If we don't have the right type, try to convert it.  */
+
+      if (!comp->attr.proc_pointer &&
+	  !gfc_compare_types (&cons->expr->ts, &comp->ts))
+	{
+	  t = FAILURE;
+	  if (strcmp (comp->name, "_extends") == 0)
+	    {
+	      /* Can afford to be brutal with the _extends initializer.
+		 The derived type can get lost because it is PRIVATE
+		 but it is not usage constrained by the standard.  */
+	      cons->expr->ts = comp->ts;
+	      t = SUCCESS;
+	    }
+	  else if (comp->attr.pointer && cons->expr->ts.type != BT_UNKNOWN)
+	    gfc_error ("The element in the derived type constructor at %L, "
+		       "for pointer component '%s', is %s but should be %s",
+		       &cons->expr->where, comp->name,
+		       gfc_basic_typename (cons->expr->ts.type),
+		       gfc_basic_typename (comp->ts.type));
+	  else
+	    t = gfc_convert_type (cons->expr, &comp->ts, 1);
+	}
+
+      /* For strings, the length of the constructor should be the same as
+	 the one of the structure, ensure this if the lengths are known at
+ 	 compile time and when we are dealing with PARAMETER or structure
+	 constructors.  */
+      if (cons->expr->ts.type == BT_CHARACTER && comp->ts.u.cl
+	  && comp->ts.u.cl->length
+	  && comp->ts.u.cl->length->expr_type == EXPR_CONSTANT
+	  && cons->expr->ts.u.cl && cons->expr->ts.u.cl->length
+	  && cons->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT
+	  && cons->expr->rank != 0
+	  && mpz_cmp (cons->expr->ts.u.cl->length->value.integer,
+		      comp->ts.u.cl->length->value.integer) != 0)
+	{
+	  if (cons->expr->expr_type == EXPR_VARIABLE
+	      && cons->expr->symtree->n.sym->attr.flavor == FL_PARAMETER)
+	    {
+	      /* Wrap the parameter in an array constructor (EXPR_ARRAY)
+		 to make use of the gfc_resolve_character_array_constructor
+		 machinery.  The expression is later simplified away to
+		 an array of string literals.  */
+	      gfc_expr *para = cons->expr;
+	      cons->expr = gfc_get_expr ();
+	      cons->expr->ts = para->ts;
+	      cons->expr->where = para->where;
+	      cons->expr->expr_type = EXPR_ARRAY;
+	      cons->expr->rank = para->rank;
+	      cons->expr->shape = gfc_copy_shape (para->shape, para->rank);
+	      gfc_constructor_append_expr (&cons->expr->value.constructor,
+					   para, &cons->expr->where);
+	    }
+	  if (cons->expr->expr_type == EXPR_ARRAY)
+	    {
+	      gfc_constructor *p;
+	      p = gfc_constructor_first (cons->expr->value.constructor);
+	      if (cons->expr->ts.u.cl != p->expr->ts.u.cl)
+		{
+		  gfc_charlen *cl, *cl2;
+
+		  cl2 = NULL;
+		  for (cl = gfc_current_ns->cl_list; cl; cl = cl->next)
+		    {
+		      if (cl == cons->expr->ts.u.cl)
+			break;
+		      cl2 = cl;
+		    }
+
+		  gcc_assert (cl);
+
+		  if (cl2)
+		    cl2->next = cl->next;
+
+		  gfc_free_expr (cl->length);
+		  gfc_free (cl);
+		}
+
+	      cons->expr->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+	      cons->expr->ts.u.cl->length_from_typespec = true;
+	      cons->expr->ts.u.cl->length = gfc_copy_expr (comp->ts.u.cl->length);
+	      gfc_resolve_character_array_constructor (cons->expr);
+	    }
+	}
+
+      if (cons->expr->expr_type == EXPR_NULL
+	  && !(comp->attr.pointer || comp->attr.allocatable
+	       || comp->attr.proc_pointer
+	       || (comp->ts.type == BT_CLASS
+		   && (CLASS_DATA (comp)->attr.class_pointer
+		       || CLASS_DATA (comp)->attr.allocatable))))
+	{
+	  t = FAILURE;
+	  gfc_error ("The NULL in the derived type constructor at %L is "
+		     "being applied to component '%s', which is neither "
+		     "a POINTER nor ALLOCATABLE", &cons->expr->where,
+		     comp->name);
+	}
+
+      if (!comp->attr.pointer || comp->attr.proc_pointer
+	  || cons->expr->expr_type == EXPR_NULL)
+	continue;
+
+      a = gfc_expr_attr (cons->expr);
+
+      if (!a.pointer && !a.target)
+	{
+	  t = FAILURE;
+	  gfc_error ("The element in the derived type constructor at %L, "
+		     "for pointer component '%s' should be a POINTER or "
+		     "a TARGET", &cons->expr->where, comp->name);
+	}
+
+      if (init)
+	{
+	  /* F08:C461. Additional checks for pointer initialization.  */
+	  if (a.allocatable)
+	    {
+	      t = FAILURE;
+	      gfc_error ("Pointer initialization target at %L "
+			 "must not be ALLOCATABLE ", &cons->expr->where);
+	    }
+	  if (!a.save)
+	    {
+	      t = FAILURE;
+	      gfc_error ("Pointer initialization target at %L "
+			 "must have the SAVE attribute", &cons->expr->where);
+	    }
+	}
+
+      /* F2003, C1272 (3).  */
+      if (gfc_pure (NULL) && cons->expr->expr_type == EXPR_VARIABLE
+	  && (gfc_impure_variable (cons->expr->symtree->n.sym)
+	      || gfc_is_coindexed (cons->expr)))
+	{
+	  t = FAILURE;
+	  gfc_error ("Invalid expression in the derived type constructor for "
+		     "pointer component '%s' at %L in PURE procedure",
+		     comp->name, &cons->expr->where);
+	}
+
+      if (gfc_implicit_pure (NULL)
+	    && cons->expr->expr_type == EXPR_VARIABLE
+	    && (gfc_impure_variable (cons->expr->symtree->n.sym)
+		|| gfc_is_coindexed (cons->expr)))
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+    }
+
+  return t;
+}
+
+
+/****************** Expression name resolution ******************/
+
+/* Returns 0 if a symbol was not declared with a type or
+   attribute declaration statement, nonzero otherwise.  */
+
+static int
+was_declared (gfc_symbol *sym)
+{
+  symbol_attribute a;
+
+  a = sym->attr;
+
+  if (!a.implicit_type && sym->ts.type != BT_UNKNOWN)
+    return 1;
+
+  if (a.allocatable || a.dimension || a.dummy || a.external || a.intrinsic
+      || a.optional || a.pointer || a.save || a.target || a.volatile_
+      || a.value || a.access != ACCESS_UNKNOWN || a.intent != INTENT_UNKNOWN
+      || a.asynchronous || a.codimension)
+    return 1;
+
+  return 0;
+}
+
+
+/* Determine if a symbol is generic or not.  */
+
+static int
+generic_sym (gfc_symbol *sym)
+{
+  gfc_symbol *s;
+
+  if (sym->attr.generic ||
+      (sym->attr.intrinsic && gfc_generic_intrinsic (sym->name)))
+    return 1;
+
+  if (was_declared (sym) || sym->ns->parent == NULL)
+    return 0;
+
+  gfc_find_symbol (sym->name, sym->ns->parent, 1, &s);
+  
+  if (s != NULL)
+    {
+      if (s == sym)
+	return 0;
+      else
+	return generic_sym (s);
+    }
+
+  return 0;
+}
+
+
+/* Determine if a symbol is specific or not.  */
+
+static int
+specific_sym (gfc_symbol *sym)
+{
+  gfc_symbol *s;
+
+  if (sym->attr.if_source == IFSRC_IFBODY
+      || sym->attr.proc == PROC_MODULE
+      || sym->attr.proc == PROC_INTERNAL
+      || sym->attr.proc == PROC_ST_FUNCTION
+      || (sym->attr.intrinsic && gfc_specific_intrinsic (sym->name))
+      || sym->attr.external)
+    return 1;
+
+  if (was_declared (sym) || sym->ns->parent == NULL)
+    return 0;
+
+  gfc_find_symbol (sym->name, sym->ns->parent, 1, &s);
+
+  return (s == NULL) ? 0 : specific_sym (s);
+}
+
+
+/* Figure out if the procedure is specific, generic or unknown.  */
+
+typedef enum
+{ PTYPE_GENERIC = 1, PTYPE_SPECIFIC, PTYPE_UNKNOWN }
+proc_type;
+
+static proc_type
+procedure_kind (gfc_symbol *sym)
+{
+  if (generic_sym (sym))
+    return PTYPE_GENERIC;
+
+  if (specific_sym (sym))
+    return PTYPE_SPECIFIC;
+
+  return PTYPE_UNKNOWN;
+}
+
+/* Check references to assumed size arrays.  The flag need_full_assumed_size
+   is nonzero when matching actual arguments.  */
+
+static int need_full_assumed_size = 0;
+
+static bool
+check_assumed_size_reference (gfc_symbol *sym, gfc_expr *e)
+{
+  if (need_full_assumed_size || !(sym->as && sym->as->type == AS_ASSUMED_SIZE))
+      return false;
+
+  /* FIXME: The comparison "e->ref->u.ar.type == AR_FULL" is wrong.
+     What should it be?  */
+  if ((e->ref->u.ar.end[e->ref->u.ar.as->rank - 1] == NULL)
+	  && (e->ref->u.ar.as->type == AS_ASSUMED_SIZE)
+	       && (e->ref->u.ar.type == AR_FULL))
+    {
+      gfc_error ("The upper bound in the last dimension must "
+		 "appear in the reference to the assumed size "
+		 "array '%s' at %L", sym->name, &e->where);
+      return true;
+    }
+  return false;
+}
+
+
+/* Look for bad assumed size array references in argument expressions
+  of elemental and array valued intrinsic procedures.  Since this is
+  called from procedure resolution functions, it only recurses at
+  operators.  */
+
+static bool
+resolve_assumed_size_actual (gfc_expr *e)
+{
+  if (e == NULL)
+   return false;
+
+  switch (e->expr_type)
+    {
+    case EXPR_VARIABLE:
+      if (e->symtree && check_assumed_size_reference (e->symtree->n.sym, e))
+	return true;
+      break;
+
+    case EXPR_OP:
+      if (resolve_assumed_size_actual (e->value.op.op1)
+	  || resolve_assumed_size_actual (e->value.op.op2))
+	return true;
+      break;
+
+    default:
+      break;
+    }
+  return false;
+}
+
+
+/* Check a generic procedure, passed as an actual argument, to see if
+   there is a matching specific name.  If none, it is an error, and if
+   more than one, the reference is ambiguous.  */
+static int
+count_specific_procs (gfc_expr *e)
+{
+  int n;
+  gfc_interface *p;
+  gfc_symbol *sym;
+	
+  n = 0;
+  sym = e->symtree->n.sym;
+
+  for (p = sym->generic; p; p = p->next)
+    if (strcmp (sym->name, p->sym->name) == 0)
+      {
+	e->symtree = gfc_find_symtree (p->sym->ns->sym_root,
+				       sym->name);
+	n++;
+      }
+
+  if (n > 1)
+    gfc_error ("'%s' at %L is ambiguous", e->symtree->n.sym->name,
+	       &e->where);
+
+  if (n == 0)
+    gfc_error ("GENERIC procedure '%s' is not allowed as an actual "
+	       "argument at %L", sym->name, &e->where);
+
+  return n;
+}
+
+
+/* See if a call to sym could possibly be a not allowed RECURSION because of
+   a missing RECURIVE declaration.  This means that either sym is the current
+   context itself, or sym is the parent of a contained procedure calling its
+   non-RECURSIVE containing procedure.
+   This also works if sym is an ENTRY.  */
+
+static bool
+is_illegal_recursion (gfc_symbol* sym, gfc_namespace* context)
+{
+  gfc_symbol* proc_sym;
+  gfc_symbol* context_proc;
+  gfc_namespace* real_context;
+
+  if (sym->attr.flavor == FL_PROGRAM)
+    return false;
+
+  gcc_assert (sym->attr.flavor == FL_PROCEDURE);
+
+  /* If we've got an ENTRY, find real procedure.  */
+  if (sym->attr.entry && sym->ns->entries)
+    proc_sym = sym->ns->entries->sym;
+  else
+    proc_sym = sym;
+
+  /* If sym is RECURSIVE, all is well of course.  */
+  if (proc_sym->attr.recursive || gfc_option.flag_recursive)
+    return false;
+
+  /* Find the context procedure's "real" symbol if it has entries.
+     We look for a procedure symbol, so recurse on the parents if we don't
+     find one (like in case of a BLOCK construct).  */
+  for (real_context = context; ; real_context = real_context->parent)
+    {
+      /* We should find something, eventually!  */
+      gcc_assert (real_context);
+
+      context_proc = (real_context->entries ? real_context->entries->sym
+					    : real_context->proc_name);
+
+      /* In some special cases, there may not be a proc_name, like for this
+	 invalid code:
+	 real(bad_kind()) function foo () ...
+	 when checking the call to bad_kind ().
+	 In these cases, we simply return here and assume that the
+	 call is ok.  */
+      if (!context_proc)
+	return false;
+
+      if (context_proc->attr.flavor != FL_LABEL)
+	break;
+    }
+
+  /* A call from sym's body to itself is recursion, of course.  */
+  if (context_proc == proc_sym)
+    return true;
+
+  /* The same is true if context is a contained procedure and sym the
+     containing one.  */
+  if (context_proc->attr.contained)
+    {
+      gfc_symbol* parent_proc;
+
+      gcc_assert (context->parent);
+      parent_proc = (context->parent->entries ? context->parent->entries->sym
+					      : context->parent->proc_name);
+
+      if (parent_proc == proc_sym)
+	return true;
+    }
+
+  return false;
+}
+
+
+/* Resolve an intrinsic procedure: Set its function/subroutine attribute,
+   its typespec and formal argument list.  */
+
+static gfc_try
+resolve_intrinsic (gfc_symbol *sym, locus *loc)
+{
+  gfc_intrinsic_sym* isym = NULL;
+  const char* symstd;
+
+  if (sym->formal)
+    return SUCCESS;
+
+  /* We already know this one is an intrinsic, so we don't call
+     gfc_is_intrinsic for full checking but rather use gfc_find_function and
+     gfc_find_subroutine directly to check whether it is a function or
+     subroutine.  */
+
+  if (sym->intmod_sym_id)
+    isym = gfc_intrinsic_function_by_id ((gfc_isym_id) sym->intmod_sym_id);
+  else if (!sym->attr.subroutine)
+    isym = gfc_find_function (sym->name);
+
+  if (isym)
+    {
+      if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising
+	  && !sym->attr.implicit_type)
+	gfc_warning ("Type specified for intrinsic function '%s' at %L is"
+		      " ignored", sym->name, &sym->declared_at);
+
+      if (!sym->attr.function &&
+	  gfc_add_function (&sym->attr, sym->name, loc) == FAILURE)
+	return FAILURE;
+
+      sym->ts = isym->ts;
+    }
+  else if ((isym = gfc_find_subroutine (sym->name)))
+    {
+      if (sym->ts.type != BT_UNKNOWN && !sym->attr.implicit_type)
+	{
+	  gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type"
+		      " specifier", sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+
+      if (!sym->attr.subroutine &&
+	  gfc_add_subroutine (&sym->attr, sym->name, loc) == FAILURE)
+	return FAILURE;
+    }
+  else
+    {
+      gfc_error ("'%s' declared INTRINSIC at %L does not exist", sym->name,
+		 &sym->declared_at);
+      return FAILURE;
+    }
+
+  gfc_copy_formal_args_intr (sym, isym);
+
+  /* Check it is actually available in the standard settings.  */
+  if (gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at)
+      == FAILURE)
+    {
+      gfc_error ("The intrinsic '%s' declared INTRINSIC at %L is not"
+		 " available in the current standard settings but %s.  Use"
+		 " an appropriate -std=* option or enable -fall-intrinsics"
+		 " in order to use it.",
+		 sym->name, &sym->declared_at, symstd);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Resolve a procedure expression, like passing it to a called procedure or as
+   RHS for a procedure pointer assignment.  */
+
+static gfc_try
+resolve_procedure_expression (gfc_expr* expr)
+{
+  gfc_symbol* sym;
+
+  if (expr->expr_type != EXPR_VARIABLE)
+    return SUCCESS;
+  gcc_assert (expr->symtree);
+
+  sym = expr->symtree->n.sym;
+
+  if (sym->attr.intrinsic)
+    resolve_intrinsic (sym, &expr->where);
+
+  if (sym->attr.flavor != FL_PROCEDURE
+      || (sym->attr.function && sym->result == sym))
+    return SUCCESS;
+
+  /* A non-RECURSIVE procedure that is used as procedure expression within its
+     own body is in danger of being called recursively.  */
+  if (is_illegal_recursion (sym, gfc_current_ns))
+    gfc_warning ("Non-RECURSIVE procedure '%s' at %L is possibly calling"
+		 " itself recursively.  Declare it RECURSIVE or use"
+		 " -frecursive", sym->name, &expr->where);
+  
+  return SUCCESS;
+}
+
+
+/* Resolve an actual argument list.  Most of the time, this is just
+   resolving the expressions in the list.
+   The exception is that we sometimes have to decide whether arguments
+   that look like procedure arguments are really simple variable
+   references.  */
+
+static gfc_try
+resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
+			bool no_formal_args)
+{
+  gfc_symbol *sym;
+  gfc_symtree *parent_st;
+  gfc_expr *e;
+  int save_need_full_assumed_size;
+
+  for (; arg; arg = arg->next)
+    {
+      e = arg->expr;
+      if (e == NULL)
+	{
+	  /* Check the label is a valid branching target.  */
+	  if (arg->label)
+	    {
+	      if (arg->label->defined == ST_LABEL_UNKNOWN)
+		{
+		  gfc_error ("Label %d referenced at %L is never defined",
+			     arg->label->value, &arg->label->where);
+		  return FAILURE;
+		}
+	    }
+	  continue;
+	}
+
+      if (e->expr_type == EXPR_VARIABLE
+	    && e->symtree->n.sym->attr.generic
+	    && no_formal_args
+	    && count_specific_procs (e) != 1)
+	return FAILURE;
+
+      if (e->ts.type != BT_PROCEDURE)
+	{
+	  save_need_full_assumed_size = need_full_assumed_size;
+	  if (e->expr_type != EXPR_VARIABLE)
+	    need_full_assumed_size = 0;
+	  if (gfc_resolve_expr (e) != SUCCESS)
+	    return FAILURE;
+	  need_full_assumed_size = save_need_full_assumed_size;
+	  goto argument_list;
+	}
+
+      /* See if the expression node should really be a variable reference.  */
+
+      sym = e->symtree->n.sym;
+
+      if (sym->attr.flavor == FL_PROCEDURE
+	  || sym->attr.intrinsic
+	  || sym->attr.external)
+	{
+	  int actual_ok;
+
+	  /* If a procedure is not already determined to be something else
+	     check if it is intrinsic.  */
+	  if (!sym->attr.intrinsic
+	      && !(sym->attr.external || sym->attr.use_assoc
+		   || sym->attr.if_source == IFSRC_IFBODY)
+	      && gfc_is_intrinsic (sym, sym->attr.subroutine, e->where))
+	    sym->attr.intrinsic = 1;
+
+	  if (sym->attr.proc == PROC_ST_FUNCTION)
+	    {
+	      gfc_error ("Statement function '%s' at %L is not allowed as an "
+			 "actual argument", sym->name, &e->where);
+	    }
+
+	  actual_ok = gfc_intrinsic_actual_ok (sym->name,
+					       sym->attr.subroutine);
+	  if (sym->attr.intrinsic && actual_ok == 0)
+	    {
+	      gfc_error ("Intrinsic '%s' at %L is not allowed as an "
+			 "actual argument", sym->name, &e->where);
+	    }
+
+	  if (sym->attr.contained && !sym->attr.use_assoc
+	      && sym->ns->proc_name->attr.flavor != FL_MODULE)
+	    {
+	      if (gfc_notify_std (GFC_STD_F2008,
+				  "Fortran 2008: Internal procedure '%s' is"
+				  " used as actual argument at %L",
+				  sym->name, &e->where) == FAILURE)
+		return FAILURE;
+	    }
+
+	  if (sym->attr.elemental && !sym->attr.intrinsic)
+	    {
+	      gfc_error ("ELEMENTAL non-INTRINSIC procedure '%s' is not "
+			 "allowed as an actual argument at %L", sym->name,
+			 &e->where);
+	    }
+
+	  /* Check if a generic interface has a specific procedure
+	    with the same name before emitting an error.  */
+	  if (sym->attr.generic && count_specific_procs (e) != 1)
+	    return FAILURE;
+	  
+	  /* Just in case a specific was found for the expression.  */
+	  sym = e->symtree->n.sym;
+
+	  /* If the symbol is the function that names the current (or
+	     parent) scope, then we really have a variable reference.  */
+
+	  if (gfc_is_function_return_value (sym, sym->ns))
+	    goto got_variable;
+
+	  /* If all else fails, see if we have a specific intrinsic.  */
+	  if (sym->ts.type == BT_UNKNOWN && sym->attr.intrinsic)
+	    {
+	      gfc_intrinsic_sym *isym;
+
+	      isym = gfc_find_function (sym->name);
+	      if (isym == NULL || !isym->specific)
+		{
+		  gfc_error ("Unable to find a specific INTRINSIC procedure "
+			     "for the reference '%s' at %L", sym->name,
+			     &e->where);
+		  return FAILURE;
+		}
+	      sym->ts = isym->ts;
+	      sym->attr.intrinsic = 1;
+	      sym->attr.function = 1;
+	    }
+
+	  if (gfc_resolve_expr (e) == FAILURE)
+	    return FAILURE;
+	  goto argument_list;
+	}
+
+      /* See if the name is a module procedure in a parent unit.  */
+
+      if (was_declared (sym) || sym->ns->parent == NULL)
+	goto got_variable;
+
+      if (gfc_find_sym_tree (sym->name, sym->ns->parent, 1, &parent_st))
+	{
+	  gfc_error ("Symbol '%s' at %L is ambiguous", sym->name, &e->where);
+	  return FAILURE;
+	}
+
+      if (parent_st == NULL)
+	goto got_variable;
+
+      sym = parent_st->n.sym;
+      e->symtree = parent_st;		/* Point to the right thing.  */
+
+      if (sym->attr.flavor == FL_PROCEDURE
+	  || sym->attr.intrinsic
+	  || sym->attr.external)
+	{
+	  if (gfc_resolve_expr (e) == FAILURE)
+	    return FAILURE;
+	  goto argument_list;
+	}
+
+    got_variable:
+      e->expr_type = EXPR_VARIABLE;
+      e->ts = sym->ts;
+      if (sym->as != NULL)
+	{
+	  e->rank = sym->as->rank;
+	  e->ref = gfc_get_ref ();
+	  e->ref->type = REF_ARRAY;
+	  e->ref->u.ar.type = AR_FULL;
+	  e->ref->u.ar.as = sym->as;
+	}
+
+      /* Expressions are assigned a default ts.type of BT_PROCEDURE in
+	 primary.c (match_actual_arg). If above code determines that it
+	 is a  variable instead, it needs to be resolved as it was not
+	 done at the beginning of this function.  */
+      save_need_full_assumed_size = need_full_assumed_size;
+      if (e->expr_type != EXPR_VARIABLE)
+	need_full_assumed_size = 0;
+      if (gfc_resolve_expr (e) != SUCCESS)
+	return FAILURE;
+      need_full_assumed_size = save_need_full_assumed_size;
+
+    argument_list:
+      /* Check argument list functions %VAL, %LOC and %REF.  There is
+	 nothing to do for %REF.  */
+      if (arg->name && arg->name[0] == '%')
+	{
+	  if (strncmp ("%VAL", arg->name, 4) == 0)
+	    {
+	      if (e->ts.type == BT_CHARACTER || e->ts.type == BT_DERIVED)
+		{
+		  gfc_error ("By-value argument at %L is not of numeric "
+			     "type", &e->where);
+		  return FAILURE;
+		}
+
+	      if (e->rank)
+		{
+		  gfc_error ("By-value argument at %L cannot be an array or "
+			     "an array section", &e->where);
+		return FAILURE;
+		}
+
+	      /* Intrinsics are still PROC_UNKNOWN here.  However,
+		 since same file external procedures are not resolvable
+		 in gfortran, it is a good deal easier to leave them to
+		 intrinsic.c.  */
+	      if (ptype != PROC_UNKNOWN
+		  && ptype != PROC_DUMMY
+		  && ptype != PROC_EXTERNAL
+		  && ptype != PROC_MODULE)
+		{
+		  gfc_error ("By-value argument at %L is not allowed "
+			     "in this context", &e->where);
+		  return FAILURE;
+		}
+	    }
+
+	  /* Statement functions have already been excluded above.  */
+	  else if (strncmp ("%LOC", arg->name, 4) == 0
+		   && e->ts.type == BT_PROCEDURE)
+	    {
+	      if (e->symtree->n.sym->attr.proc == PROC_INTERNAL)
+		{
+		  gfc_error ("Passing internal procedure at %L by location "
+			     "not allowed", &e->where);
+		  return FAILURE;
+		}
+	    }
+	}
+
+      /* Fortran 2008, C1237.  */
+      if (e->expr_type == EXPR_VARIABLE && gfc_is_coindexed (e)
+          && gfc_has_ultimate_pointer (e))
+        {
+          gfc_error ("Coindexed actual argument at %L with ultimate pointer "
+		     "component", &e->where);
+          return FAILURE;
+        }
+    }
+
+  return SUCCESS;
+}
+
+
+/* Do the checks of the actual argument list that are specific to elemental
+   procedures.  If called with c == NULL, we have a function, otherwise if
+   expr == NULL, we have a subroutine.  */
+
+static gfc_try
+resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
+{
+  gfc_actual_arglist *arg0;
+  gfc_actual_arglist *arg;
+  gfc_symbol *esym = NULL;
+  gfc_intrinsic_sym *isym = NULL;
+  gfc_expr *e = NULL;
+  gfc_intrinsic_arg *iformal = NULL;
+  gfc_formal_arglist *eformal = NULL;
+  bool formal_optional = false;
+  bool set_by_optional = false;
+  int i;
+  int rank = 0;
+
+  /* Is this an elemental procedure?  */
+  if (expr && expr->value.function.actual != NULL)
+    {
+      if (expr->value.function.esym != NULL
+	  && expr->value.function.esym->attr.elemental)
+	{
+	  arg0 = expr->value.function.actual;
+	  esym = expr->value.function.esym;
+	}
+      else if (expr->value.function.isym != NULL
+	       && expr->value.function.isym->elemental)
+	{
+	  arg0 = expr->value.function.actual;
+	  isym = expr->value.function.isym;
+	}
+      else
+	return SUCCESS;
+    }
+  else if (c && c->ext.actual != NULL)
+    {
+      arg0 = c->ext.actual;
+      
+      if (c->resolved_sym)
+	esym = c->resolved_sym;
+      else
+	esym = c->symtree->n.sym;
+      gcc_assert (esym);
+
+      if (!esym->attr.elemental)
+	return SUCCESS;
+    }
+  else
+    return SUCCESS;
+
+  /* The rank of an elemental is the rank of its array argument(s).  */
+  for (arg = arg0; arg; arg = arg->next)
+    {
+      if (arg->expr != NULL && arg->expr->rank > 0)
+	{
+	  rank = arg->expr->rank;
+	  if (arg->expr->expr_type == EXPR_VARIABLE
+	      && arg->expr->symtree->n.sym->attr.optional)
+	    set_by_optional = true;
+
+	  /* Function specific; set the result rank and shape.  */
+	  if (expr)
+	    {
+	      expr->rank = rank;
+	      if (!expr->shape && arg->expr->shape)
+		{
+		  expr->shape = gfc_get_shape (rank);
+		  for (i = 0; i < rank; i++)
+		    mpz_init_set (expr->shape[i], arg->expr->shape[i]);
+		}
+	    }
+	  break;
+	}
+    }
+
+  /* If it is an array, it shall not be supplied as an actual argument
+     to an elemental procedure unless an array of the same rank is supplied
+     as an actual argument corresponding to a nonoptional dummy argument of
+     that elemental procedure(12.4.1.5).  */
+  formal_optional = false;
+  if (isym)
+    iformal = isym->formal;
+  else
+    eformal = esym->formal;
+
+  for (arg = arg0; arg; arg = arg->next)
+    {
+      if (eformal)
+	{
+	  if (eformal->sym && eformal->sym->attr.optional)
+	    formal_optional = true;
+	  eformal = eformal->next;
+	}
+      else if (isym && iformal)
+	{
+	  if (iformal->optional)
+	    formal_optional = true;
+	  iformal = iformal->next;
+	}
+      else if (isym)
+	formal_optional = true;
+
+      if (pedantic && arg->expr != NULL
+	  && arg->expr->expr_type == EXPR_VARIABLE
+	  && arg->expr->symtree->n.sym->attr.optional
+	  && formal_optional
+	  && arg->expr->rank
+	  && (set_by_optional || arg->expr->rank != rank)
+	  && !(isym && isym->id == GFC_ISYM_CONVERSION))
+	{
+	  gfc_warning ("'%s' at %L is an array and OPTIONAL; IF IT IS "
+		       "MISSING, it cannot be the actual argument of an "
+		       "ELEMENTAL procedure unless there is a non-optional "
+		       "argument with the same rank (12.4.1.5)",
+		       arg->expr->symtree->n.sym->name, &arg->expr->where);
+	  return FAILURE;
+	}
+    }
+
+  for (arg = arg0; arg; arg = arg->next)
+    {
+      if (arg->expr == NULL || arg->expr->rank == 0)
+	continue;
+
+      /* Being elemental, the last upper bound of an assumed size array
+	 argument must be present.  */
+      if (resolve_assumed_size_actual (arg->expr))
+	return FAILURE;
+
+      /* Elemental procedure's array actual arguments must conform.  */
+      if (e != NULL)
+	{
+	  if (gfc_check_conformance (arg->expr, e,
+				     "elemental procedure") == FAILURE)
+	    return FAILURE;
+	}
+      else
+	e = arg->expr;
+    }
+
+  /* INTENT(OUT) is only allowed for subroutines; if any actual argument
+     is an array, the intent inout/out variable needs to be also an array.  */
+  if (rank > 0 && esym && expr == NULL)
+    for (eformal = esym->formal, arg = arg0; arg && eformal;
+	 arg = arg->next, eformal = eformal->next)
+      if ((eformal->sym->attr.intent == INTENT_OUT
+	   || eformal->sym->attr.intent == INTENT_INOUT)
+	  && arg->expr && arg->expr->rank == 0)
+	{
+	  gfc_error ("Actual argument at %L for INTENT(%s) dummy '%s' of "
+		     "ELEMENTAL subroutine '%s' is a scalar, but another "
+		     "actual argument is an array", &arg->expr->where,
+		     (eformal->sym->attr.intent == INTENT_OUT) ? "OUT"
+		     : "INOUT", eformal->sym->name, esym->name);
+	  return FAILURE;
+	}
+  return SUCCESS;
+}
+
+
+/* This function does the checking of references to global procedures
+   as defined in sections 18.1 and 14.1, respectively, of the Fortran
+   77 and 95 standards.  It checks for a gsymbol for the name, making
+   one if it does not already exist.  If it already exists, then the
+   reference being resolved must correspond to the type of gsymbol.
+   Otherwise, the new symbol is equipped with the attributes of the
+   reference.  The corresponding code that is called in creating
+   global entities is parse.c.
+
+   In addition, for all but -std=legacy, the gsymbols are used to
+   check the interfaces of external procedures from the same file.
+   The namespace of the gsymbol is resolved and then, once this is
+   done the interface is checked.  */
+
+
+static bool
+not_in_recursive (gfc_symbol *sym, gfc_namespace *gsym_ns)
+{
+  if (!gsym_ns->proc_name->attr.recursive)
+    return true;
+
+  if (sym->ns == gsym_ns)
+    return false;
+
+  if (sym->ns->parent && sym->ns->parent == gsym_ns)
+    return false;
+
+  return true;
+}
+
+static bool
+not_entry_self_reference  (gfc_symbol *sym, gfc_namespace *gsym_ns)
+{
+  if (gsym_ns->entries)
+    {
+      gfc_entry_list *entry = gsym_ns->entries;
+
+      for (; entry; entry = entry->next)
+	{
+	  if (strcmp (sym->name, entry->sym->name) == 0)
+	    {
+	      if (strcmp (gsym_ns->proc_name->name,
+			  sym->ns->proc_name->name) == 0)
+		return false;
+
+	      if (sym->ns->parent
+		  && strcmp (gsym_ns->proc_name->name,
+			     sym->ns->parent->proc_name->name) == 0)
+		return false;
+	    }
+	}
+    }
+  return true;
+}
+
+static void
+resolve_global_procedure (gfc_symbol *sym, locus *where,
+			  gfc_actual_arglist **actual, int sub)
+{
+  gfc_gsymbol * gsym;
+  gfc_namespace *ns;
+  enum gfc_symbol_type type;
+
+  type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
+
+  gsym = gfc_get_gsymbol (sym->name);
+
+  if ((gsym->type != GSYM_UNKNOWN && gsym->type != type))
+    gfc_global_used (gsym, where);
+
+  if (gfc_option.flag_whole_file
+	&& (sym->attr.if_source == IFSRC_UNKNOWN
+	    || sym->attr.if_source == IFSRC_IFBODY)
+	&& gsym->type != GSYM_UNKNOWN
+	&& gsym->ns
+	&& gsym->ns->resolved != -1
+	&& gsym->ns->proc_name
+	&& not_in_recursive (sym, gsym->ns)
+	&& not_entry_self_reference (sym, gsym->ns))
+    {
+      gfc_symbol *def_sym;
+
+      /* Resolve the gsymbol namespace if needed.  */
+      if (!gsym->ns->resolved)
+	{
+	  gfc_dt_list *old_dt_list;
+	  struct gfc_omp_saved_state old_omp_state;
+
+	  /* Stash away derived types so that the backend_decls do not
+	     get mixed up.  */
+	  old_dt_list = gfc_derived_types;
+	  gfc_derived_types = NULL;
+	  /* And stash away openmp state.  */
+	  gfc_omp_save_and_clear_state (&old_omp_state);
+
+	  gfc_resolve (gsym->ns);
+
+	  /* Store the new derived types with the global namespace.  */
+	  if (gfc_derived_types)
+	    gsym->ns->derived_types = gfc_derived_types;
+
+	  /* Restore the derived types of this namespace.  */
+	  gfc_derived_types = old_dt_list;
+	  /* And openmp state.  */
+	  gfc_omp_restore_state (&old_omp_state);
+	}
+
+      /* Make sure that translation for the gsymbol occurs before
+	 the procedure currently being resolved.  */
+      ns = gfc_global_ns_list;
+      for (; ns && ns != gsym->ns; ns = ns->sibling)
+	{
+	  if (ns->sibling == gsym->ns)
+	    {
+	      ns->sibling = gsym->ns->sibling;
+	      gsym->ns->sibling = gfc_global_ns_list;
+	      gfc_global_ns_list = gsym->ns;
+	      break;
+	    }
+	}
+
+      def_sym = gsym->ns->proc_name;
+      if (def_sym->attr.entry_master)
+	{
+	  gfc_entry_list *entry;
+	  for (entry = gsym->ns->entries; entry; entry = entry->next)
+	    if (strcmp (entry->sym->name, sym->name) == 0)
+	      {
+		def_sym = entry->sym;
+		break;
+	      }
+	}
+
+      /* Differences in constant character lengths.  */
+      if (sym->attr.function && sym->ts.type == BT_CHARACTER)
+	{
+	  long int l1 = 0, l2 = 0;
+	  gfc_charlen *cl1 = sym->ts.u.cl;
+	  gfc_charlen *cl2 = def_sym->ts.u.cl;
+
+	  if (cl1 != NULL
+	      && cl1->length != NULL
+	      && cl1->length->expr_type == EXPR_CONSTANT)
+	    l1 = mpz_get_si (cl1->length->value.integer);
+
+  	  if (cl2 != NULL
+	      && cl2->length != NULL
+	      && cl2->length->expr_type == EXPR_CONSTANT)
+	    l2 = mpz_get_si (cl2->length->value.integer);
+
+	  if (l1 && l2 && l1 != l2)
+	    gfc_error ("Character length mismatch in return type of "
+		       "function '%s' at %L (%ld/%ld)", sym->name,
+		       &sym->declared_at, l1, l2);
+	}
+
+     /* Type mismatch of function return type and expected type.  */
+     if (sym->attr.function
+	 && !gfc_compare_types (&sym->ts, &def_sym->ts))
+	gfc_error ("Return type mismatch of function '%s' at %L (%s/%s)",
+		   sym->name, &sym->declared_at, gfc_typename (&sym->ts),
+		   gfc_typename (&def_sym->ts));
+
+      if (def_sym->formal && sym->attr.if_source != IFSRC_IFBODY)
+	{
+	  gfc_formal_arglist *arg = def_sym->formal;
+	  for ( ; arg; arg = arg->next)
+	    if (!arg->sym)
+	      continue;
+	    /* F2003, 12.3.1.1 (2a); F2008, 12.4.2.2 (2a)  */
+	    else if (arg->sym->attr.allocatable
+		     || arg->sym->attr.asynchronous
+		     || arg->sym->attr.optional
+		     || arg->sym->attr.pointer
+		     || arg->sym->attr.target
+		     || arg->sym->attr.value
+		     || arg->sym->attr.volatile_)
+	      {
+		gfc_error ("Dummy argument '%s' of procedure '%s' at %L "
+			   "has an attribute that requires an explicit "
+			   "interface for this procedure", arg->sym->name,
+			   sym->name, &sym->declared_at);
+		break;
+	      }
+	    /* F2003, 12.3.1.1 (2b); F2008, 12.4.2.2 (2b)  */
+	    else if (arg->sym && arg->sym->as
+		     && arg->sym->as->type == AS_ASSUMED_SHAPE)
+	      {
+		gfc_error ("Procedure '%s' at %L with assumed-shape dummy "
+			   "argument '%s' must have an explicit interface",
+			   sym->name, &sym->declared_at, arg->sym->name);
+		break;
+	      }
+	    /* F2008, 12.4.2.2 (2c)  */
+	    else if (arg->sym->attr.codimension)
+	      {
+		gfc_error ("Procedure '%s' at %L with coarray dummy argument "
+			   "'%s' must have an explicit interface",
+			   sym->name, &sym->declared_at, arg->sym->name);
+		break;
+	      }
+	    /* F2003, 12.3.1.1 (2c); F2008, 12.4.2.2 (2d)   */
+	    else if (false) /* TODO: is a parametrized derived type  */
+	      {
+		gfc_error ("Procedure '%s' at %L with parametrized derived "
+			   "type argument '%s' must have an explicit "
+			   "interface", sym->name, &sym->declared_at,
+			   arg->sym->name);
+		break;
+	      }
+	    /* F2003, 12.3.1.1 (2d); F2008, 12.4.2.2 (2e)   */
+	    else if (arg->sym->ts.type == BT_CLASS)
+	      {
+		gfc_error ("Procedure '%s' at %L with polymorphic dummy "
+			   "argument '%s' must have an explicit interface",
+			   sym->name, &sym->declared_at, arg->sym->name);
+		break;
+	      }
+	}
+
+      if (def_sym->attr.function)
+	{
+	  /* F2003, 12.3.1.1 (3a); F2008, 12.4.2.2 (3a) */
+	  if (def_sym->as && def_sym->as->rank
+	      && (!sym->as || sym->as->rank != def_sym->as->rank))
+	    gfc_error ("The reference to function '%s' at %L either needs an "
+		       "explicit INTERFACE or the rank is incorrect", sym->name,
+		       where);
+
+	  /* F2003, 12.3.1.1 (3b); F2008, 12.4.2.2 (3b) */
+	  if ((def_sym->result->attr.pointer
+	       || def_sym->result->attr.allocatable)
+	       && (sym->attr.if_source != IFSRC_IFBODY
+		   || def_sym->result->attr.pointer
+			!= sym->result->attr.pointer
+		   || def_sym->result->attr.allocatable
+			!= sym->result->attr.allocatable))
+	    gfc_error ("Function '%s' at %L with a POINTER or ALLOCATABLE "
+		       "result must have an explicit interface", sym->name,
+		       where);
+
+	  /* F2003, 12.3.1.1 (3c); F2008, 12.4.2.2 (3c)  */
+	  if (sym->ts.type == BT_CHARACTER && sym->attr.if_source != IFSRC_IFBODY
+	      && def_sym->ts.type == BT_CHARACTER && def_sym->ts.u.cl->length != NULL)
+	    {
+	      gfc_charlen *cl = sym->ts.u.cl;
+
+	      if (!sym->attr.entry_master && sym->attr.if_source == IFSRC_UNKNOWN
+		  && cl && cl->length && cl->length->expr_type != EXPR_CONSTANT)
+		{
+		  gfc_error ("Nonconstant character-length function '%s' at %L "
+			     "must have an explicit interface", sym->name,
+			     &sym->declared_at);
+		}
+	    }
+	}
+
+      /* F2003, 12.3.1.1 (4); F2008, 12.4.2.2 (4) */
+      if (def_sym->attr.elemental && !sym->attr.elemental)
+	{
+	  gfc_error ("ELEMENTAL procedure '%s' at %L must have an explicit "
+		     "interface", sym->name, &sym->declared_at);
+	}
+
+      /* F2003, 12.3.1.1 (5); F2008, 12.4.2.2 (5) */
+      if (def_sym->attr.is_bind_c && !sym->attr.is_bind_c)
+	{
+	  gfc_error ("Procedure '%s' at %L with BIND(C) attribute must have "
+		     "an explicit interface", sym->name, &sym->declared_at);
+	}
+
+      if (gfc_option.flag_whole_file == 1
+	  || ((gfc_option.warn_std & GFC_STD_LEGACY)
+	      && !(gfc_option.warn_std & GFC_STD_GNU)))
+	gfc_errors_to_warnings (1);
+
+      if (sym->attr.if_source != IFSRC_IFBODY)  
+	gfc_procedure_use (def_sym, actual, where);
+
+      gfc_errors_to_warnings (0);
+    }
+
+  if (gsym->type == GSYM_UNKNOWN)
+    {
+      gsym->type = type;
+      gsym->where = *where;
+    }
+
+  gsym->used = 1;
+}
+
+
+/************* Function resolution *************/
+
+/* Resolve a function call known to be generic.
+   Section 14.1.2.4.1.  */
+
+static match
+resolve_generic_f0 (gfc_expr *expr, gfc_symbol *sym)
+{
+  gfc_symbol *s;
+
+  if (sym->attr.generic)
+    {
+      s = gfc_search_interface (sym->generic, 0, &expr->value.function.actual);
+      if (s != NULL)
+	{
+	  expr->value.function.name = s->name;
+	  expr->value.function.esym = s;
+
+	  if (s->ts.type != BT_UNKNOWN)
+	    expr->ts = s->ts;
+	  else if (s->result != NULL && s->result->ts.type != BT_UNKNOWN)
+	    expr->ts = s->result->ts;
+
+	  if (s->as != NULL)
+	    expr->rank = s->as->rank;
+	  else if (s->result != NULL && s->result->as != NULL)
+	    expr->rank = s->result->as->rank;
+
+	  gfc_set_sym_referenced (expr->value.function.esym);
+
+	  return MATCH_YES;
+	}
+
+      /* TODO: Need to search for elemental references in generic
+	 interface.  */
+    }
+
+  if (sym->attr.intrinsic)
+    return gfc_intrinsic_func_interface (expr, 0);
+
+  return MATCH_NO;
+}
+
+
+static gfc_try
+resolve_generic_f (gfc_expr *expr)
+{
+  gfc_symbol *sym;
+  match m;
+
+  sym = expr->symtree->n.sym;
+
+  for (;;)
+    {
+      m = resolve_generic_f0 (expr, sym);
+      if (m == MATCH_YES)
+	return SUCCESS;
+      else if (m == MATCH_ERROR)
+	return FAILURE;
+
+generic:
+      if (sym->ns->parent == NULL)
+	break;
+      gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
+
+      if (sym == NULL)
+	break;
+      if (!generic_sym (sym))
+	goto generic;
+    }
+
+  /* Last ditch attempt.  See if the reference is to an intrinsic
+     that possesses a matching interface.  14.1.2.4  */
+  if (sym && !gfc_is_intrinsic (sym, 0, expr->where))
+    {
+      gfc_error ("There is no specific function for the generic '%s' at %L",
+		 expr->symtree->n.sym->name, &expr->where);
+      return FAILURE;
+    }
+
+  m = gfc_intrinsic_func_interface (expr, 0);
+  if (m == MATCH_YES)
+    return SUCCESS;
+  if (m == MATCH_NO)
+    gfc_error ("Generic function '%s' at %L is not consistent with a "
+	       "specific intrinsic interface", expr->symtree->n.sym->name,
+	       &expr->where);
+
+  return FAILURE;
+}
+
+
+/* Resolve a function call known to be specific.  */
+
+static match
+resolve_specific_f0 (gfc_symbol *sym, gfc_expr *expr)
+{
+  match m;
+
+  if (sym->attr.external || sym->attr.if_source == IFSRC_IFBODY)
+    {
+      if (sym->attr.dummy)
+	{
+	  sym->attr.proc = PROC_DUMMY;
+	  goto found;
+	}
+
+      sym->attr.proc = PROC_EXTERNAL;
+      goto found;
+    }
+
+  if (sym->attr.proc == PROC_MODULE
+      || sym->attr.proc == PROC_ST_FUNCTION
+      || sym->attr.proc == PROC_INTERNAL)
+    goto found;
+
+  if (sym->attr.intrinsic)
+    {
+      m = gfc_intrinsic_func_interface (expr, 1);
+      if (m == MATCH_YES)
+	return MATCH_YES;
+      if (m == MATCH_NO)
+	gfc_error ("Function '%s' at %L is INTRINSIC but is not compatible "
+		   "with an intrinsic", sym->name, &expr->where);
+
+      return MATCH_ERROR;
+    }
+
+  return MATCH_NO;
+
+found:
+  gfc_procedure_use (sym, &expr->value.function.actual, &expr->where);
+
+  if (sym->result)
+    expr->ts = sym->result->ts;
+  else
+    expr->ts = sym->ts;
+  expr->value.function.name = sym->name;
+  expr->value.function.esym = sym;
+  if (sym->as != NULL)
+    expr->rank = sym->as->rank;
+
+  return MATCH_YES;
+}
+
+
+static gfc_try
+resolve_specific_f (gfc_expr *expr)
+{
+  gfc_symbol *sym;
+  match m;
+
+  sym = expr->symtree->n.sym;
+
+  for (;;)
+    {
+      m = resolve_specific_f0 (sym, expr);
+      if (m == MATCH_YES)
+	return SUCCESS;
+      if (m == MATCH_ERROR)
+	return FAILURE;
+
+      if (sym->ns->parent == NULL)
+	break;
+
+      gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
+
+      if (sym == NULL)
+	break;
+    }
+
+  gfc_error ("Unable to resolve the specific function '%s' at %L",
+	     expr->symtree->n.sym->name, &expr->where);
+
+  return SUCCESS;
+}
+
+
+/* Resolve a procedure call not known to be generic nor specific.  */
+
+static gfc_try
+resolve_unknown_f (gfc_expr *expr)
+{
+  gfc_symbol *sym;
+  gfc_typespec *ts;
+
+  sym = expr->symtree->n.sym;
+
+  if (sym->attr.dummy)
+    {
+      sym->attr.proc = PROC_DUMMY;
+      expr->value.function.name = sym->name;
+      goto set_type;
+    }
+
+  /* See if we have an intrinsic function reference.  */
+
+  if (gfc_is_intrinsic (sym, 0, expr->where))
+    {
+      if (gfc_intrinsic_func_interface (expr, 1) == MATCH_YES)
+	return SUCCESS;
+      return FAILURE;
+    }
+
+  /* The reference is to an external name.  */
+
+  sym->attr.proc = PROC_EXTERNAL;
+  expr->value.function.name = sym->name;
+  expr->value.function.esym = expr->symtree->n.sym;
+
+  if (sym->as != NULL)
+    expr->rank = sym->as->rank;
+
+  /* Type of the expression is either the type of the symbol or the
+     default type of the symbol.  */
+
+set_type:
+  gfc_procedure_use (sym, &expr->value.function.actual, &expr->where);
+
+  if (sym->ts.type != BT_UNKNOWN)
+    expr->ts = sym->ts;
+  else
+    {
+      ts = gfc_get_default_type (sym->name, sym->ns);
+
+      if (ts->type == BT_UNKNOWN)
+	{
+	  gfc_error ("Function '%s' at %L has no IMPLICIT type",
+		     sym->name, &expr->where);
+	  return FAILURE;
+	}
+      else
+	expr->ts = *ts;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Return true, if the symbol is an external procedure.  */
+static bool
+is_external_proc (gfc_symbol *sym)
+{
+  if (!sym->attr.dummy && !sym->attr.contained
+	&& !(sym->attr.intrinsic
+	      || gfc_is_intrinsic (sym, sym->attr.subroutine, sym->declared_at))
+	&& sym->attr.proc != PROC_ST_FUNCTION
+	&& !sym->attr.proc_pointer
+	&& !sym->attr.use_assoc
+	&& sym->name)
+    return true;
+
+  return false;
+}
+
+
+/* Figure out if a function reference is pure or not.  Also set the name
+   of the function for a potential error message.  Return nonzero if the
+   function is PURE, zero if not.  */
+static int
+pure_stmt_function (gfc_expr *, gfc_symbol *);
+
+static int
+pure_function (gfc_expr *e, const char **name)
+{
+  int pure;
+
+  *name = NULL;
+
+  if (e->symtree != NULL
+        && e->symtree->n.sym != NULL
+        && e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION)
+    return pure_stmt_function (e, e->symtree->n.sym);
+
+  if (e->value.function.esym)
+    {
+      pure = gfc_pure (e->value.function.esym);
+      *name = e->value.function.esym->name;
+    }
+  else if (e->value.function.isym)
+    {
+      pure = e->value.function.isym->pure
+	     || e->value.function.isym->elemental;
+      *name = e->value.function.isym->name;
+    }
+  else
+    {
+      /* Implicit functions are not pure.  */
+      pure = 0;
+      *name = e->value.function.name;
+    }
+
+  return pure;
+}
+
+
+static bool
+impure_stmt_fcn (gfc_expr *e, gfc_symbol *sym,
+		 int *f ATTRIBUTE_UNUSED)
+{
+  const char *name;
+
+  /* Don't bother recursing into other statement functions
+     since they will be checked individually for purity.  */
+  if (e->expr_type != EXPR_FUNCTION
+	|| !e->symtree
+	|| e->symtree->n.sym == sym
+	|| e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION)
+    return false;
+
+  return pure_function (e, &name) ? false : true;
+}
+
+
+static int
+pure_stmt_function (gfc_expr *e, gfc_symbol *sym)
+{
+  return gfc_traverse_expr (e, sym, impure_stmt_fcn, 0) ? 0 : 1;
+}
+
+
+static gfc_try
+is_scalar_expr_ptr (gfc_expr *expr)
+{
+  gfc_try retval = SUCCESS;
+  gfc_ref *ref;
+  int start;
+  int end;
+
+  /* See if we have a gfc_ref, which means we have a substring, array
+     reference, or a component.  */
+  if (expr->ref != NULL)
+    {
+      ref = expr->ref;
+      while (ref->next != NULL)
+        ref = ref->next;
+
+      switch (ref->type)
+        {
+        case REF_SUBSTRING:
+          if (ref->u.ss.start == NULL || ref->u.ss.end == NULL
+	      || gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end) != 0)
+	    retval = FAILURE;
+          break;
+
+        case REF_ARRAY:
+          if (ref->u.ar.type == AR_ELEMENT)
+            retval = SUCCESS;
+          else if (ref->u.ar.type == AR_FULL)
+            {
+              /* The user can give a full array if the array is of size 1.  */
+              if (ref->u.ar.as != NULL
+                  && ref->u.ar.as->rank == 1
+                  && ref->u.ar.as->type == AS_EXPLICIT
+                  && ref->u.ar.as->lower[0] != NULL
+                  && ref->u.ar.as->lower[0]->expr_type == EXPR_CONSTANT
+                  && ref->u.ar.as->upper[0] != NULL
+                  && ref->u.ar.as->upper[0]->expr_type == EXPR_CONSTANT)
+                {
+		  /* If we have a character string, we need to check if
+		     its length is one.	 */
+		  if (expr->ts.type == BT_CHARACTER)
+		    {
+		      if (expr->ts.u.cl == NULL
+			  || expr->ts.u.cl->length == NULL
+			  || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1)
+			  != 0)
+                        retval = FAILURE;
+		    }
+		  else
+		    {
+		      /* We have constant lower and upper bounds.  If the
+			 difference between is 1, it can be considered a
+			 scalar.  
+			 FIXME: Use gfc_dep_compare_expr instead.  */
+		      start = (int) mpz_get_si
+				(ref->u.ar.as->lower[0]->value.integer);
+		      end = (int) mpz_get_si
+				(ref->u.ar.as->upper[0]->value.integer);
+		      if (end - start + 1 != 1)
+			retval = FAILURE;
+		   }
+                }
+              else
+                retval = FAILURE;
+            }
+          else
+            retval = FAILURE;
+          break;
+        default:
+          retval = SUCCESS;
+          break;
+        }
+    }
+  else if (expr->ts.type == BT_CHARACTER && expr->rank == 0)
+    {
+      /* Character string.  Make sure it's of length 1.  */
+      if (expr->ts.u.cl == NULL
+          || expr->ts.u.cl->length == NULL
+          || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1) != 0)
+        retval = FAILURE;
+    }
+  else if (expr->rank != 0)
+    retval = FAILURE;
+
+  return retval;
+}
+
+
+/* Match one of the iso_c_binding functions (c_associated or c_loc)
+   and, in the case of c_associated, set the binding label based on
+   the arguments.  */
+
+static gfc_try
+gfc_iso_c_func_interface (gfc_symbol *sym, gfc_actual_arglist *args,
+                          gfc_symbol **new_sym)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
+  int optional_arg = 0;
+  gfc_try retval = SUCCESS;
+  gfc_symbol *args_sym;
+  gfc_typespec *arg_ts;
+  symbol_attribute arg_attr;
+
+  if (args->expr->expr_type == EXPR_CONSTANT
+      || args->expr->expr_type == EXPR_OP
+      || args->expr->expr_type == EXPR_NULL)
+    {
+      gfc_error ("Argument to '%s' at %L is not a variable",
+		 sym->name, &(args->expr->where));
+      return FAILURE;
+    }
+
+  args_sym = args->expr->symtree->n.sym;
+
+  /* The typespec for the actual arg should be that stored in the expr
+     and not necessarily that of the expr symbol (args_sym), because
+     the actual expression could be a part-ref of the expr symbol.  */
+  arg_ts = &(args->expr->ts);
+  arg_attr = gfc_expr_attr (args->expr);
+    
+  if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
+    {
+      /* If the user gave two args then they are providing something for
+	 the optional arg (the second cptr).  Therefore, set the name and
+	 binding label to the c_associated for two cptrs.  Otherwise,
+	 set c_associated to expect one cptr.  */
+      if (args->next)
+	{
+	  /* two args.  */
+	  sprintf (name, "%s_2", sym->name);
+	  sprintf (binding_label, "%s_2", sym->binding_label);
+	  optional_arg = 1;
+	}
+      else
+	{
+	  /* one arg.  */
+	  sprintf (name, "%s_1", sym->name);
+	  sprintf (binding_label, "%s_1", sym->binding_label);
+	  optional_arg = 0;
+	}
+
+      /* Get a new symbol for the version of c_associated that
+	 will get called.  */
+      *new_sym = get_iso_c_sym (sym, name, binding_label, optional_arg);
+    }
+  else if (sym->intmod_sym_id == ISOCBINDING_LOC
+	   || sym->intmod_sym_id == ISOCBINDING_FUNLOC)
+    {
+      sprintf (name, "%s", sym->name);
+      sprintf (binding_label, "%s", sym->binding_label);
+
+      /* Error check the call.  */
+      if (args->next != NULL)
+        {
+          gfc_error_now ("More actual than formal arguments in '%s' "
+                         "call at %L", name, &(args->expr->where));
+          retval = FAILURE;
+        }
+      else if (sym->intmod_sym_id == ISOCBINDING_LOC)
+        {
+	  gfc_ref *ref;
+	  bool seen_section;
+
+          /* Make sure we have either the target or pointer attribute.  */
+	  if (!arg_attr.target && !arg_attr.pointer)
+            {
+              gfc_error_now ("Parameter '%s' to '%s' at %L must be either "
+                             "a TARGET or an associated pointer",
+                             args_sym->name,
+                             sym->name, &(args->expr->where));
+              retval = FAILURE;
+            }
+
+	  if (gfc_is_coindexed (args->expr))
+	    {
+	      gfc_error_now ("Coindexed argument not permitted"
+			     " in '%s' call at %L", name,
+			     &(args->expr->where));
+	      retval = FAILURE;
+	    }
+
+	  /* Follow references to make sure there are no array
+	     sections.  */
+	  seen_section = false;
+
+	  for (ref=args->expr->ref; ref; ref = ref->next)
+	    {
+	      if (ref->type == REF_ARRAY)
+		{
+		  if (ref->u.ar.type == AR_SECTION)
+		    seen_section = true;
+
+		  if (ref->u.ar.type != AR_ELEMENT)
+		    {
+		      gfc_ref *r;
+		      for (r = ref->next; r; r=r->next)
+			if (r->type == REF_COMPONENT)
+			  {
+			    gfc_error_now ("Array section not permitted"
+					   " in '%s' call at %L", name,
+					   &(args->expr->where));
+			    retval = FAILURE;
+			    break;
+			  }
+		    }
+		}
+	    }
+
+	  if (seen_section && retval == SUCCESS)
+	    gfc_warning ("Array section in '%s' call at %L", name,
+			 &(args->expr->where));
+			 
+          /* See if we have interoperable type and type param.  */
+          if (verify_c_interop (arg_ts) == SUCCESS
+              || gfc_check_any_c_kind (arg_ts) == SUCCESS)
+            {
+              if (args_sym->attr.target == 1)
+                {
+                  /* Case 1a, section 15.1.2.5, J3/04-007: variable that
+                     has the target attribute and is interoperable.  */
+                  /* Case 1b, section 15.1.2.5, J3/04-007: allocated
+                     allocatable variable that has the TARGET attribute and
+                     is not an array of zero size.  */
+                  if (args_sym->attr.allocatable == 1)
+                    {
+                      if (args_sym->attr.dimension != 0 
+                          && (args_sym->as && args_sym->as->rank == 0))
+                        {
+                          gfc_error_now ("Allocatable variable '%s' used as a "
+                                         "parameter to '%s' at %L must not be "
+                                         "an array of zero size",
+                                         args_sym->name, sym->name,
+                                         &(args->expr->where));
+                          retval = FAILURE;
+                        }
+                    }
+                  else
+		    {
+		      /* A non-allocatable target variable with C
+			 interoperable type and type parameters must be
+			 interoperable.	 */
+		      if (args_sym && args_sym->attr.dimension)
+			{
+			  if (args_sym->as->type == AS_ASSUMED_SHAPE)
+			    {
+			      gfc_error ("Assumed-shape array '%s' at %L "
+					 "cannot be an argument to the "
+					 "procedure '%s' because "
+					 "it is not C interoperable",
+					 args_sym->name,
+					 &(args->expr->where), sym->name);
+			      retval = FAILURE;
+			    }
+			  else if (args_sym->as->type == AS_DEFERRED)
+			    {
+			      gfc_error ("Deferred-shape array '%s' at %L "
+					 "cannot be an argument to the "
+					 "procedure '%s' because "
+					 "it is not C interoperable",
+					 args_sym->name,
+					 &(args->expr->where), sym->name);
+			      retval = FAILURE;
+			    }
+			}
+                              
+                      /* Make sure it's not a character string.  Arrays of
+                         any type should be ok if the variable is of a C
+                         interoperable type.  */
+		      if (arg_ts->type == BT_CHARACTER)
+			if (arg_ts->u.cl != NULL
+			    && (arg_ts->u.cl->length == NULL
+				|| arg_ts->u.cl->length->expr_type
+				   != EXPR_CONSTANT
+				|| mpz_cmp_si
+				    (arg_ts->u.cl->length->value.integer, 1)
+				   != 0)
+			    && is_scalar_expr_ptr (args->expr) != SUCCESS)
+			  {
+			    gfc_error_now ("CHARACTER argument '%s' to '%s' "
+					   "at %L must have a length of 1",
+					   args_sym->name, sym->name,
+					   &(args->expr->where));
+			    retval = FAILURE;
+			  }
+                    }
+                }
+              else if (arg_attr.pointer
+		       && is_scalar_expr_ptr (args->expr) != SUCCESS)
+                {
+                  /* Case 1c, section 15.1.2.5, J3/04-007: an associated
+                     scalar pointer.  */
+                  gfc_error_now ("Argument '%s' to '%s' at %L must be an "
+                                 "associated scalar POINTER", args_sym->name,
+                                 sym->name, &(args->expr->where));
+                  retval = FAILURE;
+                }
+            }
+          else
+            {
+              /* The parameter is not required to be C interoperable.  If it
+                 is not C interoperable, it must be a nonpolymorphic scalar
+                 with no length type parameters.  It still must have either
+                 the pointer or target attribute, and it can be
+                 allocatable (but must be allocated when c_loc is called).  */
+              if (args->expr->rank != 0 
+                  && is_scalar_expr_ptr (args->expr) != SUCCESS)
+                {
+                  gfc_error_now ("Parameter '%s' to '%s' at %L must be a "
+                                 "scalar", args_sym->name, sym->name,
+                                 &(args->expr->where));
+                  retval = FAILURE;
+                }
+              else if (arg_ts->type == BT_CHARACTER 
+                       && is_scalar_expr_ptr (args->expr) != SUCCESS)
+                {
+                  gfc_error_now ("CHARACTER argument '%s' to '%s' at "
+                                 "%L must have a length of 1",
+                                 args_sym->name, sym->name,
+                                 &(args->expr->where));
+                  retval = FAILURE;
+                }
+	      else if (arg_ts->type == BT_CLASS)
+		{
+		  gfc_error_now ("Parameter '%s' to '%s' at %L must not be "
+				 "polymorphic", args_sym->name, sym->name,
+				 &(args->expr->where));
+		  retval = FAILURE;
+		}
+            }
+        }
+      else if (sym->intmod_sym_id == ISOCBINDING_FUNLOC)
+        {
+          if (args_sym->attr.flavor != FL_PROCEDURE)
+            {
+              /* TODO: Update this error message to allow for procedure
+                 pointers once they are implemented.  */
+              gfc_error_now ("Parameter '%s' to '%s' at %L must be a "
+                             "procedure",
+                             args_sym->name, sym->name,
+                             &(args->expr->where));
+              retval = FAILURE;
+            }
+	  else if (args_sym->attr.is_bind_c != 1)
+	    {
+	      gfc_error_now ("Parameter '%s' to '%s' at %L must be "
+			     "BIND(C)",
+			     args_sym->name, sym->name,
+			     &(args->expr->where));
+	      retval = FAILURE;
+	    }
+        }
+      
+      /* for c_loc/c_funloc, the new symbol is the same as the old one */
+      *new_sym = sym;
+    }
+  else
+    {
+      gfc_internal_error ("gfc_iso_c_func_interface(): Unhandled "
+			  "iso_c_binding function: '%s'!\n", sym->name);
+    }
+
+  return retval;
+}
+
+
+/* Resolve a function call, which means resolving the arguments, then figuring
+   out which entity the name refers to.  */
+
+static gfc_try
+resolve_function (gfc_expr *expr)
+{
+  gfc_actual_arglist *arg;
+  gfc_symbol *sym;
+  const char *name;
+  gfc_try t;
+  int temp;
+  procedure_type p = PROC_INTRINSIC;
+  bool no_formal_args;
+
+  sym = NULL;
+  if (expr->symtree)
+    sym = expr->symtree->n.sym;
+
+  /* If this is a procedure pointer component, it has already been resolved.  */
+  if (gfc_is_proc_ptr_comp (expr, NULL))
+    return SUCCESS;
+  
+  if (sym && sym->attr.intrinsic
+      && resolve_intrinsic (sym, &expr->where) == FAILURE)
+    return FAILURE;
+
+  if (sym && (sym->attr.flavor == FL_VARIABLE || sym->attr.subroutine))
+    {
+      gfc_error ("'%s' at %L is not a function", sym->name, &expr->where);
+      return FAILURE;
+    }
+
+  /* If this ia a deferred TBP with an abstract interface (which may
+     of course be referenced), expr->value.function.esym will be set.  */
+  if (sym && sym->attr.abstract && !expr->value.function.esym)
+    {
+      gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L",
+		 sym->name, &expr->where);
+      return FAILURE;
+    }
+
+  /* Switch off assumed size checking and do this again for certain kinds
+     of procedure, once the procedure itself is resolved.  */
+  need_full_assumed_size++;
+
+  if (expr->symtree && expr->symtree->n.sym)
+    p = expr->symtree->n.sym->attr.proc;
+
+  if (expr->value.function.isym && expr->value.function.isym->inquiry)
+    inquiry_argument = true;
+  no_formal_args = sym && is_external_proc (sym) && sym->formal == NULL;
+
+  if (resolve_actual_arglist (expr->value.function.actual,
+			      p, no_formal_args) == FAILURE)
+    {
+      inquiry_argument = false;
+      return FAILURE;
+    }
+
+  inquiry_argument = false;
+ 
+  /* Need to setup the call to the correct c_associated, depending on
+     the number of cptrs to user gives to compare.  */
+  if (sym && sym->attr.is_iso_c == 1)
+    {
+      if (gfc_iso_c_func_interface (sym, expr->value.function.actual, &sym)
+          == FAILURE)
+        return FAILURE;
+      
+      /* Get the symtree for the new symbol (resolved func).
+         the old one will be freed later, when it's no longer used.  */
+      gfc_find_sym_tree (sym->name, sym->ns, 1, &(expr->symtree));
+    }
+  
+  /* Resume assumed_size checking.  */
+  need_full_assumed_size--;
+
+  /* If the procedure is external, check for usage.  */
+  if (sym && is_external_proc (sym))
+    resolve_global_procedure (sym, &expr->where,
+			      &expr->value.function.actual, 0);
+
+  if (sym && sym->ts.type == BT_CHARACTER
+      && sym->ts.u.cl
+      && sym->ts.u.cl->length == NULL
+      && !sym->attr.dummy
+      && !sym->ts.deferred
+      && expr->value.function.esym == NULL
+      && !sym->attr.contained)
+    {
+      /* Internal procedures are taken care of in resolve_contained_fntype.  */
+      gfc_error ("Function '%s' is declared CHARACTER(*) and cannot "
+		 "be used at %L since it is not a dummy argument",
+		 sym->name, &expr->where);
+      return FAILURE;
+    }
+
+  /* See if function is already resolved.  */
+
+  if (expr->value.function.name != NULL)
+    {
+      if (expr->ts.type == BT_UNKNOWN)
+	expr->ts = sym->ts;
+      t = SUCCESS;
+    }
+  else
+    {
+      /* Apply the rules of section 14.1.2.  */
+
+      switch (procedure_kind (sym))
+	{
+	case PTYPE_GENERIC:
+	  t = resolve_generic_f (expr);
+	  break;
+
+	case PTYPE_SPECIFIC:
+	  t = resolve_specific_f (expr);
+	  break;
+
+	case PTYPE_UNKNOWN:
+	  t = resolve_unknown_f (expr);
+	  break;
+
+	default:
+	  gfc_internal_error ("resolve_function(): bad function type");
+	}
+    }
+
+  /* If the expression is still a function (it might have simplified),
+     then we check to see if we are calling an elemental function.  */
+
+  if (expr->expr_type != EXPR_FUNCTION)
+    return t;
+
+  temp = need_full_assumed_size;
+  need_full_assumed_size = 0;
+
+  if (resolve_elemental_actual (expr, NULL) == FAILURE)
+    return FAILURE;
+
+  if (omp_workshare_flag
+      && expr->value.function.esym
+      && ! gfc_elemental (expr->value.function.esym))
+    {
+      gfc_error ("User defined non-ELEMENTAL function '%s' at %L not allowed "
+		 "in WORKSHARE construct", expr->value.function.esym->name,
+		 &expr->where);
+      t = FAILURE;
+    }
+
+#define GENERIC_ID expr->value.function.isym->id
+  else if (expr->value.function.actual != NULL
+	   && expr->value.function.isym != NULL
+	   && GENERIC_ID != GFC_ISYM_LBOUND
+	   && GENERIC_ID != GFC_ISYM_LEN
+	   && GENERIC_ID != GFC_ISYM_LOC
+	   && GENERIC_ID != GFC_ISYM_PRESENT)
+    {
+      /* Array intrinsics must also have the last upper bound of an
+	 assumed size array argument.  UBOUND and SIZE have to be
+	 excluded from the check if the second argument is anything
+	 than a constant.  */
+
+      for (arg = expr->value.function.actual; arg; arg = arg->next)
+	{
+	  if ((GENERIC_ID == GFC_ISYM_UBOUND || GENERIC_ID == GFC_ISYM_SIZE)
+	      && arg->next != NULL && arg->next->expr)
+	    {
+	      if (arg->next->expr->expr_type != EXPR_CONSTANT)
+		break;
+
+	      if (arg->next->name && strncmp(arg->next->name, "kind", 4) == 0)
+		break;
+
+	      if ((int)mpz_get_si (arg->next->expr->value.integer)
+			< arg->expr->rank)
+		break;
+	    }
+
+	  if (arg->expr != NULL
+	      && arg->expr->rank > 0
+	      && resolve_assumed_size_actual (arg->expr))
+	    return FAILURE;
+	}
+    }
+#undef GENERIC_ID
+
+  need_full_assumed_size = temp;
+  name = NULL;
+
+  if (!pure_function (expr, &name) && name)
+    {
+      if (forall_flag)
+	{
+	  gfc_error ("reference to non-PURE function '%s' at %L inside a "
+		     "FORALL %s", name, &expr->where,
+		     forall_flag == 2 ? "mask" : "block");
+	  t = FAILURE;
+	}
+      else if (gfc_pure (NULL))
+	{
+	  gfc_error ("Function reference to '%s' at %L is to a non-PURE "
+		     "procedure within a PURE procedure", name, &expr->where);
+	  t = FAILURE;
+	}
+
+      if (gfc_implicit_pure (NULL))
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+    }
+
+  /* Functions without the RECURSIVE attribution are not allowed to
+   * call themselves.  */
+  if (expr->value.function.esym && !expr->value.function.esym->attr.recursive)
+    {
+      gfc_symbol *esym;
+      esym = expr->value.function.esym;
+
+      if (is_illegal_recursion (esym, gfc_current_ns))
+      {
+	if (esym->attr.entry && esym->ns->entries)
+	  gfc_error ("ENTRY '%s' at %L cannot be called recursively, as"
+		     " function '%s' is not RECURSIVE",
+		     esym->name, &expr->where, esym->ns->entries->sym->name);
+	else
+	  gfc_error ("Function '%s' at %L cannot be called recursively, as it"
+		     " is not RECURSIVE", esym->name, &expr->where);
+
+	t = FAILURE;
+      }
+    }
+
+  /* Character lengths of use associated functions may contains references to
+     symbols not referenced from the current program unit otherwise.  Make sure
+     those symbols are marked as referenced.  */
+
+  if (expr->ts.type == BT_CHARACTER && expr->value.function.esym
+      && expr->value.function.esym->attr.use_assoc)
+    {
+      gfc_expr_set_symbols_referenced (expr->ts.u.cl->length);
+    }
+
+  /* Make sure that the expression has a typespec that works.  */
+  if (expr->ts.type == BT_UNKNOWN)
+    {
+      if (expr->symtree->n.sym->result
+	    && expr->symtree->n.sym->result->ts.type != BT_UNKNOWN
+	    && !expr->symtree->n.sym->result->attr.proc_pointer)
+	expr->ts = expr->symtree->n.sym->result->ts;
+    }
+
+  return t;
+}
+
+
+/************* Subroutine resolution *************/
+
+static void
+pure_subroutine (gfc_code *c, gfc_symbol *sym)
+{
+  if (gfc_pure (sym))
+    return;
+
+  if (forall_flag)
+    gfc_error ("Subroutine call to '%s' in FORALL block at %L is not PURE",
+	       sym->name, &c->loc);
+  else if (gfc_pure (NULL))
+    gfc_error ("Subroutine call to '%s' at %L is not PURE", sym->name,
+	       &c->loc);
+
+  if (gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+}
+
+
+static match
+resolve_generic_s0 (gfc_code *c, gfc_symbol *sym)
+{
+  gfc_symbol *s;
+
+  if (sym->attr.generic)
+    {
+      s = gfc_search_interface (sym->generic, 1, &c->ext.actual);
+      if (s != NULL)
+	{
+	  c->resolved_sym = s;
+	  pure_subroutine (c, s);
+	  return MATCH_YES;
+	}
+
+      /* TODO: Need to search for elemental references in generic interface.  */
+    }
+
+  if (sym->attr.intrinsic)
+    return gfc_intrinsic_sub_interface (c, 0);
+
+  return MATCH_NO;
+}
+
+
+static gfc_try
+resolve_generic_s (gfc_code *c)
+{
+  gfc_symbol *sym;
+  match m;
+
+  sym = c->symtree->n.sym;
+
+  for (;;)
+    {
+      m = resolve_generic_s0 (c, sym);
+      if (m == MATCH_YES)
+	return SUCCESS;
+      else if (m == MATCH_ERROR)
+	return FAILURE;
+
+generic:
+      if (sym->ns->parent == NULL)
+	break;
+      gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
+
+      if (sym == NULL)
+	break;
+      if (!generic_sym (sym))
+	goto generic;
+    }
+
+  /* Last ditch attempt.  See if the reference is to an intrinsic
+     that possesses a matching interface.  14.1.2.4  */
+  sym = c->symtree->n.sym;
+
+  if (!gfc_is_intrinsic (sym, 1, c->loc))
+    {
+      gfc_error ("There is no specific subroutine for the generic '%s' at %L",
+		 sym->name, &c->loc);
+      return FAILURE;
+    }
+
+  m = gfc_intrinsic_sub_interface (c, 0);
+  if (m == MATCH_YES)
+    return SUCCESS;
+  if (m == MATCH_NO)
+    gfc_error ("Generic subroutine '%s' at %L is not consistent with an "
+	       "intrinsic subroutine interface", sym->name, &c->loc);
+
+  return FAILURE;
+}
+
+
+/* Set the name and binding label of the subroutine symbol in the call
+   expression represented by 'c' to include the type and kind of the
+   second parameter.  This function is for resolving the appropriate
+   version of c_f_pointer() and c_f_procpointer().  For example, a
+   call to c_f_pointer() for a default integer pointer could have a
+   name of c_f_pointer_i4.  If no second arg exists, which is an error
+   for these two functions, it defaults to the generic symbol's name
+   and binding label.  */
+
+static void
+set_name_and_label (gfc_code *c, gfc_symbol *sym,
+                    char *name, char *binding_label)
+{
+  gfc_expr *arg = NULL;
+  char type;
+  int kind;
+
+  /* The second arg of c_f_pointer and c_f_procpointer determines
+     the type and kind for the procedure name.  */
+  arg = c->ext.actual->next->expr;
+
+  if (arg != NULL)
+    {
+      /* Set up the name to have the given symbol's name,
+         plus the type and kind.  */
+      /* a derived type is marked with the type letter 'u' */
+      if (arg->ts.type == BT_DERIVED)
+        {
+          type = 'd';
+          kind = 0; /* set the kind as 0 for now */
+        }
+      else
+        {
+          type = gfc_type_letter (arg->ts.type);
+          kind = arg->ts.kind;
+        }
+
+      if (arg->ts.type == BT_CHARACTER)
+	/* Kind info for character strings not needed.	*/
+	kind = 0;
+
+      sprintf (name, "%s_%c%d", sym->name, type, kind);
+      /* Set up the binding label as the given symbol's label plus
+         the type and kind.  */
+      sprintf (binding_label, "%s_%c%d", sym->binding_label, type, kind);
+    }
+  else
+    {
+      /* If the second arg is missing, set the name and label as
+         was, cause it should at least be found, and the missing
+         arg error will be caught by compare_parameters().  */
+      sprintf (name, "%s", sym->name);
+      sprintf (binding_label, "%s", sym->binding_label);
+    }
+   
+  return;
+}
+
+
+/* Resolve a generic version of the iso_c_binding procedure given
+   (sym) to the specific one based on the type and kind of the
+   argument(s).  Currently, this function resolves c_f_pointer() and
+   c_f_procpointer based on the type and kind of the second argument
+   (FPTR).  Other iso_c_binding procedures aren't specially handled.
+   Upon successfully exiting, c->resolved_sym will hold the resolved
+   symbol.  Returns MATCH_ERROR if an error occurred; MATCH_YES
+   otherwise.  */
+
+match
+gfc_iso_c_sub_interface (gfc_code *c, gfc_symbol *sym)
+{
+  gfc_symbol *new_sym;
+  /* this is fine, since we know the names won't use the max */
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
+  /* default to success; will override if find error */
+  match m = MATCH_YES;
+
+  /* Make sure the actual arguments are in the necessary order (based on the 
+     formal args) before resolving.  */
+  gfc_procedure_use (sym, &c->ext.actual, &(c->loc));
+
+  if ((sym->intmod_sym_id == ISOCBINDING_F_POINTER) ||
+      (sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER))
+    {
+      set_name_and_label (c, sym, name, binding_label);
+      
+      if (sym->intmod_sym_id == ISOCBINDING_F_POINTER)
+	{
+	  if (c->ext.actual != NULL && c->ext.actual->next != NULL)
+	    {
+	      /* Make sure we got a third arg if the second arg has non-zero
+		 rank.	We must also check that the type and rank are
+		 correct since we short-circuit this check in
+		 gfc_procedure_use() (called above to sort actual args).  */
+	      if (c->ext.actual->next->expr->rank != 0)
+		{
+		  if(c->ext.actual->next->next == NULL 
+		     || c->ext.actual->next->next->expr == NULL)
+		    {
+		      m = MATCH_ERROR;
+		      gfc_error ("Missing SHAPE parameter for call to %s "
+				 "at %L", sym->name, &(c->loc));
+		    }
+		  else if (c->ext.actual->next->next->expr->ts.type
+			   != BT_INTEGER
+			   || c->ext.actual->next->next->expr->rank != 1)
+		    {
+		      m = MATCH_ERROR;
+		      gfc_error ("SHAPE parameter for call to %s at %L must "
+				 "be a rank 1 INTEGER array", sym->name,
+				 &(c->loc));
+		    }
+		}
+	    }
+	}
+      
+      if (m != MATCH_ERROR)
+	{
+	  /* the 1 means to add the optional arg to formal list */
+	  new_sym = get_iso_c_sym (sym, name, binding_label, 1);
+	 
+	  /* for error reporting, say it's declared where the original was */
+	  new_sym->declared_at = sym->declared_at;
+	}
+    }
+  else
+    {
+      /* no differences for c_loc or c_funloc */
+      new_sym = sym;
+    }
+
+  /* set the resolved symbol */
+  if (m != MATCH_ERROR)
+    c->resolved_sym = new_sym;
+  else
+    c->resolved_sym = sym;
+  
+  return m;
+}
+
+
+/* Resolve a subroutine call known to be specific.  */
+
+static match
+resolve_specific_s0 (gfc_code *c, gfc_symbol *sym)
+{
+  match m;
+
+  if(sym->attr.is_iso_c)
+    {
+      m = gfc_iso_c_sub_interface (c,sym);
+      return m;
+    }
+  
+  if (sym->attr.external || sym->attr.if_source == IFSRC_IFBODY)
+    {
+      if (sym->attr.dummy)
+	{
+	  sym->attr.proc = PROC_DUMMY;
+	  goto found;
+	}
+
+      sym->attr.proc = PROC_EXTERNAL;
+      goto found;
+    }
+
+  if (sym->attr.proc == PROC_MODULE || sym->attr.proc == PROC_INTERNAL)
+    goto found;
+
+  if (sym->attr.intrinsic)
+    {
+      m = gfc_intrinsic_sub_interface (c, 1);
+      if (m == MATCH_YES)
+	return MATCH_YES;
+      if (m == MATCH_NO)
+	gfc_error ("Subroutine '%s' at %L is INTRINSIC but is not compatible "
+		   "with an intrinsic", sym->name, &c->loc);
+
+      return MATCH_ERROR;
+    }
+
+  return MATCH_NO;
+
+found:
+  gfc_procedure_use (sym, &c->ext.actual, &c->loc);
+
+  c->resolved_sym = sym;
+  pure_subroutine (c, sym);
+
+  return MATCH_YES;
+}
+
+
+static gfc_try
+resolve_specific_s (gfc_code *c)
+{
+  gfc_symbol *sym;
+  match m;
+
+  sym = c->symtree->n.sym;
+
+  for (;;)
+    {
+      m = resolve_specific_s0 (c, sym);
+      if (m == MATCH_YES)
+	return SUCCESS;
+      if (m == MATCH_ERROR)
+	return FAILURE;
+
+      if (sym->ns->parent == NULL)
+	break;
+
+      gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
+
+      if (sym == NULL)
+	break;
+    }
+
+  sym = c->symtree->n.sym;
+  gfc_error ("Unable to resolve the specific subroutine '%s' at %L",
+	     sym->name, &c->loc);
+
+  return FAILURE;
+}
+
+
+/* Resolve a subroutine call not known to be generic nor specific.  */
+
+static gfc_try
+resolve_unknown_s (gfc_code *c)
+{
+  gfc_symbol *sym;
+
+  sym = c->symtree->n.sym;
+
+  if (sym->attr.dummy)
+    {
+      sym->attr.proc = PROC_DUMMY;
+      goto found;
+    }
+
+  /* See if we have an intrinsic function reference.  */
+
+  if (gfc_is_intrinsic (sym, 1, c->loc))
+    {
+      if (gfc_intrinsic_sub_interface (c, 1) == MATCH_YES)
+	return SUCCESS;
+      return FAILURE;
+    }
+
+  /* The reference is to an external name.  */
+
+found:
+  gfc_procedure_use (sym, &c->ext.actual, &c->loc);
+
+  c->resolved_sym = sym;
+
+  pure_subroutine (c, sym);
+
+  return SUCCESS;
+}
+
+
+/* Resolve a subroutine call.  Although it was tempting to use the same code
+   for functions, subroutines and functions are stored differently and this
+   makes things awkward.  */
+
+static gfc_try
+resolve_call (gfc_code *c)
+{
+  gfc_try t;
+  procedure_type ptype = PROC_INTRINSIC;
+  gfc_symbol *csym, *sym;
+  bool no_formal_args;
+
+  csym = c->symtree ? c->symtree->n.sym : NULL;
+
+  if (csym && csym->ts.type != BT_UNKNOWN)
+    {
+      gfc_error ("'%s' at %L has a type, which is not consistent with "
+		 "the CALL at %L", csym->name, &csym->declared_at, &c->loc);
+      return FAILURE;
+    }
+
+  if (csym && gfc_current_ns->parent && csym->ns != gfc_current_ns)
+    {
+      gfc_symtree *st;
+      gfc_find_sym_tree (c->symtree->name, gfc_current_ns, 1, &st);
+      sym = st ? st->n.sym : NULL;
+      if (sym && csym != sym
+	      && sym->ns == gfc_current_ns
+	      && sym->attr.flavor == FL_PROCEDURE
+	      && sym->attr.contained)
+	{
+	  sym->refs++;
+	  if (csym->attr.generic)
+	    c->symtree->n.sym = sym;
+	  else
+	    c->symtree = st;
+	  csym = c->symtree->n.sym;
+	}
+    }
+
+  /* If this ia a deferred TBP with an abstract interface
+     (which may of course be referenced), c->expr1 will be set.  */
+  if (csym && csym->attr.abstract && !c->expr1)
+    {
+      gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L",
+		 csym->name, &c->loc);
+      return FAILURE;
+    }
+
+  /* Subroutines without the RECURSIVE attribution are not allowed to
+   * call themselves.  */
+  if (csym && is_illegal_recursion (csym, gfc_current_ns))
+    {
+      if (csym->attr.entry && csym->ns->entries)
+	gfc_error ("ENTRY '%s' at %L cannot be called recursively, as"
+		   " subroutine '%s' is not RECURSIVE",
+		   csym->name, &c->loc, csym->ns->entries->sym->name);
+      else
+	gfc_error ("SUBROUTINE '%s' at %L cannot be called recursively, as it"
+		   " is not RECURSIVE", csym->name, &c->loc);
+
+      t = FAILURE;
+    }
+
+  /* Switch off assumed size checking and do this again for certain kinds
+     of procedure, once the procedure itself is resolved.  */
+  need_full_assumed_size++;
+
+  if (csym)
+    ptype = csym->attr.proc;
+
+  no_formal_args = csym && is_external_proc (csym) && csym->formal == NULL;
+  if (resolve_actual_arglist (c->ext.actual, ptype,
+			      no_formal_args) == FAILURE)
+    return FAILURE;
+
+  /* Resume assumed_size checking.  */
+  need_full_assumed_size--;
+
+  /* If external, check for usage.  */
+  if (csym && is_external_proc (csym))
+    resolve_global_procedure (csym, &c->loc, &c->ext.actual, 1);
+
+  t = SUCCESS;
+  if (c->resolved_sym == NULL)
+    {
+      c->resolved_isym = NULL;
+      switch (procedure_kind (csym))
+	{
+	case PTYPE_GENERIC:
+	  t = resolve_generic_s (c);
+	  break;
+
+	case PTYPE_SPECIFIC:
+	  t = resolve_specific_s (c);
+	  break;
+
+	case PTYPE_UNKNOWN:
+	  t = resolve_unknown_s (c);
+	  break;
+
+	default:
+	  gfc_internal_error ("resolve_subroutine(): bad function type");
+	}
+    }
+
+  /* Some checks of elemental subroutine actual arguments.  */
+  if (resolve_elemental_actual (NULL, c) == FAILURE)
+    return FAILURE;
+
+  return t;
+}
+
+
+/* Compare the shapes of two arrays that have non-NULL shapes.  If both
+   op1->shape and op2->shape are non-NULL return SUCCESS if their shapes
+   match.  If both op1->shape and op2->shape are non-NULL return FAILURE
+   if their shapes do not match.  If either op1->shape or op2->shape is
+   NULL, return SUCCESS.  */
+
+static gfc_try
+compare_shapes (gfc_expr *op1, gfc_expr *op2)
+{
+  gfc_try t;
+  int i;
+
+  t = SUCCESS;
+
+  if (op1->shape != NULL && op2->shape != NULL)
+    {
+      for (i = 0; i < op1->rank; i++)
+	{
+	  if (mpz_cmp (op1->shape[i], op2->shape[i]) != 0)
+	   {
+	     gfc_error ("Shapes for operands at %L and %L are not conformable",
+			 &op1->where, &op2->where);
+	     t = FAILURE;
+	     break;
+	   }
+	}
+    }
+
+  return t;
+}
+
+
+/* Resolve an operator expression node.  This can involve replacing the
+   operation with a user defined function call.  */
+
+static gfc_try
+resolve_operator (gfc_expr *e)
+{
+  gfc_expr *op1, *op2;
+  char msg[200];
+  bool dual_locus_error;
+  gfc_try t;
+
+  /* Resolve all subnodes-- give them types.  */
+
+  switch (e->value.op.op)
+    {
+    default:
+      if (gfc_resolve_expr (e->value.op.op2) == FAILURE)
+	return FAILURE;
+
+    /* Fall through...  */
+
+    case INTRINSIC_NOT:
+    case INTRINSIC_UPLUS:
+    case INTRINSIC_UMINUS:
+    case INTRINSIC_PARENTHESES:
+      if (gfc_resolve_expr (e->value.op.op1) == FAILURE)
+	return FAILURE;
+      break;
+    }
+
+  /* Typecheck the new node.  */
+
+  op1 = e->value.op.op1;
+  op2 = e->value.op.op2;
+  dual_locus_error = false;
+
+  if ((op1 && op1->expr_type == EXPR_NULL)
+      || (op2 && op2->expr_type == EXPR_NULL))
+    {
+      sprintf (msg, _("Invalid context for NULL() pointer at %%L"));
+      goto bad_op;
+    }
+
+  switch (e->value.op.op)
+    {
+    case INTRINSIC_UPLUS:
+    case INTRINSIC_UMINUS:
+      if (op1->ts.type == BT_INTEGER
+	  || op1->ts.type == BT_REAL
+	  || op1->ts.type == BT_COMPLEX)
+	{
+	  e->ts = op1->ts;
+	  break;
+	}
+
+      sprintf (msg, _("Operand of unary numeric operator '%s' at %%L is %s"),
+	       gfc_op2string (e->value.op.op), gfc_typename (&e->ts));
+      goto bad_op;
+
+    case INTRINSIC_PLUS:
+    case INTRINSIC_MINUS:
+    case INTRINSIC_TIMES:
+    case INTRINSIC_DIVIDE:
+    case INTRINSIC_POWER:
+      if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
+	{
+	  gfc_type_convert_binary (e, 1);
+	  break;
+	}
+
+      sprintf (msg,
+	       _("Operands of binary numeric operator '%s' at %%L are %s/%s"),
+	       gfc_op2string (e->value.op.op), gfc_typename (&op1->ts),
+	       gfc_typename (&op2->ts));
+      goto bad_op;
+
+    case INTRINSIC_CONCAT:
+      if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
+	  && op1->ts.kind == op2->ts.kind)
+	{
+	  e->ts.type = BT_CHARACTER;
+	  e->ts.kind = op1->ts.kind;
+	  break;
+	}
+
+      sprintf (msg,
+	       _("Operands of string concatenation operator at %%L are %s/%s"),
+	       gfc_typename (&op1->ts), gfc_typename (&op2->ts));
+      goto bad_op;
+
+    case INTRINSIC_AND:
+    case INTRINSIC_OR:
+    case INTRINSIC_EQV:
+    case INTRINSIC_NEQV:
+      if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL)
+	{
+	  e->ts.type = BT_LOGICAL;
+	  e->ts.kind = gfc_kind_max (op1, op2);
+	  if (op1->ts.kind < e->ts.kind)
+	    gfc_convert_type (op1, &e->ts, 2);
+	  else if (op2->ts.kind < e->ts.kind)
+	    gfc_convert_type (op2, &e->ts, 2);
+	  break;
+	}
+
+      sprintf (msg, _("Operands of logical operator '%s' at %%L are %s/%s"),
+	       gfc_op2string (e->value.op.op), gfc_typename (&op1->ts),
+	       gfc_typename (&op2->ts));
+
+      goto bad_op;
+
+    case INTRINSIC_NOT:
+      if (op1->ts.type == BT_LOGICAL)
+	{
+	  e->ts.type = BT_LOGICAL;
+	  e->ts.kind = op1->ts.kind;
+	  break;
+	}
+
+      sprintf (msg, _("Operand of .not. operator at %%L is %s"),
+	       gfc_typename (&op1->ts));
+      goto bad_op;
+
+    case INTRINSIC_GT:
+    case INTRINSIC_GT_OS:
+    case INTRINSIC_GE:
+    case INTRINSIC_GE_OS:
+    case INTRINSIC_LT:
+    case INTRINSIC_LT_OS:
+    case INTRINSIC_LE:
+    case INTRINSIC_LE_OS:
+      if (op1->ts.type == BT_COMPLEX || op2->ts.type == BT_COMPLEX)
+	{
+	  strcpy (msg, _("COMPLEX quantities cannot be compared at %L"));
+	  goto bad_op;
+	}
+
+      /* Fall through...  */
+
+    case INTRINSIC_EQ:
+    case INTRINSIC_EQ_OS:
+    case INTRINSIC_NE:
+    case INTRINSIC_NE_OS:
+      if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
+	  && op1->ts.kind == op2->ts.kind)
+	{
+	  e->ts.type = BT_LOGICAL;
+	  e->ts.kind = gfc_default_logical_kind;
+	  break;
+	}
+
+      if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
+	{
+	  gfc_type_convert_binary (e, 1);
+
+	  e->ts.type = BT_LOGICAL;
+	  e->ts.kind = gfc_default_logical_kind;
+	  break;
+	}
+
+      if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL)
+	sprintf (msg,
+		 _("Logicals at %%L must be compared with %s instead of %s"),
+		 (e->value.op.op == INTRINSIC_EQ 
+		  || e->value.op.op == INTRINSIC_EQ_OS)
+		 ? ".eqv." : ".neqv.", gfc_op2string (e->value.op.op));
+      else
+	sprintf (msg,
+		 _("Operands of comparison operator '%s' at %%L are %s/%s"),
+		 gfc_op2string (e->value.op.op), gfc_typename (&op1->ts),
+		 gfc_typename (&op2->ts));
+
+      goto bad_op;
+
+    case INTRINSIC_USER:
+      if (e->value.op.uop->op == NULL)
+	sprintf (msg, _("Unknown operator '%s' at %%L"), e->value.op.uop->name);
+      else if (op2 == NULL)
+	sprintf (msg, _("Operand of user operator '%s' at %%L is %s"),
+		 e->value.op.uop->name, gfc_typename (&op1->ts));
+      else
+	{
+	  sprintf (msg, _("Operands of user operator '%s' at %%L are %s/%s"),
+		   e->value.op.uop->name, gfc_typename (&op1->ts),
+		   gfc_typename (&op2->ts));
+	  e->value.op.uop->op->sym->attr.referenced = 1;
+	}
+
+      goto bad_op;
+
+    case INTRINSIC_PARENTHESES:
+      e->ts = op1->ts;
+      if (e->ts.type == BT_CHARACTER)
+	e->ts.u.cl = op1->ts.u.cl;
+      break;
+
+    default:
+      gfc_internal_error ("resolve_operator(): Bad intrinsic");
+    }
+
+  /* Deal with arrayness of an operand through an operator.  */
+
+  t = SUCCESS;
+
+  switch (e->value.op.op)
+    {
+    case INTRINSIC_PLUS:
+    case INTRINSIC_MINUS:
+    case INTRINSIC_TIMES:
+    case INTRINSIC_DIVIDE:
+    case INTRINSIC_POWER:
+    case INTRINSIC_CONCAT:
+    case INTRINSIC_AND:
+    case INTRINSIC_OR:
+    case INTRINSIC_EQV:
+    case INTRINSIC_NEQV:
+    case INTRINSIC_EQ:
+    case INTRINSIC_EQ_OS:
+    case INTRINSIC_NE:
+    case INTRINSIC_NE_OS:
+    case INTRINSIC_GT:
+    case INTRINSIC_GT_OS:
+    case INTRINSIC_GE:
+    case INTRINSIC_GE_OS:
+    case INTRINSIC_LT:
+    case INTRINSIC_LT_OS:
+    case INTRINSIC_LE:
+    case INTRINSIC_LE_OS:
+
+      if (op1->rank == 0 && op2->rank == 0)
+	e->rank = 0;
+
+      if (op1->rank == 0 && op2->rank != 0)
+	{
+	  e->rank = op2->rank;
+
+	  if (e->shape == NULL)
+	    e->shape = gfc_copy_shape (op2->shape, op2->rank);
+	}
+
+      if (op1->rank != 0 && op2->rank == 0)
+	{
+	  e->rank = op1->rank;
+
+	  if (e->shape == NULL)
+	    e->shape = gfc_copy_shape (op1->shape, op1->rank);
+	}
+
+      if (op1->rank != 0 && op2->rank != 0)
+	{
+	  if (op1->rank == op2->rank)
+	    {
+	      e->rank = op1->rank;
+	      if (e->shape == NULL)
+		{
+		  t = compare_shapes (op1, op2);
+		  if (t == FAILURE)
+		    e->shape = NULL;
+		  else
+		    e->shape = gfc_copy_shape (op1->shape, op1->rank);
+		}
+	    }
+	  else
+	    {
+	      /* Allow higher level expressions to work.  */
+	      e->rank = 0;
+
+	      /* Try user-defined operators, and otherwise throw an error.  */
+	      dual_locus_error = true;
+	      sprintf (msg,
+		       _("Inconsistent ranks for operator at %%L and %%L"));
+	      goto bad_op;
+	    }
+	}
+
+      break;
+
+    case INTRINSIC_PARENTHESES:
+    case INTRINSIC_NOT:
+    case INTRINSIC_UPLUS:
+    case INTRINSIC_UMINUS:
+      /* Simply copy arrayness attribute */
+      e->rank = op1->rank;
+
+      if (e->shape == NULL)
+	e->shape = gfc_copy_shape (op1->shape, op1->rank);
+
+      break;
+
+    default:
+      break;
+    }
+
+  /* Attempt to simplify the expression.  */
+  if (t == SUCCESS)
+    {
+      t = gfc_simplify_expr (e, 0);
+      /* Some calls do not succeed in simplification and return FAILURE
+	 even though there is no error; e.g. variable references to
+	 PARAMETER arrays.  */
+      if (!gfc_is_constant_expr (e))
+	t = SUCCESS;
+    }
+  return t;
+
+bad_op:
+
+  {
+    bool real_error;
+    if (gfc_extend_expr (e, &real_error) == SUCCESS)
+      return SUCCESS;
+
+    if (real_error)
+      return FAILURE;
+  }
+
+  if (dual_locus_error)
+    gfc_error (msg, &op1->where, &op2->where);
+  else
+    gfc_error (msg, &e->where);
+
+  return FAILURE;
+}
+
+
+/************** Array resolution subroutines **************/
+
+typedef enum
+{ CMP_LT, CMP_EQ, CMP_GT, CMP_UNKNOWN }
+comparison;
+
+/* Compare two integer expressions.  */
+
+static comparison
+compare_bound (gfc_expr *a, gfc_expr *b)
+{
+  int i;
+
+  if (a == NULL || a->expr_type != EXPR_CONSTANT
+      || b == NULL || b->expr_type != EXPR_CONSTANT)
+    return CMP_UNKNOWN;
+
+  /* If either of the types isn't INTEGER, we must have
+     raised an error earlier.  */
+
+  if (a->ts.type != BT_INTEGER || b->ts.type != BT_INTEGER)
+    return CMP_UNKNOWN;
+
+  i = mpz_cmp (a->value.integer, b->value.integer);
+
+  if (i < 0)
+    return CMP_LT;
+  if (i > 0)
+    return CMP_GT;
+  return CMP_EQ;
+}
+
+
+/* Compare an integer expression with an integer.  */
+
+static comparison
+compare_bound_int (gfc_expr *a, int b)
+{
+  int i;
+
+  if (a == NULL || a->expr_type != EXPR_CONSTANT)
+    return CMP_UNKNOWN;
+
+  if (a->ts.type != BT_INTEGER)
+    gfc_internal_error ("compare_bound_int(): Bad expression");
+
+  i = mpz_cmp_si (a->value.integer, b);
+
+  if (i < 0)
+    return CMP_LT;
+  if (i > 0)
+    return CMP_GT;
+  return CMP_EQ;
+}
+
+
+/* Compare an integer expression with a mpz_t.  */
+
+static comparison
+compare_bound_mpz_t (gfc_expr *a, mpz_t b)
+{
+  int i;
+
+  if (a == NULL || a->expr_type != EXPR_CONSTANT)
+    return CMP_UNKNOWN;
+
+  if (a->ts.type != BT_INTEGER)
+    gfc_internal_error ("compare_bound_int(): Bad expression");
+
+  i = mpz_cmp (a->value.integer, b);
+
+  if (i < 0)
+    return CMP_LT;
+  if (i > 0)
+    return CMP_GT;
+  return CMP_EQ;
+}
+
+
+/* Compute the last value of a sequence given by a triplet.  
+   Return 0 if it wasn't able to compute the last value, or if the
+   sequence if empty, and 1 otherwise.  */
+
+static int
+compute_last_value_for_triplet (gfc_expr *start, gfc_expr *end,
+				gfc_expr *stride, mpz_t last)
+{
+  mpz_t rem;
+
+  if (start == NULL || start->expr_type != EXPR_CONSTANT
+      || end == NULL || end->expr_type != EXPR_CONSTANT
+      || (stride != NULL && stride->expr_type != EXPR_CONSTANT))
+    return 0;
+
+  if (start->ts.type != BT_INTEGER || end->ts.type != BT_INTEGER
+      || (stride != NULL && stride->ts.type != BT_INTEGER))
+    return 0;
+
+  if (stride == NULL || compare_bound_int(stride, 1) == CMP_EQ)
+    {
+      if (compare_bound (start, end) == CMP_GT)
+	return 0;
+      mpz_set (last, end->value.integer);
+      return 1;
+    }
+
+  if (compare_bound_int (stride, 0) == CMP_GT)
+    {
+      /* Stride is positive */
+      if (mpz_cmp (start->value.integer, end->value.integer) > 0)
+	return 0;
+    }
+  else
+    {
+      /* Stride is negative */
+      if (mpz_cmp (start->value.integer, end->value.integer) < 0)
+	return 0;
+    }
+
+  mpz_init (rem);
+  mpz_sub (rem, end->value.integer, start->value.integer);
+  mpz_tdiv_r (rem, rem, stride->value.integer);
+  mpz_sub (last, end->value.integer, rem);
+  mpz_clear (rem);
+
+  return 1;
+}
+
+
+/* Compare a single dimension of an array reference to the array
+   specification.  */
+
+static gfc_try
+check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as)
+{
+  mpz_t last_value;
+
+  if (ar->dimen_type[i] == DIMEN_STAR)
+    {
+      gcc_assert (ar->stride[i] == NULL);
+      /* This implies [*] as [*:] and [*:3] are not possible.  */
+      if (ar->start[i] == NULL)
+	{
+	  gcc_assert (ar->end[i] == NULL);
+	  return SUCCESS;
+	}
+    }
+
+/* Given start, end and stride values, calculate the minimum and
+   maximum referenced indexes.  */
+
+  switch (ar->dimen_type[i])
+    {
+    case DIMEN_VECTOR:
+      break;
+
+    case DIMEN_STAR:
+    case DIMEN_ELEMENT:
+      if (compare_bound (ar->start[i], as->lower[i]) == CMP_LT)
+	{
+	  if (i < as->rank)
+	    gfc_warning ("Array reference at %L is out of bounds "
+			 "(%ld < %ld) in dimension %d", &ar->c_where[i],
+			 mpz_get_si (ar->start[i]->value.integer),
+			 mpz_get_si (as->lower[i]->value.integer), i+1);
+	  else
+	    gfc_warning ("Array reference at %L is out of bounds "
+			 "(%ld < %ld) in codimension %d", &ar->c_where[i],
+			 mpz_get_si (ar->start[i]->value.integer),
+			 mpz_get_si (as->lower[i]->value.integer),
+			 i + 1 - as->rank);
+	  return SUCCESS;
+	}
+      if (compare_bound (ar->start[i], as->upper[i]) == CMP_GT)
+	{
+	  if (i < as->rank)
+	    gfc_warning ("Array reference at %L is out of bounds "
+			 "(%ld > %ld) in dimension %d", &ar->c_where[i],
+			 mpz_get_si (ar->start[i]->value.integer),
+			 mpz_get_si (as->upper[i]->value.integer), i+1);
+	  else
+	    gfc_warning ("Array reference at %L is out of bounds "
+			 "(%ld > %ld) in codimension %d", &ar->c_where[i],
+			 mpz_get_si (ar->start[i]->value.integer),
+			 mpz_get_si (as->upper[i]->value.integer),
+			 i + 1 - as->rank);
+	  return SUCCESS;
+	}
+
+      break;
+
+    case DIMEN_RANGE:
+      {
+#define AR_START (ar->start[i] ? ar->start[i] : as->lower[i])
+#define AR_END (ar->end[i] ? ar->end[i] : as->upper[i])
+
+	comparison comp_start_end = compare_bound (AR_START, AR_END);
+
+	/* Check for zero stride, which is not allowed.  */
+	if (compare_bound_int (ar->stride[i], 0) == CMP_EQ)
+	  {
+	    gfc_error ("Illegal stride of zero at %L", &ar->c_where[i]);
+	    return FAILURE;
+	  }
+
+	/* if start == len || (stride > 0 && start < len)
+			   || (stride < 0 && start > len),
+	   then the array section contains at least one element.  In this
+	   case, there is an out-of-bounds access if
+	   (start < lower || start > upper).  */
+	if (compare_bound (AR_START, AR_END) == CMP_EQ
+	    || ((compare_bound_int (ar->stride[i], 0) == CMP_GT
+		 || ar->stride[i] == NULL) && comp_start_end == CMP_LT)
+	    || (compare_bound_int (ar->stride[i], 0) == CMP_LT
+	        && comp_start_end == CMP_GT))
+	  {
+	    if (compare_bound (AR_START, as->lower[i]) == CMP_LT)
+	      {
+		gfc_warning ("Lower array reference at %L is out of bounds "
+		       "(%ld < %ld) in dimension %d", &ar->c_where[i],
+		       mpz_get_si (AR_START->value.integer),
+		       mpz_get_si (as->lower[i]->value.integer), i+1);
+		return SUCCESS;
+	      }
+	    if (compare_bound (AR_START, as->upper[i]) == CMP_GT)
+	      {
+		gfc_warning ("Lower array reference at %L is out of bounds "
+		       "(%ld > %ld) in dimension %d", &ar->c_where[i],
+		       mpz_get_si (AR_START->value.integer),
+		       mpz_get_si (as->upper[i]->value.integer), i+1);
+		return SUCCESS;
+	      }
+	  }
+
+	/* If we can compute the highest index of the array section,
+	   then it also has to be between lower and upper.  */
+	mpz_init (last_value);
+	if (compute_last_value_for_triplet (AR_START, AR_END, ar->stride[i],
+					    last_value))
+	  {
+	    if (compare_bound_mpz_t (as->lower[i], last_value) == CMP_GT)
+	      {
+		gfc_warning ("Upper array reference at %L is out of bounds "
+		       "(%ld < %ld) in dimension %d", &ar->c_where[i],
+		       mpz_get_si (last_value),
+		       mpz_get_si (as->lower[i]->value.integer), i+1);
+	        mpz_clear (last_value);
+		return SUCCESS;
+	      }
+	    if (compare_bound_mpz_t (as->upper[i], last_value) == CMP_LT)
+	      {
+		gfc_warning ("Upper array reference at %L is out of bounds "
+		       "(%ld > %ld) in dimension %d", &ar->c_where[i],
+		       mpz_get_si (last_value),
+		       mpz_get_si (as->upper[i]->value.integer), i+1);
+	        mpz_clear (last_value);
+		return SUCCESS;
+	      }
+	  }
+	mpz_clear (last_value);
+
+#undef AR_START
+#undef AR_END
+      }
+      break;
+
+    default:
+      gfc_internal_error ("check_dimension(): Bad array reference");
+    }
+
+  return SUCCESS;
+}
+
+
+/* Compare an array reference with an array specification.  */
+
+static gfc_try
+compare_spec_to_ref (gfc_array_ref *ar)
+{
+  gfc_array_spec *as;
+  int i;
+
+  as = ar->as;
+  i = as->rank - 1;
+  /* TODO: Full array sections are only allowed as actual parameters.  */
+  if (as->type == AS_ASSUMED_SIZE
+      && (/*ar->type == AR_FULL
+	  ||*/ (ar->type == AR_SECTION
+	      && ar->dimen_type[i] == DIMEN_RANGE && ar->end[i] == NULL)))
+    {
+      gfc_error ("Rightmost upper bound of assumed size array section "
+		 "not specified at %L", &ar->where);
+      return FAILURE;
+    }
+
+  if (ar->type == AR_FULL)
+    return SUCCESS;
+
+  if (as->rank != ar->dimen)
+    {
+      gfc_error ("Rank mismatch in array reference at %L (%d/%d)",
+		 &ar->where, ar->dimen, as->rank);
+      return FAILURE;
+    }
+
+  /* ar->codimen == 0 is a local array.  */
+  if (as->corank != ar->codimen && ar->codimen != 0)
+    {
+      gfc_error ("Coindex rank mismatch in array reference at %L (%d/%d)",
+		 &ar->where, ar->codimen, as->corank);
+      return FAILURE;
+    }
+
+  for (i = 0; i < as->rank; i++)
+    if (check_dimension (i, ar, as) == FAILURE)
+      return FAILURE;
+
+  /* Local access has no coarray spec.  */
+  if (ar->codimen != 0)
+    for (i = as->rank; i < as->rank + as->corank; i++)
+      {
+	if (ar->dimen_type[i] != DIMEN_ELEMENT && !ar->in_allocate)
+	  {
+	    gfc_error ("Coindex of codimension %d must be a scalar at %L",
+		       i + 1 - as->rank, &ar->where);
+	    return FAILURE;
+	  }
+	if (check_dimension (i, ar, as) == FAILURE)
+	  return FAILURE;
+      }
+
+  return SUCCESS;
+}
+
+
+/* Resolve one part of an array index.  */
+
+static gfc_try
+gfc_resolve_index_1 (gfc_expr *index, int check_scalar,
+		     int force_index_integer_kind)
+{
+  gfc_typespec ts;
+
+  if (index == NULL)
+    return SUCCESS;
+
+  if (gfc_resolve_expr (index) == FAILURE)
+    return FAILURE;
+
+  if (check_scalar && index->rank != 0)
+    {
+      gfc_error ("Array index at %L must be scalar", &index->where);
+      return FAILURE;
+    }
+
+  if (index->ts.type != BT_INTEGER && index->ts.type != BT_REAL)
+    {
+      gfc_error ("Array index at %L must be of INTEGER type, found %s",
+		 &index->where, gfc_basic_typename (index->ts.type));
+      return FAILURE;
+    }
+
+  if (index->ts.type == BT_REAL)
+    if (gfc_notify_std (GFC_STD_LEGACY, "Extension: REAL array index at %L",
+			&index->where) == FAILURE)
+      return FAILURE;
+
+  if ((index->ts.kind != gfc_index_integer_kind
+       && force_index_integer_kind)
+      || index->ts.type != BT_INTEGER)
+    {
+      gfc_clear_ts (&ts);
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_index_integer_kind;
+
+      gfc_convert_type_warn (index, &ts, 2, 0);
+    }
+
+  return SUCCESS;
+}
+
+/* Resolve one part of an array index.  */
+
+gfc_try
+gfc_resolve_index (gfc_expr *index, int check_scalar)
+{
+  return gfc_resolve_index_1 (index, check_scalar, 1);
+}
+
+/* Resolve a dim argument to an intrinsic function.  */
+
+gfc_try
+gfc_resolve_dim_arg (gfc_expr *dim)
+{
+  if (dim == NULL)
+    return SUCCESS;
+
+  if (gfc_resolve_expr (dim) == FAILURE)
+    return FAILURE;
+
+  if (dim->rank != 0)
+    {
+      gfc_error ("Argument dim at %L must be scalar", &dim->where);
+      return FAILURE;
+
+    }
+
+  if (dim->ts.type != BT_INTEGER)
+    {
+      gfc_error ("Argument dim at %L must be of INTEGER type", &dim->where);
+      return FAILURE;
+    }
+
+  if (dim->ts.kind != gfc_index_integer_kind)
+    {
+      gfc_typespec ts;
+
+      gfc_clear_ts (&ts);
+      ts.type = BT_INTEGER;
+      ts.kind = gfc_index_integer_kind;
+
+      gfc_convert_type_warn (dim, &ts, 2, 0);
+    }
+
+  return SUCCESS;
+}
+
+/* Given an expression that contains array references, update those array
+   references to point to the right array specifications.  While this is
+   filled in during matching, this information is difficult to save and load
+   in a module, so we take care of it here.
+
+   The idea here is that the original array reference comes from the
+   base symbol.  We traverse the list of reference structures, setting
+   the stored reference to references.  Component references can
+   provide an additional array specification.  */
+
+static void
+find_array_spec (gfc_expr *e)
+{
+  gfc_array_spec *as;
+  gfc_component *c;
+  gfc_symbol *derived;
+  gfc_ref *ref;
+
+  if (e->symtree->n.sym->ts.type == BT_CLASS)
+    as = CLASS_DATA (e->symtree->n.sym)->as;
+  else
+    as = e->symtree->n.sym->as;
+  derived = NULL;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    switch (ref->type)
+      {
+      case REF_ARRAY:
+	if (as == NULL)
+	  gfc_internal_error ("find_array_spec(): Missing spec");
+
+	ref->u.ar.as = as;
+	as = NULL;
+	break;
+
+      case REF_COMPONENT:
+	if (derived == NULL)
+	  derived = e->symtree->n.sym->ts.u.derived;
+
+	if (derived->attr.is_class)
+	  derived = derived->components->ts.u.derived;
+
+	c = derived->components;
+
+	for (; c; c = c->next)
+	  if (c == ref->u.c.component)
+	    {
+	      /* Track the sequence of component references.  */
+	      if (c->ts.type == BT_DERIVED)
+		derived = c->ts.u.derived;
+	      break;
+	    }
+
+	if (c == NULL)
+	  gfc_internal_error ("find_array_spec(): Component not found");
+
+	if (c->attr.dimension)
+	  {
+	    if (as != NULL)
+	      gfc_internal_error ("find_array_spec(): unused as(1)");
+	    as = c->as;
+	  }
+
+	break;
+
+      case REF_SUBSTRING:
+	break;
+      }
+
+  if (as != NULL)
+    gfc_internal_error ("find_array_spec(): unused as(2)");
+}
+
+
+/* Resolve an array reference.  */
+
+static gfc_try
+resolve_array_ref (gfc_array_ref *ar)
+{
+  int i, check_scalar;
+  gfc_expr *e;
+
+  for (i = 0; i < ar->dimen + ar->codimen; i++)
+    {
+      check_scalar = ar->dimen_type[i] == DIMEN_RANGE;
+
+      /* Do not force gfc_index_integer_kind for the start.  We can
+         do fine with any integer kind.  This avoids temporary arrays
+	 created for indexing with a vector.  */
+      if (gfc_resolve_index_1 (ar->start[i], check_scalar, 0) == FAILURE)
+	return FAILURE;
+      if (gfc_resolve_index (ar->end[i], check_scalar) == FAILURE)
+	return FAILURE;
+      if (gfc_resolve_index (ar->stride[i], check_scalar) == FAILURE)
+	return FAILURE;
+
+      e = ar->start[i];
+
+      if (ar->dimen_type[i] == DIMEN_UNKNOWN)
+	switch (e->rank)
+	  {
+	  case 0:
+	    ar->dimen_type[i] = DIMEN_ELEMENT;
+	    break;
+
+	  case 1:
+	    ar->dimen_type[i] = DIMEN_VECTOR;
+	    if (e->expr_type == EXPR_VARIABLE
+		&& e->symtree->n.sym->ts.type == BT_DERIVED)
+	      ar->start[i] = gfc_get_parentheses (e);
+	    break;
+
+	  default:
+	    gfc_error ("Array index at %L is an array of rank %d",
+		       &ar->c_where[i], e->rank);
+	    return FAILURE;
+	  }
+
+      /* Fill in the upper bound, which may be lower than the
+	 specified one for something like a(2:10:5), which is
+	 identical to a(2:7:5).  Only relevant for strides not equal
+	 to one.  Don't try a division by zero.  */
+      if (ar->dimen_type[i] == DIMEN_RANGE
+	  && ar->stride[i] != NULL && ar->stride[i]->expr_type == EXPR_CONSTANT
+	  && mpz_cmp_si (ar->stride[i]->value.integer, 1L) != 0
+	  && mpz_cmp_si (ar->stride[i]->value.integer, 0L) != 0)
+	{
+	  mpz_t size, end;
+
+	  if (gfc_ref_dimen_size (ar, i, &size, &end) == SUCCESS)
+	    {
+	      if (ar->end[i] == NULL)
+		{
+		  ar->end[i] =
+		    gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind,
+					   &ar->where);
+		  mpz_set (ar->end[i]->value.integer, end);
+		}
+	      else if (ar->end[i]->ts.type == BT_INTEGER
+		       && ar->end[i]->expr_type == EXPR_CONSTANT)
+		{
+		  mpz_set (ar->end[i]->value.integer, end);
+		}
+	      else
+		gcc_unreachable ();
+
+	      mpz_clear (size);
+	      mpz_clear (end);
+	    }
+	}
+    }
+
+  if (ar->type == AR_FULL && ar->as->rank == 0)
+    ar->type = AR_ELEMENT;
+
+  /* If the reference type is unknown, figure out what kind it is.  */
+
+  if (ar->type == AR_UNKNOWN)
+    {
+      ar->type = AR_ELEMENT;
+      for (i = 0; i < ar->dimen; i++)
+	if (ar->dimen_type[i] == DIMEN_RANGE
+	    || ar->dimen_type[i] == DIMEN_VECTOR)
+	  {
+	    ar->type = AR_SECTION;
+	    break;
+	  }
+    }
+
+  if (!ar->as->cray_pointee && compare_spec_to_ref (ar) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+static gfc_try
+resolve_substring (gfc_ref *ref)
+{
+  int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+
+  if (ref->u.ss.start != NULL)
+    {
+      if (gfc_resolve_expr (ref->u.ss.start) == FAILURE)
+	return FAILURE;
+
+      if (ref->u.ss.start->ts.type != BT_INTEGER)
+	{
+	  gfc_error ("Substring start index at %L must be of type INTEGER",
+		     &ref->u.ss.start->where);
+	  return FAILURE;
+	}
+
+      if (ref->u.ss.start->rank != 0)
+	{
+	  gfc_error ("Substring start index at %L must be scalar",
+		     &ref->u.ss.start->where);
+	  return FAILURE;
+	}
+
+      if (compare_bound_int (ref->u.ss.start, 1) == CMP_LT
+	  && (compare_bound (ref->u.ss.end, ref->u.ss.start) == CMP_EQ
+	      || compare_bound (ref->u.ss.end, ref->u.ss.start) == CMP_GT))
+	{
+	  gfc_error ("Substring start index at %L is less than one",
+		     &ref->u.ss.start->where);
+	  return FAILURE;
+	}
+    }
+
+  if (ref->u.ss.end != NULL)
+    {
+      if (gfc_resolve_expr (ref->u.ss.end) == FAILURE)
+	return FAILURE;
+
+      if (ref->u.ss.end->ts.type != BT_INTEGER)
+	{
+	  gfc_error ("Substring end index at %L must be of type INTEGER",
+		     &ref->u.ss.end->where);
+	  return FAILURE;
+	}
+
+      if (ref->u.ss.end->rank != 0)
+	{
+	  gfc_error ("Substring end index at %L must be scalar",
+		     &ref->u.ss.end->where);
+	  return FAILURE;
+	}
+
+      if (ref->u.ss.length != NULL
+	  && compare_bound (ref->u.ss.end, ref->u.ss.length->length) == CMP_GT
+	  && (compare_bound (ref->u.ss.end, ref->u.ss.start) == CMP_EQ
+	      || compare_bound (ref->u.ss.end, ref->u.ss.start) == CMP_GT))
+	{
+	  gfc_error ("Substring end index at %L exceeds the string length",
+		     &ref->u.ss.start->where);
+	  return FAILURE;
+	}
+
+      if (compare_bound_mpz_t (ref->u.ss.end,
+			       gfc_integer_kinds[k].huge) == CMP_GT
+	  && (compare_bound (ref->u.ss.end, ref->u.ss.start) == CMP_EQ
+	      || compare_bound (ref->u.ss.end, ref->u.ss.start) == CMP_GT))
+	{
+	  gfc_error ("Substring end index at %L is too large",
+		     &ref->u.ss.end->where);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* This function supplies missing substring charlens.  */
+
+void
+gfc_resolve_substring_charlen (gfc_expr *e)
+{
+  gfc_ref *char_ref;
+  gfc_expr *start, *end;
+
+  for (char_ref = e->ref; char_ref; char_ref = char_ref->next)
+    if (char_ref->type == REF_SUBSTRING)
+      break;
+
+  if (!char_ref)
+    return;
+
+  gcc_assert (char_ref->next == NULL);
+
+  if (e->ts.u.cl)
+    {
+      if (e->ts.u.cl->length)
+	gfc_free_expr (e->ts.u.cl->length);
+      else if (e->expr_type == EXPR_VARIABLE
+		 && e->symtree->n.sym->attr.dummy)
+	return;
+    }
+
+  e->ts.type = BT_CHARACTER;
+  e->ts.kind = gfc_default_character_kind;
+
+  if (!e->ts.u.cl)
+    e->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+
+  if (char_ref->u.ss.start)
+    start = gfc_copy_expr (char_ref->u.ss.start);
+  else
+    start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+
+  if (char_ref->u.ss.end)
+    end = gfc_copy_expr (char_ref->u.ss.end);
+  else if (e->expr_type == EXPR_VARIABLE)
+    end = gfc_copy_expr (e->symtree->n.sym->ts.u.cl->length);
+  else
+    end = NULL;
+
+  if (!start || !end)
+    return;
+
+  /* Length = (end - start +1).  */
+  e->ts.u.cl->length = gfc_subtract (end, start);
+  e->ts.u.cl->length = gfc_add (e->ts.u.cl->length,
+				gfc_get_int_expr (gfc_default_integer_kind,
+						  NULL, 1));
+
+  e->ts.u.cl->length->ts.type = BT_INTEGER;
+  e->ts.u.cl->length->ts.kind = gfc_charlen_int_kind;
+
+  /* Make sure that the length is simplified.  */
+  gfc_simplify_expr (e->ts.u.cl->length, 1);
+  gfc_resolve_expr (e->ts.u.cl->length);
+}
+
+
+/* Resolve subtype references.  */
+
+static gfc_try
+resolve_ref (gfc_expr *expr)
+{
+  int current_part_dimension, n_components, seen_part_dimension;
+  gfc_ref *ref;
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.as == NULL)
+      {
+	find_array_spec (expr);
+	break;
+      }
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    switch (ref->type)
+      {
+      case REF_ARRAY:
+	if (resolve_array_ref (&ref->u.ar) == FAILURE)
+	  return FAILURE;
+	break;
+
+      case REF_COMPONENT:
+	break;
+
+      case REF_SUBSTRING:
+	resolve_substring (ref);
+	break;
+      }
+
+  /* Check constraints on part references.  */
+
+  current_part_dimension = 0;
+  seen_part_dimension = 0;
+  n_components = 0;
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    {
+      switch (ref->type)
+	{
+	case REF_ARRAY:
+	  switch (ref->u.ar.type)
+	    {
+	    case AR_FULL:
+	      /* Coarray scalar.  */
+	      if (ref->u.ar.as->rank == 0)
+		{
+		  current_part_dimension = 0;
+		  break;
+		}
+	      /* Fall through.  */
+	    case AR_SECTION:
+	      current_part_dimension = 1;
+	      break;
+
+	    case AR_ELEMENT:
+	      current_part_dimension = 0;
+	      break;
+
+	    case AR_UNKNOWN:
+	      gfc_internal_error ("resolve_ref(): Bad array reference");
+	    }
+
+	  break;
+
+	case REF_COMPONENT:
+	  if (current_part_dimension || seen_part_dimension)
+	    {
+	      /* F03:C614.  */
+	      if (ref->u.c.component->attr.pointer
+		  || ref->u.c.component->attr.proc_pointer)
+		{
+		  gfc_error ("Component to the right of a part reference "
+			     "with nonzero rank must not have the POINTER "
+			     "attribute at %L", &expr->where);
+		  return FAILURE;
+		}
+	      else if (ref->u.c.component->attr.allocatable)
+		{
+		  gfc_error ("Component to the right of a part reference "
+			     "with nonzero rank must not have the ALLOCATABLE "
+			     "attribute at %L", &expr->where);
+		  return FAILURE;
+		}
+	    }
+
+	  n_components++;
+	  break;
+
+	case REF_SUBSTRING:
+	  break;
+	}
+
+      if (((ref->type == REF_COMPONENT && n_components > 1)
+	   || ref->next == NULL)
+	  && current_part_dimension
+	  && seen_part_dimension)
+	{
+	  gfc_error ("Two or more part references with nonzero rank must "
+		     "not be specified at %L", &expr->where);
+	  return FAILURE;
+	}
+
+      if (ref->type == REF_COMPONENT)
+	{
+	  if (current_part_dimension)
+	    seen_part_dimension = 1;
+
+	  /* reset to make sure */
+	  current_part_dimension = 0;
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* Given an expression, determine its shape.  This is easier than it sounds.
+   Leaves the shape array NULL if it is not possible to determine the shape.  */
+
+static void
+expression_shape (gfc_expr *e)
+{
+  mpz_t array[GFC_MAX_DIMENSIONS];
+  int i;
+
+  if (e->rank == 0 || e->shape != NULL)
+    return;
+
+  for (i = 0; i < e->rank; i++)
+    if (gfc_array_dimen_size (e, i, &array[i]) == FAILURE)
+      goto fail;
+
+  e->shape = gfc_get_shape (e->rank);
+
+  memcpy (e->shape, array, e->rank * sizeof (mpz_t));
+
+  return;
+
+fail:
+  for (i--; i >= 0; i--)
+    mpz_clear (array[i]);
+}
+
+
+/* Given a variable expression node, compute the rank of the expression by
+   examining the base symbol and any reference structures it may have.  */
+
+static void
+expression_rank (gfc_expr *e)
+{
+  gfc_ref *ref;
+  int i, rank;
+
+  /* Just to make sure, because EXPR_COMPCALL's also have an e->ref and that
+     could lead to serious confusion...  */
+  gcc_assert (e->expr_type != EXPR_COMPCALL);
+
+  if (e->ref == NULL)
+    {
+      if (e->expr_type == EXPR_ARRAY)
+	goto done;
+      /* Constructors can have a rank different from one via RESHAPE().  */
+
+      if (e->symtree == NULL)
+	{
+	  e->rank = 0;
+	  goto done;
+	}
+
+      e->rank = (e->symtree->n.sym->as == NULL)
+		? 0 : e->symtree->n.sym->as->rank;
+      goto done;
+    }
+
+  rank = 0;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_COMPONENT && ref->u.c.component->attr.proc_pointer
+	  && ref->u.c.component->attr.function && !ref->next)
+	rank = ref->u.c.component->as ? ref->u.c.component->as->rank : 0;
+
+      if (ref->type != REF_ARRAY)
+	continue;
+
+      if (ref->u.ar.type == AR_FULL)
+	{
+	  rank = ref->u.ar.as->rank;
+	  break;
+	}
+
+      if (ref->u.ar.type == AR_SECTION)
+	{
+	  /* Figure out the rank of the section.  */
+	  if (rank != 0)
+	    gfc_internal_error ("expression_rank(): Two array specs");
+
+	  for (i = 0; i < ref->u.ar.dimen; i++)
+	    if (ref->u.ar.dimen_type[i] == DIMEN_RANGE
+		|| ref->u.ar.dimen_type[i] == DIMEN_VECTOR)
+	      rank++;
+
+	  break;
+	}
+    }
+
+  e->rank = rank;
+
+done:
+  expression_shape (e);
+}
+
+
+/* Resolve a variable expression.  */
+
+static gfc_try
+resolve_variable (gfc_expr *e)
+{
+  gfc_symbol *sym;
+  gfc_try t;
+
+  t = SUCCESS;
+
+  if (e->symtree == NULL)
+    return FAILURE;
+  sym = e->symtree->n.sym;
+
+  /* If this is an associate-name, it may be parsed with an array reference
+     in error even though the target is scalar.  Fail directly in this case.  */
+  if (sym->assoc && !sym->attr.dimension && e->ref && e->ref->type == REF_ARRAY)
+    return FAILURE;
+
+  /* On the other hand, the parser may not have known this is an array;
+     in this case, we have to add a FULL reference.  */
+  if (sym->assoc && sym->attr.dimension && !e->ref)
+    {
+      e->ref = gfc_get_ref ();
+      e->ref->type = REF_ARRAY;
+      e->ref->u.ar.type = AR_FULL;
+      e->ref->u.ar.dimen = 0;
+    }
+
+  if (e->ref && resolve_ref (e) == FAILURE)
+    return FAILURE;
+
+  if (sym->attr.flavor == FL_PROCEDURE
+      && (!sym->attr.function
+	  || (sym->attr.function && sym->result
+	      && sym->result->attr.proc_pointer
+	      && !sym->result->attr.function)))
+    {
+      e->ts.type = BT_PROCEDURE;
+      goto resolve_procedure;
+    }
+
+  if (sym->ts.type != BT_UNKNOWN)
+    gfc_variable_attr (e, &e->ts);
+  else
+    {
+      /* Must be a simple variable reference.  */
+      if (gfc_set_default_type (sym, 1, sym->ns) == FAILURE)
+	return FAILURE;
+      e->ts = sym->ts;
+    }
+
+  if (check_assumed_size_reference (sym, e))
+    return FAILURE;
+
+  /* Deal with forward references to entries during resolve_code, to
+     satisfy, at least partially, 12.5.2.5.  */
+  if (gfc_current_ns->entries
+      && current_entry_id == sym->entry_id
+      && cs_base
+      && cs_base->current
+      && cs_base->current->op != EXEC_ENTRY)
+    {
+      gfc_entry_list *entry;
+      gfc_formal_arglist *formal;
+      int n;
+      bool seen;
+
+      /* If the symbol is a dummy...  */
+      if (sym->attr.dummy && sym->ns == gfc_current_ns)
+	{
+	  entry = gfc_current_ns->entries;
+	  seen = false;
+
+	  /* ...test if the symbol is a parameter of previous entries.  */
+	  for (; entry && entry->id <= current_entry_id; entry = entry->next)
+	    for (formal = entry->sym->formal; formal; formal = formal->next)
+	      {
+		if (formal->sym && sym->name == formal->sym->name)
+		  seen = true;
+	      }
+
+	  /*  If it has not been seen as a dummy, this is an error.  */
+	  if (!seen)
+	    {
+	      if (specification_expr)
+		gfc_error ("Variable '%s', used in a specification expression"
+			   ", is referenced at %L before the ENTRY statement "
+			   "in which it is a parameter",
+			   sym->name, &cs_base->current->loc);
+	      else
+		gfc_error ("Variable '%s' is used at %L before the ENTRY "
+			   "statement in which it is a parameter",
+			   sym->name, &cs_base->current->loc);
+	      t = FAILURE;
+	    }
+	}
+
+      /* Now do the same check on the specification expressions.  */
+      specification_expr = 1;
+      if (sym->ts.type == BT_CHARACTER
+	  && gfc_resolve_expr (sym->ts.u.cl->length) == FAILURE)
+	t = FAILURE;
+
+      if (sym->as)
+	for (n = 0; n < sym->as->rank; n++)
+	  {
+	     specification_expr = 1;
+	     if (gfc_resolve_expr (sym->as->lower[n]) == FAILURE)
+	       t = FAILURE;
+	     specification_expr = 1;
+	     if (gfc_resolve_expr (sym->as->upper[n]) == FAILURE)
+	       t = FAILURE;
+	  }
+      specification_expr = 0;
+
+      if (t == SUCCESS)
+	/* Update the symbol's entry level.  */
+	sym->entry_id = current_entry_id + 1;
+    }
+
+  /* If a symbol has been host_associated mark it.  This is used latter,
+     to identify if aliasing is possible via host association.  */
+  if (sym->attr.flavor == FL_VARIABLE
+	&& gfc_current_ns->parent
+	&& (gfc_current_ns->parent == sym->ns
+	      || (gfc_current_ns->parent->parent
+		    && gfc_current_ns->parent->parent == sym->ns)))
+    sym->attr.host_assoc = 1;
+
+resolve_procedure:
+  if (t == SUCCESS && resolve_procedure_expression (e) == FAILURE)
+    t = FAILURE;
+
+  /* F2008, C617 and C1229.  */
+  if (!inquiry_argument && (e->ts.type == BT_CLASS || e->ts.type == BT_DERIVED)
+      && gfc_is_coindexed (e))
+    {
+      gfc_ref *ref, *ref2 = NULL;
+
+      for (ref = e->ref; ref; ref = ref->next)
+	{
+	  if (ref->type == REF_COMPONENT)
+	    ref2 = ref;
+	  if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+	    break;
+	}
+
+      for ( ; ref; ref = ref->next)
+	if (ref->type == REF_COMPONENT)
+	  break;
+
+      /* Expression itself is not coindexed object.  */
+      if (ref && e->ts.type == BT_CLASS)
+	{
+	  gfc_error ("Polymorphic subobject of coindexed object at %L",
+		     &e->where);
+	  t = FAILURE;
+	}
+
+      /* Expression itself is coindexed object.  */
+      if (ref == NULL)
+	{
+	  gfc_component *c;
+	  c = ref2 ? ref2->u.c.component : e->symtree->n.sym->components;
+	  for ( ; c; c = c->next)
+	    if (c->attr.allocatable && c->ts.type == BT_CLASS)
+	      {
+		gfc_error ("Coindexed object with polymorphic allocatable "
+			 "subcomponent at %L", &e->where);
+		t = FAILURE;
+		break;
+	      }
+	}
+    }
+
+  return t;
+}
+
+
+/* Checks to see that the correct symbol has been host associated.
+   The only situation where this arises is that in which a twice
+   contained function is parsed after the host association is made.
+   Therefore, on detecting this, change the symbol in the expression
+   and convert the array reference into an actual arglist if the old
+   symbol is a variable.  */
+static bool
+check_host_association (gfc_expr *e)
+{
+  gfc_symbol *sym, *old_sym;
+  gfc_symtree *st;
+  int n;
+  gfc_ref *ref;
+  gfc_actual_arglist *arg, *tail = NULL;
+  bool retval = e->expr_type == EXPR_FUNCTION;
+
+  /*  If the expression is the result of substitution in
+      interface.c(gfc_extend_expr) because there is no way in
+      which the host association can be wrong.  */
+  if (e->symtree == NULL
+	|| e->symtree->n.sym == NULL
+	|| e->user_operator)
+    return retval;
+
+  old_sym = e->symtree->n.sym;
+
+  if (gfc_current_ns->parent
+	&& old_sym->ns != gfc_current_ns)
+    {
+      /* Use the 'USE' name so that renamed module symbols are
+	 correctly handled.  */
+      gfc_find_symbol (e->symtree->name, gfc_current_ns, 1, &sym);
+
+      if (sym && old_sym != sym
+	      && sym->ts.type == old_sym->ts.type
+	      && sym->attr.flavor == FL_PROCEDURE
+	      && sym->attr.contained)
+	{
+	  /* Clear the shape, since it might not be valid.  */
+	  gfc_free_shape (&e->shape, e->rank);
+
+	  /* Give the expression the right symtree!  */
+	  gfc_find_sym_tree (e->symtree->name, NULL, 1, &st);
+	  gcc_assert (st != NULL);
+
+	  if (old_sym->attr.flavor == FL_PROCEDURE
+		|| e->expr_type == EXPR_FUNCTION)
+  	    {
+	      /* Original was function so point to the new symbol, since
+		 the actual argument list is already attached to the
+		 expression. */
+	      e->value.function.esym = NULL;
+	      e->symtree = st;
+	    }
+	  else
+	    {
+	      /* Original was variable so convert array references into
+		 an actual arglist. This does not need any checking now
+		 since gfc_resolve_function will take care of it.  */
+	      e->value.function.actual = NULL;
+	      e->expr_type = EXPR_FUNCTION;
+	      e->symtree = st;
+
+	      /* Ambiguity will not arise if the array reference is not
+		 the last reference.  */
+	      for (ref = e->ref; ref; ref = ref->next)
+		if (ref->type == REF_ARRAY && ref->next == NULL)
+		  break;
+
+	      gcc_assert (ref->type == REF_ARRAY);
+
+	      /* Grab the start expressions from the array ref and
+		 copy them into actual arguments.  */
+	      for (n = 0; n < ref->u.ar.dimen; n++)
+		{
+		  arg = gfc_get_actual_arglist ();
+		  arg->expr = gfc_copy_expr (ref->u.ar.start[n]);
+		  if (e->value.function.actual == NULL)
+		    tail = e->value.function.actual = arg;
+	          else
+		    {
+		      tail->next = arg;
+		      tail = arg;
+		    }
+		}
+
+	      /* Dump the reference list and set the rank.  */
+	      gfc_free_ref_list (e->ref);
+	      e->ref = NULL;
+	      e->rank = sym->as ? sym->as->rank : 0;
+	    }
+
+	  gfc_resolve_expr (e);
+	  sym->refs++;
+	}
+    }
+  /* This might have changed!  */
+  return e->expr_type == EXPR_FUNCTION;
+}
+
+
+static void
+gfc_resolve_character_operator (gfc_expr *e)
+{
+  gfc_expr *op1 = e->value.op.op1;
+  gfc_expr *op2 = e->value.op.op2;
+  gfc_expr *e1 = NULL;
+  gfc_expr *e2 = NULL;
+
+  gcc_assert (e->value.op.op == INTRINSIC_CONCAT);
+
+  if (op1->ts.u.cl && op1->ts.u.cl->length)
+    e1 = gfc_copy_expr (op1->ts.u.cl->length);
+  else if (op1->expr_type == EXPR_CONSTANT)
+    e1 = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+			   op1->value.character.length);
+
+  if (op2->ts.u.cl && op2->ts.u.cl->length)
+    e2 = gfc_copy_expr (op2->ts.u.cl->length);
+  else if (op2->expr_type == EXPR_CONSTANT)
+    e2 = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+			   op2->value.character.length);
+
+  e->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+
+  if (!e1 || !e2)
+    return;
+
+  e->ts.u.cl->length = gfc_add (e1, e2);
+  e->ts.u.cl->length->ts.type = BT_INTEGER;
+  e->ts.u.cl->length->ts.kind = gfc_charlen_int_kind;
+  gfc_simplify_expr (e->ts.u.cl->length, 0);
+  gfc_resolve_expr (e->ts.u.cl->length);
+
+  return;
+}
+
+
+/*  Ensure that an character expression has a charlen and, if possible, a
+    length expression.  */
+
+static void
+fixup_charlen (gfc_expr *e)
+{
+  /* The cases fall through so that changes in expression type and the need
+     for multiple fixes are picked up.  In all circumstances, a charlen should
+     be available for the middle end to hang a backend_decl on.  */
+  switch (e->expr_type)
+    {
+    case EXPR_OP:
+      gfc_resolve_character_operator (e);
+
+    case EXPR_ARRAY:
+      if (e->expr_type == EXPR_ARRAY)
+	gfc_resolve_character_array_constructor (e);
+
+    case EXPR_SUBSTRING:
+      if (!e->ts.u.cl && e->ref)
+	gfc_resolve_substring_charlen (e);
+
+    default:
+      if (!e->ts.u.cl)
+	e->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+
+      break;
+    }
+}
+
+
+/* Update an actual argument to include the passed-object for type-bound
+   procedures at the right position.  */
+
+static gfc_actual_arglist*
+update_arglist_pass (gfc_actual_arglist* lst, gfc_expr* po, unsigned argpos,
+		     const char *name)
+{
+  gcc_assert (argpos > 0);
+
+  if (argpos == 1)
+    {
+      gfc_actual_arglist* result;
+
+      result = gfc_get_actual_arglist ();
+      result->expr = po;
+      result->next = lst;
+      if (name)
+        result->name = name;
+
+      return result;
+    }
+
+  if (lst)
+    lst->next = update_arglist_pass (lst->next, po, argpos - 1, name);
+  else
+    lst = update_arglist_pass (NULL, po, argpos - 1, name);
+  return lst;
+}
+
+
+/* Extract the passed-object from an EXPR_COMPCALL (a copy of it).  */
+
+static gfc_expr*
+extract_compcall_passed_object (gfc_expr* e)
+{
+  gfc_expr* po;
+
+  gcc_assert (e->expr_type == EXPR_COMPCALL);
+
+  if (e->value.compcall.base_object)
+    po = gfc_copy_expr (e->value.compcall.base_object);
+  else
+    {
+      po = gfc_get_expr ();
+      po->expr_type = EXPR_VARIABLE;
+      po->symtree = e->symtree;
+      po->ref = gfc_copy_ref (e->ref);
+      po->where = e->where;
+    }
+
+  if (gfc_resolve_expr (po) == FAILURE)
+    return NULL;
+
+  return po;
+}
+
+
+/* Update the arglist of an EXPR_COMPCALL expression to include the
+   passed-object.  */
+
+static gfc_try
+update_compcall_arglist (gfc_expr* e)
+{
+  gfc_expr* po;
+  gfc_typebound_proc* tbp;
+
+  tbp = e->value.compcall.tbp;
+
+  if (tbp->error)
+    return FAILURE;
+
+  po = extract_compcall_passed_object (e);
+  if (!po)
+    return FAILURE;
+
+  if (tbp->nopass || e->value.compcall.ignore_pass)
+    {
+      gfc_free_expr (po);
+      return SUCCESS;
+    }
+
+  gcc_assert (tbp->pass_arg_num > 0);
+  e->value.compcall.actual = update_arglist_pass (e->value.compcall.actual, po,
+						  tbp->pass_arg_num,
+						  tbp->pass_arg);
+
+  return SUCCESS;
+}
+
+
+/* Extract the passed object from a PPC call (a copy of it).  */
+
+static gfc_expr*
+extract_ppc_passed_object (gfc_expr *e)
+{
+  gfc_expr *po;
+  gfc_ref **ref;
+
+  po = gfc_get_expr ();
+  po->expr_type = EXPR_VARIABLE;
+  po->symtree = e->symtree;
+  po->ref = gfc_copy_ref (e->ref);
+  po->where = e->where;
+
+  /* Remove PPC reference.  */
+  ref = &po->ref;
+  while ((*ref)->next)
+    ref = &(*ref)->next;
+  gfc_free_ref_list (*ref);
+  *ref = NULL;
+
+  if (gfc_resolve_expr (po) == FAILURE)
+    return NULL;
+
+  return po;
+}
+
+
+/* Update the actual arglist of a procedure pointer component to include the
+   passed-object.  */
+
+static gfc_try
+update_ppc_arglist (gfc_expr* e)
+{
+  gfc_expr* po;
+  gfc_component *ppc;
+  gfc_typebound_proc* tb;
+
+  if (!gfc_is_proc_ptr_comp (e, &ppc))
+    return FAILURE;
+
+  tb = ppc->tb;
+
+  if (tb->error)
+    return FAILURE;
+  else if (tb->nopass)
+    return SUCCESS;
+
+  po = extract_ppc_passed_object (e);
+  if (!po)
+    return FAILURE;
+
+  /* F08:R739.  */
+  if (po->rank > 0)
+    {
+      gfc_error ("Passed-object at %L must be scalar", &e->where);
+      return FAILURE;
+    }
+
+  /* F08:C611.  */
+  if (po->ts.type == BT_DERIVED && po->ts.u.derived->attr.abstract)
+    {
+      gfc_error ("Base object for procedure-pointer component call at %L is of"
+		 " ABSTRACT type '%s'", &e->where, po->ts.u.derived->name);
+      return FAILURE;
+    }
+
+  gcc_assert (tb->pass_arg_num > 0);
+  e->value.compcall.actual = update_arglist_pass (e->value.compcall.actual, po,
+						  tb->pass_arg_num,
+						  tb->pass_arg);
+
+  return SUCCESS;
+}
+
+
+/* Check that the object a TBP is called on is valid, i.e. it must not be
+   of ABSTRACT type (as in subobject%abstract_parent%tbp()).  */
+
+static gfc_try
+check_typebound_baseobject (gfc_expr* e)
+{
+  gfc_expr* base;
+  gfc_try return_value = FAILURE;
+
+  base = extract_compcall_passed_object (e);
+  if (!base)
+    return FAILURE;
+
+  gcc_assert (base->ts.type == BT_DERIVED || base->ts.type == BT_CLASS);
+
+  /* F08:C611.  */
+  if (base->ts.type == BT_DERIVED && base->ts.u.derived->attr.abstract)
+    {
+      gfc_error ("Base object for type-bound procedure call at %L is of"
+		 " ABSTRACT type '%s'", &e->where, base->ts.u.derived->name);
+      goto cleanup;
+    }
+
+  /* F08:C1230. If the procedure called is NOPASS,
+     the base object must be scalar.  */
+  if (e->value.compcall.tbp->nopass && base->rank > 0)
+    {
+      gfc_error ("Base object for NOPASS type-bound procedure call at %L must"
+		 " be scalar", &e->where);
+      goto cleanup;
+    }
+
+  /* FIXME: Remove once PR 43214 is fixed (TBP with non-scalar PASS).  */
+  if (base->rank > 0)
+    {
+      gfc_error ("Non-scalar base object at %L currently not implemented",
+		 &e->where);
+      goto cleanup;
+    }
+
+  return_value = SUCCESS;
+
+cleanup:
+  gfc_free_expr (base);
+  return return_value;
+}
+
+
+/* Resolve a call to a type-bound procedure, either function or subroutine,
+   statically from the data in an EXPR_COMPCALL expression.  The adapted
+   arglist and the target-procedure symtree are returned.  */
+
+static gfc_try
+resolve_typebound_static (gfc_expr* e, gfc_symtree** target,
+			  gfc_actual_arglist** actual)
+{
+  gcc_assert (e->expr_type == EXPR_COMPCALL);
+  gcc_assert (!e->value.compcall.tbp->is_generic);
+
+  /* Update the actual arglist for PASS.  */
+  if (update_compcall_arglist (e) == FAILURE)
+    return FAILURE;
+
+  *actual = e->value.compcall.actual;
+  *target = e->value.compcall.tbp->u.specific;
+
+  gfc_free_ref_list (e->ref);
+  e->ref = NULL;
+  e->value.compcall.actual = NULL;
+
+  return SUCCESS;
+}
+
+
+/* Get the ultimate declared type from an expression.  In addition,
+   return the last class/derived type reference and the copy of the
+   reference list.  */
+static gfc_symbol*
+get_declared_from_expr (gfc_ref **class_ref, gfc_ref **new_ref,
+			gfc_expr *e)
+{
+  gfc_symbol *declared;
+  gfc_ref *ref;
+
+  declared = NULL;
+  if (class_ref)
+    *class_ref = NULL;
+  if (new_ref)
+    *new_ref = gfc_copy_ref (e->ref);
+
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      if (ref->type != REF_COMPONENT)
+	continue;
+
+      if (ref->u.c.component->ts.type == BT_CLASS
+	    || ref->u.c.component->ts.type == BT_DERIVED)
+	{
+	  declared = ref->u.c.component->ts.u.derived;
+	  if (class_ref)
+	    *class_ref = ref;
+	}
+    }
+
+  if (declared == NULL)
+    declared = e->symtree->n.sym->ts.u.derived;
+
+  return declared;
+}
+
+
+/* Given an EXPR_COMPCALL calling a GENERIC typebound procedure, figure out
+   which of the specific bindings (if any) matches the arglist and transform
+   the expression into a call of that binding.  */
+
+static gfc_try
+resolve_typebound_generic_call (gfc_expr* e, const char **name)
+{
+  gfc_typebound_proc* genproc;
+  const char* genname;
+  gfc_symtree *st;
+  gfc_symbol *derived;
+
+  gcc_assert (e->expr_type == EXPR_COMPCALL);
+  genname = e->value.compcall.name;
+  genproc = e->value.compcall.tbp;
+
+  if (!genproc->is_generic)
+    return SUCCESS;
+
+  /* Try the bindings on this type and in the inheritance hierarchy.  */
+  for (; genproc; genproc = genproc->overridden)
+    {
+      gfc_tbp_generic* g;
+
+      gcc_assert (genproc->is_generic);
+      for (g = genproc->u.generic; g; g = g->next)
+	{
+	  gfc_symbol* target;
+	  gfc_actual_arglist* args;
+	  bool matches;
+
+	  gcc_assert (g->specific);
+
+	  if (g->specific->error)
+	    continue;
+
+	  target = g->specific->u.specific->n.sym;
+
+	  /* Get the right arglist by handling PASS/NOPASS.  */
+	  args = gfc_copy_actual_arglist (e->value.compcall.actual);
+	  if (!g->specific->nopass)
+	    {
+	      gfc_expr* po;
+	      po = extract_compcall_passed_object (e);
+	      if (!po)
+		return FAILURE;
+
+	      gcc_assert (g->specific->pass_arg_num > 0);
+	      gcc_assert (!g->specific->error);
+	      args = update_arglist_pass (args, po, g->specific->pass_arg_num,
+					  g->specific->pass_arg);
+	    }
+	  resolve_actual_arglist (args, target->attr.proc,
+				  is_external_proc (target) && !target->formal);
+
+	  /* Check if this arglist matches the formal.  */
+	  matches = gfc_arglist_matches_symbol (&args, target);
+
+	  /* Clean up and break out of the loop if we've found it.  */
+	  gfc_free_actual_arglist (args);
+	  if (matches)
+	    {
+	      e->value.compcall.tbp = g->specific;
+	      genname = g->specific_st->name;
+	      /* Pass along the name for CLASS methods, where the vtab
+		 procedure pointer component has to be referenced.  */
+	      if (name)
+		*name = genname;
+	      goto success;
+	    }
+	}
+    }
+
+  /* Nothing matching found!  */
+  gfc_error ("Found no matching specific binding for the call to the GENERIC"
+	     " '%s' at %L", genname, &e->where);
+  return FAILURE;
+
+success:
+  /* Make sure that we have the right specific instance for the name.  */
+  derived = get_declared_from_expr (NULL, NULL, e);
+
+  st = gfc_find_typebound_proc (derived, NULL, genname, true, &e->where);
+  if (st)
+    e->value.compcall.tbp = st->n.tb;
+
+  return SUCCESS;
+}
+
+
+/* Resolve a call to a type-bound subroutine.  */
+
+static gfc_try
+resolve_typebound_call (gfc_code* c, const char **name)
+{
+  gfc_actual_arglist* newactual;
+  gfc_symtree* target;
+
+  /* Check that's really a SUBROUTINE.  */
+  if (!c->expr1->value.compcall.tbp->subroutine)
+    {
+      gfc_error ("'%s' at %L should be a SUBROUTINE",
+		 c->expr1->value.compcall.name, &c->loc);
+      return FAILURE;
+    }
+
+  if (check_typebound_baseobject (c->expr1) == FAILURE)
+    return FAILURE;
+
+  /* Pass along the name for CLASS methods, where the vtab
+     procedure pointer component has to be referenced.  */
+  if (name)
+    *name = c->expr1->value.compcall.name;
+
+  if (resolve_typebound_generic_call (c->expr1, name) == FAILURE)
+    return FAILURE;
+
+  /* Transform into an ordinary EXEC_CALL for now.  */
+
+  if (resolve_typebound_static (c->expr1, &target, &newactual) == FAILURE)
+    return FAILURE;
+
+  c->ext.actual = newactual;
+  c->symtree = target;
+  c->op = (c->expr1->value.compcall.assign ? EXEC_ASSIGN_CALL : EXEC_CALL);
+
+  gcc_assert (!c->expr1->ref && !c->expr1->value.compcall.actual);
+
+  gfc_free_expr (c->expr1);
+  c->expr1 = gfc_get_expr ();
+  c->expr1->expr_type = EXPR_FUNCTION;
+  c->expr1->symtree = target;
+  c->expr1->where = c->loc;
+
+  return resolve_call (c);
+}
+
+
+/* Resolve a component-call expression.  */
+static gfc_try
+resolve_compcall (gfc_expr* e, const char **name)
+{
+  gfc_actual_arglist* newactual;
+  gfc_symtree* target;
+
+  /* Check that's really a FUNCTION.  */
+  if (!e->value.compcall.tbp->function)
+    {
+      gfc_error ("'%s' at %L should be a FUNCTION",
+		 e->value.compcall.name, &e->where);
+      return FAILURE;
+    }
+
+  /* These must not be assign-calls!  */
+  gcc_assert (!e->value.compcall.assign);
+
+  if (check_typebound_baseobject (e) == FAILURE)
+    return FAILURE;
+
+  /* Pass along the name for CLASS methods, where the vtab
+     procedure pointer component has to be referenced.  */
+  if (name)
+    *name = e->value.compcall.name;
+
+  if (resolve_typebound_generic_call (e, name) == FAILURE)
+    return FAILURE;
+  gcc_assert (!e->value.compcall.tbp->is_generic);
+
+  /* Take the rank from the function's symbol.  */
+  if (e->value.compcall.tbp->u.specific->n.sym->as)
+    e->rank = e->value.compcall.tbp->u.specific->n.sym->as->rank;
+
+  /* For now, we simply transform it into an EXPR_FUNCTION call with the same
+     arglist to the TBP's binding target.  */
+
+  if (resolve_typebound_static (e, &target, &newactual) == FAILURE)
+    return FAILURE;
+
+  e->value.function.actual = newactual;
+  e->value.function.name = NULL;
+  e->value.function.esym = target->n.sym;
+  e->value.function.isym = NULL;
+  e->symtree = target;
+  e->ts = target->n.sym->ts;
+  e->expr_type = EXPR_FUNCTION;
+
+  /* Resolution is not necessary if this is a class subroutine; this
+     function only has to identify the specific proc. Resolution of
+     the call will be done next in resolve_typebound_call.  */
+  return gfc_resolve_expr (e);
+}
+
+
+
+/* Resolve a typebound function, or 'method'. First separate all
+   the non-CLASS references by calling resolve_compcall directly.  */
+
+static gfc_try
+resolve_typebound_function (gfc_expr* e)
+{
+  gfc_symbol *declared;
+  gfc_component *c;
+  gfc_ref *new_ref;
+  gfc_ref *class_ref;
+  gfc_symtree *st;
+  const char *name;
+  gfc_typespec ts;
+  gfc_expr *expr;
+
+  st = e->symtree;
+
+  /* Deal with typebound operators for CLASS objects.  */
+  expr = e->value.compcall.base_object;
+  if (expr && expr->ts.type == BT_CLASS && e->value.compcall.name)
+    {
+      /* Since the typebound operators are generic, we have to ensure
+	 that any delays in resolution are corrected and that the vtab
+	 is present.  */
+      ts = expr->ts;
+      declared = ts.u.derived;
+      c = gfc_find_component (declared, "_vptr", true, true);
+      if (c->ts.u.derived == NULL)
+	c->ts.u.derived = gfc_find_derived_vtab (declared);
+
+      if (resolve_compcall (e, &name) == FAILURE)
+	return FAILURE;
+
+      /* Use the generic name if it is there.  */
+      name = name ? name : e->value.function.esym->name;
+      e->symtree = expr->symtree;
+      e->ref = gfc_copy_ref (expr->ref);
+      gfc_add_vptr_component (e);
+      gfc_add_component_ref (e, name);
+      e->value.function.esym = NULL;
+      return SUCCESS;
+    }
+
+  if (st == NULL)
+    return resolve_compcall (e, NULL);
+
+  if (resolve_ref (e) == FAILURE)
+    return FAILURE;
+
+  /* Get the CLASS declared type.  */
+  declared = get_declared_from_expr (&class_ref, &new_ref, e);
+
+  /* Weed out cases of the ultimate component being a derived type.  */
+  if ((class_ref && class_ref->u.c.component->ts.type == BT_DERIVED)
+	 || (!class_ref && st->n.sym->ts.type != BT_CLASS))
+    {
+      gfc_free_ref_list (new_ref);
+      return resolve_compcall (e, NULL);
+    }
+
+  c = gfc_find_component (declared, "_data", true, true);
+  declared = c->ts.u.derived;
+
+  /* Treat the call as if it is a typebound procedure, in order to roll
+     out the correct name for the specific function.  */
+  if (resolve_compcall (e, &name) == FAILURE)
+    return FAILURE;
+  ts = e->ts;
+
+  /* Then convert the expression to a procedure pointer component call.  */
+  e->value.function.esym = NULL;
+  e->symtree = st;
+
+  if (new_ref)  
+    e->ref = new_ref;
+
+  /* '_vptr' points to the vtab, which contains the procedure pointers.  */
+  gfc_add_vptr_component (e);
+  gfc_add_component_ref (e, name);
+
+  /* Recover the typespec for the expression.  This is really only
+     necessary for generic procedures, where the additional call
+     to gfc_add_component_ref seems to throw the collection of the
+     correct typespec.  */
+  e->ts = ts;
+  return SUCCESS;
+}
+
+/* Resolve a typebound subroutine, or 'method'. First separate all
+   the non-CLASS references by calling resolve_typebound_call
+   directly.  */
+
+static gfc_try
+resolve_typebound_subroutine (gfc_code *code)
+{
+  gfc_symbol *declared;
+  gfc_component *c;
+  gfc_ref *new_ref;
+  gfc_ref *class_ref;
+  gfc_symtree *st;
+  const char *name;
+  gfc_typespec ts;
+  gfc_expr *expr;
+
+  st = code->expr1->symtree;
+
+  /* Deal with typebound operators for CLASS objects.  */
+  expr = code->expr1->value.compcall.base_object;
+  if (expr && expr->ts.type == BT_CLASS && code->expr1->value.compcall.name)
+    {
+      /* Since the typebound operators are generic, we have to ensure
+	 that any delays in resolution are corrected and that the vtab
+	 is present.  */
+      declared = expr->ts.u.derived;
+      c = gfc_find_component (declared, "_vptr", true, true);
+      if (c->ts.u.derived == NULL)
+	c->ts.u.derived = gfc_find_derived_vtab (declared);
+
+      if (resolve_typebound_call (code, &name) == FAILURE)
+	return FAILURE;
+
+      /* Use the generic name if it is there.  */
+      name = name ? name : code->expr1->value.function.esym->name;
+      code->expr1->symtree = expr->symtree;
+      code->expr1->ref = gfc_copy_ref (expr->ref);
+      gfc_add_vptr_component (code->expr1);
+      gfc_add_component_ref (code->expr1, name);
+      code->expr1->value.function.esym = NULL;
+      return SUCCESS;
+    }
+
+  if (st == NULL)
+    return resolve_typebound_call (code, NULL);
+
+  if (resolve_ref (code->expr1) == FAILURE)
+    return FAILURE;
+
+  /* Get the CLASS declared type.  */
+  get_declared_from_expr (&class_ref, &new_ref, code->expr1);
+
+  /* Weed out cases of the ultimate component being a derived type.  */
+  if ((class_ref && class_ref->u.c.component->ts.type == BT_DERIVED)
+	 || (!class_ref && st->n.sym->ts.type != BT_CLASS))
+    {
+      gfc_free_ref_list (new_ref);
+      return resolve_typebound_call (code, NULL);
+    }
+
+  if (resolve_typebound_call (code, &name) == FAILURE)
+    return FAILURE;
+  ts = code->expr1->ts;
+
+  /* Then convert the expression to a procedure pointer component call.  */
+  code->expr1->value.function.esym = NULL;
+  code->expr1->symtree = st;
+
+  if (new_ref)
+    code->expr1->ref = new_ref;
+
+  /* '_vptr' points to the vtab, which contains the procedure pointers.  */
+  gfc_add_vptr_component (code->expr1);
+  gfc_add_component_ref (code->expr1, name);
+
+  /* Recover the typespec for the expression.  This is really only
+     necessary for generic procedures, where the additional call
+     to gfc_add_component_ref seems to throw the collection of the
+     correct typespec.  */
+  code->expr1->ts = ts;
+  return SUCCESS;
+}
+
+
+/* Resolve a CALL to a Procedure Pointer Component (Subroutine).  */
+
+static gfc_try
+resolve_ppc_call (gfc_code* c)
+{
+  gfc_component *comp;
+  bool b;
+
+  b = gfc_is_proc_ptr_comp (c->expr1, &comp);
+  gcc_assert (b);
+
+  c->resolved_sym = c->expr1->symtree->n.sym;
+  c->expr1->expr_type = EXPR_VARIABLE;
+
+  if (!comp->attr.subroutine)
+    gfc_add_subroutine (&comp->attr, comp->name, &c->expr1->where);
+
+  if (resolve_ref (c->expr1) == FAILURE)
+    return FAILURE;
+
+  if (update_ppc_arglist (c->expr1) == FAILURE)
+    return FAILURE;
+
+  c->ext.actual = c->expr1->value.compcall.actual;
+
+  if (resolve_actual_arglist (c->ext.actual, comp->attr.proc,
+			      comp->formal == NULL) == FAILURE)
+    return FAILURE;
+
+  gfc_ppc_use (comp, &c->expr1->value.compcall.actual, &c->expr1->where);
+
+  return SUCCESS;
+}
+
+
+/* Resolve a Function Call to a Procedure Pointer Component (Function).  */
+
+static gfc_try
+resolve_expr_ppc (gfc_expr* e)
+{
+  gfc_component *comp;
+  bool b;
+
+  b = gfc_is_proc_ptr_comp (e, &comp);
+  gcc_assert (b);
+
+  /* Convert to EXPR_FUNCTION.  */
+  e->expr_type = EXPR_FUNCTION;
+  e->value.function.isym = NULL;
+  e->value.function.actual = e->value.compcall.actual;
+  e->ts = comp->ts;
+  if (comp->as != NULL)
+    e->rank = comp->as->rank;
+
+  if (!comp->attr.function)
+    gfc_add_function (&comp->attr, comp->name, &e->where);
+
+  if (resolve_ref (e) == FAILURE)
+    return FAILURE;
+
+  if (resolve_actual_arglist (e->value.function.actual, comp->attr.proc,
+			      comp->formal == NULL) == FAILURE)
+    return FAILURE;
+
+  if (update_ppc_arglist (e) == FAILURE)
+    return FAILURE;
+
+  gfc_ppc_use (comp, &e->value.compcall.actual, &e->where);
+
+  return SUCCESS;
+}
+
+
+static bool
+gfc_is_expandable_expr (gfc_expr *e)
+{
+  gfc_constructor *con;
+
+  if (e->expr_type == EXPR_ARRAY)
+    {
+      /* Traverse the constructor looking for variables that are flavor
+	 parameter.  Parameters must be expanded since they are fully used at
+	 compile time.  */
+      con = gfc_constructor_first (e->value.constructor);
+      for (; con; con = gfc_constructor_next (con))
+	{
+	  if (con->expr->expr_type == EXPR_VARIABLE
+	      && con->expr->symtree
+	      && (con->expr->symtree->n.sym->attr.flavor == FL_PARAMETER
+	      || con->expr->symtree->n.sym->attr.flavor == FL_VARIABLE))
+	    return true;
+	  if (con->expr->expr_type == EXPR_ARRAY
+	      && gfc_is_expandable_expr (con->expr))
+	    return true;
+	}
+    }
+
+  return false;
+}
+
+/* Resolve an expression.  That is, make sure that types of operands agree
+   with their operators, intrinsic operators are converted to function calls
+   for overloaded types and unresolved function references are resolved.  */
+
+gfc_try
+gfc_resolve_expr (gfc_expr *e)
+{
+  gfc_try t;
+  bool inquiry_save;
+
+  if (e == NULL)
+    return SUCCESS;
+
+  /* inquiry_argument only applies to variables.  */
+  inquiry_save = inquiry_argument;
+  if (e->expr_type != EXPR_VARIABLE)
+    inquiry_argument = false;
+
+  switch (e->expr_type)
+    {
+    case EXPR_OP:
+      t = resolve_operator (e);
+      break;
+
+    case EXPR_FUNCTION:
+    case EXPR_VARIABLE:
+
+      if (check_host_association (e))
+	t = resolve_function (e);
+      else
+	{
+	  t = resolve_variable (e);
+	  if (t == SUCCESS)
+	    expression_rank (e);
+	}
+
+      if (e->ts.type == BT_CHARACTER && e->ts.u.cl == NULL && e->ref
+	  && e->ref->type != REF_SUBSTRING)
+	gfc_resolve_substring_charlen (e);
+
+      break;
+
+    case EXPR_COMPCALL:
+      t = resolve_typebound_function (e);
+      break;
+
+    case EXPR_SUBSTRING:
+      t = resolve_ref (e);
+      break;
+
+    case EXPR_CONSTANT:
+    case EXPR_NULL:
+      t = SUCCESS;
+      break;
+
+    case EXPR_PPC:
+      t = resolve_expr_ppc (e);
+      break;
+
+    case EXPR_ARRAY:
+      t = FAILURE;
+      if (resolve_ref (e) == FAILURE)
+	break;
+
+      t = gfc_resolve_array_constructor (e);
+      /* Also try to expand a constructor.  */
+      if (t == SUCCESS)
+	{
+	  expression_rank (e);
+	  if (gfc_is_constant_expr (e) || gfc_is_expandable_expr (e))
+	    gfc_expand_constructor (e, false);
+	}
+
+      /* This provides the opportunity for the length of constructors with
+	 character valued function elements to propagate the string length
+	 to the expression.  */
+      if (t == SUCCESS && e->ts.type == BT_CHARACTER)
+        {
+	  /* For efficiency, we call gfc_expand_constructor for BT_CHARACTER
+	     here rather then add a duplicate test for it above.  */ 
+	  gfc_expand_constructor (e, false);
+	  t = gfc_resolve_character_array_constructor (e);
+	}
+
+      break;
+
+    case EXPR_STRUCTURE:
+      t = resolve_ref (e);
+      if (t == FAILURE)
+	break;
+
+      t = resolve_structure_cons (e, 0);
+      if (t == FAILURE)
+	break;
+
+      t = gfc_simplify_expr (e, 0);
+      break;
+
+    default:
+      gfc_internal_error ("gfc_resolve_expr(): Bad expression type");
+    }
+
+  if (e->ts.type == BT_CHARACTER && t == SUCCESS && !e->ts.u.cl)
+    fixup_charlen (e);
+
+  inquiry_argument = inquiry_save;
+
+  return t;
+}
+
+
+/* Resolve an expression from an iterator.  They must be scalar and have
+   INTEGER or (optionally) REAL type.  */
+
+static gfc_try
+gfc_resolve_iterator_expr (gfc_expr *expr, bool real_ok,
+			   const char *name_msgid)
+{
+  if (gfc_resolve_expr (expr) == FAILURE)
+    return FAILURE;
+
+  if (expr->rank != 0)
+    {
+      gfc_error ("%s at %L must be a scalar", _(name_msgid), &expr->where);
+      return FAILURE;
+    }
+
+  if (expr->ts.type != BT_INTEGER)
+    {
+      if (expr->ts.type == BT_REAL)
+	{
+	  if (real_ok)
+	    return gfc_notify_std (GFC_STD_F95_DEL,
+				   "Deleted feature: %s at %L must be integer",
+				   _(name_msgid), &expr->where);
+	  else
+	    {
+	      gfc_error ("%s at %L must be INTEGER", _(name_msgid),
+			 &expr->where);
+	      return FAILURE;
+	    }
+	}
+      else
+	{
+	  gfc_error ("%s at %L must be INTEGER", _(name_msgid), &expr->where);
+	  return FAILURE;
+	}
+    }
+  return SUCCESS;
+}
+
+
+/* Resolve the expressions in an iterator structure.  If REAL_OK is
+   false allow only INTEGER type iterators, otherwise allow REAL types.  */
+
+gfc_try
+gfc_resolve_iterator (gfc_iterator *iter, bool real_ok)
+{
+  if (gfc_resolve_iterator_expr (iter->var, real_ok, "Loop variable")
+      == FAILURE)
+    return FAILURE;
+
+  if (gfc_check_vardef_context (iter->var, false, _("iterator variable"))
+      == FAILURE)
+    return FAILURE;
+
+  if (gfc_resolve_iterator_expr (iter->start, real_ok,
+				 "Start expression in DO loop") == FAILURE)
+    return FAILURE;
+
+  if (gfc_resolve_iterator_expr (iter->end, real_ok,
+				 "End expression in DO loop") == FAILURE)
+    return FAILURE;
+
+  if (gfc_resolve_iterator_expr (iter->step, real_ok,
+				 "Step expression in DO loop") == FAILURE)
+    return FAILURE;
+
+  if (iter->step->expr_type == EXPR_CONSTANT)
+    {
+      if ((iter->step->ts.type == BT_INTEGER
+	   && mpz_cmp_ui (iter->step->value.integer, 0) == 0)
+	  || (iter->step->ts.type == BT_REAL
+	      && mpfr_sgn (iter->step->value.real) == 0))
+	{
+	  gfc_error ("Step expression in DO loop at %L cannot be zero",
+		     &iter->step->where);
+	  return FAILURE;
+	}
+    }
+
+  /* Convert start, end, and step to the same type as var.  */
+  if (iter->start->ts.kind != iter->var->ts.kind
+      || iter->start->ts.type != iter->var->ts.type)
+    gfc_convert_type (iter->start, &iter->var->ts, 2);
+
+  if (iter->end->ts.kind != iter->var->ts.kind
+      || iter->end->ts.type != iter->var->ts.type)
+    gfc_convert_type (iter->end, &iter->var->ts, 2);
+
+  if (iter->step->ts.kind != iter->var->ts.kind
+      || iter->step->ts.type != iter->var->ts.type)
+    gfc_convert_type (iter->step, &iter->var->ts, 2);
+
+  if (iter->start->expr_type == EXPR_CONSTANT
+      && iter->end->expr_type == EXPR_CONSTANT
+      && iter->step->expr_type == EXPR_CONSTANT)
+    {
+      int sgn, cmp;
+      if (iter->start->ts.type == BT_INTEGER)
+	{
+	  sgn = mpz_cmp_ui (iter->step->value.integer, 0);
+	  cmp = mpz_cmp (iter->end->value.integer, iter->start->value.integer);
+	}
+      else
+	{
+	  sgn = mpfr_sgn (iter->step->value.real);
+	  cmp = mpfr_cmp (iter->end->value.real, iter->start->value.real);
+	}
+      if ((sgn > 0 && cmp < 0) || (sgn < 0 && cmp > 0))
+	gfc_warning ("DO loop at %L will be executed zero times",
+		     &iter->step->where);
+    }
+
+  return SUCCESS;
+}
+
+
+/* Traversal function for find_forall_index.  f == 2 signals that
+   that variable itself is not to be checked - only the references.  */
+
+static bool
+forall_index (gfc_expr *expr, gfc_symbol *sym, int *f)
+{
+  if (expr->expr_type != EXPR_VARIABLE)
+    return false;
+  
+  /* A scalar assignment  */
+  if (!expr->ref || *f == 1)
+    {
+      if (expr->symtree->n.sym == sym)
+	return true;
+      else
+	return false;
+    }
+
+  if (*f == 2)
+    *f = 1;
+  return false;
+}
+
+
+/* Check whether the FORALL index appears in the expression or not.
+   Returns SUCCESS if SYM is found in EXPR.  */
+
+gfc_try
+find_forall_index (gfc_expr *expr, gfc_symbol *sym, int f)
+{
+  if (gfc_traverse_expr (expr, sym, forall_index, f))
+    return SUCCESS;
+  else
+    return FAILURE;
+}
+
+
+/* Resolve a list of FORALL iterators.  The FORALL index-name is constrained
+   to be a scalar INTEGER variable.  The subscripts and stride are scalar
+   INTEGERs, and if stride is a constant it must be nonzero.
+   Furthermore "A subscript or stride in a forall-triplet-spec shall
+   not contain a reference to any index-name in the
+   forall-triplet-spec-list in which it appears." (7.5.4.1)  */
+
+static void
+resolve_forall_iterators (gfc_forall_iterator *it)
+{
+  gfc_forall_iterator *iter, *iter2;
+
+  for (iter = it; iter; iter = iter->next)
+    {
+      if (gfc_resolve_expr (iter->var) == SUCCESS
+	  && (iter->var->ts.type != BT_INTEGER || iter->var->rank != 0))
+	gfc_error ("FORALL index-name at %L must be a scalar INTEGER",
+		   &iter->var->where);
+
+      if (gfc_resolve_expr (iter->start) == SUCCESS
+	  && (iter->start->ts.type != BT_INTEGER || iter->start->rank != 0))
+	gfc_error ("FORALL start expression at %L must be a scalar INTEGER",
+		   &iter->start->where);
+      if (iter->var->ts.kind != iter->start->ts.kind)
+	gfc_convert_type (iter->start, &iter->var->ts, 2);
+
+      if (gfc_resolve_expr (iter->end) == SUCCESS
+	  && (iter->end->ts.type != BT_INTEGER || iter->end->rank != 0))
+	gfc_error ("FORALL end expression at %L must be a scalar INTEGER",
+		   &iter->end->where);
+      if (iter->var->ts.kind != iter->end->ts.kind)
+	gfc_convert_type (iter->end, &iter->var->ts, 2);
+
+      if (gfc_resolve_expr (iter->stride) == SUCCESS)
+	{
+	  if (iter->stride->ts.type != BT_INTEGER || iter->stride->rank != 0)
+	    gfc_error ("FORALL stride expression at %L must be a scalar %s",
+		       &iter->stride->where, "INTEGER");
+
+	  if (iter->stride->expr_type == EXPR_CONSTANT
+	      && mpz_cmp_ui(iter->stride->value.integer, 0) == 0)
+	    gfc_error ("FORALL stride expression at %L cannot be zero",
+		       &iter->stride->where);
+	}
+      if (iter->var->ts.kind != iter->stride->ts.kind)
+	gfc_convert_type (iter->stride, &iter->var->ts, 2);
+    }
+
+  for (iter = it; iter; iter = iter->next)
+    for (iter2 = iter; iter2; iter2 = iter2->next)
+      {
+	if (find_forall_index (iter2->start,
+			       iter->var->symtree->n.sym, 0) == SUCCESS
+	    || find_forall_index (iter2->end,
+				  iter->var->symtree->n.sym, 0) == SUCCESS
+	    || find_forall_index (iter2->stride,
+				  iter->var->symtree->n.sym, 0) == SUCCESS)
+	  gfc_error ("FORALL index '%s' may not appear in triplet "
+		     "specification at %L", iter->var->symtree->name,
+		     &iter2->start->where);
+      }
+}
+
+
+/* Given a pointer to a symbol that is a derived type, see if it's
+   inaccessible, i.e. if it's defined in another module and the components are
+   PRIVATE.  The search is recursive if necessary.  Returns zero if no
+   inaccessible components are found, nonzero otherwise.  */
+
+static int
+derived_inaccessible (gfc_symbol *sym)
+{
+  gfc_component *c;
+
+  if (sym->attr.use_assoc && sym->attr.private_comp)
+    return 1;
+
+  for (c = sym->components; c; c = c->next)
+    {
+	if (c->ts.type == BT_DERIVED && derived_inaccessible (c->ts.u.derived))
+	  return 1;
+    }
+
+  return 0;
+}
+
+
+/* Resolve the argument of a deallocate expression.  The expression must be
+   a pointer or a full array.  */
+
+static gfc_try
+resolve_deallocate_expr (gfc_expr *e)
+{
+  symbol_attribute attr;
+  int allocatable, pointer;
+  gfc_ref *ref;
+  gfc_symbol *sym;
+  gfc_component *c;
+
+  if (gfc_resolve_expr (e) == FAILURE)
+    return FAILURE;
+
+  if (e->expr_type != EXPR_VARIABLE)
+    goto bad;
+
+  sym = e->symtree->n.sym;
+
+  if (sym->ts.type == BT_CLASS)
+    {
+      allocatable = CLASS_DATA (sym)->attr.allocatable;
+      pointer = CLASS_DATA (sym)->attr.class_pointer;
+    }
+  else
+    {
+      allocatable = sym->attr.allocatable;
+      pointer = sym->attr.pointer;
+    }
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      switch (ref->type)
+	{
+	case REF_ARRAY:
+	  if (ref->u.ar.type != AR_FULL)
+	    allocatable = 0;
+	  break;
+
+	case REF_COMPONENT:
+	  c = ref->u.c.component;
+	  if (c->ts.type == BT_CLASS)
+	    {
+	      allocatable = CLASS_DATA (c)->attr.allocatable;
+	      pointer = CLASS_DATA (c)->attr.class_pointer;
+	    }
+	  else
+	    {
+	      allocatable = c->attr.allocatable;
+	      pointer = c->attr.pointer;
+	    }
+	  break;
+
+	case REF_SUBSTRING:
+	  allocatable = 0;
+	  break;
+	}
+    }
+
+  attr = gfc_expr_attr (e);
+
+  if (allocatable == 0 && attr.pointer == 0)
+    {
+    bad:
+      gfc_error ("Allocate-object at %L must be ALLOCATABLE or a POINTER",
+		 &e->where);
+      return FAILURE;
+    }
+
+  if (pointer
+      && gfc_check_vardef_context (e, true, _("DEALLOCATE object")) == FAILURE)
+    return FAILURE;
+  if (gfc_check_vardef_context (e, false, _("DEALLOCATE object")) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Returns true if the expression e contains a reference to the symbol sym.  */
+static bool
+sym_in_expr (gfc_expr *e, gfc_symbol *sym, int *f ATTRIBUTE_UNUSED)
+{
+  if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym == sym)
+    return true;
+
+  return false;
+}
+
+bool
+gfc_find_sym_in_expr (gfc_symbol *sym, gfc_expr *e)
+{
+  return gfc_traverse_expr (e, sym, sym_in_expr, 0);
+}
+
+
+/* Given the expression node e for an allocatable/pointer of derived type to be
+   allocated, get the expression node to be initialized afterwards (needed for
+   derived types with default initializers, and derived types with allocatable
+   components that need nullification.)  */
+
+gfc_expr *
+gfc_expr_to_initialize (gfc_expr *e)
+{
+  gfc_expr *result;
+  gfc_ref *ref;
+  int i;
+
+  result = gfc_copy_expr (e);
+
+  /* Change the last array reference from AR_ELEMENT to AR_FULL.  */
+  for (ref = result->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->next == NULL)
+      {
+	ref->u.ar.type = AR_FULL;
+
+	for (i = 0; i < ref->u.ar.dimen; i++)
+	  ref->u.ar.start[i] = ref->u.ar.end[i] = ref->u.ar.stride[i] = NULL;
+
+	break;
+      }
+
+  gfc_free_shape (&result->shape, result->rank);
+
+  /* Recalculate rank, shape, etc.  */
+  gfc_resolve_expr (result);
+  return result;
+}
+
+
+/* If the last ref of an expression is an array ref, return a copy of the
+   expression with that one removed.  Otherwise, a copy of the original
+   expression.  This is used for allocate-expressions and pointer assignment
+   LHS, where there may be an array specification that needs to be stripped
+   off when using gfc_check_vardef_context.  */
+
+static gfc_expr*
+remove_last_array_ref (gfc_expr* e)
+{
+  gfc_expr* e2;
+  gfc_ref** r;
+
+  e2 = gfc_copy_expr (e);
+  for (r = &e2->ref; *r; r = &(*r)->next)
+    if ((*r)->type == REF_ARRAY && !(*r)->next)
+      {
+	gfc_free_ref_list (*r);
+	*r = NULL;
+	break;
+      }
+
+  return e2;
+}
+
+
+/* Used in resolve_allocate_expr to check that a allocation-object and
+   a source-expr are conformable.  This does not catch all possible 
+   cases; in particular a runtime checking is needed.  */
+
+static gfc_try
+conformable_arrays (gfc_expr *e1, gfc_expr *e2)
+{
+  gfc_ref *tail;
+  for (tail = e2->ref; tail && tail->next; tail = tail->next);
+  
+  /* First compare rank.  */
+  if (tail && e1->rank != tail->u.ar.as->rank)
+    {
+      gfc_error ("Source-expr at %L must be scalar or have the "
+		 "same rank as the allocate-object at %L",
+		 &e1->where, &e2->where);
+      return FAILURE;
+    }
+
+  if (e1->shape)
+    {
+      int i;
+      mpz_t s;
+
+      mpz_init (s);
+
+      for (i = 0; i < e1->rank; i++)
+	{
+	  if (tail->u.ar.end[i])
+	    {
+	      mpz_set (s, tail->u.ar.end[i]->value.integer);
+	      mpz_sub (s, s, tail->u.ar.start[i]->value.integer);
+	      mpz_add_ui (s, s, 1);
+	    }
+	  else
+	    {
+	      mpz_set (s, tail->u.ar.start[i]->value.integer);
+	    }
+
+	  if (mpz_cmp (e1->shape[i], s) != 0)
+	    {
+	      gfc_error ("Source-expr at %L and allocate-object at %L must "
+			 "have the same shape", &e1->where, &e2->where);
+	      mpz_clear (s);
+   	      return FAILURE;
+	    }
+	}
+
+      mpz_clear (s);
+    }
+
+  return SUCCESS;
+}
+
+
+/* Resolve the expression in an ALLOCATE statement, doing the additional
+   checks to see whether the expression is OK or not.  The expression must
+   have a trailing array reference that gives the size of the array.  */
+
+static gfc_try
+resolve_allocate_expr (gfc_expr *e, gfc_code *code)
+{
+  int i, pointer, allocatable, dimension, is_abstract;
+  int codimension;
+  symbol_attribute attr;
+  gfc_ref *ref, *ref2;
+  gfc_expr *e2;
+  gfc_array_ref *ar;
+  gfc_symbol *sym = NULL;
+  gfc_alloc *a;
+  gfc_component *c;
+  gfc_try t;
+
+  /* Mark the ultimost array component as being in allocate to allow DIMEN_STAR
+     checking of coarrays.  */
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->next == NULL)
+      break;
+
+  if (ref && ref->type == REF_ARRAY)
+    ref->u.ar.in_allocate = true;
+
+  if (gfc_resolve_expr (e) == FAILURE)
+    goto failure;
+
+  /* Make sure the expression is allocatable or a pointer.  If it is
+     pointer, the next-to-last reference must be a pointer.  */
+
+  ref2 = NULL;
+  if (e->symtree)
+    sym = e->symtree->n.sym;
+
+  /* Check whether ultimate component is abstract and CLASS.  */
+  is_abstract = 0;
+
+  if (e->expr_type != EXPR_VARIABLE)
+    {
+      allocatable = 0;
+      attr = gfc_expr_attr (e);
+      pointer = attr.pointer;
+      dimension = attr.dimension;
+      codimension = attr.codimension;
+    }
+  else
+    {
+      if (sym->ts.type == BT_CLASS)
+	{
+	  allocatable = CLASS_DATA (sym)->attr.allocatable;
+	  pointer = CLASS_DATA (sym)->attr.class_pointer;
+	  dimension = CLASS_DATA (sym)->attr.dimension;
+	  codimension = CLASS_DATA (sym)->attr.codimension;
+	  is_abstract = CLASS_DATA (sym)->attr.abstract;
+	}
+      else
+	{
+	  allocatable = sym->attr.allocatable;
+	  pointer = sym->attr.pointer;
+	  dimension = sym->attr.dimension;
+	  codimension = sym->attr.codimension;
+	}
+
+      for (ref = e->ref; ref; ref2 = ref, ref = ref->next)
+	{
+	  switch (ref->type)
+	    {
+ 	      case REF_ARRAY:
+		if (ref->next != NULL)
+		  pointer = 0;
+		break;
+
+	      case REF_COMPONENT:
+		/* F2008, C644.  */
+		if (gfc_is_coindexed (e))
+		  {
+		    gfc_error ("Coindexed allocatable object at %L",
+			       &e->where);
+		    goto failure;
+		  }
+
+		c = ref->u.c.component;
+		if (c->ts.type == BT_CLASS)
+		  {
+		    allocatable = CLASS_DATA (c)->attr.allocatable;
+		    pointer = CLASS_DATA (c)->attr.class_pointer;
+		    dimension = CLASS_DATA (c)->attr.dimension;
+		    codimension = CLASS_DATA (c)->attr.codimension;
+		    is_abstract = CLASS_DATA (c)->attr.abstract;
+		  }
+		else
+		  {
+		    allocatable = c->attr.allocatable;
+		    pointer = c->attr.pointer;
+		    dimension = c->attr.dimension;
+		    codimension = c->attr.codimension;
+		    is_abstract = c->attr.abstract;
+		  }
+		break;
+
+	      case REF_SUBSTRING:
+		allocatable = 0;
+		pointer = 0;
+		break;
+	    }
+	}
+    }
+
+  if (allocatable == 0 && pointer == 0)
+    {
+      gfc_error ("Allocate-object at %L must be ALLOCATABLE or a POINTER",
+		 &e->where);
+      goto failure;
+    }
+
+  /* Some checks for the SOURCE tag.  */
+  if (code->expr3)
+    {
+      /* Check F03:C631.  */
+      if (!gfc_type_compatible (&e->ts, &code->expr3->ts))
+	{
+	  gfc_error ("Type of entity at %L is type incompatible with "
+		      "source-expr at %L", &e->where, &code->expr3->where);
+	  goto failure;
+	}
+
+      /* Check F03:C632 and restriction following Note 6.18.  */
+      if (code->expr3->rank > 0
+	  && conformable_arrays (code->expr3, e) == FAILURE)
+	goto failure;
+
+      /* Check F03:C633.  */
+      if (code->expr3->ts.kind != e->ts.kind)
+	{
+	  gfc_error ("The allocate-object at %L and the source-expr at %L "
+		      "shall have the same kind type parameter",
+		      &e->where, &code->expr3->where);
+	  goto failure;
+	}
+    }
+
+  /* Check F08:C629.  */
+  if (is_abstract && code->ext.alloc.ts.type == BT_UNKNOWN
+      && !code->expr3)
+    {
+      gcc_assert (e->ts.type == BT_CLASS);
+      gfc_error ("Allocating %s of ABSTRACT base type at %L requires a "
+		 "type-spec or source-expr", sym->name, &e->where);
+      goto failure;
+    }
+
+  /* In the variable definition context checks, gfc_expr_attr is used
+     on the expression.  This is fooled by the array specification
+     present in e, thus we have to eliminate that one temporarily.  */
+  e2 = remove_last_array_ref (e);
+  t = SUCCESS;
+  if (t == SUCCESS && pointer)
+    t = gfc_check_vardef_context (e2, true, _("ALLOCATE object"));
+  if (t == SUCCESS)
+    t = gfc_check_vardef_context (e2, false, _("ALLOCATE object"));
+  gfc_free_expr (e2);
+  if (t == FAILURE)
+    goto failure;
+
+  if (!code->expr3)
+    {
+      /* Set up default initializer if needed.  */
+      gfc_typespec ts;
+      gfc_expr *init_e;
+
+      if (code->ext.alloc.ts.type == BT_DERIVED)
+	ts = code->ext.alloc.ts;
+      else
+	ts = e->ts;
+
+      if (ts.type == BT_CLASS)
+	ts = ts.u.derived->components->ts;
+
+      if (ts.type == BT_DERIVED && (init_e = gfc_default_initializer (&ts)))
+	{
+	  gfc_code *init_st = gfc_get_code ();
+	  init_st->loc = code->loc;
+	  init_st->op = EXEC_INIT_ASSIGN;
+	  init_st->expr1 = gfc_expr_to_initialize (e);
+	  init_st->expr2 = init_e;
+	  init_st->next = code->next;
+	  code->next = init_st;
+	}
+    }
+  else if (code->expr3->mold && code->expr3->ts.type == BT_DERIVED)
+    {
+      /* Default initialization via MOLD (non-polymorphic).  */
+      gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts);
+      gfc_resolve_expr (rhs);
+      gfc_free_expr (code->expr3);
+      code->expr3 = rhs;
+    }
+
+  if (e->ts.type == BT_CLASS)
+    {
+      /* Make sure the vtab symbol is present when
+	 the module variables are generated.  */
+      gfc_typespec ts = e->ts;
+      if (code->expr3)
+	ts = code->expr3->ts;
+      else if (code->ext.alloc.ts.type == BT_DERIVED)
+	ts = code->ext.alloc.ts;
+      gfc_find_derived_vtab (ts.u.derived);
+    }
+
+  if (dimension == 0 && codimension == 0)
+    goto success;
+
+  /* Make sure the last reference node is an array specifiction.  */
+
+  if (!ref2 || ref2->type != REF_ARRAY || ref2->u.ar.type == AR_FULL
+      || (dimension && ref2->u.ar.dimen == 0))
+    {
+      gfc_error ("Array specification required in ALLOCATE statement "
+		 "at %L", &e->where);
+      goto failure;
+    }
+
+  /* Make sure that the array section reference makes sense in the
+    context of an ALLOCATE specification.  */
+
+  ar = &ref2->u.ar;
+
+  if (codimension && ar->codimen == 0)
+    {
+      gfc_error ("Coarray specification required in ALLOCATE statement "
+		 "at %L", &e->where);
+      goto failure;
+    }
+
+  for (i = 0; i < ar->dimen; i++)
+    {
+      if (ref2->u.ar.type == AR_ELEMENT)
+	goto check_symbols;
+
+      switch (ar->dimen_type[i])
+	{
+	case DIMEN_ELEMENT:
+	  break;
+
+	case DIMEN_RANGE:
+	  if (ar->start[i] != NULL
+	      && ar->end[i] != NULL
+	      && ar->stride[i] == NULL)
+	    break;
+
+	  /* Fall Through...  */
+
+	case DIMEN_UNKNOWN:
+	case DIMEN_VECTOR:
+	case DIMEN_STAR:
+	  gfc_error ("Bad array specification in ALLOCATE statement at %L",
+		     &e->where);
+	  goto failure;
+	}
+
+check_symbols:
+      for (a = code->ext.alloc.list; a; a = a->next)
+	{
+	  sym = a->expr->symtree->n.sym;
+
+	  /* TODO - check derived type components.  */
+	  if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
+	    continue;
+
+	  if ((ar->start[i] != NULL
+	       && gfc_find_sym_in_expr (sym, ar->start[i]))
+	      || (ar->end[i] != NULL
+		  && gfc_find_sym_in_expr (sym, ar->end[i])))
+	    {
+	      gfc_error ("'%s' must not appear in the array specification at "
+			 "%L in the same ALLOCATE statement where it is "
+			 "itself allocated", sym->name, &ar->where);
+	      goto failure;
+	    }
+	}
+    }
+
+  for (i = ar->dimen; i < ar->codimen + ar->dimen; i++)
+    {
+      if (ar->dimen_type[i] == DIMEN_ELEMENT
+	  || ar->dimen_type[i] == DIMEN_RANGE)
+	{
+	  if (i == (ar->dimen + ar->codimen - 1))
+	    {
+	      gfc_error ("Expected '*' in coindex specification in ALLOCATE "
+			 "statement at %L", &e->where);
+	      goto failure;
+	    }
+	  break;
+	}
+
+      if (ar->dimen_type[i] == DIMEN_STAR && i == (ar->dimen + ar->codimen - 1)
+	  && ar->stride[i] == NULL)
+	break;
+
+      gfc_error ("Bad coarray specification in ALLOCATE statement at %L",
+		 &e->where);
+      goto failure;
+    }
+
+  if (codimension && ar->as->rank == 0)
+    {
+      gfc_error ("Sorry, allocatable scalar coarrays are not yet supported "
+		 "at %L", &e->where);
+      goto failure;
+    }
+
+success:
+  return SUCCESS;
+
+failure:
+  return FAILURE;
+}
+
+static void
+resolve_allocate_deallocate (gfc_code *code, const char *fcn)
+{
+  gfc_expr *stat, *errmsg, *pe, *qe;
+  gfc_alloc *a, *p, *q;
+
+  stat = code->expr1;
+  errmsg = code->expr2;
+
+  /* Check the stat variable.  */
+  if (stat)
+    {
+      gfc_check_vardef_context (stat, false, _("STAT variable"));
+
+      if ((stat->ts.type != BT_INTEGER
+	   && !(stat->ref && (stat->ref->type == REF_ARRAY
+			      || stat->ref->type == REF_COMPONENT)))
+	  || stat->rank > 0)
+	gfc_error ("Stat-variable at %L must be a scalar INTEGER "
+		   "variable", &stat->where);
+
+      for (p = code->ext.alloc.list; p; p = p->next)
+	if (p->expr->symtree->n.sym->name == stat->symtree->n.sym->name)
+	  {
+	    gfc_ref *ref1, *ref2;
+	    bool found = true;
+
+	    for (ref1 = p->expr->ref, ref2 = stat->ref; ref1 && ref2;
+		 ref1 = ref1->next, ref2 = ref2->next)
+	      {
+		if (ref1->type != REF_COMPONENT || ref2->type != REF_COMPONENT)
+		  continue;
+		if (ref1->u.c.component->name != ref2->u.c.component->name)
+		  {
+		    found = false;
+		    break;
+		  }
+	      }
+
+	    if (found)
+	      {
+		gfc_error ("Stat-variable at %L shall not be %sd within "
+			   "the same %s statement", &stat->where, fcn, fcn);
+		break;
+	      }
+	  }
+    }
+
+  /* Check the errmsg variable.  */
+  if (errmsg)
+    {
+      if (!stat)
+	gfc_warning ("ERRMSG at %L is useless without a STAT tag",
+		     &errmsg->where);
+
+      gfc_check_vardef_context (errmsg, false, _("ERRMSG variable"));
+
+      if ((errmsg->ts.type != BT_CHARACTER
+	   && !(errmsg->ref
+		&& (errmsg->ref->type == REF_ARRAY
+		    || errmsg->ref->type == REF_COMPONENT)))
+	  || errmsg->rank > 0 )
+	gfc_error ("Errmsg-variable at %L must be a scalar CHARACTER "
+		   "variable", &errmsg->where);
+
+      for (p = code->ext.alloc.list; p; p = p->next)
+	if (p->expr->symtree->n.sym->name == errmsg->symtree->n.sym->name)
+	  {
+	    gfc_ref *ref1, *ref2;
+	    bool found = true;
+
+	    for (ref1 = p->expr->ref, ref2 = errmsg->ref; ref1 && ref2;
+		 ref1 = ref1->next, ref2 = ref2->next)
+	      {
+		if (ref1->type != REF_COMPONENT || ref2->type != REF_COMPONENT)
+		  continue;
+		if (ref1->u.c.component->name != ref2->u.c.component->name)
+		  {
+		    found = false;
+		    break;
+		  }
+	      }
+
+	    if (found)
+	      {
+		gfc_error ("Errmsg-variable at %L shall not be %sd within "
+			   "the same %s statement", &errmsg->where, fcn, fcn);
+		break;
+	      }
+	  }
+    }
+
+  /* Check that an allocate-object appears only once in the statement.  
+     FIXME: Checking derived types is disabled.  */
+  for (p = code->ext.alloc.list; p; p = p->next)
+    {
+      pe = p->expr;
+      for (q = p->next; q; q = q->next)
+	{
+	  qe = q->expr;
+	  if (pe->symtree->n.sym->name == qe->symtree->n.sym->name)
+	    {
+	      /* This is a potential collision.  */
+	      gfc_ref *pr = pe->ref;
+	      gfc_ref *qr = qe->ref;
+	      
+	      /* Follow the references  until
+		 a) They start to differ, in which case there is no error;
+		 you can deallocate a%b and a%c in a single statement
+		 b) Both of them stop, which is an error
+		 c) One of them stops, which is also an error.  */
+	      while (1)
+		{
+		  if (pr == NULL && qr == NULL)
+		    {
+		      gfc_error ("Allocate-object at %L also appears at %L",
+				 &pe->where, &qe->where);
+		      break;
+		    }
+		  else if (pr != NULL && qr == NULL)
+		    {
+		      gfc_error ("Allocate-object at %L is subobject of"
+				 " object at %L", &pe->where, &qe->where);
+		      break;
+		    }
+		  else if (pr == NULL && qr != NULL)
+		    {
+		      gfc_error ("Allocate-object at %L is subobject of"
+				 " object at %L", &qe->where, &pe->where);
+		      break;
+		    }
+		  /* Here, pr != NULL && qr != NULL  */
+		  gcc_assert(pr->type == qr->type);
+		  if (pr->type == REF_ARRAY)
+		    {
+		      /* Handle cases like allocate(v(3)%x(3), v(2)%x(3)),
+			 which are legal.  */
+		      gcc_assert (qr->type == REF_ARRAY);
+
+		      if (pr->next && qr->next)
+			{
+			  int i;
+			  gfc_array_ref *par = &(pr->u.ar);
+			  gfc_array_ref *qar = &(qr->u.ar);
+
+			  for (i=0; i<par->dimen; i++)
+			    {
+			      if ((par->start[i] != NULL
+				   || qar->start[i] != NULL)
+				  && gfc_dep_compare_expr (par->start[i],
+							   qar->start[i]) != 0)
+				goto break_label;
+			    }
+			}
+		    }
+		  else
+		    {
+		      if (pr->u.c.component->name != qr->u.c.component->name)
+			break;
+		    }
+		  
+		  pr = pr->next;
+		  qr = qr->next;
+		}
+	    break_label:
+	      ;
+	    }
+	}
+    }
+
+  if (strcmp (fcn, "ALLOCATE") == 0)
+    {
+      for (a = code->ext.alloc.list; a; a = a->next)
+	resolve_allocate_expr (a->expr, code);
+    }
+  else
+    {
+      for (a = code->ext.alloc.list; a; a = a->next)
+	resolve_deallocate_expr (a->expr);
+    }
+}
+
+
+/************ SELECT CASE resolution subroutines ************/
+
+/* Callback function for our mergesort variant.  Determines interval
+   overlaps for CASEs. Return <0 if op1 < op2, 0 for overlap, >0 for
+   op1 > op2.  Assumes we're not dealing with the default case.  
+   We have op1 = (:L), (K:L) or (K:) and op2 = (:N), (M:N) or (M:).
+   There are nine situations to check.  */
+
+static int
+compare_cases (const gfc_case *op1, const gfc_case *op2)
+{
+  int retval;
+
+  if (op1->low == NULL) /* op1 = (:L)  */
+    {
+      /* op2 = (:N), so overlap.  */
+      retval = 0;
+      /* op2 = (M:) or (M:N),  L < M  */
+      if (op2->low != NULL
+	  && gfc_compare_expr (op1->high, op2->low, INTRINSIC_LT) < 0)
+	retval = -1;
+    }
+  else if (op1->high == NULL) /* op1 = (K:)  */
+    {
+      /* op2 = (M:), so overlap.  */
+      retval = 0;
+      /* op2 = (:N) or (M:N), K > N  */
+      if (op2->high != NULL
+	  && gfc_compare_expr (op1->low, op2->high, INTRINSIC_GT) > 0)
+	retval = 1;
+    }
+  else /* op1 = (K:L)  */
+    {
+      if (op2->low == NULL)       /* op2 = (:N), K > N  */
+	retval = (gfc_compare_expr (op1->low, op2->high, INTRINSIC_GT) > 0)
+		 ? 1 : 0;
+      else if (op2->high == NULL) /* op2 = (M:), L < M  */
+	retval = (gfc_compare_expr (op1->high, op2->low, INTRINSIC_LT) < 0)
+		 ? -1 : 0;
+      else			/* op2 = (M:N)  */
+	{
+	  retval =  0;
+	  /* L < M  */
+	  if (gfc_compare_expr (op1->high, op2->low, INTRINSIC_LT) < 0)
+	    retval =  -1;
+	  /* K > N  */
+	  else if (gfc_compare_expr (op1->low, op2->high, INTRINSIC_GT) > 0)
+	    retval =  1;
+	}
+    }
+
+  return retval;
+}
+
+
+/* Merge-sort a double linked case list, detecting overlap in the
+   process.  LIST is the head of the double linked case list before it
+   is sorted.  Returns the head of the sorted list if we don't see any
+   overlap, or NULL otherwise.  */
+
+static gfc_case *
+check_case_overlap (gfc_case *list)
+{
+  gfc_case *p, *q, *e, *tail;
+  int insize, nmerges, psize, qsize, cmp, overlap_seen;
+
+  /* If the passed list was empty, return immediately.  */
+  if (!list)
+    return NULL;
+
+  overlap_seen = 0;
+  insize = 1;
+
+  /* Loop unconditionally.  The only exit from this loop is a return
+     statement, when we've finished sorting the case list.  */
+  for (;;)
+    {
+      p = list;
+      list = NULL;
+      tail = NULL;
+
+      /* Count the number of merges we do in this pass.  */
+      nmerges = 0;
+
+      /* Loop while there exists a merge to be done.  */
+      while (p)
+	{
+	  int i;
+
+	  /* Count this merge.  */
+	  nmerges++;
+
+	  /* Cut the list in two pieces by stepping INSIZE places
+	     forward in the list, starting from P.  */
+	  psize = 0;
+	  q = p;
+	  for (i = 0; i < insize; i++)
+	    {
+	      psize++;
+	      q = q->right;
+	      if (!q)
+		break;
+	    }
+	  qsize = insize;
+
+	  /* Now we have two lists.  Merge them!  */
+	  while (psize > 0 || (qsize > 0 && q != NULL))
+	    {
+	      /* See from which the next case to merge comes from.  */
+	      if (psize == 0)
+		{
+		  /* P is empty so the next case must come from Q.  */
+		  e = q;
+		  q = q->right;
+		  qsize--;
+		}
+	      else if (qsize == 0 || q == NULL)
+		{
+		  /* Q is empty.  */
+		  e = p;
+		  p = p->right;
+		  psize--;
+		}
+	      else
+		{
+		  cmp = compare_cases (p, q);
+		  if (cmp < 0)
+		    {
+		      /* The whole case range for P is less than the
+			 one for Q.  */
+		      e = p;
+		      p = p->right;
+		      psize--;
+		    }
+		  else if (cmp > 0)
+		    {
+		      /* The whole case range for Q is greater than
+			 the case range for P.  */
+		      e = q;
+		      q = q->right;
+		      qsize--;
+		    }
+		  else
+		    {
+		      /* The cases overlap, or they are the same
+			 element in the list.  Either way, we must
+			 issue an error and get the next case from P.  */
+		      /* FIXME: Sort P and Q by line number.  */
+		      gfc_error ("CASE label at %L overlaps with CASE "
+				 "label at %L", &p->where, &q->where);
+		      overlap_seen = 1;
+		      e = p;
+		      p = p->right;
+		      psize--;
+		    }
+		}
+
+		/* Add the next element to the merged list.  */
+	      if (tail)
+		tail->right = e;
+	      else
+		list = e;
+	      e->left = tail;
+	      tail = e;
+	    }
+
+	  /* P has now stepped INSIZE places along, and so has Q.  So
+	     they're the same.  */
+	  p = q;
+	}
+      tail->right = NULL;
+
+      /* If we have done only one merge or none at all, we've
+	 finished sorting the cases.  */
+      if (nmerges <= 1)
+	{
+	  if (!overlap_seen)
+	    return list;
+	  else
+	    return NULL;
+	}
+
+      /* Otherwise repeat, merging lists twice the size.  */
+      insize *= 2;
+    }
+}
+
+
+/* Check to see if an expression is suitable for use in a CASE statement.
+   Makes sure that all case expressions are scalar constants of the same
+   type.  Return FAILURE if anything is wrong.  */
+
+static gfc_try
+validate_case_label_expr (gfc_expr *e, gfc_expr *case_expr)
+{
+  if (e == NULL) return SUCCESS;
+
+  if (e->ts.type != case_expr->ts.type)
+    {
+      gfc_error ("Expression in CASE statement at %L must be of type %s",
+		 &e->where, gfc_basic_typename (case_expr->ts.type));
+      return FAILURE;
+    }
+
+  /* C805 (R808) For a given case-construct, each case-value shall be of
+     the same type as case-expr.  For character type, length differences
+     are allowed, but the kind type parameters shall be the same.  */
+
+  if (case_expr->ts.type == BT_CHARACTER && e->ts.kind != case_expr->ts.kind)
+    {
+      gfc_error ("Expression in CASE statement at %L must be of kind %d",
+		 &e->where, case_expr->ts.kind);
+      return FAILURE;
+    }
+
+  /* Convert the case value kind to that of case expression kind,
+     if needed */
+
+  if (e->ts.kind != case_expr->ts.kind)
+    gfc_convert_type_warn (e, &case_expr->ts, 2, 0);
+
+  if (e->rank != 0)
+    {
+      gfc_error ("Expression in CASE statement at %L must be scalar",
+		 &e->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Given a completely parsed select statement, we:
+
+     - Validate all expressions and code within the SELECT.
+     - Make sure that the selection expression is not of the wrong type.
+     - Make sure that no case ranges overlap.
+     - Eliminate unreachable cases and unreachable code resulting from
+       removing case labels.
+
+   The standard does allow unreachable cases, e.g. CASE (5:3).  But
+   they are a hassle for code generation, and to prevent that, we just
+   cut them out here.  This is not necessary for overlapping cases
+   because they are illegal and we never even try to generate code.
+
+   We have the additional caveat that a SELECT construct could have
+   been a computed GOTO in the source code. Fortunately we can fairly
+   easily work around that here: The case_expr for a "real" SELECT CASE
+   is in code->expr1, but for a computed GOTO it is in code->expr2. All
+   we have to do is make sure that the case_expr is a scalar integer
+   expression.  */
+
+static void
+resolve_select (gfc_code *code)
+{
+  gfc_code *body;
+  gfc_expr *case_expr;
+  gfc_case *cp, *default_case, *tail, *head;
+  int seen_unreachable;
+  int seen_logical;
+  int ncases;
+  bt type;
+  gfc_try t;
+
+  if (code->expr1 == NULL)
+    {
+      /* This was actually a computed GOTO statement.  */
+      case_expr = code->expr2;
+      if (case_expr->ts.type != BT_INTEGER|| case_expr->rank != 0)
+	gfc_error ("Selection expression in computed GOTO statement "
+		   "at %L must be a scalar integer expression",
+		   &case_expr->where);
+
+      /* Further checking is not necessary because this SELECT was built
+	 by the compiler, so it should always be OK.  Just move the
+	 case_expr from expr2 to expr so that we can handle computed
+	 GOTOs as normal SELECTs from here on.  */
+      code->expr1 = code->expr2;
+      code->expr2 = NULL;
+      return;
+    }
+
+  case_expr = code->expr1;
+
+  type = case_expr->ts.type;
+  if (type != BT_LOGICAL && type != BT_INTEGER && type != BT_CHARACTER)
+    {
+      gfc_error ("Argument of SELECT statement at %L cannot be %s",
+		 &case_expr->where, gfc_typename (&case_expr->ts));
+
+      /* Punt. Going on here just produce more garbage error messages.  */
+      return;
+    }
+
+  if (case_expr->rank != 0)
+    {
+      gfc_error ("Argument of SELECT statement at %L must be a scalar "
+		 "expression", &case_expr->where);
+
+      /* Punt.  */
+      return;
+    }
+
+
+  /* Raise a warning if an INTEGER case value exceeds the range of
+     the case-expr. Later, all expressions will be promoted to the
+     largest kind of all case-labels.  */
+
+  if (type == BT_INTEGER)
+    for (body = code->block; body; body = body->block)
+      for (cp = body->ext.block.case_list; cp; cp = cp->next)
+	{
+	  if (cp->low
+	      && gfc_check_integer_range (cp->low->value.integer,
+					  case_expr->ts.kind) != ARITH_OK)
+	    gfc_warning ("Expression in CASE statement at %L is "
+			 "not in the range of %s", &cp->low->where,
+			 gfc_typename (&case_expr->ts));
+
+	  if (cp->high
+	      && cp->low != cp->high
+	      && gfc_check_integer_range (cp->high->value.integer,
+					  case_expr->ts.kind) != ARITH_OK)
+	    gfc_warning ("Expression in CASE statement at %L is "
+			 "not in the range of %s", &cp->high->where,
+			 gfc_typename (&case_expr->ts));
+	}
+
+  /* PR 19168 has a long discussion concerning a mismatch of the kinds
+     of the SELECT CASE expression and its CASE values.  Walk the lists
+     of case values, and if we find a mismatch, promote case_expr to
+     the appropriate kind.  */
+
+  if (type == BT_LOGICAL || type == BT_INTEGER)
+    {
+      for (body = code->block; body; body = body->block)
+	{
+	  /* Walk the case label list.  */
+	  for (cp = body->ext.block.case_list; cp; cp = cp->next)
+	    {
+	      /* Intercept the DEFAULT case.  It does not have a kind.  */
+	      if (cp->low == NULL && cp->high == NULL)
+		continue;
+
+	      /* Unreachable case ranges are discarded, so ignore.  */
+	      if (cp->low != NULL && cp->high != NULL
+		  && cp->low != cp->high
+		  && gfc_compare_expr (cp->low, cp->high, INTRINSIC_GT) > 0)
+		continue;
+
+	      if (cp->low != NULL
+		  && case_expr->ts.kind != gfc_kind_max(case_expr, cp->low))
+		gfc_convert_type_warn (case_expr, &cp->low->ts, 2, 0);
+
+	      if (cp->high != NULL
+		  && case_expr->ts.kind != gfc_kind_max(case_expr, cp->high))
+		gfc_convert_type_warn (case_expr, &cp->high->ts, 2, 0);
+	    }
+	 }
+    }
+
+  /* Assume there is no DEFAULT case.  */
+  default_case = NULL;
+  head = tail = NULL;
+  ncases = 0;
+  seen_logical = 0;
+
+  for (body = code->block; body; body = body->block)
+    {
+      /* Assume the CASE list is OK, and all CASE labels can be matched.  */
+      t = SUCCESS;
+      seen_unreachable = 0;
+
+      /* Walk the case label list, making sure that all case labels
+	 are legal.  */
+      for (cp = body->ext.block.case_list; cp; cp = cp->next)
+	{
+	  /* Count the number of cases in the whole construct.  */
+	  ncases++;
+
+	  /* Intercept the DEFAULT case.  */
+	  if (cp->low == NULL && cp->high == NULL)
+	    {
+	      if (default_case != NULL)
+		{
+		  gfc_error ("The DEFAULT CASE at %L cannot be followed "
+			     "by a second DEFAULT CASE at %L",
+			     &default_case->where, &cp->where);
+		  t = FAILURE;
+		  break;
+		}
+	      else
+		{
+		  default_case = cp;
+		  continue;
+		}
+	    }
+
+	  /* Deal with single value cases and case ranges.  Errors are
+	     issued from the validation function.  */
+	  if (validate_case_label_expr (cp->low, case_expr) != SUCCESS
+	      || validate_case_label_expr (cp->high, case_expr) != SUCCESS)
+	    {
+	      t = FAILURE;
+	      break;
+	    }
+
+	  if (type == BT_LOGICAL
+	      && ((cp->low == NULL || cp->high == NULL)
+		  || cp->low != cp->high))
+	    {
+	      gfc_error ("Logical range in CASE statement at %L is not "
+			 "allowed", &cp->low->where);
+	      t = FAILURE;
+	      break;
+	    }
+
+	  if (type == BT_LOGICAL && cp->low->expr_type == EXPR_CONSTANT)
+	    {
+	      int value;
+	      value = cp->low->value.logical == 0 ? 2 : 1;
+	      if (value & seen_logical)
+		{
+		  gfc_error ("Constant logical value in CASE statement "
+			     "is repeated at %L",
+			     &cp->low->where);
+		  t = FAILURE;
+		  break;
+		}
+	      seen_logical |= value;
+	    }
+
+	  if (cp->low != NULL && cp->high != NULL
+	      && cp->low != cp->high
+	      && gfc_compare_expr (cp->low, cp->high, INTRINSIC_GT) > 0)
+	    {
+	      if (gfc_option.warn_surprising)
+		gfc_warning ("Range specification at %L can never "
+			     "be matched", &cp->where);
+
+	      cp->unreachable = 1;
+	      seen_unreachable = 1;
+	    }
+	  else
+	    {
+	      /* If the case range can be matched, it can also overlap with
+		 other cases.  To make sure it does not, we put it in a
+		 double linked list here.  We sort that with a merge sort
+		 later on to detect any overlapping cases.  */
+	      if (!head)
+		{
+		  head = tail = cp;
+		  head->right = head->left = NULL;
+		}
+	      else
+		{
+		  tail->right = cp;
+		  tail->right->left = tail;
+		  tail = tail->right;
+		  tail->right = NULL;
+		}
+	    }
+	}
+
+      /* It there was a failure in the previous case label, give up
+	 for this case label list.  Continue with the next block.  */
+      if (t == FAILURE)
+	continue;
+
+      /* See if any case labels that are unreachable have been seen.
+	 If so, we eliminate them.  This is a bit of a kludge because
+	 the case lists for a single case statement (label) is a
+	 single forward linked lists.  */
+      if (seen_unreachable)
+      {
+	/* Advance until the first case in the list is reachable.  */
+	while (body->ext.block.case_list != NULL
+	       && body->ext.block.case_list->unreachable)
+	  {
+	    gfc_case *n = body->ext.block.case_list;
+	    body->ext.block.case_list = body->ext.block.case_list->next;
+	    n->next = NULL;
+	    gfc_free_case_list (n);
+	  }
+
+	/* Strip all other unreachable cases.  */
+	if (body->ext.block.case_list)
+	  {
+	    for (cp = body->ext.block.case_list; cp->next; cp = cp->next)
+	      {
+		if (cp->next->unreachable)
+		  {
+		    gfc_case *n = cp->next;
+		    cp->next = cp->next->next;
+		    n->next = NULL;
+		    gfc_free_case_list (n);
+		  }
+	      }
+	  }
+      }
+    }
+
+  /* See if there were overlapping cases.  If the check returns NULL,
+     there was overlap.  In that case we don't do anything.  If head
+     is non-NULL, we prepend the DEFAULT case.  The sorted list can
+     then used during code generation for SELECT CASE constructs with
+     a case expression of a CHARACTER type.  */
+  if (head)
+    {
+      head = check_case_overlap (head);
+
+      /* Prepend the default_case if it is there.  */
+      if (head != NULL && default_case)
+	{
+	  default_case->left = NULL;
+	  default_case->right = head;
+	  head->left = default_case;
+	}
+    }
+
+  /* Eliminate dead blocks that may be the result if we've seen
+     unreachable case labels for a block.  */
+  for (body = code; body && body->block; body = body->block)
+    {
+      if (body->block->ext.block.case_list == NULL)
+	{
+	  /* Cut the unreachable block from the code chain.  */
+	  gfc_code *c = body->block;
+	  body->block = c->block;
+
+	  /* Kill the dead block, but not the blocks below it.  */
+	  c->block = NULL;
+	  gfc_free_statements (c);
+	}
+    }
+
+  /* More than two cases is legal but insane for logical selects.
+     Issue a warning for it.  */
+  if (gfc_option.warn_surprising && type == BT_LOGICAL
+      && ncases > 2)
+    gfc_warning ("Logical SELECT CASE block at %L has more that two cases",
+		 &code->loc);
+}
+
+
+/* Check if a derived type is extensible.  */
+
+bool
+gfc_type_is_extensible (gfc_symbol *sym)
+{
+  return !(sym->attr.is_bind_c || sym->attr.sequence);
+}
+
+
+/* Resolve an associate name:  Resolve target and ensure the type-spec is
+   correct as well as possibly the array-spec.  */
+
+static void
+resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
+{
+  gfc_expr* target;
+
+  gcc_assert (sym->assoc);
+  gcc_assert (sym->attr.flavor == FL_VARIABLE);
+
+  /* If this is for SELECT TYPE, the target may not yet be set.  In that
+     case, return.  Resolution will be called later manually again when
+     this is done.  */
+  target = sym->assoc->target;
+  if (!target)
+    return;
+  gcc_assert (!sym->assoc->dangling);
+
+  if (resolve_target && gfc_resolve_expr (target) != SUCCESS)
+    return;
+
+  /* For variable targets, we get some attributes from the target.  */
+  if (target->expr_type == EXPR_VARIABLE)
+    {
+      gfc_symbol* tsym;
+
+      gcc_assert (target->symtree);
+      tsym = target->symtree->n.sym;
+
+      sym->attr.asynchronous = tsym->attr.asynchronous;
+      sym->attr.volatile_ = tsym->attr.volatile_;
+
+      sym->attr.target = (tsym->attr.target || tsym->attr.pointer);
+    }
+
+  /* Get type if this was not already set.  Note that it can be
+     some other type than the target in case this is a SELECT TYPE
+     selector!  So we must not update when the type is already there.  */
+  if (sym->ts.type == BT_UNKNOWN)
+    sym->ts = target->ts;
+  gcc_assert (sym->ts.type != BT_UNKNOWN);
+
+  /* See if this is a valid association-to-variable.  */
+  sym->assoc->variable = (target->expr_type == EXPR_VARIABLE
+			  && !gfc_has_vector_subscript (target));
+
+  /* Finally resolve if this is an array or not.  */
+  if (sym->attr.dimension && target->rank == 0)
+    {
+      gfc_error ("Associate-name '%s' at %L is used as array",
+		 sym->name, &sym->declared_at);
+      sym->attr.dimension = 0;
+      return;
+    }
+  if (target->rank > 0)
+    sym->attr.dimension = 1;
+
+  if (sym->attr.dimension)
+    {
+      sym->as = gfc_get_array_spec ();
+      sym->as->rank = target->rank;
+      sym->as->type = AS_DEFERRED;
+
+      /* Target must not be coindexed, thus the associate-variable
+	 has no corank.  */
+      sym->as->corank = 0;
+    }
+}
+
+
+/* Resolve a SELECT TYPE statement.  */
+
+static void
+resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
+{
+  gfc_symbol *selector_type;
+  gfc_code *body, *new_st, *if_st, *tail;
+  gfc_code *class_is = NULL, *default_case = NULL;
+  gfc_case *c;
+  gfc_symtree *st;
+  char name[GFC_MAX_SYMBOL_LEN];
+  gfc_namespace *ns;
+  int error = 0;
+
+  ns = code->ext.block.ns;
+  gfc_resolve (ns);
+
+  /* Check for F03:C813.  */
+  if (code->expr1->ts.type != BT_CLASS
+      && !(code->expr2 && code->expr2->ts.type == BT_CLASS))
+    {
+      gfc_error ("Selector shall be polymorphic in SELECT TYPE statement "
+		 "at %L", &code->loc);
+      return;
+    }
+
+  if (code->expr2)
+    {
+      if (code->expr1->symtree->n.sym->attr.untyped)
+	code->expr1->symtree->n.sym->ts = code->expr2->ts;
+      selector_type = CLASS_DATA (code->expr2)->ts.u.derived;
+    }
+  else
+    selector_type = CLASS_DATA (code->expr1)->ts.u.derived;
+
+  /* Loop over TYPE IS / CLASS IS cases.  */
+  for (body = code->block; body; body = body->block)
+    {
+      c = body->ext.block.case_list;
+
+      /* Check F03:C815.  */
+      if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
+	  && !gfc_type_is_extensible (c->ts.u.derived))
+	{
+	  gfc_error ("Derived type '%s' at %L must be extensible",
+		     c->ts.u.derived->name, &c->where);
+	  error++;
+	  continue;
+	}
+
+      /* Check F03:C816.  */
+      if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
+	  && !gfc_type_is_extension_of (selector_type, c->ts.u.derived))
+	{
+	  gfc_error ("Derived type '%s' at %L must be an extension of '%s'",
+		     c->ts.u.derived->name, &c->where, selector_type->name);
+	  error++;
+	  continue;
+	}
+
+      /* Intercept the DEFAULT case.  */
+      if (c->ts.type == BT_UNKNOWN)
+	{
+	  /* Check F03:C818.  */
+	  if (default_case)
+	    {
+	      gfc_error ("The DEFAULT CASE at %L cannot be followed "
+			 "by a second DEFAULT CASE at %L",
+			 &default_case->ext.block.case_list->where, &c->where);
+	      error++;
+	      continue;
+	    }
+
+	  default_case = body;
+	}
+    }
+    
+  if (error > 0)
+    return;
+
+  /* Transform SELECT TYPE statement to BLOCK and associate selector to
+     target if present.  If there are any EXIT statements referring to the
+     SELECT TYPE construct, this is no problem because the gfc_code
+     reference stays the same and EXIT is equally possible from the BLOCK
+     it is changed to.  */
+  code->op = EXEC_BLOCK;
+  if (code->expr2)
+    {
+      gfc_association_list* assoc;
+
+      assoc = gfc_get_association_list ();
+      assoc->st = code->expr1->symtree;
+      assoc->target = gfc_copy_expr (code->expr2);
+      /* assoc->variable will be set by resolve_assoc_var.  */
+      
+      code->ext.block.assoc = assoc;
+      code->expr1->symtree->n.sym->assoc = assoc;
+
+      resolve_assoc_var (code->expr1->symtree->n.sym, false);
+    }
+  else
+    code->ext.block.assoc = NULL;
+
+  /* Add EXEC_SELECT to switch on type.  */
+  new_st = gfc_get_code ();
+  new_st->op = code->op;
+  new_st->expr1 = code->expr1;
+  new_st->expr2 = code->expr2;
+  new_st->block = code->block;
+  code->expr1 = code->expr2 =  NULL;
+  code->block = NULL;
+  if (!ns->code)
+    ns->code = new_st;
+  else
+    ns->code->next = new_st;
+  code = new_st;
+  code->op = EXEC_SELECT;
+  gfc_add_vptr_component (code->expr1);
+  gfc_add_hash_component (code->expr1);
+
+  /* Loop over TYPE IS / CLASS IS cases.  */
+  for (body = code->block; body; body = body->block)
+    {
+      c = body->ext.block.case_list;
+
+      if (c->ts.type == BT_DERIVED)
+	c->low = c->high = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+					     c->ts.u.derived->hash_value);
+
+      else if (c->ts.type == BT_UNKNOWN)
+	continue;
+
+      /* Associate temporary to selector.  This should only be done
+	 when this case is actually true, so build a new ASSOCIATE
+	 that does precisely this here (instead of using the
+	 'global' one).  */
+
+      if (c->ts.type == BT_CLASS)
+	sprintf (name, "__tmp_class_%s", c->ts.u.derived->name);
+      else
+	sprintf (name, "__tmp_type_%s", c->ts.u.derived->name);
+      st = gfc_find_symtree (ns->sym_root, name);
+      gcc_assert (st->n.sym->assoc);
+      st->n.sym->assoc->target = gfc_get_variable_expr (code->expr1->symtree);
+      if (c->ts.type == BT_DERIVED)
+	gfc_add_data_component (st->n.sym->assoc->target);
+
+      new_st = gfc_get_code ();
+      new_st->op = EXEC_BLOCK;
+      new_st->ext.block.ns = gfc_build_block_ns (ns);
+      new_st->ext.block.ns->code = body->next;
+      body->next = new_st;
+
+      /* Chain in the new list only if it is marked as dangling.  Otherwise
+	 there is a CASE label overlap and this is already used.  Just ignore,
+	 the error is diagonsed elsewhere.  */
+      if (st->n.sym->assoc->dangling)
+	{
+	  new_st->ext.block.assoc = st->n.sym->assoc;
+	  st->n.sym->assoc->dangling = 0;
+	}
+
+      resolve_assoc_var (st->n.sym, false);
+    }
+    
+  /* Take out CLASS IS cases for separate treatment.  */
+  body = code;
+  while (body && body->block)
+    {
+      if (body->block->ext.block.case_list->ts.type == BT_CLASS)
+	{
+	  /* Add to class_is list.  */
+	  if (class_is == NULL)
+	    { 
+	      class_is = body->block;
+	      tail = class_is;
+	    }
+	  else
+	    {
+	      for (tail = class_is; tail->block; tail = tail->block) ;
+	      tail->block = body->block;
+	      tail = tail->block;
+	    }
+	  /* Remove from EXEC_SELECT list.  */
+	  body->block = body->block->block;
+	  tail->block = NULL;
+	}
+      else
+	body = body->block;
+    }
+
+  if (class_is)
+    {
+      gfc_symbol *vtab;
+      
+      if (!default_case)
+	{
+	  /* Add a default case to hold the CLASS IS cases.  */
+	  for (tail = code; tail->block; tail = tail->block) ;
+	  tail->block = gfc_get_code ();
+	  tail = tail->block;
+	  tail->op = EXEC_SELECT_TYPE;
+	  tail->ext.block.case_list = gfc_get_case ();
+	  tail->ext.block.case_list->ts.type = BT_UNKNOWN;
+	  tail->next = NULL;
+	  default_case = tail;
+	}
+
+      /* More than one CLASS IS block?  */
+      if (class_is->block)
+	{
+	  gfc_code **c1,*c2;
+	  bool swapped;
+	  /* Sort CLASS IS blocks by extension level.  */
+	  do
+	    {
+	      swapped = false;
+	      for (c1 = &class_is; (*c1) && (*c1)->block; c1 = &((*c1)->block))
+		{
+		  c2 = (*c1)->block;
+		  /* F03:C817 (check for doubles).  */
+		  if ((*c1)->ext.block.case_list->ts.u.derived->hash_value
+		      == c2->ext.block.case_list->ts.u.derived->hash_value)
+		    {
+		      gfc_error ("Double CLASS IS block in SELECT TYPE "
+				 "statement at %L",
+				 &c2->ext.block.case_list->where);
+		      return;
+		    }
+		  if ((*c1)->ext.block.case_list->ts.u.derived->attr.extension
+		      < c2->ext.block.case_list->ts.u.derived->attr.extension)
+		    {
+		      /* Swap.  */
+		      (*c1)->block = c2->block;
+		      c2->block = *c1;
+		      *c1 = c2;
+		      swapped = true;
+		    }
+		}
+	    }
+	  while (swapped);
+	}
+	
+      /* Generate IF chain.  */
+      if_st = gfc_get_code ();
+      if_st->op = EXEC_IF;
+      new_st = if_st;
+      for (body = class_is; body; body = body->block)
+	{
+	  new_st->block = gfc_get_code ();
+	  new_st = new_st->block;
+	  new_st->op = EXEC_IF;
+	  /* Set up IF condition: Call _gfortran_is_extension_of.  */
+	  new_st->expr1 = gfc_get_expr ();
+	  new_st->expr1->expr_type = EXPR_FUNCTION;
+	  new_st->expr1->ts.type = BT_LOGICAL;
+	  new_st->expr1->ts.kind = 4;
+	  new_st->expr1->value.function.name = gfc_get_string (PREFIX ("is_extension_of"));
+	  new_st->expr1->value.function.isym = XCNEW (gfc_intrinsic_sym);
+	  new_st->expr1->value.function.isym->id = GFC_ISYM_EXTENDS_TYPE_OF;
+	  /* Set up arguments.  */
+	  new_st->expr1->value.function.actual = gfc_get_actual_arglist ();
+	  new_st->expr1->value.function.actual->expr = gfc_get_variable_expr (code->expr1->symtree);
+	  new_st->expr1->value.function.actual->expr->where = code->loc;
+	  gfc_add_vptr_component (new_st->expr1->value.function.actual->expr);
+	  vtab = gfc_find_derived_vtab (body->ext.block.case_list->ts.u.derived);
+	  st = gfc_find_symtree (vtab->ns->sym_root, vtab->name);
+	  new_st->expr1->value.function.actual->next = gfc_get_actual_arglist ();
+	  new_st->expr1->value.function.actual->next->expr = gfc_get_variable_expr (st);
+	  new_st->next = body->next;
+	}
+	if (default_case->next)
+	  {
+	    new_st->block = gfc_get_code ();
+	    new_st = new_st->block;
+	    new_st->op = EXEC_IF;
+	    new_st->next = default_case->next;
+	  }
+	  
+	/* Replace CLASS DEFAULT code by the IF chain.  */
+	default_case->next = if_st;
+    }
+
+  /* Resolve the internal code.  This can not be done earlier because
+     it requires that the sym->assoc of selectors is set already.  */
+  gfc_current_ns = ns;
+  gfc_resolve_blocks (code->block, gfc_current_ns);
+  gfc_current_ns = old_ns;
+
+  resolve_select (code);
+}
+
+
+/* Resolve a transfer statement. This is making sure that:
+   -- a derived type being transferred has only non-pointer components
+   -- a derived type being transferred doesn't have private components, unless 
+      it's being transferred from the module where the type was defined
+   -- we're not trying to transfer a whole assumed size array.  */
+
+static void
+resolve_transfer (gfc_code *code)
+{
+  gfc_typespec *ts;
+  gfc_symbol *sym;
+  gfc_ref *ref;
+  gfc_expr *exp;
+
+  exp = code->expr1;
+
+  while (exp != NULL && exp->expr_type == EXPR_OP
+	 && exp->value.op.op == INTRINSIC_PARENTHESES)
+    exp = exp->value.op.op1;
+
+  if (exp == NULL || (exp->expr_type != EXPR_VARIABLE
+		      && exp->expr_type != EXPR_FUNCTION))
+    return;
+
+  /* If we are reading, the variable will be changed.  Note that
+     code->ext.dt may be NULL if the TRANSFER is related to
+     an INQUIRE statement -- but in this case, we are not reading, either.  */
+  if (code->ext.dt && code->ext.dt->dt_io_kind->value.iokind == M_READ
+      && gfc_check_vardef_context (exp, false, _("item in READ")) == FAILURE)
+    return;
+
+  sym = exp->symtree->n.sym;
+  ts = &sym->ts;
+
+  /* Go to actual component transferred.  */
+  for (ref = exp->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT)
+      ts = &ref->u.c.component->ts;
+
+  if (ts->type == BT_CLASS)
+    {
+      /* FIXME: Test for defined input/output.  */
+      gfc_error ("Data transfer element at %L cannot be polymorphic unless "
+                "it is processed by a defined input/output procedure",
+                &code->loc);
+      return;
+    }
+
+  if (ts->type == BT_DERIVED)
+    {
+      /* Check that transferred derived type doesn't contain POINTER
+	 components.  */
+      if (ts->u.derived->attr.pointer_comp)
+	{
+	  gfc_error ("Data transfer element at %L cannot have "
+		     "POINTER components", &code->loc);
+	  return;
+	}
+
+      /* F08:C935.  */
+      if (ts->u.derived->attr.proc_pointer_comp)
+	{
+	  gfc_error ("Data transfer element at %L cannot have "
+		     "procedure pointer components", &code->loc);
+	  return;
+	}
+
+      if (ts->u.derived->attr.alloc_comp)
+	{
+	  gfc_error ("Data transfer element at %L cannot have "
+		     "ALLOCATABLE components", &code->loc);
+	  return;
+	}
+
+      if (derived_inaccessible (ts->u.derived))
+	{
+	  gfc_error ("Data transfer element at %L cannot have "
+		     "PRIVATE components",&code->loc);
+	  return;
+	}
+    }
+
+  if (sym->as != NULL && sym->as->type == AS_ASSUMED_SIZE
+      && exp->ref->type == REF_ARRAY && exp->ref->u.ar.type == AR_FULL)
+    {
+      gfc_error ("Data transfer element at %L cannot be a full reference to "
+		 "an assumed-size array", &code->loc);
+      return;
+    }
+}
+
+
+/*********** Toplevel code resolution subroutines ***********/
+
+/* Find the set of labels that are reachable from this block.  We also
+   record the last statement in each block.  */
+     
+static void
+find_reachable_labels (gfc_code *block)
+{
+  gfc_code *c;
+
+  if (!block)
+    return;
+
+  cs_base->reachable_labels = bitmap_obstack_alloc (&labels_obstack);
+
+  /* Collect labels in this block.  We don't keep those corresponding
+     to END {IF|SELECT}, these are checked in resolve_branch by going
+     up through the code_stack.  */
+  for (c = block; c; c = c->next)
+    {
+      if (c->here && c->op != EXEC_END_BLOCK)
+	bitmap_set_bit (cs_base->reachable_labels, c->here->value);
+    }
+
+  /* Merge with labels from parent block.  */
+  if (cs_base->prev)
+    {
+      gcc_assert (cs_base->prev->reachable_labels);
+      bitmap_ior_into (cs_base->reachable_labels,
+		       cs_base->prev->reachable_labels);
+    }
+}
+
+
+static void
+resolve_sync (gfc_code *code)
+{
+  /* Check imageset. The * case matches expr1 == NULL.  */
+  if (code->expr1)
+    {
+      if (code->expr1->ts.type != BT_INTEGER || code->expr1->rank > 1)
+	gfc_error ("Imageset argument at %L must be a scalar or rank-1 "
+		   "INTEGER expression", &code->expr1->where);
+      if (code->expr1->expr_type == EXPR_CONSTANT && code->expr1->rank == 0
+	  && mpz_cmp_si (code->expr1->value.integer, 1) < 0)
+	gfc_error ("Imageset argument at %L must between 1 and num_images()",
+		   &code->expr1->where);
+      else if (code->expr1->expr_type == EXPR_ARRAY
+	       && gfc_simplify_expr (code->expr1, 0) == SUCCESS)
+	{
+	   gfc_constructor *cons;
+	   cons = gfc_constructor_first (code->expr1->value.constructor);
+	   for (; cons; cons = gfc_constructor_next (cons))
+	     if (cons->expr->expr_type == EXPR_CONSTANT
+		 &&  mpz_cmp_si (cons->expr->value.integer, 1) < 0)
+	       gfc_error ("Imageset argument at %L must between 1 and "
+			  "num_images()", &cons->expr->where);
+	}
+    }
+
+  /* Check STAT.  */
+  if (code->expr2
+      && (code->expr2->ts.type != BT_INTEGER || code->expr2->rank != 0
+	  || code->expr2->expr_type != EXPR_VARIABLE))
+    gfc_error ("STAT= argument at %L must be a scalar INTEGER variable",
+	       &code->expr2->where);
+
+  /* Check ERRMSG.  */
+  if (code->expr3
+      && (code->expr3->ts.type != BT_CHARACTER || code->expr3->rank != 0
+	  || code->expr3->expr_type != EXPR_VARIABLE))
+    gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable",
+	       &code->expr3->where);
+}
+
+
+/* Given a branch to a label, see if the branch is conforming.
+   The code node describes where the branch is located.  */
+
+static void
+resolve_branch (gfc_st_label *label, gfc_code *code)
+{
+  code_stack *stack;
+
+  if (label == NULL)
+    return;
+
+  /* Step one: is this a valid branching target?  */
+
+  if (label->defined == ST_LABEL_UNKNOWN)
+    {
+      gfc_error ("Label %d referenced at %L is never defined", label->value,
+		 &label->where);
+      return;
+    }
+
+  if (label->defined != ST_LABEL_TARGET)
+    {
+      gfc_error ("Statement at %L is not a valid branch target statement "
+		 "for the branch statement at %L", &label->where, &code->loc);
+      return;
+    }
+
+  /* Step two: make sure this branch is not a branch to itself ;-)  */
+
+  if (code->here == label)
+    {
+      gfc_warning ("Branch at %L may result in an infinite loop", &code->loc);
+      return;
+    }
+
+  /* Step three:  See if the label is in the same block as the
+     branching statement.  The hard work has been done by setting up
+     the bitmap reachable_labels.  */
+
+  if (bitmap_bit_p (cs_base->reachable_labels, label->value))
+    {
+      /* Check now whether there is a CRITICAL construct; if so, check
+	 whether the label is still visible outside of the CRITICAL block,
+	 which is invalid.  */
+      for (stack = cs_base; stack; stack = stack->prev)
+	if (stack->current->op == EXEC_CRITICAL
+	    && bitmap_bit_p (stack->reachable_labels, label->value))
+	  gfc_error ("GOTO statement at %L leaves CRITICAL construct for label"
+		      " at %L", &code->loc, &label->where);
+
+      return;
+    }
+
+  /* Step four:  If we haven't found the label in the bitmap, it may
+    still be the label of the END of the enclosing block, in which
+    case we find it by going up the code_stack.  */
+
+  for (stack = cs_base; stack; stack = stack->prev)
+    {
+      if (stack->current->next && stack->current->next->here == label)
+	break;
+      if (stack->current->op == EXEC_CRITICAL)
+	{
+	  /* Note: A label at END CRITICAL does not leave the CRITICAL
+	     construct as END CRITICAL is still part of it.  */
+	  gfc_error ("GOTO statement at %L leaves CRITICAL construct for label"
+		      " at %L", &code->loc, &label->where);
+	  return;
+	}
+    }
+
+  if (stack)
+    {
+      gcc_assert (stack->current->next->op == EXEC_END_BLOCK);
+      return;
+    }
+
+  /* The label is not in an enclosing block, so illegal.  This was
+     allowed in Fortran 66, so we allow it as extension.  No
+     further checks are necessary in this case.  */
+  gfc_notify_std (GFC_STD_LEGACY, "Label at %L is not in the same block "
+		  "as the GOTO statement at %L", &label->where,
+		  &code->loc);
+  return;
+}
+
+
+/* Check whether EXPR1 has the same shape as EXPR2.  */
+
+static gfc_try
+resolve_where_shape (gfc_expr *expr1, gfc_expr *expr2)
+{
+  mpz_t shape[GFC_MAX_DIMENSIONS];
+  mpz_t shape2[GFC_MAX_DIMENSIONS];
+  gfc_try result = FAILURE;
+  int i;
+
+  /* Compare the rank.  */
+  if (expr1->rank != expr2->rank)
+    return result;
+
+  /* Compare the size of each dimension.  */
+  for (i=0; i<expr1->rank; i++)
+    {
+      if (gfc_array_dimen_size (expr1, i, &shape[i]) == FAILURE)
+	goto ignore;
+
+      if (gfc_array_dimen_size (expr2, i, &shape2[i]) == FAILURE)
+	goto ignore;
+
+      if (mpz_cmp (shape[i], shape2[i]))
+	goto over;
+    }
+
+  /* When either of the two expression is an assumed size array, we
+     ignore the comparison of dimension sizes.  */
+ignore:
+  result = SUCCESS;
+
+over:
+  gfc_clear_shape (shape, i);
+  gfc_clear_shape (shape2, i);
+  return result;
+}
+
+
+/* Check whether a WHERE assignment target or a WHERE mask expression
+   has the same shape as the outmost WHERE mask expression.  */
+
+static void
+resolve_where (gfc_code *code, gfc_expr *mask)
+{
+  gfc_code *cblock;
+  gfc_code *cnext;
+  gfc_expr *e = NULL;
+
+  cblock = code->block;
+
+  /* Store the first WHERE mask-expr of the WHERE statement or construct.
+     In case of nested WHERE, only the outmost one is stored.  */
+  if (mask == NULL) /* outmost WHERE */
+    e = cblock->expr1;
+  else /* inner WHERE */
+    e = mask;
+
+  while (cblock)
+    {
+      if (cblock->expr1)
+	{
+	  /* Check if the mask-expr has a consistent shape with the
+	     outmost WHERE mask-expr.  */
+	  if (resolve_where_shape (cblock->expr1, e) == FAILURE)
+	    gfc_error ("WHERE mask at %L has inconsistent shape",
+		       &cblock->expr1->where);
+	 }
+
+      /* the assignment statement of a WHERE statement, or the first
+	 statement in where-body-construct of a WHERE construct */
+      cnext = cblock->next;
+      while (cnext)
+	{
+	  switch (cnext->op)
+	    {
+	    /* WHERE assignment statement */
+	    case EXEC_ASSIGN:
+
+	      /* Check shape consistent for WHERE assignment target.  */
+	      if (e && resolve_where_shape (cnext->expr1, e) == FAILURE)
+	       gfc_error ("WHERE assignment target at %L has "
+			  "inconsistent shape", &cnext->expr1->where);
+	      break;
+
+  
+	    case EXEC_ASSIGN_CALL:
+	      resolve_call (cnext);
+	      if (!cnext->resolved_sym->attr.elemental)
+		gfc_error("Non-ELEMENTAL user-defined assignment in WHERE at %L",
+			  &cnext->ext.actual->expr->where);
+	      break;
+
+	    /* WHERE or WHERE construct is part of a where-body-construct */
+	    case EXEC_WHERE:
+	      resolve_where (cnext, e);
+	      break;
+
+	    default:
+	      gfc_error ("Unsupported statement inside WHERE at %L",
+			 &cnext->loc);
+	    }
+	 /* the next statement within the same where-body-construct */
+	 cnext = cnext->next;
+       }
+    /* the next masked-elsewhere-stmt, elsewhere-stmt, or end-where-stmt */
+    cblock = cblock->block;
+  }
+}
+
+
+/* Resolve assignment in FORALL construct.
+   NVAR is the number of FORALL index variables, and VAR_EXPR records the
+   FORALL index variables.  */
+
+static void
+gfc_resolve_assign_in_forall (gfc_code *code, int nvar, gfc_expr **var_expr)
+{
+  int n;
+
+  for (n = 0; n < nvar; n++)
+    {
+      gfc_symbol *forall_index;
+
+      forall_index = var_expr[n]->symtree->n.sym;
+
+      /* Check whether the assignment target is one of the FORALL index
+	 variable.  */
+      if ((code->expr1->expr_type == EXPR_VARIABLE)
+	  && (code->expr1->symtree->n.sym == forall_index))
+	gfc_error ("Assignment to a FORALL index variable at %L",
+		   &code->expr1->where);
+      else
+	{
+	  /* If one of the FORALL index variables doesn't appear in the
+	     assignment variable, then there could be a many-to-one
+	     assignment.  Emit a warning rather than an error because the
+	     mask could be resolving this problem.  */
+	  if (find_forall_index (code->expr1, forall_index, 0) == FAILURE)
+	    gfc_warning ("The FORALL with index '%s' is not used on the "
+			 "left side of the assignment at %L and so might "
+			 "cause multiple assignment to this object",
+			 var_expr[n]->symtree->name, &code->expr1->where);
+	}
+    }
+}
+
+
+/* Resolve WHERE statement in FORALL construct.  */
+
+static void
+gfc_resolve_where_code_in_forall (gfc_code *code, int nvar,
+				  gfc_expr **var_expr)
+{
+  gfc_code *cblock;
+  gfc_code *cnext;
+
+  cblock = code->block;
+  while (cblock)
+    {
+      /* the assignment statement of a WHERE statement, or the first
+	 statement in where-body-construct of a WHERE construct */
+      cnext = cblock->next;
+      while (cnext)
+	{
+	  switch (cnext->op)
+	    {
+	    /* WHERE assignment statement */
+	    case EXEC_ASSIGN:
+	      gfc_resolve_assign_in_forall (cnext, nvar, var_expr);
+	      break;
+  
+	    /* WHERE operator assignment statement */
+	    case EXEC_ASSIGN_CALL:
+	      resolve_call (cnext);
+	      if (!cnext->resolved_sym->attr.elemental)
+		gfc_error("Non-ELEMENTAL user-defined assignment in WHERE at %L",
+			  &cnext->ext.actual->expr->where);
+	      break;
+
+	    /* WHERE or WHERE construct is part of a where-body-construct */
+	    case EXEC_WHERE:
+	      gfc_resolve_where_code_in_forall (cnext, nvar, var_expr);
+	      break;
+
+	    default:
+	      gfc_error ("Unsupported statement inside WHERE at %L",
+			 &cnext->loc);
+	    }
+	  /* the next statement within the same where-body-construct */
+	  cnext = cnext->next;
+	}
+      /* the next masked-elsewhere-stmt, elsewhere-stmt, or end-where-stmt */
+      cblock = cblock->block;
+    }
+}
+
+
+/* Traverse the FORALL body to check whether the following errors exist:
+   1. For assignment, check if a many-to-one assignment happens.
+   2. For WHERE statement, check the WHERE body to see if there is any
+      many-to-one assignment.  */
+
+static void
+gfc_resolve_forall_body (gfc_code *code, int nvar, gfc_expr **var_expr)
+{
+  gfc_code *c;
+
+  c = code->block->next;
+  while (c)
+    {
+      switch (c->op)
+	{
+	case EXEC_ASSIGN:
+	case EXEC_POINTER_ASSIGN:
+	  gfc_resolve_assign_in_forall (c, nvar, var_expr);
+	  break;
+
+	case EXEC_ASSIGN_CALL:
+	  resolve_call (c);
+	  break;
+
+	/* Because the gfc_resolve_blocks() will handle the nested FORALL,
+	   there is no need to handle it here.  */
+	case EXEC_FORALL:
+	  break;
+	case EXEC_WHERE:
+	  gfc_resolve_where_code_in_forall(c, nvar, var_expr);
+	  break;
+	default:
+	  break;
+	}
+      /* The next statement in the FORALL body.  */
+      c = c->next;
+    }
+}
+
+
+/* Counts the number of iterators needed inside a forall construct, including
+   nested forall constructs. This is used to allocate the needed memory 
+   in gfc_resolve_forall.  */
+
+static int 
+gfc_count_forall_iterators (gfc_code *code)
+{
+  int max_iters, sub_iters, current_iters;
+  gfc_forall_iterator *fa;
+
+  gcc_assert(code->op == EXEC_FORALL);
+  max_iters = 0;
+  current_iters = 0;
+
+  for (fa = code->ext.forall_iterator; fa; fa = fa->next)
+    current_iters ++;
+  
+  code = code->block->next;
+
+  while (code)
+    {          
+      if (code->op == EXEC_FORALL)
+        {
+          sub_iters = gfc_count_forall_iterators (code);
+          if (sub_iters > max_iters)
+            max_iters = sub_iters;
+        }
+      code = code->next;
+    }
+
+  return current_iters + max_iters;
+}
+
+
+/* Given a FORALL construct, first resolve the FORALL iterator, then call
+   gfc_resolve_forall_body to resolve the FORALL body.  */
+
+static void
+gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
+{
+  static gfc_expr **var_expr;
+  static int total_var = 0;
+  static int nvar = 0;
+  int old_nvar, tmp;
+  gfc_forall_iterator *fa;
+  int i;
+
+  old_nvar = nvar;
+
+  /* Start to resolve a FORALL construct   */
+  if (forall_save == 0)
+    {
+      /* Count the total number of FORALL index in the nested FORALL
+         construct in order to allocate the VAR_EXPR with proper size.  */
+      total_var = gfc_count_forall_iterators (code);
+
+      /* Allocate VAR_EXPR with NUMBER_OF_FORALL_INDEX elements.  */
+      var_expr = (gfc_expr **) gfc_getmem (total_var * sizeof (gfc_expr *));
+    }
+
+  /* The information about FORALL iterator, including FORALL index start, end
+     and stride. The FORALL index can not appear in start, end or stride.  */
+  for (fa = code->ext.forall_iterator; fa; fa = fa->next)
+    {
+      /* Check if any outer FORALL index name is the same as the current
+	 one.  */
+      for (i = 0; i < nvar; i++)
+	{
+	  if (fa->var->symtree->n.sym == var_expr[i]->symtree->n.sym)
+	    {
+	      gfc_error ("An outer FORALL construct already has an index "
+			 "with this name %L", &fa->var->where);
+	    }
+	}
+
+      /* Record the current FORALL index.  */
+      var_expr[nvar] = gfc_copy_expr (fa->var);
+
+      nvar++;
+
+      /* No memory leak.  */
+      gcc_assert (nvar <= total_var);
+    }
+
+  /* Resolve the FORALL body.  */
+  gfc_resolve_forall_body (code, nvar, var_expr);
+
+  /* May call gfc_resolve_forall to resolve the inner FORALL loop.  */
+  gfc_resolve_blocks (code->block, ns);
+
+  tmp = nvar;
+  nvar = old_nvar;
+  /* Free only the VAR_EXPRs allocated in this frame.  */
+  for (i = nvar; i < tmp; i++)
+     gfc_free_expr (var_expr[i]);
+
+  if (nvar == 0)
+    {
+      /* We are in the outermost FORALL construct.  */
+      gcc_assert (forall_save == 0);
+
+      /* VAR_EXPR is not needed any more.  */
+      gfc_free (var_expr);
+      total_var = 0;
+    }
+}
+
+
+/* Resolve a BLOCK construct statement.  */
+
+static void
+resolve_block_construct (gfc_code* code)
+{
+  /* Resolve the BLOCK's namespace.  */
+  gfc_resolve (code->ext.block.ns);
+
+  /* For an ASSOCIATE block, the associations (and their targets) are already
+     resolved during resolve_symbol.  */
+}
+
+
+/* Resolve lists of blocks found in IF, SELECT CASE, WHERE, FORALL, GOTO and
+   DO code nodes.  */
+
+static void resolve_code (gfc_code *, gfc_namespace *);
+
+void
+gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
+{
+  gfc_try t;
+
+  for (; b; b = b->block)
+    {
+      t = gfc_resolve_expr (b->expr1);
+      if (gfc_resolve_expr (b->expr2) == FAILURE)
+	t = FAILURE;
+
+      switch (b->op)
+	{
+	case EXEC_IF:
+	  if (t == SUCCESS && b->expr1 != NULL
+	      && (b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0))
+	    gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
+		       &b->expr1->where);
+	  break;
+
+	case EXEC_WHERE:
+	  if (t == SUCCESS
+	      && b->expr1 != NULL
+	      && (b->expr1->ts.type != BT_LOGICAL || b->expr1->rank == 0))
+	    gfc_error ("WHERE/ELSEWHERE clause at %L requires a LOGICAL array",
+		       &b->expr1->where);
+	  break;
+
+	case EXEC_GOTO:
+	  resolve_branch (b->label1, b);
+	  break;
+
+	case EXEC_BLOCK:
+	  resolve_block_construct (b);
+	  break;
+
+	case EXEC_SELECT:
+	case EXEC_SELECT_TYPE:
+	case EXEC_FORALL:
+	case EXEC_DO:
+	case EXEC_DO_WHILE:
+	case EXEC_CRITICAL:
+	case EXEC_READ:
+	case EXEC_WRITE:
+	case EXEC_IOLENGTH:
+	case EXEC_WAIT:
+	  break;
+
+	case EXEC_OMP_ATOMIC:
+	case EXEC_OMP_CRITICAL:
+	case EXEC_OMP_DO:
+	case EXEC_OMP_MASTER:
+	case EXEC_OMP_ORDERED:
+	case EXEC_OMP_PARALLEL:
+	case EXEC_OMP_PARALLEL_DO:
+	case EXEC_OMP_PARALLEL_SECTIONS:
+	case EXEC_OMP_PARALLEL_WORKSHARE:
+	case EXEC_OMP_SECTIONS:
+	case EXEC_OMP_SINGLE:
+	case EXEC_OMP_TASK:
+	case EXEC_OMP_TASKWAIT:
+	case EXEC_OMP_WORKSHARE:
+	  break;
+
+	default:
+	  gfc_internal_error ("gfc_resolve_blocks(): Bad block type");
+	}
+
+      resolve_code (b->next, ns);
+    }
+}
+
+
+/* Does everything to resolve an ordinary assignment.  Returns true
+   if this is an interface assignment.  */
+static bool
+resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
+{
+  bool rval = false;
+  gfc_expr *lhs;
+  gfc_expr *rhs;
+  int llen = 0;
+  int rlen = 0;
+  int n;
+  gfc_ref *ref;
+
+  if (gfc_extend_assign (code, ns) == SUCCESS)
+    {
+      gfc_expr** rhsptr;
+
+      if (code->op == EXEC_ASSIGN_CALL)
+	{
+	  lhs = code->ext.actual->expr;
+	  rhsptr = &code->ext.actual->next->expr;
+	}
+      else
+	{
+	  gfc_actual_arglist* args;
+	  gfc_typebound_proc* tbp;
+
+	  gcc_assert (code->op == EXEC_COMPCALL);
+
+	  args = code->expr1->value.compcall.actual;
+	  lhs = args->expr;
+	  rhsptr = &args->next->expr;
+
+	  tbp = code->expr1->value.compcall.tbp;
+	  gcc_assert (!tbp->is_generic);
+	}
+
+      /* Make a temporary rhs when there is a default initializer
+	 and rhs is the same symbol as the lhs.  */
+      if ((*rhsptr)->expr_type == EXPR_VARIABLE
+	    && (*rhsptr)->symtree->n.sym->ts.type == BT_DERIVED
+	    && gfc_has_default_initializer ((*rhsptr)->symtree->n.sym->ts.u.derived)
+	    && (lhs->symtree->n.sym == (*rhsptr)->symtree->n.sym))
+	*rhsptr = gfc_get_parentheses (*rhsptr);
+
+      return true;
+    }
+
+  lhs = code->expr1;
+  rhs = code->expr2;
+
+  if (rhs->is_boz
+      && gfc_notify_std (GFC_STD_GNU, "Extension: BOZ literal at %L outside "
+			 "a DATA statement and outside INT/REAL/DBLE/CMPLX",
+			 &code->loc) == FAILURE)
+    return false;
+
+  /* Handle the case of a BOZ literal on the RHS.  */
+  if (rhs->is_boz && lhs->ts.type != BT_INTEGER)
+    {
+      int rc;
+      if (gfc_option.warn_surprising)
+	gfc_warning ("BOZ literal at %L is bitwise transferred "
+		     "non-integer symbol '%s'", &code->loc,
+		     lhs->symtree->n.sym->name);
+
+      if (!gfc_convert_boz (rhs, &lhs->ts))
+	return false;
+      if ((rc = gfc_range_check (rhs)) != ARITH_OK)
+	{
+	  if (rc == ARITH_UNDERFLOW)
+	    gfc_error ("Arithmetic underflow of bit-wise transferred BOZ at %L"
+		       ". This check can be disabled with the option "
+		       "-fno-range-check", &rhs->where);
+	  else if (rc == ARITH_OVERFLOW)
+	    gfc_error ("Arithmetic overflow of bit-wise transferred BOZ at %L"
+		       ". This check can be disabled with the option "
+		       "-fno-range-check", &rhs->where);
+	  else if (rc == ARITH_NAN)
+	    gfc_error ("Arithmetic NaN of bit-wise transferred BOZ at %L"
+		       ". This check can be disabled with the option "
+		       "-fno-range-check", &rhs->where);
+	  return false;
+	}
+    }
+
+  if (lhs->ts.type == BT_CHARACTER
+	&& gfc_option.warn_character_truncation)
+    {
+      if (lhs->ts.u.cl != NULL
+	    && lhs->ts.u.cl->length != NULL
+	    && lhs->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+	llen = mpz_get_si (lhs->ts.u.cl->length->value.integer);
+
+      if (rhs->expr_type == EXPR_CONSTANT)
+ 	rlen = rhs->value.character.length;
+
+      else if (rhs->ts.u.cl != NULL
+		 && rhs->ts.u.cl->length != NULL
+		 && rhs->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+	rlen = mpz_get_si (rhs->ts.u.cl->length->value.integer);
+
+      if (rlen && llen && rlen > llen)
+	gfc_warning_now ("CHARACTER expression will be truncated "
+			 "in assignment (%d/%d) at %L",
+			 llen, rlen, &code->loc);
+    }
+
+  /* Ensure that a vector index expression for the lvalue is evaluated
+     to a temporary if the lvalue symbol is referenced in it.  */
+  if (lhs->rank)
+    {
+      for (ref = lhs->ref; ref; ref= ref->next)
+	if (ref->type == REF_ARRAY)
+	  {
+	    for (n = 0; n < ref->u.ar.dimen; n++)
+	      if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR
+		  && gfc_find_sym_in_expr (lhs->symtree->n.sym,
+					   ref->u.ar.start[n]))
+		ref->u.ar.start[n]
+			= gfc_get_parentheses (ref->u.ar.start[n]);
+	  }
+    }
+
+  if (gfc_pure (NULL))
+    {
+      if (lhs->ts.type == BT_DERIVED
+	    && lhs->expr_type == EXPR_VARIABLE
+	    && lhs->ts.u.derived->attr.pointer_comp
+	    && rhs->expr_type == EXPR_VARIABLE
+	    && (gfc_impure_variable (rhs->symtree->n.sym)
+		|| gfc_is_coindexed (rhs)))
+	{
+	  /* F2008, C1283.  */
+	  if (gfc_is_coindexed (rhs))
+	    gfc_error ("Coindexed expression at %L is assigned to "
+			"a derived type variable with a POINTER "
+			"component in a PURE procedure",
+			&rhs->where);
+	  else
+	    gfc_error ("The impure variable at %L is assigned to "
+			"a derived type variable with a POINTER "
+			"component in a PURE procedure (12.6)",
+			&rhs->where);
+	  return rval;
+	}
+
+      /* Fortran 2008, C1283.  */
+      if (gfc_is_coindexed (lhs))
+	{
+	  gfc_error ("Assignment to coindexed variable at %L in a PURE "
+		     "procedure", &rhs->where);
+	  return rval;
+	}
+    }
+
+  if (gfc_implicit_pure (NULL))
+    {
+      if (lhs->expr_type == EXPR_VARIABLE
+	    && lhs->symtree->n.sym != gfc_current_ns->proc_name
+	    && lhs->symtree->n.sym->ns != gfc_current_ns)
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+      if (lhs->ts.type == BT_DERIVED
+	    && lhs->expr_type == EXPR_VARIABLE
+	    && lhs->ts.u.derived->attr.pointer_comp
+	    && rhs->expr_type == EXPR_VARIABLE
+	    && (gfc_impure_variable (rhs->symtree->n.sym)
+		|| gfc_is_coindexed (rhs)))
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+      /* Fortran 2008, C1283.  */
+      if (gfc_is_coindexed (lhs))
+	gfc_current_ns->proc_name->attr.implicit_pure = 0;
+    }
+
+  /* F03:7.4.1.2.  */
+  /* FIXME: Valid in Fortran 2008, unless the LHS is both polymorphic
+     and coindexed; cf. F2008, 7.2.1.2 and PR 43366.  */
+  if (lhs->ts.type == BT_CLASS)
+    {
+      gfc_error ("Variable must not be polymorphic in assignment at %L",
+		 &lhs->where);
+      return false;
+    }
+
+  /* F2008, Section 7.2.1.2.  */
+  if (gfc_is_coindexed (lhs) && gfc_has_ultimate_allocatable (lhs))
+    {
+      gfc_error ("Coindexed variable must not be have an allocatable ultimate "
+		 "component in assignment at %L", &lhs->where);
+      return false;
+    }
+
+  gfc_check_assign (lhs, rhs, 1);
+  return false;
+}
+
+
+/* Given a block of code, recursively resolve everything pointed to by this
+   code block.  */
+
+static void
+resolve_code (gfc_code *code, gfc_namespace *ns)
+{
+  int omp_workshare_save;
+  int forall_save;
+  code_stack frame;
+  gfc_try t;
+
+  frame.prev = cs_base;
+  frame.head = code;
+  cs_base = &frame;
+
+  find_reachable_labels (code);
+
+  for (; code; code = code->next)
+    {
+      frame.current = code;
+      forall_save = forall_flag;
+
+      if (code->op == EXEC_FORALL)
+	{
+	  forall_flag = 1;
+	  gfc_resolve_forall (code, ns, forall_save);
+	  forall_flag = 2;
+	}
+      else if (code->block)
+	{
+	  omp_workshare_save = -1;
+	  switch (code->op)
+	    {
+	    case EXEC_OMP_PARALLEL_WORKSHARE:
+	      omp_workshare_save = omp_workshare_flag;
+	      omp_workshare_flag = 1;
+	      gfc_resolve_omp_parallel_blocks (code, ns);
+	      break;
+	    case EXEC_OMP_PARALLEL:
+	    case EXEC_OMP_PARALLEL_DO:
+	    case EXEC_OMP_PARALLEL_SECTIONS:
+	    case EXEC_OMP_TASK:
+	      omp_workshare_save = omp_workshare_flag;
+	      omp_workshare_flag = 0;
+	      gfc_resolve_omp_parallel_blocks (code, ns);
+	      break;
+	    case EXEC_OMP_DO:
+	      gfc_resolve_omp_do_blocks (code, ns);
+	      break;
+	    case EXEC_SELECT_TYPE:
+	      /* Blocks are handled in resolve_select_type because we have
+		 to transform the SELECT TYPE into ASSOCIATE first.  */
+	      break;
+	    case EXEC_OMP_WORKSHARE:
+	      omp_workshare_save = omp_workshare_flag;
+	      omp_workshare_flag = 1;
+	      /* FALLTHROUGH */
+	    default:
+	      gfc_resolve_blocks (code->block, ns);
+	      break;
+	    }
+
+	  if (omp_workshare_save != -1)
+	    omp_workshare_flag = omp_workshare_save;
+	}
+
+      t = SUCCESS;
+      if (code->op != EXEC_COMPCALL && code->op != EXEC_CALL_PPC)
+	t = gfc_resolve_expr (code->expr1);
+      forall_flag = forall_save;
+
+      if (gfc_resolve_expr (code->expr2) == FAILURE)
+	t = FAILURE;
+
+      if (code->op == EXEC_ALLOCATE
+	  && gfc_resolve_expr (code->expr3) == FAILURE)
+	t = FAILURE;
+
+      switch (code->op)
+	{
+	case EXEC_NOP:
+	case EXEC_END_BLOCK:
+	case EXEC_CYCLE:
+	case EXEC_PAUSE:
+	case EXEC_STOP:
+	case EXEC_ERROR_STOP:
+	case EXEC_EXIT:
+	case EXEC_CONTINUE:
+	case EXEC_DT_END:
+	case EXEC_ASSIGN_CALL:
+	case EXEC_CRITICAL:
+	  break;
+
+	case EXEC_SYNC_ALL:
+	case EXEC_SYNC_IMAGES:
+	case EXEC_SYNC_MEMORY:
+	  resolve_sync (code);
+	  break;
+
+	case EXEC_ENTRY:
+	  /* Keep track of which entry we are up to.  */
+	  current_entry_id = code->ext.entry->id;
+	  break;
+
+	case EXEC_WHERE:
+	  resolve_where (code, NULL);
+	  break;
+
+	case EXEC_GOTO:
+	  if (code->expr1 != NULL)
+	    {
+	      if (code->expr1->ts.type != BT_INTEGER)
+		gfc_error ("ASSIGNED GOTO statement at %L requires an "
+			   "INTEGER variable", &code->expr1->where);
+	      else if (code->expr1->symtree->n.sym->attr.assign != 1)
+		gfc_error ("Variable '%s' has not been assigned a target "
+			   "label at %L", code->expr1->symtree->n.sym->name,
+			   &code->expr1->where);
+	    }
+	  else
+	    resolve_branch (code->label1, code);
+	  break;
+
+	case EXEC_RETURN:
+	  if (code->expr1 != NULL
+		&& (code->expr1->ts.type != BT_INTEGER || code->expr1->rank))
+	    gfc_error ("Alternate RETURN statement at %L requires a SCALAR-"
+		       "INTEGER return specifier", &code->expr1->where);
+	  break;
+
+	case EXEC_INIT_ASSIGN:
+	case EXEC_END_PROCEDURE:
+	  break;
+
+	case EXEC_ASSIGN:
+	  if (t == FAILURE)
+	    break;
+
+	  if (gfc_check_vardef_context (code->expr1, false, _("assignment"))
+		== FAILURE)
+	    break;
+
+	  if (resolve_ordinary_assign (code, ns))
+	    {
+	      if (code->op == EXEC_COMPCALL)
+		goto compcall;
+	      else
+		goto call;
+	    }
+	  break;
+
+	case EXEC_LABEL_ASSIGN:
+	  if (code->label1->defined == ST_LABEL_UNKNOWN)
+	    gfc_error ("Label %d referenced at %L is never defined",
+		       code->label1->value, &code->label1->where);
+	  if (t == SUCCESS
+	      && (code->expr1->expr_type != EXPR_VARIABLE
+		  || code->expr1->symtree->n.sym->ts.type != BT_INTEGER
+		  || code->expr1->symtree->n.sym->ts.kind
+		     != gfc_default_integer_kind
+		  || code->expr1->symtree->n.sym->as != NULL))
+	    gfc_error ("ASSIGN statement at %L requires a scalar "
+		       "default INTEGER variable", &code->expr1->where);
+	  break;
+
+	case EXEC_POINTER_ASSIGN:
+	  {
+	    gfc_expr* e;
+
+	    if (t == FAILURE)
+	      break;
+
+	    /* This is both a variable definition and pointer assignment
+	       context, so check both of them.  For rank remapping, a final
+	       array ref may be present on the LHS and fool gfc_expr_attr
+	       used in gfc_check_vardef_context.  Remove it.  */
+	    e = remove_last_array_ref (code->expr1);
+	    t = gfc_check_vardef_context (e, true, _("pointer assignment"));
+	    if (t == SUCCESS)
+	      t = gfc_check_vardef_context (e, false, _("pointer assignment"));
+	    gfc_free_expr (e);
+	    if (t == FAILURE)
+	      break;
+
+	    gfc_check_pointer_assign (code->expr1, code->expr2);
+	    break;
+	  }
+
+	case EXEC_ARITHMETIC_IF:
+	  if (t == SUCCESS
+	      && code->expr1->ts.type != BT_INTEGER
+	      && code->expr1->ts.type != BT_REAL)
+	    gfc_error ("Arithmetic IF statement at %L requires a numeric "
+		       "expression", &code->expr1->where);
+
+	  resolve_branch (code->label1, code);
+	  resolve_branch (code->label2, code);
+	  resolve_branch (code->label3, code);
+	  break;
+
+	case EXEC_IF:
+	  if (t == SUCCESS && code->expr1 != NULL
+	      && (code->expr1->ts.type != BT_LOGICAL
+		  || code->expr1->rank != 0))
+	    gfc_error ("IF clause at %L requires a scalar LOGICAL expression",
+		       &code->expr1->where);
+	  break;
+
+	case EXEC_CALL:
+	call:
+	  resolve_call (code);
+	  break;
+
+	case EXEC_COMPCALL:
+	compcall:
+	  resolve_typebound_subroutine (code);
+	  break;
+
+	case EXEC_CALL_PPC:
+	  resolve_ppc_call (code);
+	  break;
+
+	case EXEC_SELECT:
+	  /* Select is complicated. Also, a SELECT construct could be
+	     a transformed computed GOTO.  */
+	  resolve_select (code);
+	  break;
+
+	case EXEC_SELECT_TYPE:
+	  resolve_select_type (code, ns);
+	  break;
+
+	case EXEC_BLOCK:
+	  resolve_block_construct (code);
+	  break;
+
+	case EXEC_DO:
+	  if (code->ext.iterator != NULL)
+	    {
+	      gfc_iterator *iter = code->ext.iterator;
+	      if (gfc_resolve_iterator (iter, true) != FAILURE)
+		gfc_resolve_do_iterator (code, iter->var->symtree->n.sym);
+	    }
+	  break;
+
+	case EXEC_DO_WHILE:
+	  if (code->expr1 == NULL)
+	    gfc_internal_error ("resolve_code(): No expression on DO WHILE");
+	  if (t == SUCCESS
+	      && (code->expr1->rank != 0
+		  || code->expr1->ts.type != BT_LOGICAL))
+	    gfc_error ("Exit condition of DO WHILE loop at %L must be "
+		       "a scalar LOGICAL expression", &code->expr1->where);
+	  break;
+
+	case EXEC_ALLOCATE:
+	  if (t == SUCCESS)
+	    resolve_allocate_deallocate (code, "ALLOCATE");
+
+	  break;
+
+	case EXEC_DEALLOCATE:
+	  if (t == SUCCESS)
+	    resolve_allocate_deallocate (code, "DEALLOCATE");
+
+	  break;
+
+	case EXEC_OPEN:
+	  if (gfc_resolve_open (code->ext.open) == FAILURE)
+	    break;
+
+	  resolve_branch (code->ext.open->err, code);
+	  break;
+
+	case EXEC_CLOSE:
+	  if (gfc_resolve_close (code->ext.close) == FAILURE)
+	    break;
+
+	  resolve_branch (code->ext.close->err, code);
+	  break;
+
+	case EXEC_BACKSPACE:
+	case EXEC_ENDFILE:
+	case EXEC_REWIND:
+	case EXEC_FLUSH:
+	  if (gfc_resolve_filepos (code->ext.filepos) == FAILURE)
+	    break;
+
+	  resolve_branch (code->ext.filepos->err, code);
+	  break;
+
+	case EXEC_INQUIRE:
+	  if (gfc_resolve_inquire (code->ext.inquire) == FAILURE)
+	      break;
+
+	  resolve_branch (code->ext.inquire->err, code);
+	  break;
+
+	case EXEC_IOLENGTH:
+	  gcc_assert (code->ext.inquire != NULL);
+	  if (gfc_resolve_inquire (code->ext.inquire) == FAILURE)
+	    break;
+
+	  resolve_branch (code->ext.inquire->err, code);
+	  break;
+
+	case EXEC_WAIT:
+	  if (gfc_resolve_wait (code->ext.wait) == FAILURE)
+	    break;
+
+	  resolve_branch (code->ext.wait->err, code);
+	  resolve_branch (code->ext.wait->end, code);
+	  resolve_branch (code->ext.wait->eor, code);
+	  break;
+
+	case EXEC_READ:
+	case EXEC_WRITE:
+	  if (gfc_resolve_dt (code->ext.dt, &code->loc) == FAILURE)
+	    break;
+
+	  resolve_branch (code->ext.dt->err, code);
+	  resolve_branch (code->ext.dt->end, code);
+	  resolve_branch (code->ext.dt->eor, code);
+	  break;
+
+	case EXEC_TRANSFER:
+	  resolve_transfer (code);
+	  break;
+
+	case EXEC_FORALL:
+	  resolve_forall_iterators (code->ext.forall_iterator);
+
+	  if (code->expr1 != NULL
+	      && (code->expr1->ts.type != BT_LOGICAL || code->expr1->rank))
+	    gfc_error ("FORALL mask clause at %L requires a scalar LOGICAL "
+		       "expression", &code->expr1->where);
+	  break;
+
+	case EXEC_OMP_ATOMIC:
+	case EXEC_OMP_BARRIER:
+	case EXEC_OMP_CRITICAL:
+	case EXEC_OMP_FLUSH:
+	case EXEC_OMP_DO:
+	case EXEC_OMP_MASTER:
+	case EXEC_OMP_ORDERED:
+	case EXEC_OMP_SECTIONS:
+	case EXEC_OMP_SINGLE:
+	case EXEC_OMP_TASKWAIT:
+	case EXEC_OMP_WORKSHARE:
+	  gfc_resolve_omp_directive (code, ns);
+	  break;
+
+	case EXEC_OMP_PARALLEL:
+	case EXEC_OMP_PARALLEL_DO:
+	case EXEC_OMP_PARALLEL_SECTIONS:
+	case EXEC_OMP_PARALLEL_WORKSHARE:
+	case EXEC_OMP_TASK:
+	  omp_workshare_save = omp_workshare_flag;
+	  omp_workshare_flag = 0;
+	  gfc_resolve_omp_directive (code, ns);
+	  omp_workshare_flag = omp_workshare_save;
+	  break;
+
+	default:
+	  gfc_internal_error ("resolve_code(): Bad statement code");
+	}
+    }
+
+  cs_base = frame.prev;
+}
+
+
+/* Resolve initial values and make sure they are compatible with
+   the variable.  */
+
+static void
+resolve_values (gfc_symbol *sym)
+{
+  gfc_try t;
+
+  if (sym->value == NULL)
+    return;
+
+  if (sym->value->expr_type == EXPR_STRUCTURE)
+    t= resolve_structure_cons (sym->value, 1);
+  else 
+    t = gfc_resolve_expr (sym->value);
+
+  if (t == FAILURE)
+    return;
+
+  gfc_check_assign_symbol (sym, sym->value);
+}
+
+
+/* Verify the binding labels for common blocks that are BIND(C).  The label
+   for a BIND(C) common block must be identical in all scoping units in which
+   the common block is declared.  Further, the binding label can not collide
+   with any other global entity in the program.  */
+
+static void
+resolve_bind_c_comms (gfc_symtree *comm_block_tree)
+{
+  if (comm_block_tree->n.common->is_bind_c == 1)
+    {
+      gfc_gsymbol *binding_label_gsym;
+      gfc_gsymbol *comm_name_gsym;
+
+      /* See if a global symbol exists by the common block's name.  It may
+         be NULL if the common block is use-associated.  */
+      comm_name_gsym = gfc_find_gsymbol (gfc_gsym_root,
+                                         comm_block_tree->n.common->name);
+      if (comm_name_gsym != NULL && comm_name_gsym->type != GSYM_COMMON)
+        gfc_error ("Binding label '%s' for common block '%s' at %L collides "
+                   "with the global entity '%s' at %L",
+                   comm_block_tree->n.common->binding_label,
+                   comm_block_tree->n.common->name,
+                   &(comm_block_tree->n.common->where),
+                   comm_name_gsym->name, &(comm_name_gsym->where));
+      else if (comm_name_gsym != NULL
+	       && strcmp (comm_name_gsym->name,
+			  comm_block_tree->n.common->name) == 0)
+        {
+          /* TODO: Need to make sure the fields of gfc_gsymbol are initialized
+             as expected.  */
+          if (comm_name_gsym->binding_label == NULL)
+            /* No binding label for common block stored yet; save this one.  */
+            comm_name_gsym->binding_label =
+              comm_block_tree->n.common->binding_label;
+          else
+            if (strcmp (comm_name_gsym->binding_label,
+                        comm_block_tree->n.common->binding_label) != 0)
+              {
+                /* Common block names match but binding labels do not.  */
+                gfc_error ("Binding label '%s' for common block '%s' at %L "
+                           "does not match the binding label '%s' for common "
+                           "block '%s' at %L",
+                           comm_block_tree->n.common->binding_label,
+                           comm_block_tree->n.common->name,
+                           &(comm_block_tree->n.common->where),
+                           comm_name_gsym->binding_label,
+                           comm_name_gsym->name,
+                           &(comm_name_gsym->where));
+                return;
+              }
+        }
+
+      /* There is no binding label (NAME="") so we have nothing further to
+         check and nothing to add as a global symbol for the label.  */
+      if (comm_block_tree->n.common->binding_label[0] == '\0' )
+        return;
+      
+      binding_label_gsym =
+        gfc_find_gsymbol (gfc_gsym_root,
+                          comm_block_tree->n.common->binding_label);
+      if (binding_label_gsym == NULL)
+        {
+          /* Need to make a global symbol for the binding label to prevent
+             it from colliding with another.  */
+          binding_label_gsym =
+            gfc_get_gsymbol (comm_block_tree->n.common->binding_label);
+          binding_label_gsym->sym_name = comm_block_tree->n.common->name;
+          binding_label_gsym->type = GSYM_COMMON;
+        }
+      else
+        {
+          /* If comm_name_gsym is NULL, the name common block is use
+             associated and the name could be colliding.  */
+          if (binding_label_gsym->type != GSYM_COMMON)
+            gfc_error ("Binding label '%s' for common block '%s' at %L "
+                       "collides with the global entity '%s' at %L",
+                       comm_block_tree->n.common->binding_label,
+                       comm_block_tree->n.common->name,
+                       &(comm_block_tree->n.common->where),
+                       binding_label_gsym->name,
+                       &(binding_label_gsym->where));
+          else if (comm_name_gsym != NULL
+		   && (strcmp (binding_label_gsym->name,
+			       comm_name_gsym->binding_label) != 0)
+		   && (strcmp (binding_label_gsym->sym_name,
+			       comm_name_gsym->name) != 0))
+            gfc_error ("Binding label '%s' for common block '%s' at %L "
+                       "collides with global entity '%s' at %L",
+                       binding_label_gsym->name, binding_label_gsym->sym_name,
+                       &(comm_block_tree->n.common->where),
+                       comm_name_gsym->name, &(comm_name_gsym->where));
+        }
+    }
+  
+  return;
+}
+
+
+/* Verify any BIND(C) derived types in the namespace so we can report errors
+   for them once, rather than for each variable declared of that type.  */
+
+static void
+resolve_bind_c_derived_types (gfc_symbol *derived_sym)
+{
+  if (derived_sym != NULL && derived_sym->attr.flavor == FL_DERIVED
+      && derived_sym->attr.is_bind_c == 1)
+    verify_bind_c_derived_type (derived_sym);
+  
+  return;
+}
+
+
+/* Verify that any binding labels used in a given namespace do not collide 
+   with the names or binding labels of any global symbols.  */
+
+static void
+gfc_verify_binding_labels (gfc_symbol *sym)
+{
+  int has_error = 0;
+  
+  if (sym != NULL && sym->attr.is_bind_c && sym->attr.is_iso_c == 0 
+      && sym->attr.flavor != FL_DERIVED && sym->binding_label[0] != '\0')
+    {
+      gfc_gsymbol *bind_c_sym;
+
+      bind_c_sym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label);
+      if (bind_c_sym != NULL 
+          && strcmp (bind_c_sym->name, sym->binding_label) == 0)
+        {
+          if (sym->attr.if_source == IFSRC_DECL 
+              && (bind_c_sym->type != GSYM_SUBROUTINE 
+                  && bind_c_sym->type != GSYM_FUNCTION) 
+              && ((sym->attr.contained == 1 
+                   && strcmp (bind_c_sym->sym_name, sym->name) != 0) 
+                  || (sym->attr.use_assoc == 1 
+                      && (strcmp (bind_c_sym->mod_name, sym->module) != 0))))
+            {
+              /* Make sure global procedures don't collide with anything.  */
+              gfc_error ("Binding label '%s' at %L collides with the global "
+                         "entity '%s' at %L", sym->binding_label,
+                         &(sym->declared_at), bind_c_sym->name,
+                         &(bind_c_sym->where));
+              has_error = 1;
+            }
+          else if (sym->attr.contained == 0 
+                   && (sym->attr.if_source == IFSRC_IFBODY 
+                       && sym->attr.flavor == FL_PROCEDURE) 
+                   && (bind_c_sym->sym_name != NULL 
+                       && strcmp (bind_c_sym->sym_name, sym->name) != 0))
+            {
+              /* Make sure procedures in interface bodies don't collide.  */
+              gfc_error ("Binding label '%s' in interface body at %L collides "
+                         "with the global entity '%s' at %L",
+                         sym->binding_label,
+                         &(sym->declared_at), bind_c_sym->name,
+                         &(bind_c_sym->where));
+              has_error = 1;
+            }
+          else if (sym->attr.contained == 0 
+                   && sym->attr.if_source == IFSRC_UNKNOWN)
+	    if ((sym->attr.use_assoc && bind_c_sym->mod_name
+		 && strcmp (bind_c_sym->mod_name, sym->module) != 0) 
+		|| sym->attr.use_assoc == 0)
+              {
+                gfc_error ("Binding label '%s' at %L collides with global "
+                           "entity '%s' at %L", sym->binding_label,
+                           &(sym->declared_at), bind_c_sym->name,
+                           &(bind_c_sym->where));
+                has_error = 1;
+              }
+
+          if (has_error != 0)
+            /* Clear the binding label to prevent checking multiple times.  */
+            sym->binding_label[0] = '\0';
+        }
+      else if (bind_c_sym == NULL)
+	{
+	  bind_c_sym = gfc_get_gsymbol (sym->binding_label);
+	  bind_c_sym->where = sym->declared_at;
+	  bind_c_sym->sym_name = sym->name;
+
+          if (sym->attr.use_assoc == 1)
+            bind_c_sym->mod_name = sym->module;
+          else
+            if (sym->ns->proc_name != NULL)
+              bind_c_sym->mod_name = sym->ns->proc_name->name;
+
+          if (sym->attr.contained == 0)
+            {
+              if (sym->attr.subroutine)
+                bind_c_sym->type = GSYM_SUBROUTINE;
+              else if (sym->attr.function)
+                bind_c_sym->type = GSYM_FUNCTION;
+            }
+        }
+    }
+  return;
+}
+
+
+/* Resolve an index expression.  */
+
+static gfc_try
+resolve_index_expr (gfc_expr *e)
+{
+  if (gfc_resolve_expr (e) == FAILURE)
+    return FAILURE;
+
+  if (gfc_simplify_expr (e, 0) == FAILURE)
+    return FAILURE;
+
+  if (gfc_specification_expr (e) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+/* Resolve a charlen structure.  */
+
+static gfc_try
+resolve_charlen (gfc_charlen *cl)
+{
+  int i, k;
+
+  if (cl->resolved)
+    return SUCCESS;
+
+  cl->resolved = 1;
+
+  specification_expr = 1;
+
+  if (resolve_index_expr (cl->length) == FAILURE)
+    {
+      specification_expr = 0;
+      return FAILURE;
+    }
+
+  /* "If the character length parameter value evaluates to a negative
+     value, the length of character entities declared is zero."  */
+  if (cl->length && !gfc_extract_int (cl->length, &i) && i < 0)
+    {
+      if (gfc_option.warn_surprising)
+	gfc_warning_now ("CHARACTER variable at %L has negative length %d,"
+			 " the length has been set to zero",
+			 &cl->length->where, i);
+      gfc_replace_expr (cl->length,
+			gfc_get_int_expr (gfc_default_integer_kind, NULL, 0));
+    }
+
+  /* Check that the character length is not too large.  */
+  k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+  if (cl->length && cl->length->expr_type == EXPR_CONSTANT
+      && cl->length->ts.type == BT_INTEGER
+      && mpz_cmp (cl->length->value.integer, gfc_integer_kinds[k].huge) > 0)
+    {
+      gfc_error ("String length at %L is too large", &cl->length->where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Test for non-constant shape arrays.  */
+
+static bool
+is_non_constant_shape_array (gfc_symbol *sym)
+{
+  gfc_expr *e;
+  int i;
+  bool not_constant;
+
+  not_constant = false;
+  if (sym->as != NULL)
+    {
+      /* Unfortunately, !gfc_is_compile_time_shape hits a legal case that
+	 has not been simplified; parameter array references.  Do the
+	 simplification now.  */
+      for (i = 0; i < sym->as->rank + sym->as->corank; i++)
+	{
+	  e = sym->as->lower[i];
+	  if (e && (resolve_index_expr (e) == FAILURE
+		    || !gfc_is_constant_expr (e)))
+	    not_constant = true;
+	  e = sym->as->upper[i];
+	  if (e && (resolve_index_expr (e) == FAILURE
+		    || !gfc_is_constant_expr (e)))
+	    not_constant = true;
+	}
+    }
+  return not_constant;
+}
+
+/* Given a symbol and an initialization expression, add code to initialize
+   the symbol to the function entry.  */
+static void
+build_init_assign (gfc_symbol *sym, gfc_expr *init)
+{
+  gfc_expr *lval;
+  gfc_code *init_st;
+  gfc_namespace *ns = sym->ns;
+
+  /* Search for the function namespace if this is a contained
+     function without an explicit result.  */
+  if (sym->attr.function && sym == sym->result
+      && sym->name != sym->ns->proc_name->name)
+    {
+      ns = ns->contained;
+      for (;ns; ns = ns->sibling)
+	if (strcmp (ns->proc_name->name, sym->name) == 0)
+	  break;
+    }
+
+  if (ns == NULL)
+    {
+      gfc_free_expr (init);
+      return;
+    }
+
+  /* Build an l-value expression for the result.  */
+  lval = gfc_lval_expr_from_sym (sym);
+
+  /* Add the code at scope entry.  */
+  init_st = gfc_get_code ();
+  init_st->next = ns->code;
+  ns->code = init_st;
+
+  /* Assign the default initializer to the l-value.  */
+  init_st->loc = sym->declared_at;
+  init_st->op = EXEC_INIT_ASSIGN;
+  init_st->expr1 = lval;
+  init_st->expr2 = init;
+}
+
+/* Assign the default initializer to a derived type variable or result.  */
+
+static void
+apply_default_init (gfc_symbol *sym)
+{
+  gfc_expr *init = NULL;
+
+  if (sym->attr.flavor != FL_VARIABLE && !sym->attr.function)
+    return;
+
+  if (sym->ts.type == BT_DERIVED && sym->ts.u.derived)
+    init = gfc_default_initializer (&sym->ts);
+
+  if (init == NULL && sym->ts.type != BT_CLASS)
+    return;
+
+  build_init_assign (sym, init);
+  sym->attr.referenced = 1;
+}
+
+/* Build an initializer for a local integer, real, complex, logical, or
+   character variable, based on the command line flags finit-local-zero,
+   finit-integer=, finit-real=, finit-logical=, and finit-runtime.  Returns 
+   null if the symbol should not have a default initialization.  */
+static gfc_expr *
+build_default_init_expr (gfc_symbol *sym)
+{
+  int char_len;
+  gfc_expr *init_expr;
+  int i;
+
+  /* These symbols should never have a default initialization.  */
+  if (sym->attr.allocatable
+      || sym->attr.external
+      || sym->attr.dummy
+      || sym->attr.pointer
+      || sym->attr.in_equivalence
+      || sym->attr.in_common
+      || sym->attr.data
+      || sym->module
+      || sym->attr.cray_pointee
+      || sym->attr.cray_pointer
+      || sym->assoc)
+    return NULL;
+
+  /* Now we'll try to build an initializer expression.  */
+  init_expr = gfc_get_constant_expr (sym->ts.type, sym->ts.kind,
+				     &sym->declared_at);
+
+  /* We will only initialize integers, reals, complex, logicals, and
+     characters, and only if the corresponding command-line flags
+     were set.  Otherwise, we free init_expr and return null.  */
+  switch (sym->ts.type)
+    {    
+    case BT_INTEGER:
+      if (gfc_option.flag_init_integer != GFC_INIT_INTEGER_OFF)
+	mpz_set_si (init_expr->value.integer, 
+			 gfc_option.flag_init_integer_value);
+      else
+	{
+	  gfc_free_expr (init_expr);
+	  init_expr = NULL;
+	}
+      break;
+
+    case BT_REAL:
+      switch (gfc_option.flag_init_real)
+	{
+	case GFC_INIT_REAL_SNAN:
+	  init_expr->is_snan = 1;
+	  /* Fall through.  */
+	case GFC_INIT_REAL_NAN:
+	  mpfr_set_nan (init_expr->value.real);
+	  break;
+
+	case GFC_INIT_REAL_INF:
+	  mpfr_set_inf (init_expr->value.real, 1);
+	  break;
+
+	case GFC_INIT_REAL_NEG_INF:
+	  mpfr_set_inf (init_expr->value.real, -1);
+	  break;
+
+	case GFC_INIT_REAL_ZERO:
+	  mpfr_set_ui (init_expr->value.real, 0.0, GFC_RND_MODE);
+	  break;
+
+	default:
+	  gfc_free_expr (init_expr);
+	  init_expr = NULL;
+	  break;
+	}
+      break;
+	  
+    case BT_COMPLEX:
+      switch (gfc_option.flag_init_real)
+	{
+	case GFC_INIT_REAL_SNAN:
+	  init_expr->is_snan = 1;
+	  /* Fall through.  */
+	case GFC_INIT_REAL_NAN:
+	  mpfr_set_nan (mpc_realref (init_expr->value.complex));
+	  mpfr_set_nan (mpc_imagref (init_expr->value.complex));
+	  break;
+
+	case GFC_INIT_REAL_INF:
+	  mpfr_set_inf (mpc_realref (init_expr->value.complex), 1);
+	  mpfr_set_inf (mpc_imagref (init_expr->value.complex), 1);
+	  break;
+
+	case GFC_INIT_REAL_NEG_INF:
+	  mpfr_set_inf (mpc_realref (init_expr->value.complex), -1);
+	  mpfr_set_inf (mpc_imagref (init_expr->value.complex), -1);
+	  break;
+
+	case GFC_INIT_REAL_ZERO:
+	  mpc_set_ui (init_expr->value.complex, 0, GFC_MPC_RND_MODE);
+	  break;
+
+	default:
+	  gfc_free_expr (init_expr);
+	  init_expr = NULL;
+	  break;
+	}
+      break;
+	  
+    case BT_LOGICAL:
+      if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_FALSE)
+	init_expr->value.logical = 0;
+      else if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_TRUE)
+	init_expr->value.logical = 1;
+      else
+	{
+	  gfc_free_expr (init_expr);
+	  init_expr = NULL;
+	}
+      break;
+	  
+    case BT_CHARACTER:
+      /* For characters, the length must be constant in order to 
+	 create a default initializer.  */
+      if (gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON
+	  && sym->ts.u.cl->length
+	  && sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+	{
+	  char_len = mpz_get_si (sym->ts.u.cl->length->value.integer);
+	  init_expr->value.character.length = char_len;
+	  init_expr->value.character.string = gfc_get_wide_string (char_len+1);
+	  for (i = 0; i < char_len; i++)
+	    init_expr->value.character.string[i]
+	      = (unsigned char) gfc_option.flag_init_character_value;
+	}
+      else
+	{
+	  gfc_free_expr (init_expr);
+	  init_expr = NULL;
+	}
+      if (!init_expr && gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON
+	  && sym->ts.u.cl->length)
+	{
+	  gfc_actual_arglist *arg;
+	  init_expr = gfc_get_expr ();
+	  init_expr->where = sym->declared_at;
+	  init_expr->ts = sym->ts;
+	  init_expr->expr_type = EXPR_FUNCTION;
+	  init_expr->value.function.isym =
+		gfc_intrinsic_function_by_id (GFC_ISYM_REPEAT);
+	  init_expr->value.function.name = "repeat";
+	  arg = gfc_get_actual_arglist ();
+	  arg->expr = gfc_get_character_expr (sym->ts.kind, &sym->declared_at,
+					      NULL, 1);
+	  arg->expr->value.character.string[0]
+		= gfc_option.flag_init_character_value;
+	  arg->next = gfc_get_actual_arglist ();
+	  arg->next->expr = gfc_copy_expr (sym->ts.u.cl->length);
+	  init_expr->value.function.actual = arg;
+	}
+      break;
+	  
+    default:
+     gfc_free_expr (init_expr);
+     init_expr = NULL;
+    }
+  return init_expr;
+}
+
+/* Add an initialization expression to a local variable.  */
+static void
+apply_default_init_local (gfc_symbol *sym)
+{
+  gfc_expr *init = NULL;
+
+  /* The symbol should be a variable or a function return value.  */
+  if ((sym->attr.flavor != FL_VARIABLE && !sym->attr.function)
+      || (sym->attr.function && sym->result != sym))
+    return;
+
+  /* Try to build the initializer expression.  If we can't initialize
+     this symbol, then init will be NULL.  */
+  init = build_default_init_expr (sym);
+  if (init == NULL)
+    return;
+
+  /* For saved variables, we don't want to add an initializer at function
+     entry, so we just add a static initializer. Note that automatic variables
+     are stack allocated even with -fno-automatic.  */
+  if (sym->attr.save || sym->ns->save_all 
+      || (gfc_option.flag_max_stack_var_size == 0
+	  && (!sym->attr.dimension || !is_non_constant_shape_array (sym))))
+    {
+      /* Don't clobber an existing initializer!  */
+      gcc_assert (sym->value == NULL);
+      sym->value = init;
+      return;
+    }
+
+  build_init_assign (sym, init);
+}
+
+
+/* Resolution of common features of flavors variable and procedure.  */
+
+static gfc_try
+resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
+{
+  /* Avoid double diagnostics for function result symbols.  */
+  if ((sym->result || sym->attr.result) && !sym->attr.dummy
+      && (sym->ns != gfc_current_ns))
+    return SUCCESS;
+
+  /* Constraints on deferred shape variable.  */
+  if (sym->as == NULL || sym->as->type != AS_DEFERRED)
+    {
+      if (sym->attr.allocatable)
+	{
+	  if (sym->attr.dimension)
+	    {
+	      gfc_error ("Allocatable array '%s' at %L must have "
+			 "a deferred shape", sym->name, &sym->declared_at);
+	      return FAILURE;
+	    }
+	  else if (gfc_notify_std (GFC_STD_F2003, "Scalar object '%s' at %L "
+				   "may not be ALLOCATABLE", sym->name,
+				   &sym->declared_at) == FAILURE)
+	    return FAILURE;
+	}
+
+      if (sym->attr.pointer && sym->attr.dimension)
+	{
+	  gfc_error ("Array pointer '%s' at %L must have a deferred shape",
+		     sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+    }
+  else
+    {
+      if (!mp_flag && !sym->attr.allocatable && !sym->attr.pointer
+	  && sym->ts.type != BT_CLASS && !sym->assoc)
+	{
+	  gfc_error ("Array '%s' at %L cannot have a deferred shape",
+		     sym->name, &sym->declared_at);
+	  return FAILURE;
+	 }
+    }
+
+  /* Constraints on polymorphic variables.  */
+  if (sym->ts.type == BT_CLASS && !(sym->result && sym->result != sym))
+    {
+      /* F03:C502.  */
+      if (sym->attr.class_ok
+	  && !gfc_type_is_extensible (CLASS_DATA (sym)->ts.u.derived))
+	{
+	  gfc_error ("Type '%s' of CLASS variable '%s' at %L is not extensible",
+		     CLASS_DATA (sym)->ts.u.derived->name, sym->name,
+		     &sym->declared_at);
+	  return FAILURE;
+	}
+
+      /* F03:C509.  */
+      /* Assume that use associated symbols were checked in the module ns.
+	 Class-variables that are associate-names are also something special
+	 and excepted from the test.  */
+      if (!sym->attr.class_ok && !sym->attr.use_assoc && !sym->assoc)
+	{
+	  gfc_error ("CLASS variable '%s' at %L must be dummy, allocatable "
+		     "or pointer", sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+    }
+    
+  return SUCCESS;
+}
+
+
+/* Additional checks for symbols with flavor variable and derived
+   type.  To be called from resolve_fl_variable.  */
+
+static gfc_try
+resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
+{
+  gcc_assert (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS);
+
+  /* Check to see if a derived type is blocked from being host
+     associated by the presence of another class I symbol in the same
+     namespace.  14.6.1.3 of the standard and the discussion on
+     comp.lang.fortran.  */
+  if (sym->ns != sym->ts.u.derived->ns
+      && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY)
+    {
+      gfc_symbol *s;
+      gfc_find_symbol (sym->ts.u.derived->name, sym->ns, 0, &s);
+      if (s && s->attr.flavor != FL_DERIVED)
+	{
+	  gfc_error ("The type '%s' cannot be host associated at %L "
+		     "because it is blocked by an incompatible object "
+		     "of the same name declared at %L",
+		     sym->ts.u.derived->name, &sym->declared_at,
+		     &s->declared_at);
+	  return FAILURE;
+	}
+    }
+
+  /* 4th constraint in section 11.3: "If an object of a type for which
+     component-initialization is specified (R429) appears in the
+     specification-part of a module and does not have the ALLOCATABLE
+     or POINTER attribute, the object shall have the SAVE attribute."
+
+     The check for initializers is performed with
+     gfc_has_default_initializer because gfc_default_initializer generates
+     a hidden default for allocatable components.  */
+  if (!(sym->value || no_init_flag) && sym->ns->proc_name
+      && sym->ns->proc_name->attr.flavor == FL_MODULE
+      && !sym->ns->save_all && !sym->attr.save
+      && !sym->attr.pointer && !sym->attr.allocatable
+      && gfc_has_default_initializer (sym->ts.u.derived)
+      && gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Implied SAVE for "
+			 "module variable '%s' at %L, needed due to "
+			 "the default initialization", sym->name,
+			 &sym->declared_at) == FAILURE)
+    return FAILURE;
+
+  /* Assign default initializer.  */
+  if (!(sym->value || sym->attr.pointer || sym->attr.allocatable)
+      && (!no_init_flag || sym->attr.intent == INTENT_OUT))
+    {
+      sym->value = gfc_default_initializer (&sym->ts);
+    }
+
+  return SUCCESS;
+}
+
+
+/* Resolve symbols with flavor variable.  */
+
+static gfc_try
+resolve_fl_variable (gfc_symbol *sym, int mp_flag)
+{
+  int no_init_flag, automatic_flag;
+  gfc_expr *e;
+  const char *auto_save_msg;
+
+  auto_save_msg = "Automatic object '%s' at %L cannot have the "
+		  "SAVE attribute";
+
+  if (resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
+    return FAILURE;
+
+  /* Set this flag to check that variables are parameters of all entries.
+     This check is effected by the call to gfc_resolve_expr through
+     is_non_constant_shape_array.  */
+  specification_expr = 1;
+
+  if (sym->ns->proc_name
+      && (sym->ns->proc_name->attr.flavor == FL_MODULE
+	  || sym->ns->proc_name->attr.is_main_program)
+      && !sym->attr.use_assoc
+      && !sym->attr.allocatable
+      && !sym->attr.pointer
+      && is_non_constant_shape_array (sym))
+    {
+      /* The shape of a main program or module array needs to be
+	 constant.  */
+      gfc_error ("The module or main program array '%s' at %L must "
+		 "have constant shape", sym->name, &sym->declared_at);
+      specification_expr = 0;
+      return FAILURE;
+    }
+
+  /* Constraints on deferred type parameter.  */
+  if (sym->ts.deferred && !(sym->attr.pointer || sym->attr.allocatable))
+    {
+      gfc_error ("Entity '%s' at %L has a deferred type parameter and "
+		 "requires either the pointer or allocatable attribute",
+		     sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+
+  if (sym->ts.type == BT_CHARACTER)
+    {
+      /* Make sure that character string variables with assumed length are
+	 dummy arguments.  */
+      e = sym->ts.u.cl->length;
+      if (e == NULL && !sym->attr.dummy && !sym->attr.result
+	  && !sym->ts.deferred)
+	{
+	  gfc_error ("Entity with assumed character length at %L must be a "
+		     "dummy argument or a PARAMETER", &sym->declared_at);
+	  return FAILURE;
+	}
+
+      if (e && sym->attr.save == SAVE_EXPLICIT && !gfc_is_constant_expr (e))
+	{
+	  gfc_error (auto_save_msg, sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+
+      if (!gfc_is_constant_expr (e)
+	  && !(e->expr_type == EXPR_VARIABLE
+	       && e->symtree->n.sym->attr.flavor == FL_PARAMETER)
+	  && sym->ns->proc_name
+	  && (sym->ns->proc_name->attr.flavor == FL_MODULE
+	      || sym->ns->proc_name->attr.is_main_program)
+	  && !sym->attr.use_assoc)
+	{
+	  gfc_error ("'%s' at %L must have constant character length "
+		     "in this context", sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+    }
+
+  if (sym->value == NULL && sym->attr.referenced)
+    apply_default_init_local (sym); /* Try to apply a default initialization.  */
+
+  /* Determine if the symbol may not have an initializer.  */
+  no_init_flag = automatic_flag = 0;
+  if (sym->attr.allocatable || sym->attr.external || sym->attr.dummy
+      || sym->attr.intrinsic || sym->attr.result)
+    no_init_flag = 1;
+  else if ((sym->attr.dimension || sym->attr.codimension) && !sym->attr.pointer
+	   && is_non_constant_shape_array (sym))
+    {
+      no_init_flag = automatic_flag = 1;
+
+      /* Also, they must not have the SAVE attribute.
+	 SAVE_IMPLICIT is checked below.  */
+      if (sym->attr.save == SAVE_EXPLICIT)
+	{
+	  gfc_error (auto_save_msg, sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+    }
+
+  /* Ensure that any initializer is simplified.  */
+  if (sym->value)
+    gfc_simplify_expr (sym->value, 1);
+
+  /* Reject illegal initializers.  */
+  if (!sym->mark && sym->value)
+    {
+      if (sym->attr.allocatable || (sym->ts.type == BT_CLASS
+				    && CLASS_DATA (sym)->attr.allocatable))
+	gfc_error ("Allocatable '%s' at %L cannot have an initializer",
+		   sym->name, &sym->declared_at);
+      else if (sym->attr.external)
+	gfc_error ("External '%s' at %L cannot have an initializer",
+		   sym->name, &sym->declared_at);
+      else if (sym->attr.dummy
+	&& !(sym->ts.type == BT_DERIVED && sym->attr.intent == INTENT_OUT))
+	gfc_error ("Dummy '%s' at %L cannot have an initializer",
+		   sym->name, &sym->declared_at);
+      else if (sym->attr.intrinsic)
+	gfc_error ("Intrinsic '%s' at %L cannot have an initializer",
+		   sym->name, &sym->declared_at);
+      else if (sym->attr.result)
+	gfc_error ("Function result '%s' at %L cannot have an initializer",
+		   sym->name, &sym->declared_at);
+      else if (automatic_flag)
+	gfc_error ("Automatic array '%s' at %L cannot have an initializer",
+		   sym->name, &sym->declared_at);
+      else
+	goto no_init_error;
+      return FAILURE;
+    }
+
+no_init_error:
+  if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
+    return resolve_fl_variable_derived (sym, no_init_flag);
+
+  return SUCCESS;
+}
+
+
+/* Resolve a procedure.  */
+
+static gfc_try
+resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
+{
+  gfc_formal_arglist *arg;
+
+  if (sym->attr.function
+      && resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
+    return FAILURE;
+
+  if (sym->ts.type == BT_CHARACTER)
+    {
+      gfc_charlen *cl = sym->ts.u.cl;
+
+      if (cl && cl->length && gfc_is_constant_expr (cl->length)
+	     && resolve_charlen (cl) == FAILURE)
+	return FAILURE;
+
+      if ((!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
+	  && sym->attr.proc == PROC_ST_FUNCTION)
+	{
+	  gfc_error ("Character-valued statement function '%s' at %L must "
+		     "have constant length", sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+    }
+
+  /* Ensure that derived type for are not of a private type.  Internal
+     module procedures are excluded by 2.2.3.3 - i.e., they are not
+     externally accessible and can access all the objects accessible in
+     the host.  */
+  if (!(sym->ns->parent
+	&& sym->ns->parent->proc_name->attr.flavor == FL_MODULE)
+      && gfc_check_symbol_access (sym))
+    {
+      gfc_interface *iface;
+
+      for (arg = sym->formal; arg; arg = arg->next)
+	{
+	  if (arg->sym
+	      && arg->sym->ts.type == BT_DERIVED
+	      && !arg->sym->ts.u.derived->attr.use_assoc
+	      && !gfc_check_symbol_access (arg->sym->ts.u.derived)
+	      && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: '%s' is of a "
+				 "PRIVATE type and cannot be a dummy argument"
+				 " of '%s', which is PUBLIC at %L",
+				 arg->sym->name, sym->name, &sym->declared_at)
+		 == FAILURE)
+	    {
+	      /* Stop this message from recurring.  */
+	      arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC;
+	      return FAILURE;
+	    }
+	}
+
+      /* PUBLIC interfaces may expose PRIVATE procedures that take types
+	 PRIVATE to the containing module.  */
+      for (iface = sym->generic; iface; iface = iface->next)
+	{
+	  for (arg = iface->sym->formal; arg; arg = arg->next)
+	    {
+	      if (arg->sym
+		  && arg->sym->ts.type == BT_DERIVED
+		  && !arg->sym->ts.u.derived->attr.use_assoc
+		  && !gfc_check_symbol_access (arg->sym->ts.u.derived)
+		  && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure "
+				     "'%s' in PUBLIC interface '%s' at %L "
+				     "takes dummy arguments of '%s' which is "
+				     "PRIVATE", iface->sym->name, sym->name,
+				     &iface->sym->declared_at,
+				     gfc_typename (&arg->sym->ts)) == FAILURE)
+		{
+		  /* Stop this message from recurring.  */
+		  arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC;
+		  return FAILURE;
+		}
+	     }
+	}
+
+      /* PUBLIC interfaces may expose PRIVATE procedures that take types
+	 PRIVATE to the containing module.  */
+      for (iface = sym->generic; iface; iface = iface->next)
+	{
+	  for (arg = iface->sym->formal; arg; arg = arg->next)
+	    {
+	      if (arg->sym
+		  && arg->sym->ts.type == BT_DERIVED
+		  && !arg->sym->ts.u.derived->attr.use_assoc
+		  && !gfc_check_symbol_access (arg->sym->ts.u.derived)
+		  && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Procedure "
+				     "'%s' in PUBLIC interface '%s' at %L "
+				     "takes dummy arguments of '%s' which is "
+				     "PRIVATE", iface->sym->name, sym->name,
+				     &iface->sym->declared_at,
+				     gfc_typename (&arg->sym->ts)) == FAILURE)
+		{
+		  /* Stop this message from recurring.  */
+		  arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC;
+		  return FAILURE;
+		}
+	     }
+	}
+    }
+
+  if (sym->attr.function && sym->value && sym->attr.proc != PROC_ST_FUNCTION
+      && !sym->attr.proc_pointer)
+    {
+      gfc_error ("Function '%s' at %L cannot have an initializer",
+		 sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+
+  /* An external symbol may not have an initializer because it is taken to be
+     a procedure. Exception: Procedure Pointers.  */
+  if (sym->attr.external && sym->value && !sym->attr.proc_pointer)
+    {
+      gfc_error ("External object '%s' at %L may not have an initializer",
+		 sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+
+  /* An elemental function is required to return a scalar 12.7.1  */
+  if (sym->attr.elemental && sym->attr.function && sym->as)
+    {
+      gfc_error ("ELEMENTAL function '%s' at %L must have a scalar "
+		 "result", sym->name, &sym->declared_at);
+      /* Reset so that the error only occurs once.  */
+      sym->attr.elemental = 0;
+      return FAILURE;
+    }
+
+  if (sym->attr.proc == PROC_ST_FUNCTION
+      && (sym->attr.allocatable || sym->attr.pointer))
+    {
+      gfc_error ("Statement function '%s' at %L may not have pointer or "
+		 "allocatable attribute", sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+
+  /* 5.1.1.5 of the Standard: A function name declared with an asterisk
+     char-len-param shall not be array-valued, pointer-valued, recursive
+     or pure.  ....snip... A character value of * may only be used in the
+     following ways: (i) Dummy arg of procedure - dummy associates with
+     actual length; (ii) To declare a named constant; or (iii) External
+     function - but length must be declared in calling scoping unit.  */
+  if (sym->attr.function
+      && sym->ts.type == BT_CHARACTER
+      && sym->ts.u.cl && sym->ts.u.cl->length == NULL)
+    {
+      if ((sym->as && sym->as->rank) || (sym->attr.pointer)
+	  || (sym->attr.recursive) || (sym->attr.pure))
+	{
+	  if (sym->as && sym->as->rank)
+	    gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
+		       "array-valued", sym->name, &sym->declared_at);
+
+	  if (sym->attr.pointer)
+	    gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
+		       "pointer-valued", sym->name, &sym->declared_at);
+
+	  if (sym->attr.pure)
+	    gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
+		       "pure", sym->name, &sym->declared_at);
+
+	  if (sym->attr.recursive)
+	    gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
+		       "recursive", sym->name, &sym->declared_at);
+
+	  return FAILURE;
+	}
+
+      /* Appendix B.2 of the standard.  Contained functions give an
+	 error anyway.  Fixed-form is likely to be F77/legacy. Deferred
+	 character length is an F2003 feature.  */
+      if (!sym->attr.contained
+	    && gfc_current_form != FORM_FIXED
+	    && !sym->ts.deferred)
+	gfc_notify_std (GFC_STD_F95_OBS, "Obsolescent feature: "
+			"CHARACTER(*) function '%s' at %L",
+			sym->name, &sym->declared_at);
+    }
+
+  if (sym->attr.is_bind_c && sym->attr.is_c_interop != 1)
+    {
+      gfc_formal_arglist *curr_arg;
+      int has_non_interop_arg = 0;
+
+      if (verify_bind_c_sym (sym, &(sym->ts), sym->attr.in_common,
+                             sym->common_block) == FAILURE)
+        {
+          /* Clear these to prevent looking at them again if there was an
+             error.  */
+          sym->attr.is_bind_c = 0;
+          sym->attr.is_c_interop = 0;
+          sym->ts.is_c_interop = 0;
+        }
+      else
+        {
+          /* So far, no errors have been found.  */
+          sym->attr.is_c_interop = 1;
+          sym->ts.is_c_interop = 1;
+        }
+      
+      curr_arg = sym->formal;
+      while (curr_arg != NULL)
+        {
+          /* Skip implicitly typed dummy args here.  */
+	  if (curr_arg->sym->attr.implicit_type == 0)
+	    if (verify_c_interop_param (curr_arg->sym) == FAILURE)
+	      /* If something is found to fail, record the fact so we
+		 can mark the symbol for the procedure as not being
+		 BIND(C) to try and prevent multiple errors being
+		 reported.  */
+	      has_non_interop_arg = 1;
+          
+          curr_arg = curr_arg->next;
+        }
+
+      /* See if any of the arguments were not interoperable and if so, clear
+	 the procedure symbol to prevent duplicate error messages.  */
+      if (has_non_interop_arg != 0)
+	{
+	  sym->attr.is_c_interop = 0;
+	  sym->ts.is_c_interop = 0;
+	  sym->attr.is_bind_c = 0;
+	}
+    }
+  
+  if (!sym->attr.proc_pointer)
+    {
+      if (sym->attr.save == SAVE_EXPLICIT)
+	{
+	  gfc_error ("PROCEDURE attribute conflicts with SAVE attribute "
+		     "in '%s' at %L", sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+      if (sym->attr.intent)
+	{
+	  gfc_error ("PROCEDURE attribute conflicts with INTENT attribute "
+		     "in '%s' at %L", sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+      if (sym->attr.subroutine && sym->attr.result)
+	{
+	  gfc_error ("PROCEDURE attribute conflicts with RESULT attribute "
+		     "in '%s' at %L", sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+      if (sym->attr.external && sym->attr.function
+	  && ((sym->attr.if_source == IFSRC_DECL && !sym->attr.procedure)
+	      || sym->attr.contained))
+	{
+	  gfc_error ("EXTERNAL attribute conflicts with FUNCTION attribute "
+		     "in '%s' at %L", sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+      if (strcmp ("ppr@", sym->name) == 0)
+	{
+	  gfc_error ("Procedure pointer result '%s' at %L "
+		     "is missing the pointer attribute",
+		     sym->ns->proc_name->name, &sym->declared_at);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* Resolve a list of finalizer procedures.  That is, after they have hopefully
+   been defined and we now know their defined arguments, check that they fulfill
+   the requirements of the standard for procedures used as finalizers.  */
+
+static gfc_try
+gfc_resolve_finalizers (gfc_symbol* derived)
+{
+  gfc_finalizer* list;
+  gfc_finalizer** prev_link; /* For removing wrong entries from the list.  */
+  gfc_try result = SUCCESS;
+  bool seen_scalar = false;
+
+  if (!derived->f2k_derived || !derived->f2k_derived->finalizers)
+    return SUCCESS;
+
+  /* Walk over the list of finalizer-procedures, check them, and if any one
+     does not fit in with the standard's definition, print an error and remove
+     it from the list.  */
+  prev_link = &derived->f2k_derived->finalizers;
+  for (list = derived->f2k_derived->finalizers; list; list = *prev_link)
+    {
+      gfc_symbol* arg;
+      gfc_finalizer* i;
+      int my_rank;
+
+      /* Skip this finalizer if we already resolved it.  */
+      if (list->proc_tree)
+	{
+	  prev_link = &(list->next);
+	  continue;
+	}
+
+      /* Check this exists and is a SUBROUTINE.  */
+      if (!list->proc_sym->attr.subroutine)
+	{
+	  gfc_error ("FINAL procedure '%s' at %L is not a SUBROUTINE",
+		     list->proc_sym->name, &list->where);
+	  goto error;
+	}
+
+      /* We should have exactly one argument.  */
+      if (!list->proc_sym->formal || list->proc_sym->formal->next)
+	{
+	  gfc_error ("FINAL procedure at %L must have exactly one argument",
+		     &list->where);
+	  goto error;
+	}
+      arg = list->proc_sym->formal->sym;
+
+      /* This argument must be of our type.  */
+      if (arg->ts.type != BT_DERIVED || arg->ts.u.derived != derived)
+	{
+	  gfc_error ("Argument of FINAL procedure at %L must be of type '%s'",
+		     &arg->declared_at, derived->name);
+	  goto error;
+	}
+
+      /* It must neither be a pointer nor allocatable nor optional.  */
+      if (arg->attr.pointer)
+	{
+	  gfc_error ("Argument of FINAL procedure at %L must not be a POINTER",
+		     &arg->declared_at);
+	  goto error;
+	}
+      if (arg->attr.allocatable)
+	{
+	  gfc_error ("Argument of FINAL procedure at %L must not be"
+		     " ALLOCATABLE", &arg->declared_at);
+	  goto error;
+	}
+      if (arg->attr.optional)
+	{
+	  gfc_error ("Argument of FINAL procedure at %L must not be OPTIONAL",
+		     &arg->declared_at);
+	  goto error;
+	}
+
+      /* It must not be INTENT(OUT).  */
+      if (arg->attr.intent == INTENT_OUT)
+	{
+	  gfc_error ("Argument of FINAL procedure at %L must not be"
+		     " INTENT(OUT)", &arg->declared_at);
+	  goto error;
+	}
+
+      /* Warn if the procedure is non-scalar and not assumed shape.  */
+      if (gfc_option.warn_surprising && arg->as && arg->as->rank > 0
+	  && arg->as->type != AS_ASSUMED_SHAPE)
+	gfc_warning ("Non-scalar FINAL procedure at %L should have assumed"
+		     " shape argument", &arg->declared_at);
+
+      /* Check that it does not match in kind and rank with a FINAL procedure
+	 defined earlier.  To really loop over the *earlier* declarations,
+	 we need to walk the tail of the list as new ones were pushed at the
+	 front.  */
+      /* TODO: Handle kind parameters once they are implemented.  */
+      my_rank = (arg->as ? arg->as->rank : 0);
+      for (i = list->next; i; i = i->next)
+	{
+	  /* Argument list might be empty; that is an error signalled earlier,
+	     but we nevertheless continued resolving.  */
+	  if (i->proc_sym->formal)
+	    {
+	      gfc_symbol* i_arg = i->proc_sym->formal->sym;
+	      const int i_rank = (i_arg->as ? i_arg->as->rank : 0);
+	      if (i_rank == my_rank)
+		{
+		  gfc_error ("FINAL procedure '%s' declared at %L has the same"
+			     " rank (%d) as '%s'",
+			     list->proc_sym->name, &list->where, my_rank, 
+			     i->proc_sym->name);
+		  goto error;
+		}
+	    }
+	}
+
+	/* Is this the/a scalar finalizer procedure?  */
+	if (!arg->as || arg->as->rank == 0)
+	  seen_scalar = true;
+
+	/* Find the symtree for this procedure.  */
+	gcc_assert (!list->proc_tree);
+	list->proc_tree = gfc_find_sym_in_symtree (list->proc_sym);
+
+	prev_link = &list->next;
+	continue;
+
+	/* Remove wrong nodes immediately from the list so we don't risk any
+	   troubles in the future when they might fail later expectations.  */
+error:
+	result = FAILURE;
+	i = list;
+	*prev_link = list->next;
+	gfc_free_finalizer (i);
+    }
+
+  /* Warn if we haven't seen a scalar finalizer procedure (but we know there
+     were nodes in the list, must have been for arrays.  It is surely a good
+     idea to have a scalar version there if there's something to finalize.  */
+  if (gfc_option.warn_surprising && result == SUCCESS && !seen_scalar)
+    gfc_warning ("Only array FINAL procedures declared for derived type '%s'"
+		 " defined at %L, suggest also scalar one",
+		 derived->name, &derived->declared_at);
+
+  /* TODO:  Remove this error when finalization is finished.  */
+  gfc_error ("Finalization at %L is not yet implemented",
+	     &derived->declared_at);
+
+  return result;
+}
+
+
+/* Check that it is ok for the typebound procedure proc to override the
+   procedure old.  */
+
+static gfc_try
+check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
+{
+  locus where;
+  const gfc_symbol* proc_target;
+  const gfc_symbol* old_target;
+  unsigned proc_pass_arg, old_pass_arg, argpos;
+  gfc_formal_arglist* proc_formal;
+  gfc_formal_arglist* old_formal;
+
+  /* This procedure should only be called for non-GENERIC proc.  */
+  gcc_assert (!proc->n.tb->is_generic);
+
+  /* If the overwritten procedure is GENERIC, this is an error.  */
+  if (old->n.tb->is_generic)
+    {
+      gfc_error ("Can't overwrite GENERIC '%s' at %L",
+		 old->name, &proc->n.tb->where);
+      return FAILURE;
+    }
+
+  where = proc->n.tb->where;
+  proc_target = proc->n.tb->u.specific->n.sym;
+  old_target = old->n.tb->u.specific->n.sym;
+
+  /* Check that overridden binding is not NON_OVERRIDABLE.  */
+  if (old->n.tb->non_overridable)
+    {
+      gfc_error ("'%s' at %L overrides a procedure binding declared"
+		 " NON_OVERRIDABLE", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* It's an error to override a non-DEFERRED procedure with a DEFERRED one.  */
+  if (!old->n.tb->deferred && proc->n.tb->deferred)
+    {
+      gfc_error ("'%s' at %L must not be DEFERRED as it overrides a"
+		 " non-DEFERRED binding", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is PURE, the overriding must be, too.  */
+  if (old_target->attr.pure && !proc_target->attr.pure)
+    {
+      gfc_error ("'%s' at %L overrides a PURE procedure and must also be PURE",
+		 proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is ELEMENTAL, the overriding must be, too.  If it
+     is not, the overriding must not be either.  */
+  if (old_target->attr.elemental && !proc_target->attr.elemental)
+    {
+      gfc_error ("'%s' at %L overrides an ELEMENTAL procedure and must also be"
+		 " ELEMENTAL", proc->name, &where);
+      return FAILURE;
+    }
+  if (!old_target->attr.elemental && proc_target->attr.elemental)
+    {
+      gfc_error ("'%s' at %L overrides a non-ELEMENTAL procedure and must not"
+		 " be ELEMENTAL, either", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is a SUBROUTINE, the overriding must also be a
+     SUBROUTINE.  */
+  if (old_target->attr.subroutine && !proc_target->attr.subroutine)
+    {
+      gfc_error ("'%s' at %L overrides a SUBROUTINE and must also be a"
+		 " SUBROUTINE", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is a FUNCTION, the overriding must also be a
+     FUNCTION and have the same characteristics.  */
+  if (old_target->attr.function)
+    {
+      if (!proc_target->attr.function)
+	{
+	  gfc_error ("'%s' at %L overrides a FUNCTION and must also be a"
+		     " FUNCTION", proc->name, &where);
+	  return FAILURE;
+	}
+
+      /* FIXME:  Do more comprehensive checking (including, for instance, the
+	 rank and array-shape).  */
+      gcc_assert (proc_target->result && old_target->result);
+      if (!gfc_compare_types (&proc_target->result->ts,
+			      &old_target->result->ts))
+	{
+	  gfc_error ("'%s' at %L and the overridden FUNCTION should have"
+		     " matching result types", proc->name, &where);
+	  return FAILURE;
+	}
+    }
+
+  /* If the overridden binding is PUBLIC, the overriding one must not be
+     PRIVATE.  */
+  if (old->n.tb->access == ACCESS_PUBLIC
+      && proc->n.tb->access == ACCESS_PRIVATE)
+    {
+      gfc_error ("'%s' at %L overrides a PUBLIC procedure and must not be"
+		 " PRIVATE", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* Compare the formal argument lists of both procedures.  This is also abused
+     to find the position of the passed-object dummy arguments of both
+     bindings as at least the overridden one might not yet be resolved and we
+     need those positions in the check below.  */
+  proc_pass_arg = old_pass_arg = 0;
+  if (!proc->n.tb->nopass && !proc->n.tb->pass_arg)
+    proc_pass_arg = 1;
+  if (!old->n.tb->nopass && !old->n.tb->pass_arg)
+    old_pass_arg = 1;
+  argpos = 1;
+  for (proc_formal = proc_target->formal, old_formal = old_target->formal;
+       proc_formal && old_formal;
+       proc_formal = proc_formal->next, old_formal = old_formal->next)
+    {
+      if (proc->n.tb->pass_arg
+	  && !strcmp (proc->n.tb->pass_arg, proc_formal->sym->name))
+	proc_pass_arg = argpos;
+      if (old->n.tb->pass_arg
+	  && !strcmp (old->n.tb->pass_arg, old_formal->sym->name))
+	old_pass_arg = argpos;
+
+      /* Check that the names correspond.  */
+      if (strcmp (proc_formal->sym->name, old_formal->sym->name))
+	{
+	  gfc_error ("Dummy argument '%s' of '%s' at %L should be named '%s' as"
+		     " to match the corresponding argument of the overridden"
+		     " procedure", proc_formal->sym->name, proc->name, &where,
+		     old_formal->sym->name);
+	  return FAILURE;
+	}
+
+      /* Check that the types correspond if neither is the passed-object
+	 argument.  */
+      /* FIXME:  Do more comprehensive testing here.  */
+      if (proc_pass_arg != argpos && old_pass_arg != argpos
+	  && !gfc_compare_types (&proc_formal->sym->ts, &old_formal->sym->ts))
+	{
+	  gfc_error ("Types mismatch for dummy argument '%s' of '%s' %L "
+		     "in respect to the overridden procedure",
+		     proc_formal->sym->name, proc->name, &where);
+	  return FAILURE;
+	}
+
+      ++argpos;
+    }
+  if (proc_formal || old_formal)
+    {
+      gfc_error ("'%s' at %L must have the same number of formal arguments as"
+		 " the overridden procedure", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is NOPASS, the overriding one must also be
+     NOPASS.  */
+  if (old->n.tb->nopass && !proc->n.tb->nopass)
+    {
+      gfc_error ("'%s' at %L overrides a NOPASS binding and must also be"
+		 " NOPASS", proc->name, &where);
+      return FAILURE;
+    }
+
+  /* If the overridden binding is PASS(x), the overriding one must also be
+     PASS and the passed-object dummy arguments must correspond.  */
+  if (!old->n.tb->nopass)
+    {
+      if (proc->n.tb->nopass)
+	{
+	  gfc_error ("'%s' at %L overrides a binding with PASS and must also be"
+		     " PASS", proc->name, &where);
+	  return FAILURE;
+	}
+
+      if (proc_pass_arg != old_pass_arg)
+	{
+	  gfc_error ("Passed-object dummy argument of '%s' at %L must be at"
+		     " the same position as the passed-object dummy argument of"
+		     " the overridden procedure", proc->name, &where);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* Check if two GENERIC targets are ambiguous and emit an error is they are.  */
+
+static gfc_try
+check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2,
+			     const char* generic_name, locus where)
+{
+  gfc_symbol* sym1;
+  gfc_symbol* sym2;
+
+  gcc_assert (t1->specific && t2->specific);
+  gcc_assert (!t1->specific->is_generic);
+  gcc_assert (!t2->specific->is_generic);
+
+  sym1 = t1->specific->u.specific->n.sym;
+  sym2 = t2->specific->u.specific->n.sym;
+
+  if (sym1 == sym2)
+    return SUCCESS;
+
+  /* Both must be SUBROUTINEs or both must be FUNCTIONs.  */
+  if (sym1->attr.subroutine != sym2->attr.subroutine
+      || sym1->attr.function != sym2->attr.function)
+    {
+      gfc_error ("'%s' and '%s' can't be mixed FUNCTION/SUBROUTINE for"
+		 " GENERIC '%s' at %L",
+		 sym1->name, sym2->name, generic_name, &where);
+      return FAILURE;
+    }
+
+  /* Compare the interfaces.  */
+  if (gfc_compare_interfaces (sym1, sym2, sym2->name, 1, 0, NULL, 0))
+    {
+      gfc_error ("'%s' and '%s' for GENERIC '%s' at %L are ambiguous",
+		 sym1->name, sym2->name, generic_name, &where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Worker function for resolving a generic procedure binding; this is used to
+   resolve GENERIC as well as user and intrinsic OPERATOR typebound procedures.
+
+   The difference between those cases is finding possible inherited bindings
+   that are overridden, as one has to look for them in tb_sym_root,
+   tb_uop_root or tb_op, respectively.  Thus the caller must already find
+   the super-type and set p->overridden correctly.  */
+
+static gfc_try
+resolve_tb_generic_targets (gfc_symbol* super_type,
+			    gfc_typebound_proc* p, const char* name)
+{
+  gfc_tbp_generic* target;
+  gfc_symtree* first_target;
+  gfc_symtree* inherited;
+
+  gcc_assert (p && p->is_generic);
+
+  /* Try to find the specific bindings for the symtrees in our target-list.  */
+  gcc_assert (p->u.generic);
+  for (target = p->u.generic; target; target = target->next)
+    if (!target->specific)
+      {
+	gfc_typebound_proc* overridden_tbp;
+	gfc_tbp_generic* g;
+	const char* target_name;
+
+	target_name = target->specific_st->name;
+
+	/* Defined for this type directly.  */
+	if (target->specific_st->n.tb && !target->specific_st->n.tb->error)
+	  {
+	    target->specific = target->specific_st->n.tb;
+	    goto specific_found;
+	  }
+
+	/* Look for an inherited specific binding.  */
+	if (super_type)
+	  {
+	    inherited = gfc_find_typebound_proc (super_type, NULL, target_name,
+						 true, NULL);
+
+	    if (inherited)
+	      {
+		gcc_assert (inherited->n.tb);
+		target->specific = inherited->n.tb;
+		goto specific_found;
+	      }
+	  }
+
+	gfc_error ("Undefined specific binding '%s' as target of GENERIC '%s'"
+		   " at %L", target_name, name, &p->where);
+	return FAILURE;
+
+	/* Once we've found the specific binding, check it is not ambiguous with
+	   other specifics already found or inherited for the same GENERIC.  */
+specific_found:
+	gcc_assert (target->specific);
+
+	/* This must really be a specific binding!  */
+	if (target->specific->is_generic)
+	  {
+	    gfc_error ("GENERIC '%s' at %L must target a specific binding,"
+		       " '%s' is GENERIC, too", name, &p->where, target_name);
+	    return FAILURE;
+	  }
+
+	/* Check those already resolved on this type directly.  */
+	for (g = p->u.generic; g; g = g->next)
+	  if (g != target && g->specific
+	      && check_generic_tbp_ambiguity (target, g, name, p->where)
+		  == FAILURE)
+	    return FAILURE;
+
+	/* Check for ambiguity with inherited specific targets.  */
+	for (overridden_tbp = p->overridden; overridden_tbp;
+	     overridden_tbp = overridden_tbp->overridden)
+	  if (overridden_tbp->is_generic)
+	    {
+	      for (g = overridden_tbp->u.generic; g; g = g->next)
+		{
+		  gcc_assert (g->specific);
+		  if (check_generic_tbp_ambiguity (target, g,
+						   name, p->where) == FAILURE)
+		    return FAILURE;
+		}
+	    }
+      }
+
+  /* If we attempt to "overwrite" a specific binding, this is an error.  */
+  if (p->overridden && !p->overridden->is_generic)
+    {
+      gfc_error ("GENERIC '%s' at %L can't overwrite specific binding with"
+		 " the same name", name, &p->where);
+      return FAILURE;
+    }
+
+  /* Take the SUBROUTINE/FUNCTION attributes of the first specific target, as
+     all must have the same attributes here.  */
+  first_target = p->u.generic->specific->u.specific;
+  gcc_assert (first_target);
+  p->subroutine = first_target->n.sym->attr.subroutine;
+  p->function = first_target->n.sym->attr.function;
+
+  return SUCCESS;
+}
+
+
+/* Resolve a GENERIC procedure binding for a derived type.  */
+
+static gfc_try
+resolve_typebound_generic (gfc_symbol* derived, gfc_symtree* st)
+{
+  gfc_symbol* super_type;
+
+  /* Find the overridden binding if any.  */
+  st->n.tb->overridden = NULL;
+  super_type = gfc_get_derived_super_type (derived);
+  if (super_type)
+    {
+      gfc_symtree* overridden;
+      overridden = gfc_find_typebound_proc (super_type, NULL, st->name,
+					    true, NULL);
+
+      if (overridden && overridden->n.tb)
+	st->n.tb->overridden = overridden->n.tb;
+    }
+
+  /* Resolve using worker function.  */
+  return resolve_tb_generic_targets (super_type, st->n.tb, st->name);
+}
+
+
+/* Retrieve the target-procedure of an operator binding and do some checks in
+   common for intrinsic and user-defined type-bound operators.  */
+
+static gfc_symbol*
+get_checked_tb_operator_target (gfc_tbp_generic* target, locus where)
+{
+  gfc_symbol* target_proc;
+
+  gcc_assert (target->specific && !target->specific->is_generic);
+  target_proc = target->specific->u.specific->n.sym;
+  gcc_assert (target_proc);
+
+  /* All operator bindings must have a passed-object dummy argument.  */
+  if (target->specific->nopass)
+    {
+      gfc_error ("Type-bound operator at %L can't be NOPASS", &where);
+      return NULL;
+    }
+
+  return target_proc;
+}
+
+
+/* Resolve a type-bound intrinsic operator.  */
+
+static gfc_try
+resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op,
+				gfc_typebound_proc* p)
+{
+  gfc_symbol* super_type;
+  gfc_tbp_generic* target;
+  
+  /* If there's already an error here, do nothing (but don't fail again).  */
+  if (p->error)
+    return SUCCESS;
+
+  /* Operators should always be GENERIC bindings.  */
+  gcc_assert (p->is_generic);
+
+  /* Look for an overridden binding.  */
+  super_type = gfc_get_derived_super_type (derived);
+  if (super_type && super_type->f2k_derived)
+    p->overridden = gfc_find_typebound_intrinsic_op (super_type, NULL,
+						     op, true, NULL);
+  else
+    p->overridden = NULL;
+
+  /* Resolve general GENERIC properties using worker function.  */
+  if (resolve_tb_generic_targets (super_type, p, gfc_op2string (op)) == FAILURE)
+    goto error;
+
+  /* Check the targets to be procedures of correct interface.  */
+  for (target = p->u.generic; target; target = target->next)
+    {
+      gfc_symbol* target_proc;
+
+      target_proc = get_checked_tb_operator_target (target, p->where);
+      if (!target_proc)
+	goto error;
+
+      if (!gfc_check_operator_interface (target_proc, op, p->where))
+	goto error;
+    }
+
+  return SUCCESS;
+
+error:
+  p->error = 1;
+  return FAILURE;
+}
+
+
+/* Resolve a type-bound user operator (tree-walker callback).  */
+
+static gfc_symbol* resolve_bindings_derived;
+static gfc_try resolve_bindings_result;
+
+static gfc_try check_uop_procedure (gfc_symbol* sym, locus where);
+
+static void
+resolve_typebound_user_op (gfc_symtree* stree)
+{
+  gfc_symbol* super_type;
+  gfc_tbp_generic* target;
+
+  gcc_assert (stree && stree->n.tb);
+
+  if (stree->n.tb->error)
+    return;
+
+  /* Operators should always be GENERIC bindings.  */
+  gcc_assert (stree->n.tb->is_generic);
+
+  /* Find overridden procedure, if any.  */
+  super_type = gfc_get_derived_super_type (resolve_bindings_derived);
+  if (super_type && super_type->f2k_derived)
+    {
+      gfc_symtree* overridden;
+      overridden = gfc_find_typebound_user_op (super_type, NULL,
+					       stree->name, true, NULL);
+
+      if (overridden && overridden->n.tb)
+	stree->n.tb->overridden = overridden->n.tb;
+    }
+  else
+    stree->n.tb->overridden = NULL;
+
+  /* Resolve basically using worker function.  */
+  if (resolve_tb_generic_targets (super_type, stree->n.tb, stree->name)
+	== FAILURE)
+    goto error;
+
+  /* Check the targets to be functions of correct interface.  */
+  for (target = stree->n.tb->u.generic; target; target = target->next)
+    {
+      gfc_symbol* target_proc;
+
+      target_proc = get_checked_tb_operator_target (target, stree->n.tb->where);
+      if (!target_proc)
+	goto error;
+
+      if (check_uop_procedure (target_proc, stree->n.tb->where) == FAILURE)
+	goto error;
+    }
+
+  return;
+
+error:
+  resolve_bindings_result = FAILURE;
+  stree->n.tb->error = 1;
+}
+
+
+/* Resolve the type-bound procedures for a derived type.  */
+
+static void
+resolve_typebound_procedure (gfc_symtree* stree)
+{
+  gfc_symbol* proc;
+  locus where;
+  gfc_symbol* me_arg;
+  gfc_symbol* super_type;
+  gfc_component* comp;
+
+  gcc_assert (stree);
+
+  /* Undefined specific symbol from GENERIC target definition.  */
+  if (!stree->n.tb)
+    return;
+
+  if (stree->n.tb->error)
+    return;
+
+  /* If this is a GENERIC binding, use that routine.  */
+  if (stree->n.tb->is_generic)
+    {
+      if (resolve_typebound_generic (resolve_bindings_derived, stree)
+	    == FAILURE)
+	goto error;
+      return;
+    }
+
+  /* Get the target-procedure to check it.  */
+  gcc_assert (!stree->n.tb->is_generic);
+  gcc_assert (stree->n.tb->u.specific);
+  proc = stree->n.tb->u.specific->n.sym;
+  where = stree->n.tb->where;
+
+  /* Default access should already be resolved from the parser.  */
+  gcc_assert (stree->n.tb->access != ACCESS_UNKNOWN);
+
+  /* It should be a module procedure or an external procedure with explicit
+     interface.  For DEFERRED bindings, abstract interfaces are ok as well.  */
+  if ((!proc->attr.subroutine && !proc->attr.function)
+      || (proc->attr.proc != PROC_MODULE
+	  && proc->attr.if_source != IFSRC_IFBODY)
+      || (proc->attr.abstract && !stree->n.tb->deferred))
+    {
+      gfc_error ("'%s' must be a module procedure or an external procedure with"
+		 " an explicit interface at %L", proc->name, &where);
+      goto error;
+    }
+  stree->n.tb->subroutine = proc->attr.subroutine;
+  stree->n.tb->function = proc->attr.function;
+
+  /* Find the super-type of the current derived type.  We could do this once and
+     store in a global if speed is needed, but as long as not I believe this is
+     more readable and clearer.  */
+  super_type = gfc_get_derived_super_type (resolve_bindings_derived);
+
+  /* If PASS, resolve and check arguments if not already resolved / loaded
+     from a .mod file.  */
+  if (!stree->n.tb->nopass && stree->n.tb->pass_arg_num == 0)
+    {
+      if (stree->n.tb->pass_arg)
+	{
+	  gfc_formal_arglist* i;
+
+	  /* If an explicit passing argument name is given, walk the arg-list
+	     and look for it.  */
+
+	  me_arg = NULL;
+	  stree->n.tb->pass_arg_num = 1;
+	  for (i = proc->formal; i; i = i->next)
+	    {
+	      if (!strcmp (i->sym->name, stree->n.tb->pass_arg))
+		{
+		  me_arg = i->sym;
+		  break;
+		}
+	      ++stree->n.tb->pass_arg_num;
+	    }
+
+	  if (!me_arg)
+	    {
+	      gfc_error ("Procedure '%s' with PASS(%s) at %L has no"
+			 " argument '%s'",
+			 proc->name, stree->n.tb->pass_arg, &where,
+			 stree->n.tb->pass_arg);
+	      goto error;
+	    }
+	}
+      else
+	{
+	  /* Otherwise, take the first one; there should in fact be at least
+	     one.  */
+	  stree->n.tb->pass_arg_num = 1;
+	  if (!proc->formal)
+	    {
+	      gfc_error ("Procedure '%s' with PASS at %L must have at"
+			 " least one argument", proc->name, &where);
+	      goto error;
+	    }
+	  me_arg = proc->formal->sym;
+	}
+
+      /* Now check that the argument-type matches and the passed-object
+	 dummy argument is generally fine.  */
+
+      gcc_assert (me_arg);
+
+      if (me_arg->ts.type != BT_CLASS)
+	{
+	  gfc_error ("Non-polymorphic passed-object dummy argument of '%s'"
+		     " at %L", proc->name, &where);
+	  goto error;
+	}
+
+      if (CLASS_DATA (me_arg)->ts.u.derived
+	  != resolve_bindings_derived)
+	{
+	  gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L must be of"
+		     " the derived-type '%s'", me_arg->name, proc->name,
+		     me_arg->name, &where, resolve_bindings_derived->name);
+	  goto error;
+	}
+  
+      gcc_assert (me_arg->ts.type == BT_CLASS);
+      if (CLASS_DATA (me_arg)->as && CLASS_DATA (me_arg)->as->rank > 0)
+	{
+	  gfc_error ("Passed-object dummy argument of '%s' at %L must be"
+		     " scalar", proc->name, &where);
+	  goto error;
+	}
+      if (CLASS_DATA (me_arg)->attr.allocatable)
+	{
+	  gfc_error ("Passed-object dummy argument of '%s' at %L must not"
+		     " be ALLOCATABLE", proc->name, &where);
+	  goto error;
+	}
+      if (CLASS_DATA (me_arg)->attr.class_pointer)
+	{
+	  gfc_error ("Passed-object dummy argument of '%s' at %L must not"
+		     " be POINTER", proc->name, &where);
+	  goto error;
+	}
+    }
+
+  /* If we are extending some type, check that we don't override a procedure
+     flagged NON_OVERRIDABLE.  */
+  stree->n.tb->overridden = NULL;
+  if (super_type)
+    {
+      gfc_symtree* overridden;
+      overridden = gfc_find_typebound_proc (super_type, NULL,
+					    stree->name, true, NULL);
+
+      if (overridden && overridden->n.tb)
+	stree->n.tb->overridden = overridden->n.tb;
+
+      if (overridden && check_typebound_override (stree, overridden) == FAILURE)
+	goto error;
+    }
+
+  /* See if there's a name collision with a component directly in this type.  */
+  for (comp = resolve_bindings_derived->components; comp; comp = comp->next)
+    if (!strcmp (comp->name, stree->name))
+      {
+	gfc_error ("Procedure '%s' at %L has the same name as a component of"
+		   " '%s'",
+		   stree->name, &where, resolve_bindings_derived->name);
+	goto error;
+      }
+
+  /* Try to find a name collision with an inherited component.  */
+  if (super_type && gfc_find_component (super_type, stree->name, true, true))
+    {
+      gfc_error ("Procedure '%s' at %L has the same name as an inherited"
+		 " component of '%s'",
+		 stree->name, &where, resolve_bindings_derived->name);
+      goto error;
+    }
+
+  stree->n.tb->error = 0;
+  return;
+
+error:
+  resolve_bindings_result = FAILURE;
+  stree->n.tb->error = 1;
+}
+
+
+static gfc_try
+resolve_typebound_procedures (gfc_symbol* derived)
+{
+  int op;
+  gfc_symbol* super_type;
+
+  if (!derived->f2k_derived || !derived->f2k_derived->tb_sym_root)
+    return SUCCESS;
+  
+  super_type = gfc_get_derived_super_type (derived);
+  if (super_type)
+    resolve_typebound_procedures (super_type);
+
+  resolve_bindings_derived = derived;
+  resolve_bindings_result = SUCCESS;
+
+  /* Make sure the vtab has been generated.  */
+  gfc_find_derived_vtab (derived);
+
+  if (derived->f2k_derived->tb_sym_root)
+    gfc_traverse_symtree (derived->f2k_derived->tb_sym_root,
+			  &resolve_typebound_procedure);
+
+  if (derived->f2k_derived->tb_uop_root)
+    gfc_traverse_symtree (derived->f2k_derived->tb_uop_root,
+			  &resolve_typebound_user_op);
+
+  for (op = 0; op != GFC_INTRINSIC_OPS; ++op)
+    {
+      gfc_typebound_proc* p = derived->f2k_derived->tb_op[op];
+      if (p && resolve_typebound_intrinsic_op (derived, (gfc_intrinsic_op) op,
+					       p) == FAILURE)
+	resolve_bindings_result = FAILURE;
+    }
+
+  return resolve_bindings_result;
+}
+
+
+/* Add a derived type to the dt_list.  The dt_list is used in trans-types.c
+   to give all identical derived types the same backend_decl.  */
+static void
+add_dt_to_dt_list (gfc_symbol *derived)
+{
+  gfc_dt_list *dt_list;
+
+  for (dt_list = gfc_derived_types; dt_list; dt_list = dt_list->next)
+    if (derived == dt_list->derived)
+      return;
+
+  dt_list = gfc_get_dt_list ();
+  dt_list->next = gfc_derived_types;
+  dt_list->derived = derived;
+  gfc_derived_types = dt_list;
+}
+
+
+/* Ensure that a derived-type is really not abstract, meaning that every
+   inherited DEFERRED binding is overridden by a non-DEFERRED one.  */
+
+static gfc_try
+ensure_not_abstract_walker (gfc_symbol* sub, gfc_symtree* st)
+{
+  if (!st)
+    return SUCCESS;
+
+  if (ensure_not_abstract_walker (sub, st->left) == FAILURE)
+    return FAILURE;
+  if (ensure_not_abstract_walker (sub, st->right) == FAILURE)
+    return FAILURE;
+
+  if (st->n.tb && st->n.tb->deferred)
+    {
+      gfc_symtree* overriding;
+      overriding = gfc_find_typebound_proc (sub, NULL, st->name, true, NULL);
+      if (!overriding)
+	return FAILURE;
+      gcc_assert (overriding->n.tb);
+      if (overriding->n.tb->deferred)
+	{
+	  gfc_error ("Derived-type '%s' declared at %L must be ABSTRACT because"
+		     " '%s' is DEFERRED and not overridden",
+		     sub->name, &sub->declared_at, st->name);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+static gfc_try
+ensure_not_abstract (gfc_symbol* sub, gfc_symbol* ancestor)
+{
+  /* The algorithm used here is to recursively travel up the ancestry of sub
+     and for each ancestor-type, check all bindings.  If any of them is
+     DEFERRED, look it up starting from sub and see if the found (overriding)
+     binding is not DEFERRED.
+     This is not the most efficient way to do this, but it should be ok and is
+     clearer than something sophisticated.  */
+
+  gcc_assert (ancestor && !sub->attr.abstract);
+  
+  if (!ancestor->attr.abstract)
+    return SUCCESS;
+
+  /* Walk bindings of this ancestor.  */
+  if (ancestor->f2k_derived)
+    {
+      gfc_try t;
+      t = ensure_not_abstract_walker (sub, ancestor->f2k_derived->tb_sym_root);
+      if (t == FAILURE)
+	return FAILURE;
+    }
+
+  /* Find next ancestor type and recurse on it.  */
+  ancestor = gfc_get_derived_super_type (ancestor);
+  if (ancestor)
+    return ensure_not_abstract (sub, ancestor);
+
+  return SUCCESS;
+}
+
+
+/* Resolve the components of a derived type. This does not have to wait until
+   resolution stage, but can be done as soon as the dt declaration has been
+   parsed.  */
+
+static gfc_try
+resolve_fl_derived0 (gfc_symbol *sym)
+{
+  gfc_symbol* super_type;
+  gfc_component *c;
+
+  super_type = gfc_get_derived_super_type (sym);
+
+  /* F2008, C432. */
+  if (super_type && sym->attr.coarray_comp && !super_type->attr.coarray_comp)
+    {
+      gfc_error ("As extending type '%s' at %L has a coarray component, "
+		 "parent type '%s' shall also have one", sym->name,
+		 &sym->declared_at, super_type->name);
+      return FAILURE;
+    }
+
+  /* Ensure the extended type gets resolved before we do.  */
+  if (super_type && resolve_fl_derived0 (super_type) == FAILURE)
+    return FAILURE;
+
+  /* An ABSTRACT type must be extensible.  */
+  if (sym->attr.abstract && !gfc_type_is_extensible (sym))
+    {
+      gfc_error ("Non-extensible derived-type '%s' at %L must not be ABSTRACT",
+		 sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+
+  for (c = sym->components; c != NULL; c = c->next)
+    {
+      /* See PRs 51550, 47545, 48654, 49050, 51075 - and 45170.  */
+      if (c->ts.type == BT_CHARACTER && c->ts.deferred)
+	{
+	  gfc_error ("Deferred-length character component '%s' at %L is not "
+		     "yet supported", c->name, &c->loc);
+	  return FAILURE;
+	}
+
+      /* F2008, C442.  */
+      if (c->attr.codimension /* FIXME: c->as check due to PR 43412.  */
+	  && (!c->attr.allocatable || (c->as && c->as->type != AS_DEFERRED)))
+	{
+	  gfc_error ("Coarray component '%s' at %L must be allocatable with "
+		     "deferred shape", c->name, &c->loc);
+	  return FAILURE;
+	}
+
+      /* F2008, C443.  */
+      if (c->attr.codimension && c->ts.type == BT_DERIVED
+	  && c->ts.u.derived->ts.is_iso_c)
+	{
+	  gfc_error ("Component '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
+		     "shall not be a coarray", c->name, &c->loc);
+	  return FAILURE;
+	}
+
+      /* F2008, C444.  */
+      if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp
+	  && (c->attr.codimension || c->attr.pointer || c->attr.dimension
+	      || c->attr.allocatable))
+	{
+	  gfc_error ("Component '%s' at %L with coarray component "
+		     "shall be a nonpointer, nonallocatable scalar",
+		     c->name, &c->loc);
+	  return FAILURE;
+	}
+
+      /* F2008, C448.  */
+      if (c->attr.contiguous && (!c->attr.dimension || !c->attr.pointer))
+	{
+	  gfc_error ("Component '%s' at %L has the CONTIGUOUS attribute but "
+		     "is not an array pointer", c->name, &c->loc);
+	  return FAILURE;
+	}
+
+      if (c->attr.proc_pointer && c->ts.interface)
+	{
+	  if (c->ts.interface->attr.procedure && !sym->attr.vtype)
+	    gfc_error ("Interface '%s', used by procedure pointer component "
+		       "'%s' at %L, is declared in a later PROCEDURE statement",
+		       c->ts.interface->name, c->name, &c->loc);
+
+	  /* Get the attributes from the interface (now resolved).  */
+	  if (c->ts.interface->attr.if_source
+	      || c->ts.interface->attr.intrinsic)
+	    {
+	      gfc_symbol *ifc = c->ts.interface;
+
+	      if (ifc->formal && !ifc->formal_ns)
+		resolve_symbol (ifc);
+
+	      if (ifc->attr.intrinsic)
+		resolve_intrinsic (ifc, &ifc->declared_at);
+
+	      if (ifc->result)
+		{
+		  c->ts = ifc->result->ts;
+		  c->attr.allocatable = ifc->result->attr.allocatable;
+		  c->attr.pointer = ifc->result->attr.pointer;
+		  c->attr.dimension = ifc->result->attr.dimension;
+		  c->as = gfc_copy_array_spec (ifc->result->as);
+		}
+	      else
+		{   
+		  c->ts = ifc->ts;
+		  c->attr.allocatable = ifc->attr.allocatable;
+		  c->attr.pointer = ifc->attr.pointer;
+		  c->attr.dimension = ifc->attr.dimension;
+		  c->as = gfc_copy_array_spec (ifc->as);
+		}
+	      c->ts.interface = ifc;
+	      c->attr.function = ifc->attr.function;
+	      c->attr.subroutine = ifc->attr.subroutine;
+	      gfc_copy_formal_args_ppc (c, ifc);
+
+	      c->attr.pure = ifc->attr.pure;
+	      c->attr.elemental = ifc->attr.elemental;
+	      c->attr.recursive = ifc->attr.recursive;
+	      c->attr.always_explicit = ifc->attr.always_explicit;
+	      c->attr.ext_attr |= ifc->attr.ext_attr;
+	      /* Replace symbols in array spec.  */
+	      if (c->as)
+		{
+		  int i;
+		  for (i = 0; i < c->as->rank; i++)
+		    {
+		      gfc_expr_replace_comp (c->as->lower[i], c);
+		      gfc_expr_replace_comp (c->as->upper[i], c);
+		    }
+	        }
+	      /* Copy char length.  */
+	      if (ifc->ts.type == BT_CHARACTER && ifc->ts.u.cl)
+		{
+		  gfc_charlen *cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
+		  gfc_expr_replace_comp (cl->length, c);
+		  if (cl->length && !cl->resolved
+		        && gfc_resolve_expr (cl->length) == FAILURE)
+		    return FAILURE;
+		  c->ts.u.cl = cl;
+		}
+	    }
+	  else if (!sym->attr.vtype && c->ts.interface->name[0] != '\0')
+	    {
+	      gfc_error ("Interface '%s' of procedure pointer component "
+			 "'%s' at %L must be explicit", c->ts.interface->name,
+			 c->name, &c->loc);
+	      return FAILURE;
+ 	    }
+	}
+      else if (c->attr.proc_pointer && c->ts.type == BT_UNKNOWN)
+	{
+	  /* Since PPCs are not implicitly typed, a PPC without an explicit
+	     interface must be a subroutine.  */
+	  gfc_add_subroutine (&c->attr, c->name, &c->loc);
+	}
+
+      /* Procedure pointer components: Check PASS arg.  */
+      if (c->attr.proc_pointer && !c->tb->nopass && c->tb->pass_arg_num == 0
+	  && !sym->attr.vtype)
+	{
+	  gfc_symbol* me_arg;
+
+	  if (c->tb->pass_arg)
+	    {
+	      gfc_formal_arglist* i;
+
+	      /* If an explicit passing argument name is given, walk the arg-list
+		and look for it.  */
+
+	      me_arg = NULL;
+	      c->tb->pass_arg_num = 1;
+	      for (i = c->formal; i; i = i->next)
+		{
+		  if (!strcmp (i->sym->name, c->tb->pass_arg))
+		    {
+		      me_arg = i->sym;
+		      break;
+		    }
+		  c->tb->pass_arg_num++;
+		}
+
+	      if (!me_arg)
+		{
+		  gfc_error ("Procedure pointer component '%s' with PASS(%s) "
+			     "at %L has no argument '%s'", c->name,
+			     c->tb->pass_arg, &c->loc, c->tb->pass_arg);
+		  c->tb->error = 1;
+		  return FAILURE;
+		}
+	    }
+	  else
+	    {
+	      /* Otherwise, take the first one; there should in fact be at least
+		one.  */
+	      c->tb->pass_arg_num = 1;
+	      if (!c->formal)
+		{
+		  gfc_error ("Procedure pointer component '%s' with PASS at %L "
+			     "must have at least one argument",
+			     c->name, &c->loc);
+		  c->tb->error = 1;
+		  return FAILURE;
+		}
+	      me_arg = c->formal->sym;
+	    }
+
+	  /* Now check that the argument-type matches.  */
+	  gcc_assert (me_arg);
+	  if ((me_arg->ts.type != BT_DERIVED && me_arg->ts.type != BT_CLASS)
+	      || (me_arg->ts.type == BT_DERIVED && me_arg->ts.u.derived != sym)
+	      || (me_arg->ts.type == BT_CLASS
+		  && CLASS_DATA (me_arg)->ts.u.derived != sym))
+	    {
+	      gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L must be of"
+			 " the derived type '%s'", me_arg->name, c->name,
+			 me_arg->name, &c->loc, sym->name);
+	      c->tb->error = 1;
+	      return FAILURE;
+	    }
+
+	  /* Check for C453.  */
+	  if (me_arg->attr.dimension)
+	    {
+	      gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L "
+			 "must be scalar", me_arg->name, c->name, me_arg->name,
+			 &c->loc);
+	      c->tb->error = 1;
+	      return FAILURE;
+	    }
+
+	  if (me_arg->attr.pointer)
+	    {
+	      gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L "
+			 "may not have the POINTER attribute", me_arg->name,
+			 c->name, me_arg->name, &c->loc);
+	      c->tb->error = 1;
+	      return FAILURE;
+	    }
+
+	  if (me_arg->attr.allocatable)
+	    {
+	      gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L "
+			 "may not be ALLOCATABLE", me_arg->name, c->name,
+			 me_arg->name, &c->loc);
+	      c->tb->error = 1;
+	      return FAILURE;
+	    }
+
+	  if (gfc_type_is_extensible (sym) && me_arg->ts.type != BT_CLASS)
+	    gfc_error ("Non-polymorphic passed-object dummy argument of '%s'"
+		       " at %L", c->name, &c->loc);
+
+	}
+
+      /* Check type-spec if this is not the parent-type component.  */
+      if ((!sym->attr.extension || c != sym->components) && !sym->attr.vtype
+	  && resolve_typespec_used (&c->ts, &c->loc, c->name) == FAILURE)
+	return FAILURE;
+
+      /* If this type is an extension, set the accessibility of the parent
+	 component.  */
+      if (super_type && c == sym->components
+	  && strcmp (super_type->name, c->name) == 0)
+	c->attr.access = super_type->attr.access;
+      
+      /* If this type is an extension, see if this component has the same name
+	 as an inherited type-bound procedure.  */
+      if (super_type && !sym->attr.is_class
+	  && gfc_find_typebound_proc (super_type, NULL, c->name, true, NULL))
+	{
+	  gfc_error ("Component '%s' of '%s' at %L has the same name as an"
+		     " inherited type-bound procedure",
+		     c->name, sym->name, &c->loc);
+	  return FAILURE;
+	}
+
+      if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer
+	    && !c->ts.deferred)
+	{
+	 if (c->ts.u.cl->length == NULL
+	     || (resolve_charlen (c->ts.u.cl) == FAILURE)
+	     || !gfc_is_constant_expr (c->ts.u.cl->length))
+	   {
+	     gfc_error ("Character length of component '%s' needs to "
+			"be a constant specification expression at %L",
+			c->name,
+			c->ts.u.cl->length ? &c->ts.u.cl->length->where : &c->loc);
+	     return FAILURE;
+	   }
+	}
+
+      if (c->ts.type == BT_CHARACTER && c->ts.deferred
+	  && !c->attr.pointer && !c->attr.allocatable)
+	{
+	  gfc_error ("Character component '%s' of '%s' at %L with deferred "
+		     "length must be a POINTER or ALLOCATABLE",
+		     c->name, sym->name, &c->loc);
+	  return FAILURE;
+	}
+
+      if (c->ts.type == BT_DERIVED
+	  && sym->component_access != ACCESS_PRIVATE
+	  && gfc_check_symbol_access (sym)
+	  && !is_sym_host_assoc (c->ts.u.derived, sym->ns)
+	  && !c->ts.u.derived->attr.use_assoc
+	  && !gfc_check_symbol_access (c->ts.u.derived)
+	  && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: the component '%s' "
+			     "is a PRIVATE type and cannot be a component of "
+			     "'%s', which is PUBLIC at %L", c->name,
+			     sym->name, &sym->declared_at) == FAILURE)
+	return FAILURE;
+
+      if ((sym->attr.sequence || sym->attr.is_bind_c) && c->ts.type == BT_CLASS)
+	{
+	  gfc_error ("Polymorphic component %s at %L in SEQUENCE or BIND(C) "
+		     "type %s", c->name, &c->loc, sym->name);
+	  return FAILURE;
+	}
+
+      if (sym->attr.sequence)
+	{
+	  if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.sequence == 0)
+	    {
+	      gfc_error ("Component %s of SEQUENCE type declared at %L does "
+			 "not have the SEQUENCE attribute",
+			 c->ts.u.derived->name, &sym->declared_at);
+	      return FAILURE;
+	    }
+	}
+
+      if (!sym->attr.is_class && c->ts.type == BT_DERIVED && !sym->attr.vtype
+	  && c->attr.pointer && c->ts.u.derived->components == NULL
+	  && !c->ts.u.derived->attr.zero_comp)
+	{
+	  gfc_error ("The pointer component '%s' of '%s' at %L is a type "
+		     "that has not been declared", c->name, sym->name,
+		     &c->loc);
+	  return FAILURE;
+	}
+
+      if (c->ts.type == BT_CLASS && c->attr.class_ok
+	  && CLASS_DATA (c)->attr.class_pointer
+	  && CLASS_DATA (c)->ts.u.derived->components == NULL
+	  && !CLASS_DATA (c)->ts.u.derived->attr.zero_comp)
+	{
+	  gfc_error ("The pointer component '%s' of '%s' at %L is a type "
+		     "that has not been declared", c->name, sym->name,
+		     &c->loc);
+	  return FAILURE;
+	}
+
+      /* C437.  */
+      if (c->ts.type == BT_CLASS && c->attr.flavor != FL_PROCEDURE
+	  && (!c->attr.class_ok
+	      || !(CLASS_DATA (c)->attr.class_pointer
+		   || CLASS_DATA (c)->attr.allocatable)))
+	{
+	  gfc_error ("Component '%s' with CLASS at %L must be allocatable "
+		     "or pointer", c->name, &c->loc);
+	  /* Prevent a recurrence of the error.  */
+	  c->ts.type = BT_UNKNOWN;
+	  return FAILURE;
+	}
+
+      /* Ensure that all the derived type components are put on the
+	 derived type list; even in formal namespaces, where derived type
+	 pointer components might not have been declared.  */
+      if (c->ts.type == BT_DERIVED
+	    && c->ts.u.derived
+	    && c->ts.u.derived->components
+	    && c->attr.pointer
+	    && sym != c->ts.u.derived)
+	add_dt_to_dt_list (c->ts.u.derived);
+
+      if (gfc_resolve_array_spec (c->as, !(c->attr.pointer
+					   || c->attr.proc_pointer
+					   || c->attr.allocatable)) == FAILURE)
+	return FAILURE;
+    }
+
+  /* If this is a non-ABSTRACT type extending an ABSTRACT one, ensure that
+     all DEFERRED bindings are overridden.  */
+  if (super_type && super_type->attr.abstract && !sym->attr.abstract
+      && !sym->attr.is_class
+      && ensure_not_abstract (sym, super_type) == FAILURE)
+    return FAILURE;
+
+  /* Add derived type to the derived type list.  */
+  add_dt_to_dt_list (sym);
+
+  return SUCCESS;
+}
+
+
+/* The following procedure does the full resolution of a derived type,
+   including resolution of all type-bound procedures (if present). In contrast
+   to 'resolve_fl_derived0' this can only be done after the module has been
+   parsed completely.  */
+
+static gfc_try
+resolve_fl_derived (gfc_symbol *sym)
+{
+  if (sym->attr.is_class && sym->ts.u.derived == NULL)
+    {
+      /* Fix up incomplete CLASS symbols.  */
+      gfc_component *data = gfc_find_component (sym, "_data", true, true);
+      gfc_component *vptr = gfc_find_component (sym, "_vptr", true, true);
+      if (vptr->ts.u.derived == NULL)
+	{
+	  gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived);
+	  gcc_assert (vtab);
+	  vptr->ts.u.derived = vtab->ts.u.derived;
+	}
+    }
+  
+  if (resolve_fl_derived0 (sym) == FAILURE)
+    return FAILURE;
+  
+  /* Resolve the type-bound procedures.  */
+  if (resolve_typebound_procedures (sym) == FAILURE)
+    return FAILURE;
+
+  /* Resolve the finalizer procedures.  */
+  if (gfc_resolve_finalizers (sym) == FAILURE)
+    return FAILURE;
+  
+  return SUCCESS;
+}
+
+
+static gfc_try
+resolve_fl_namelist (gfc_symbol *sym)
+{
+  gfc_namelist *nl;
+  gfc_symbol *nlsym;
+
+  for (nl = sym->namelist; nl; nl = nl->next)
+    {
+      /* Check again, the check in match only works if NAMELIST comes
+	 after the decl.  */
+      if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SIZE)
+     	{
+	  gfc_error ("Assumed size array '%s' in namelist '%s' at %L is not "
+		     "allowed", nl->sym->name, sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+
+      if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE
+	  && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NAMELIST array "
+			     "object '%s' with assumed shape in namelist "
+			     "'%s' at %L", nl->sym->name, sym->name,
+			     &sym->declared_at) == FAILURE)
+	return FAILURE;
+
+      if (is_non_constant_shape_array (nl->sym)
+	  && gfc_notify_std (GFC_STD_F2003,  "Fortran 2003: NAMELIST array "
+			     "object '%s' with nonconstant shape in namelist "
+			     "'%s' at %L", nl->sym->name, sym->name,
+			     &sym->declared_at) == FAILURE)
+	return FAILURE;
+
+      if (nl->sym->ts.type == BT_CHARACTER
+	  && (nl->sym->ts.u.cl->length == NULL
+	      || !gfc_is_constant_expr (nl->sym->ts.u.cl->length))
+	  && gfc_notify_std (GFC_STD_F2003,  "Fortran 2003: NAMELIST object "
+			     "'%s' with nonconstant character length in "
+			     "namelist '%s' at %L", nl->sym->name, sym->name,
+			     &sym->declared_at) == FAILURE)
+	return FAILURE;
+
+      /* FIXME: Once UDDTIO is implemented, the following can be
+	 removed.  */
+      if (nl->sym->ts.type == BT_CLASS)
+	{
+	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L is "
+		     "polymorphic and requires a defined input/output "
+		     "procedure", nl->sym->name, sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+
+      if (nl->sym->ts.type == BT_DERIVED
+	  && (nl->sym->ts.u.derived->attr.alloc_comp
+	      || nl->sym->ts.u.derived->attr.pointer_comp))
+	{
+	  if (gfc_notify_std (GFC_STD_F2003,  "Fortran 2003: NAMELIST object "
+			      "'%s' in namelist '%s' at %L with ALLOCATABLE "
+			      "or POINTER components", nl->sym->name,
+			      sym->name, &sym->declared_at) == FAILURE)
+	    return FAILURE;
+
+	 /* FIXME: Once UDDTIO is implemented, the following can be
+	    removed.  */
+	  gfc_error ("NAMELIST object '%s' in namelist '%s' at %L has "
+		     "ALLOCATABLE or POINTER components and thus requires "
+		     "a defined input/output procedure", nl->sym->name,
+		     sym->name, &sym->declared_at);
+	  return FAILURE;
+	}
+    }
+
+  /* Reject PRIVATE objects in a PUBLIC namelist.  */
+  if (gfc_check_symbol_access (sym))
+    {
+      for (nl = sym->namelist; nl; nl = nl->next)
+	{
+	  if (!nl->sym->attr.use_assoc
+	      && !is_sym_host_assoc (nl->sym, sym->ns)
+	      && !gfc_check_symbol_access (nl->sym))
+	    {
+	      gfc_error ("NAMELIST object '%s' was declared PRIVATE and "
+			 "cannot be member of PUBLIC namelist '%s' at %L",
+			 nl->sym->name, sym->name, &sym->declared_at);
+	      return FAILURE;
+	    }
+
+	  /* Types with private components that came here by USE-association.  */
+	  if (nl->sym->ts.type == BT_DERIVED
+	      && derived_inaccessible (nl->sym->ts.u.derived))
+	    {
+	      gfc_error ("NAMELIST object '%s' has use-associated PRIVATE "
+			 "components and cannot be member of namelist '%s' at %L",
+			 nl->sym->name, sym->name, &sym->declared_at);
+	      return FAILURE;
+	    }
+
+	  /* Types with private components that are defined in the same module.  */
+	  if (nl->sym->ts.type == BT_DERIVED
+	      && !is_sym_host_assoc (nl->sym->ts.u.derived, sym->ns)
+	      && nl->sym->ts.u.derived->attr.private_comp)
+	    {
+	      gfc_error ("NAMELIST object '%s' has PRIVATE components and "
+			 "cannot be a member of PUBLIC namelist '%s' at %L",
+			 nl->sym->name, sym->name, &sym->declared_at);
+	      return FAILURE;
+	    }
+	}
+    }
+
+
+  /* 14.1.2 A module or internal procedure represent local entities
+     of the same type as a namelist member and so are not allowed.  */
+  for (nl = sym->namelist; nl; nl = nl->next)
+    {
+      if (nl->sym->ts.kind != 0 && nl->sym->attr.flavor == FL_VARIABLE)
+	continue;
+
+      if (nl->sym->attr.function && nl->sym == nl->sym->result)
+	if ((nl->sym == sym->ns->proc_name)
+	       ||
+	    (sym->ns->parent && nl->sym == sym->ns->parent->proc_name))
+	  continue;
+
+      nlsym = NULL;
+      if (nl->sym && nl->sym->name)
+	gfc_find_symbol (nl->sym->name, sym->ns, 1, &nlsym);
+      if (nlsym && nlsym->attr.flavor == FL_PROCEDURE)
+	{
+	  gfc_error ("PROCEDURE attribute conflicts with NAMELIST "
+		     "attribute in '%s' at %L", nlsym->name,
+		     &sym->declared_at);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+static gfc_try
+resolve_fl_parameter (gfc_symbol *sym)
+{
+  /* A parameter array's shape needs to be constant.  */
+  if (sym->as != NULL 
+      && (sym->as->type == AS_DEFERRED
+          || is_non_constant_shape_array (sym)))
+    {
+      gfc_error ("Parameter array '%s' at %L cannot be automatic "
+		 "or of deferred shape", sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+
+  /* Make sure a parameter that has been implicitly typed still
+     matches the implicit type, since PARAMETER statements can precede
+     IMPLICIT statements.  */
+  if (sym->attr.implicit_type
+      && !gfc_compare_types (&sym->ts, gfc_get_default_type (sym->name,
+							     sym->ns)))
+    {
+      gfc_error ("Implicitly typed PARAMETER '%s' at %L doesn't match a "
+		 "later IMPLICIT type", sym->name, &sym->declared_at);
+      return FAILURE;
+    }
+
+  /* Make sure the types of derived parameters are consistent.  This
+     type checking is deferred until resolution because the type may
+     refer to a derived type from the host.  */
+  if (sym->ts.type == BT_DERIVED
+      && !gfc_compare_types (&sym->ts, &sym->value->ts))
+    {
+      gfc_error ("Incompatible derived type in PARAMETER at %L",
+		 &sym->value->where);
+      return FAILURE;
+    }
+  return SUCCESS;
+}
+
+
+/* Do anything necessary to resolve a symbol.  Right now, we just
+   assume that an otherwise unknown symbol is a variable.  This sort
+   of thing commonly happens for symbols in module.  */
+
+static void
+resolve_symbol (gfc_symbol *sym)
+{
+  int check_constant, mp_flag;
+  gfc_symtree *symtree;
+  gfc_symtree *this_symtree;
+  gfc_namespace *ns;
+  gfc_component *c;
+
+  if (sym->attr.flavor == FL_UNKNOWN)
+    {
+
+    /* If we find that a flavorless symbol is an interface in one of the
+       parent namespaces, find its symtree in this namespace, free the
+       symbol and set the symtree to point to the interface symbol.  */
+      for (ns = gfc_current_ns->parent; ns; ns = ns->parent)
+	{
+	  symtree = gfc_find_symtree (ns->sym_root, sym->name);
+	  if (symtree && (symtree->n.sym->generic ||
+			  (symtree->n.sym->attr.flavor == FL_PROCEDURE
+			   && sym->ns->construct_entities)))
+	    {
+	      this_symtree = gfc_find_symtree (gfc_current_ns->sym_root,
+					       sym->name);
+	      gfc_release_symbol (sym);
+	      symtree->n.sym->refs++;
+	      this_symtree->n.sym = symtree->n.sym;
+	      return;
+	    }
+	}
+
+      /* Otherwise give it a flavor according to such attributes as
+	 it has.  */
+      if (sym->attr.external == 0 && sym->attr.intrinsic == 0)
+	sym->attr.flavor = FL_VARIABLE;
+      else
+	{
+	  sym->attr.flavor = FL_PROCEDURE;
+	  if (sym->attr.dimension)
+	    sym->attr.function = 1;
+	}
+    }
+
+  if (sym->attr.external && sym->ts.type != BT_UNKNOWN && !sym->attr.function)
+    gfc_add_function (&sym->attr, sym->name, &sym->declared_at);
+
+  if (sym->attr.procedure && sym->ts.interface
+      && sym->attr.if_source != IFSRC_DECL
+      && resolve_procedure_interface (sym) == FAILURE)
+    return;
+
+  if (sym->attr.is_protected && !sym->attr.proc_pointer
+      && (sym->attr.procedure || sym->attr.external))
+    {
+      if (sym->attr.external)
+	gfc_error ("PROTECTED attribute conflicts with EXTERNAL attribute "
+	           "at %L", &sym->declared_at);
+      else
+	gfc_error ("PROCEDURE attribute conflicts with PROTECTED attribute "
+	           "at %L", &sym->declared_at);
+
+      return;
+    }
+
+
+  /* F2008, C530. */
+  if (sym->attr.contiguous
+      && (!sym->attr.dimension || (sym->as->type != AS_ASSUMED_SHAPE
+				   && !sym->attr.pointer)))
+    {
+      gfc_error ("'%s' at %L has the CONTIGUOUS attribute but is not an "
+		  "array pointer or an assumed-shape array", sym->name,
+		  &sym->declared_at);
+      return;
+    }
+
+  if (sym->attr.flavor == FL_DERIVED && resolve_fl_derived (sym) == FAILURE)
+    return;
+
+  /* Symbols that are module procedures with results (functions) have
+     the types and array specification copied for type checking in
+     procedures that call them, as well as for saving to a module
+     file.  These symbols can't stand the scrutiny that their results
+     can.  */
+  mp_flag = (sym->result != NULL && sym->result != sym);
+
+  /* Make sure that the intrinsic is consistent with its internal 
+     representation. This needs to be done before assigning a default 
+     type to avoid spurious warnings.  */
+  if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic
+      && resolve_intrinsic (sym, &sym->declared_at) == FAILURE)
+    return;
+
+  /* Resolve associate names.  */
+  if (sym->assoc)
+    resolve_assoc_var (sym, true);
+
+  /* Assign default type to symbols that need one and don't have one.  */
+  if (sym->ts.type == BT_UNKNOWN)
+    {
+      if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER)
+	gfc_set_default_type (sym, 1, NULL);
+
+      if (sym->attr.flavor == FL_PROCEDURE && sym->attr.external
+	  && !sym->attr.function && !sym->attr.subroutine
+	  && gfc_get_default_type (sym->name, sym->ns)->type == BT_UNKNOWN)
+	gfc_add_subroutine (&sym->attr, sym->name, &sym->declared_at);
+
+      if (sym->attr.flavor == FL_PROCEDURE && sym->attr.function)
+	{
+	  /* The specific case of an external procedure should emit an error
+	     in the case that there is no implicit type.  */
+	  if (!mp_flag)
+	    gfc_set_default_type (sym, sym->attr.external, NULL);
+	  else
+	    {
+	      /* Result may be in another namespace.  */
+	      resolve_symbol (sym->result);
+
+	      if (!sym->result->attr.proc_pointer)
+		{
+		  sym->ts = sym->result->ts;
+		  sym->as = gfc_copy_array_spec (sym->result->as);
+		  sym->attr.dimension = sym->result->attr.dimension;
+		  sym->attr.pointer = sym->result->attr.pointer;
+		  sym->attr.allocatable = sym->result->attr.allocatable;
+		  sym->attr.contiguous = sym->result->attr.contiguous;
+		}
+	    }
+	}
+    }
+  else if (mp_flag && sym->attr.flavor == FL_PROCEDURE && sym->attr.function)
+    gfc_resolve_array_spec (sym->result->as, false);
+
+  /* Assumed size arrays and assumed shape arrays must be dummy
+     arguments.  Array-spec's of implied-shape should have been resolved to
+     AS_EXPLICIT already.  */
+
+  if (sym->as)
+    {
+      gcc_assert (sym->as->type != AS_IMPLIED_SHAPE);
+      if (((sym->as->type == AS_ASSUMED_SIZE && !sym->as->cp_was_assumed)
+	   || sym->as->type == AS_ASSUMED_SHAPE)
+	  && sym->attr.dummy == 0)
+	{
+	  if (sym->as->type == AS_ASSUMED_SIZE)
+	    gfc_error ("Assumed size array at %L must be a dummy argument",
+		       &sym->declared_at);
+	  else
+	    gfc_error ("Assumed shape array at %L must be a dummy argument",
+		       &sym->declared_at);
+	  return;
+	}
+    }
+
+  /* Make sure symbols with known intent or optional are really dummy
+     variable.  Because of ENTRY statement, this has to be deferred
+     until resolution time.  */
+
+  if (!sym->attr.dummy
+      && (sym->attr.optional || sym->attr.intent != INTENT_UNKNOWN))
+    {
+      gfc_error ("Symbol at %L is not a DUMMY variable", &sym->declared_at);
+      return;
+    }
+
+  if (sym->attr.value && !sym->attr.dummy)
+    {
+      gfc_error ("'%s' at %L cannot have the VALUE attribute because "
+		 "it is not a dummy argument", sym->name, &sym->declared_at);
+      return;
+    }
+
+  if (sym->attr.value && sym->ts.type == BT_CHARACTER)
+    {
+      gfc_charlen *cl = sym->ts.u.cl;
+      if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
+	{
+	  gfc_error ("Character dummy variable '%s' at %L with VALUE "
+		     "attribute must have constant length",
+		     sym->name, &sym->declared_at);
+	  return;
+	}
+
+      if (sym->ts.is_c_interop
+	  && mpz_cmp_si (cl->length->value.integer, 1) != 0)
+	{
+	  gfc_error ("C interoperable character dummy variable '%s' at %L "
+		     "with VALUE attribute must have length one",
+		     sym->name, &sym->declared_at);
+	  return;
+	}
+    }
+
+  /* If the symbol is marked as bind(c), verify it's type and kind.  Do not
+     do this for something that was implicitly typed because that is handled
+     in gfc_set_default_type.  Handle dummy arguments and procedure
+     definitions separately.  Also, anything that is use associated is not
+     handled here but instead is handled in the module it is declared in.
+     Finally, derived type definitions are allowed to be BIND(C) since that
+     only implies that they're interoperable, and they are checked fully for
+     interoperability when a variable is declared of that type.  */
+  if (sym->attr.is_bind_c && sym->attr.implicit_type == 0 &&
+      sym->attr.use_assoc == 0 && sym->attr.dummy == 0 &&
+      sym->attr.flavor != FL_PROCEDURE && sym->attr.flavor != FL_DERIVED)
+    {
+      gfc_try t = SUCCESS;
+      
+      /* First, make sure the variable is declared at the
+	 module-level scope (J3/04-007, Section 15.3).	*/
+      if (sym->ns->proc_name->attr.flavor != FL_MODULE &&
+          sym->attr.in_common == 0)
+	{
+	  gfc_error ("Variable '%s' at %L cannot be BIND(C) because it "
+		     "is neither a COMMON block nor declared at the "
+		     "module level scope", sym->name, &(sym->declared_at));
+	  t = FAILURE;
+	}
+      else if (sym->common_head != NULL)
+        {
+          t = verify_com_block_vars_c_interop (sym->common_head);
+        }
+      else
+	{
+	  /* If type() declaration, we need to verify that the components
+	     of the given type are all C interoperable, etc.  */
+	  if (sym->ts.type == BT_DERIVED &&
+              sym->ts.u.derived->attr.is_c_interop != 1)
+            {
+              /* Make sure the user marked the derived type as BIND(C).  If
+                 not, call the verify routine.  This could print an error
+                 for the derived type more than once if multiple variables
+                 of that type are declared.  */
+              if (sym->ts.u.derived->attr.is_bind_c != 1)
+                verify_bind_c_derived_type (sym->ts.u.derived);
+              t = FAILURE;
+            }
+	  
+	  /* Verify the variable itself as C interoperable if it
+             is BIND(C).  It is not possible for this to succeed if
+             the verify_bind_c_derived_type failed, so don't have to handle
+             any error returned by verify_bind_c_derived_type.  */
+          t = verify_bind_c_sym (sym, &(sym->ts), sym->attr.in_common,
+                                 sym->common_block);
+	}
+
+      if (t == FAILURE)
+        {
+          /* clear the is_bind_c flag to prevent reporting errors more than
+             once if something failed.  */
+          sym->attr.is_bind_c = 0;
+          return;
+        }
+    }
+
+  /* If a derived type symbol has reached this point, without its
+     type being declared, we have an error.  Notice that most
+     conditions that produce undefined derived types have already
+     been dealt with.  However, the likes of:
+     implicit type(t) (t) ..... call foo (t) will get us here if
+     the type is not declared in the scope of the implicit
+     statement. Change the type to BT_UNKNOWN, both because it is so
+     and to prevent an ICE.  */
+  if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->components == NULL
+      && !sym->ts.u.derived->attr.zero_comp)
+    {
+      gfc_error ("The derived type '%s' at %L is of type '%s', "
+		 "which has not been defined", sym->name,
+		  &sym->declared_at, sym->ts.u.derived->name);
+      sym->ts.type = BT_UNKNOWN;
+      return;
+    }
+
+  /* Make sure that the derived type has been resolved and that the
+     derived type is visible in the symbol's namespace, if it is a
+     module function and is not PRIVATE.  */
+  if (sym->ts.type == BT_DERIVED
+	&& sym->ts.u.derived->attr.use_assoc
+	&& sym->ns->proc_name
+	&& sym->ns->proc_name->attr.flavor == FL_MODULE)
+    {
+      gfc_symbol *ds;
+
+      if (resolve_fl_derived (sym->ts.u.derived) == FAILURE)
+	return;
+
+      gfc_find_symbol (sym->ts.u.derived->name, sym->ns, 1, &ds);
+      if (!ds && sym->attr.function && gfc_check_symbol_access (sym))
+	{
+	  symtree = gfc_new_symtree (&sym->ns->sym_root,
+				     sym->ts.u.derived->name);
+	  symtree->n.sym = sym->ts.u.derived;
+	  sym->ts.u.derived->refs++;
+	}
+    }
+
+  /* Unless the derived-type declaration is use associated, Fortran 95
+     does not allow public entries of private derived types.
+     See 4.4.1 (F95) and 4.5.1.1 (F2003); and related interpretation
+     161 in 95-006r3.  */
+  if (sym->ts.type == BT_DERIVED
+      && sym->ns->proc_name && sym->ns->proc_name->attr.flavor == FL_MODULE
+      && !sym->ts.u.derived->attr.use_assoc
+      && gfc_check_symbol_access (sym)
+      && !gfc_check_symbol_access (sym->ts.u.derived)
+      && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PUBLIC %s '%s' at %L "
+		         "of PRIVATE derived type '%s'",
+			 (sym->attr.flavor == FL_PARAMETER) ? "parameter"
+			 : "variable", sym->name, &sym->declared_at,
+			 sym->ts.u.derived->name) == FAILURE)
+    return;
+
+  /* An assumed-size array with INTENT(OUT) shall not be of a type for which
+     default initialization is defined (5.1.2.4.4).  */
+  if (sym->ts.type == BT_DERIVED
+      && sym->attr.dummy
+      && sym->attr.intent == INTENT_OUT
+      && sym->as
+      && sym->as->type == AS_ASSUMED_SIZE)
+    {
+      for (c = sym->ts.u.derived->components; c; c = c->next)
+	{
+	  if (c->initializer)
+	    {
+	      gfc_error ("The INTENT(OUT) dummy argument '%s' at %L is "
+			 "ASSUMED SIZE and so cannot have a default initializer",
+			 sym->name, &sym->declared_at);
+	      return;
+	    }
+	}
+    }
+
+  /* F2008, C526.  */
+  if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
+       || sym->attr.codimension)
+      && sym->attr.result)
+    gfc_error ("Function result '%s' at %L shall not be a coarray or have "
+	       "a coarray component", sym->name, &sym->declared_at);
+
+  /* F2008, C524.  */
+  if (sym->attr.codimension && sym->ts.type == BT_DERIVED
+      && sym->ts.u.derived->ts.is_iso_c)
+    gfc_error ("Variable '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
+	       "shall not be a coarray", sym->name, &sym->declared_at);
+
+  /* F2008, C525.  */
+  if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp
+      && (sym->attr.codimension || sym->attr.pointer || sym->attr.dimension
+	  || sym->attr.allocatable))
+    gfc_error ("Variable '%s' at %L with coarray component "
+	       "shall be a nonpointer, nonallocatable scalar",
+	       sym->name, &sym->declared_at);
+
+  /* F2008, C526.  The function-result case was handled above.  */
+  if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
+       || sym->attr.codimension)
+      && !(sym->attr.allocatable || sym->attr.dummy || sym->attr.save
+	   || sym->ns->proc_name->attr.flavor == FL_MODULE
+	   || sym->ns->proc_name->attr.is_main_program
+	   || sym->attr.function || sym->attr.result || sym->attr.use_assoc))
+    gfc_error ("Variable '%s' at %L is a coarray or has a coarray "
+	       "component and is not ALLOCATABLE, SAVE nor a "
+	       "dummy argument", sym->name, &sym->declared_at);
+  /* F2008, C528.  */  /* FIXME: sym->as check due to PR 43412.  */
+  else if (sym->attr.codimension && !sym->attr.allocatable
+      && sym->as && sym->as->cotype == AS_DEFERRED)
+    gfc_error ("Coarray variable '%s' at %L shall not have codimensions with "
+		"deferred shape", sym->name, &sym->declared_at);
+  else if (sym->attr.codimension && sym->attr.allocatable
+      && (sym->as->type != AS_DEFERRED || sym->as->cotype != AS_DEFERRED))
+    gfc_error ("Allocatable coarray variable '%s' at %L must have "
+	       "deferred shape", sym->name, &sym->declared_at);
+
+
+  /* F2008, C541.  */
+  if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
+       || (sym->attr.codimension && sym->attr.allocatable))
+      && sym->attr.dummy && sym->attr.intent == INTENT_OUT)
+    gfc_error ("Variable '%s' at %L is INTENT(OUT) and can thus not be an "
+	       "allocatable coarray or have coarray components",
+	       sym->name, &sym->declared_at);
+
+  if (sym->attr.codimension && sym->attr.dummy
+      && sym->ns->proc_name && sym->ns->proc_name->attr.is_bind_c)
+    gfc_error ("Coarray dummy variable '%s' at %L not allowed in BIND(C) "
+	       "procedure '%s'", sym->name, &sym->declared_at,
+	       sym->ns->proc_name->name);
+
+  switch (sym->attr.flavor)
+    {
+    case FL_VARIABLE:
+      if (resolve_fl_variable (sym, mp_flag) == FAILURE)
+	return;
+      break;
+
+    case FL_PROCEDURE:
+      if (resolve_fl_procedure (sym, mp_flag) == FAILURE)
+	return;
+      break;
+
+    case FL_NAMELIST:
+      if (resolve_fl_namelist (sym) == FAILURE)
+	return;
+      break;
+
+    case FL_PARAMETER:
+      if (resolve_fl_parameter (sym) == FAILURE)
+	return;
+      break;
+
+    default:
+      break;
+    }
+
+  /* Resolve array specifier. Check as well some constraints
+     on COMMON blocks.  */
+
+  check_constant = sym->attr.in_common && !sym->attr.pointer;
+
+  /* Set the formal_arg_flag so that check_conflict will not throw
+     an error for host associated variables in the specification
+     expression for an array_valued function.  */
+  if (sym->attr.function && sym->as)
+    formal_arg_flag = 1;
+
+  gfc_resolve_array_spec (sym->as, check_constant);
+
+  formal_arg_flag = 0;
+
+  /* Resolve formal namespaces.  */
+  if (sym->formal_ns && sym->formal_ns != gfc_current_ns
+      && !sym->attr.contained && !sym->attr.intrinsic)
+    gfc_resolve (sym->formal_ns);
+
+  /* Make sure the formal namespace is present.  */
+  if (sym->formal && !sym->formal_ns)
+    {
+      gfc_formal_arglist *formal = sym->formal;
+      while (formal && !formal->sym)
+	formal = formal->next;
+
+      if (formal)
+	{
+	  sym->formal_ns = formal->sym->ns;
+	  sym->formal_ns->refs++;
+	}
+    }
+
+  /* Check threadprivate restrictions.  */
+  if (sym->attr.threadprivate && !sym->attr.save && !sym->ns->save_all
+      && (!sym->attr.in_common
+	  && sym->module == NULL
+	  && (sym->ns->proc_name == NULL
+	      || sym->ns->proc_name->attr.flavor != FL_MODULE)))
+    gfc_error ("Threadprivate at %L isn't SAVEd", &sym->declared_at);
+
+  /* If we have come this far we can apply default-initializers, as
+     described in 14.7.5, to those variables that have not already
+     been assigned one.  */
+  if (sym->ts.type == BT_DERIVED
+      && sym->ns == gfc_current_ns
+      && !sym->value
+      && !sym->attr.allocatable
+      && !sym->attr.alloc_comp)
+    {
+      symbol_attribute *a = &sym->attr;
+
+      if ((!a->save && !a->dummy && !a->pointer
+	   && !a->in_common && !a->use_assoc
+	   && (a->referenced || a->result)
+	   && !(a->function && sym != sym->result))
+	  || (a->dummy && a->intent == INTENT_OUT && !a->pointer))
+	apply_default_init (sym);
+    }
+
+  if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns
+      && sym->attr.dummy && sym->attr.intent == INTENT_OUT
+      && !CLASS_DATA (sym)->attr.class_pointer
+      && !CLASS_DATA (sym)->attr.allocatable)
+    apply_default_init (sym);
+
+  /* If this symbol has a type-spec, check it.  */
+  if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER
+      || (sym->attr.flavor == FL_PROCEDURE && sym->attr.function))
+    if (resolve_typespec_used (&sym->ts, &sym->declared_at, sym->name)
+	  == FAILURE)
+      return;
+}
+
+
+/************* Resolve DATA statements *************/
+
+static struct
+{
+  gfc_data_value *vnode;
+  mpz_t left;
+}
+values;
+
+
+/* Advance the values structure to point to the next value in the data list.  */
+
+static gfc_try
+next_data_value (void)
+{
+  while (mpz_cmp_ui (values.left, 0) == 0)
+    {
+
+      if (values.vnode->next == NULL)
+	return FAILURE;
+
+      values.vnode = values.vnode->next;
+      mpz_set (values.left, values.vnode->repeat);
+    }
+
+  return SUCCESS;
+}
+
+
+static gfc_try
+check_data_variable (gfc_data_variable *var, locus *where)
+{
+  gfc_expr *e;
+  mpz_t size;
+  mpz_t offset;
+  gfc_try t;
+  ar_type mark = AR_UNKNOWN;
+  int i;
+  mpz_t section_index[GFC_MAX_DIMENSIONS];
+  gfc_ref *ref;
+  gfc_array_ref *ar;
+  gfc_symbol *sym;
+  int has_pointer;
+
+  if (gfc_resolve_expr (var->expr) == FAILURE)
+    return FAILURE;
+
+  ar = NULL;
+  mpz_init_set_si (offset, 0);
+  e = var->expr;
+
+  if (e->expr_type != EXPR_VARIABLE)
+    gfc_internal_error ("check_data_variable(): Bad expression");
+
+  sym = e->symtree->n.sym;
+
+  if (sym->ns->is_block_data && !sym->attr.in_common)
+    {
+      gfc_error ("BLOCK DATA element '%s' at %L must be in COMMON",
+		 sym->name, &sym->declared_at);
+    }
+
+  if (e->ref == NULL && sym->as)
+    {
+      gfc_error ("DATA array '%s' at %L must be specified in a previous"
+		 " declaration", sym->name, where);
+      return FAILURE;
+    }
+
+  has_pointer = sym->attr.pointer;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
+	has_pointer = 1;
+
+      if (ref->type == REF_ARRAY && ref->u.ar.codimen)
+	{
+	  gfc_error ("DATA element '%s' at %L cannot have a coindex",
+		     sym->name, where);
+	  return FAILURE;
+	}
+
+      if (has_pointer
+	    && ref->type == REF_ARRAY
+	    && ref->u.ar.type != AR_FULL)
+	  {
+	    gfc_error ("DATA element '%s' at %L is a pointer and so must "
+			"be a full array", sym->name, where);
+	    return FAILURE;
+	  }
+    }
+
+  if (e->rank == 0 || has_pointer)
+    {
+      mpz_init_set_ui (size, 1);
+      ref = NULL;
+    }
+  else
+    {
+      ref = e->ref;
+
+      /* Find the array section reference.  */
+      for (ref = e->ref; ref; ref = ref->next)
+	{
+	  if (ref->type != REF_ARRAY)
+	    continue;
+	  if (ref->u.ar.type == AR_ELEMENT)
+	    continue;
+	  break;
+	}
+      gcc_assert (ref);
+
+      /* Set marks according to the reference pattern.  */
+      switch (ref->u.ar.type)
+	{
+	case AR_FULL:
+	  mark = AR_FULL;
+	  break;
+
+	case AR_SECTION:
+	  ar = &ref->u.ar;
+	  /* Get the start position of array section.  */
+	  gfc_get_section_index (ar, section_index, &offset);
+	  mark = AR_SECTION;
+	  break;
+
+	default:
+	  gcc_unreachable ();
+	}
+
+      if (gfc_array_size (e, &size) == FAILURE)
+	{
+	  gfc_error ("Nonconstant array section at %L in DATA statement",
+		     &e->where);
+	  mpz_clear (offset);
+	  return FAILURE;
+	}
+    }
+
+  t = SUCCESS;
+
+  while (mpz_cmp_ui (size, 0) > 0)
+    {
+      if (next_data_value () == FAILURE)
+	{
+	  gfc_error ("DATA statement at %L has more variables than values",
+		     where);
+	  t = FAILURE;
+	  break;
+	}
+
+      t = gfc_check_assign (var->expr, values.vnode->expr, 0);
+      if (t == FAILURE)
+	break;
+
+      /* If we have more than one element left in the repeat count,
+	 and we have more than one element left in the target variable,
+	 then create a range assignment.  */
+      /* FIXME: Only done for full arrays for now, since array sections
+	 seem tricky.  */
+      if (mark == AR_FULL && ref && ref->next == NULL
+	  && mpz_cmp_ui (values.left, 1) > 0 && mpz_cmp_ui (size, 1) > 0)
+	{
+	  mpz_t range;
+
+	  if (mpz_cmp (size, values.left) >= 0)
+	    {
+	      mpz_init_set (range, values.left);
+	      mpz_sub (size, size, values.left);
+	      mpz_set_ui (values.left, 0);
+	    }
+	  else
+	    {
+	      mpz_init_set (range, size);
+	      mpz_sub (values.left, values.left, size);
+	      mpz_set_ui (size, 0);
+	    }
+
+	  t = gfc_assign_data_value (var->expr, values.vnode->expr,
+				     offset, &range);
+
+	  mpz_add (offset, offset, range);
+	  mpz_clear (range);
+
+	  if (t == FAILURE)
+	    break;
+	}
+
+      /* Assign initial value to symbol.  */
+      else
+	{
+	  mpz_sub_ui (values.left, values.left, 1);
+	  mpz_sub_ui (size, size, 1);
+
+	  t = gfc_assign_data_value (var->expr, values.vnode->expr,
+				     offset, NULL);
+	  if (t == FAILURE)
+	    break;
+
+	  if (mark == AR_FULL)
+	    mpz_add_ui (offset, offset, 1);
+
+	  /* Modify the array section indexes and recalculate the offset
+	     for next element.  */
+	  else if (mark == AR_SECTION)
+	    gfc_advance_section (section_index, ar, &offset);
+	}
+    }
+
+  if (mark == AR_SECTION)
+    {
+      for (i = 0; i < ar->dimen; i++)
+	mpz_clear (section_index[i]);
+    }
+
+  mpz_clear (size);
+  mpz_clear (offset);
+
+  return t;
+}
+
+
+static gfc_try traverse_data_var (gfc_data_variable *, locus *);
+
+/* Iterate over a list of elements in a DATA statement.  */
+
+static gfc_try
+traverse_data_list (gfc_data_variable *var, locus *where)
+{
+  mpz_t trip;
+  iterator_stack frame;
+  gfc_expr *e, *start, *end, *step;
+  gfc_try retval = SUCCESS;
+
+  mpz_init (frame.value);
+  mpz_init (trip);
+
+  start = gfc_copy_expr (var->iter.start);
+  end = gfc_copy_expr (var->iter.end);
+  step = gfc_copy_expr (var->iter.step);
+
+  if (gfc_simplify_expr (start, 1) == FAILURE
+      || start->expr_type != EXPR_CONSTANT)
+    {
+      gfc_error ("start of implied-do loop at %L could not be "
+		 "simplified to a constant value", &start->where);
+      retval = FAILURE;
+      goto cleanup;
+    }
+  if (gfc_simplify_expr (end, 1) == FAILURE
+      || end->expr_type != EXPR_CONSTANT)
+    {
+      gfc_error ("end of implied-do loop at %L could not be "
+		 "simplified to a constant value", &start->where);
+      retval = FAILURE;
+      goto cleanup;
+    }
+  if (gfc_simplify_expr (step, 1) == FAILURE
+      || step->expr_type != EXPR_CONSTANT)
+    {
+      gfc_error ("step of implied-do loop at %L could not be "
+		 "simplified to a constant value", &start->where);
+      retval = FAILURE;
+      goto cleanup;
+    }
+
+  mpz_set (trip, end->value.integer);
+  mpz_sub (trip, trip, start->value.integer);
+  mpz_add (trip, trip, step->value.integer);
+
+  mpz_div (trip, trip, step->value.integer);
+
+  mpz_set (frame.value, start->value.integer);
+
+  frame.prev = iter_stack;
+  frame.variable = var->iter.var->symtree;
+  iter_stack = &frame;
+
+  while (mpz_cmp_ui (trip, 0) > 0)
+    {
+      if (traverse_data_var (var->list, where) == FAILURE)
+	{
+	  retval = FAILURE;
+	  goto cleanup;
+	}
+
+      e = gfc_copy_expr (var->expr);
+      if (gfc_simplify_expr (e, 1) == FAILURE)
+	{
+	  gfc_free_expr (e);
+	  retval = FAILURE;
+	  goto cleanup;
+	}
+
+      mpz_add (frame.value, frame.value, step->value.integer);
+
+      mpz_sub_ui (trip, trip, 1);
+    }
+
+cleanup:
+  mpz_clear (frame.value);
+  mpz_clear (trip);
+
+  gfc_free_expr (start);
+  gfc_free_expr (end);
+  gfc_free_expr (step);
+
+  iter_stack = frame.prev;
+  return retval;
+}
+
+
+/* Type resolve variables in the variable list of a DATA statement.  */
+
+static gfc_try
+traverse_data_var (gfc_data_variable *var, locus *where)
+{
+  gfc_try t;
+
+  for (; var; var = var->next)
+    {
+      if (var->expr == NULL)
+	t = traverse_data_list (var, where);
+      else
+	t = check_data_variable (var, where);
+
+      if (t == FAILURE)
+	return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Resolve the expressions and iterators associated with a data statement.
+   This is separate from the assignment checking because data lists should
+   only be resolved once.  */
+
+static gfc_try
+resolve_data_variables (gfc_data_variable *d)
+{
+  for (; d; d = d->next)
+    {
+      if (d->list == NULL)
+	{
+	  if (gfc_resolve_expr (d->expr) == FAILURE)
+	    return FAILURE;
+	}
+      else
+	{
+	  if (gfc_resolve_iterator (&d->iter, false) == FAILURE)
+	    return FAILURE;
+
+	  if (resolve_data_variables (d->list) == FAILURE)
+	    return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+
+/* Resolve a single DATA statement.  We implement this by storing a pointer to
+   the value list into static variables, and then recursively traversing the
+   variables list, expanding iterators and such.  */
+
+static void
+resolve_data (gfc_data *d)
+{
+
+  if (resolve_data_variables (d->var) == FAILURE)
+    return;
+
+  values.vnode = d->value;
+  if (d->value == NULL)
+    mpz_set_ui (values.left, 0);
+  else
+    mpz_set (values.left, d->value->repeat);
+
+  if (traverse_data_var (d->var, &d->where) == FAILURE)
+    return;
+
+  /* At this point, we better not have any values left.  */
+
+  if (next_data_value () == SUCCESS)
+    gfc_error ("DATA statement at %L has more values than variables",
+	       &d->where);
+}
+
+
+/* 12.6 Constraint: In a pure subprogram any variable which is in common or
+   accessed by host or use association, is a dummy argument to a pure function,
+   is a dummy argument with INTENT (IN) to a pure subroutine, or an object that
+   is storage associated with any such variable, shall not be used in the
+   following contexts: (clients of this function).  */
+
+/* Determines if a variable is not 'pure', i.e., not assignable within a pure
+   procedure.  Returns zero if assignment is OK, nonzero if there is a
+   problem.  */
+int
+gfc_impure_variable (gfc_symbol *sym)
+{
+  gfc_symbol *proc;
+  gfc_namespace *ns;
+
+  if (sym->attr.use_assoc || sym->attr.in_common)
+    return 1;
+
+  /* Check if the symbol's ns is inside the pure procedure.  */
+  for (ns = gfc_current_ns; ns; ns = ns->parent)
+    {
+      if (ns == sym->ns)
+	break;
+      if (ns->proc_name->attr.flavor == FL_PROCEDURE && !sym->attr.function)
+	return 1;
+    }
+
+  proc = sym->ns->proc_name;
+  if (sym->attr.dummy
+      && ((proc->attr.subroutine && sym->attr.intent == INTENT_IN)
+	  || proc->attr.function))
+    return 1;
+
+  /* TODO: Sort out what can be storage associated, if anything, and include
+     it here.  In principle equivalences should be scanned but it does not
+     seem to be possible to storage associate an impure variable this way.  */
+  return 0;
+}
+
+
+/* Test whether a symbol is pure or not.  For a NULL pointer, checks if the
+   current namespace is inside a pure procedure.  */
+
+int
+gfc_pure (gfc_symbol *sym)
+{
+  symbol_attribute attr;
+  gfc_namespace *ns;
+
+  if (sym == NULL)
+    {
+      /* Check if the current namespace or one of its parents
+	belongs to a pure procedure.  */
+      for (ns = gfc_current_ns; ns; ns = ns->parent)
+	{
+	  sym = ns->proc_name;
+	  if (sym == NULL)
+	    return 0;
+	  attr = sym->attr;
+	  if (attr.flavor == FL_PROCEDURE && attr.pure)
+	    return 1;
+	}
+      return 0;
+    }
+
+  attr = sym->attr;
+
+  return attr.flavor == FL_PROCEDURE && attr.pure;
+}
+
+
+/* Test whether a symbol is implicitly pure or not.  For a NULL pointer,
+   checks if the current namespace is implicitly pure.  Note that this
+   function returns false for a PURE procedure.  */
+
+int
+gfc_implicit_pure (gfc_symbol *sym)
+{
+  gfc_namespace *ns;
+
+  if (sym == NULL)
+    {
+      /* Check if the current procedure is implicit_pure.  Walk up
+	 the procedure list until we find a procedure.  */
+      for (ns = gfc_current_ns; ns; ns = ns->parent)
+	{
+	  sym = ns->proc_name;
+	  if (sym == NULL)
+	    return 0;
+	  
+	  if (sym->attr.flavor == FL_PROCEDURE)
+	    break;
+	}
+    }
+  
+  return sym->attr.flavor == FL_PROCEDURE && sym->attr.implicit_pure
+    && !sym->attr.pure;
+}
+
+
+/* Test whether the current procedure is elemental or not.  */
+
+int
+gfc_elemental (gfc_symbol *sym)
+{
+  symbol_attribute attr;
+
+  if (sym == NULL)
+    sym = gfc_current_ns->proc_name;
+  if (sym == NULL)
+    return 0;
+  attr = sym->attr;
+
+  return attr.flavor == FL_PROCEDURE && attr.elemental;
+}
+
+
+/* Warn about unused labels.  */
+
+static void
+warn_unused_fortran_label (gfc_st_label *label)
+{
+  if (label == NULL)
+    return;
+
+  warn_unused_fortran_label (label->left);
+
+  if (label->defined == ST_LABEL_UNKNOWN)
+    return;
+
+  switch (label->referenced)
+    {
+    case ST_LABEL_UNKNOWN:
+      gfc_warning ("Label %d at %L defined but not used", label->value,
+		   &label->where);
+      break;
+
+    case ST_LABEL_BAD_TARGET:
+      gfc_warning ("Label %d at %L defined but cannot be used",
+		   label->value, &label->where);
+      break;
+
+    default:
+      break;
+    }
+
+  warn_unused_fortran_label (label->right);
+}
+
+
+/* Returns the sequence type of a symbol or sequence.  */
+
+static seq_type
+sequence_type (gfc_typespec ts)
+{
+  seq_type result;
+  gfc_component *c;
+
+  switch (ts.type)
+  {
+    case BT_DERIVED:
+
+      if (ts.u.derived->components == NULL)
+	return SEQ_NONDEFAULT;
+
+      result = sequence_type (ts.u.derived->components->ts);
+      for (c = ts.u.derived->components->next; c; c = c->next)
+	if (sequence_type (c->ts) != result)
+	  return SEQ_MIXED;
+
+      return result;
+
+    case BT_CHARACTER:
+      if (ts.kind != gfc_default_character_kind)
+	  return SEQ_NONDEFAULT;
+
+      return SEQ_CHARACTER;
+
+    case BT_INTEGER:
+      if (ts.kind != gfc_default_integer_kind)
+	  return SEQ_NONDEFAULT;
+
+      return SEQ_NUMERIC;
+
+    case BT_REAL:
+      if (!(ts.kind == gfc_default_real_kind
+	    || ts.kind == gfc_default_double_kind))
+	  return SEQ_NONDEFAULT;
+
+      return SEQ_NUMERIC;
+
+    case BT_COMPLEX:
+      if (ts.kind != gfc_default_complex_kind)
+	  return SEQ_NONDEFAULT;
+
+      return SEQ_NUMERIC;
+
+    case BT_LOGICAL:
+      if (ts.kind != gfc_default_logical_kind)
+	  return SEQ_NONDEFAULT;
+
+      return SEQ_NUMERIC;
+
+    default:
+      return SEQ_NONDEFAULT;
+  }
+}
+
+
+/* Resolve derived type EQUIVALENCE object.  */
+
+static gfc_try
+resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
+{
+  gfc_component *c = derived->components;
+
+  if (!derived)
+    return SUCCESS;
+
+  /* Shall not be an object of nonsequence derived type.  */
+  if (!derived->attr.sequence)
+    {
+      gfc_error ("Derived type variable '%s' at %L must have SEQUENCE "
+		 "attribute to be an EQUIVALENCE object", sym->name,
+		 &e->where);
+      return FAILURE;
+    }
+
+  /* Shall not have allocatable components.  */
+  if (derived->attr.alloc_comp)
+    {
+      gfc_error ("Derived type variable '%s' at %L cannot have ALLOCATABLE "
+		 "components to be an EQUIVALENCE object",sym->name,
+		 &e->where);
+      return FAILURE;
+    }
+
+  if (sym->attr.in_common && gfc_has_default_initializer (sym->ts.u.derived))
+    {
+      gfc_error ("Derived type variable '%s' at %L with default "
+		 "initialization cannot be in EQUIVALENCE with a variable "
+		 "in COMMON", sym->name, &e->where);
+      return FAILURE;
+    }
+
+  for (; c ; c = c->next)
+    {
+      if (c->ts.type == BT_DERIVED
+	  && (resolve_equivalence_derived (c->ts.u.derived, sym, e) == FAILURE))
+	return FAILURE;
+
+      /* Shall not be an object of sequence derived type containing a pointer
+	 in the structure.  */
+      if (c->attr.pointer)
+	{
+	  gfc_error ("Derived type variable '%s' at %L with pointer "
+		     "component(s) cannot be an EQUIVALENCE object",
+		     sym->name, &e->where);
+	  return FAILURE;
+	}
+    }
+  return SUCCESS;
+}
+
+
+/* Resolve equivalence object. 
+   An EQUIVALENCE object shall not be a dummy argument, a pointer, a target,
+   an allocatable array, an object of nonsequence derived type, an object of
+   sequence derived type containing a pointer at any level of component
+   selection, an automatic object, a function name, an entry name, a result
+   name, a named constant, a structure component, or a subobject of any of
+   the preceding objects.  A substring shall not have length zero.  A
+   derived type shall not have components with default initialization nor
+   shall two objects of an equivalence group be initialized.
+   Either all or none of the objects shall have an protected attribute.
+   The simple constraints are done in symbol.c(check_conflict) and the rest
+   are implemented here.  */
+
+static void
+resolve_equivalence (gfc_equiv *eq)
+{
+  gfc_symbol *sym;
+  gfc_symbol *first_sym;
+  gfc_expr *e;
+  gfc_ref *r;
+  locus *last_where = NULL;
+  seq_type eq_type, last_eq_type;
+  gfc_typespec *last_ts;
+  int object, cnt_protected;
+  const char *msg;
+
+  last_ts = &eq->expr->symtree->n.sym->ts;
+
+  first_sym = eq->expr->symtree->n.sym;
+
+  cnt_protected = 0;
+
+  for (object = 1; eq; eq = eq->eq, object++)
+    {
+      e = eq->expr;
+
+      e->ts = e->symtree->n.sym->ts;
+      /* match_varspec might not know yet if it is seeing
+	 array reference or substring reference, as it doesn't
+	 know the types.  */
+      if (e->ref && e->ref->type == REF_ARRAY)
+	{
+	  gfc_ref *ref = e->ref;
+	  sym = e->symtree->n.sym;
+
+	  if (sym->attr.dimension)
+	    {
+	      ref->u.ar.as = sym->as;
+	      ref = ref->next;
+	    }
+
+	  /* For substrings, convert REF_ARRAY into REF_SUBSTRING.  */
+	  if (e->ts.type == BT_CHARACTER
+	      && ref
+	      && ref->type == REF_ARRAY
+	      && ref->u.ar.dimen == 1
+	      && ref->u.ar.dimen_type[0] == DIMEN_RANGE
+	      && ref->u.ar.stride[0] == NULL)
+	    {
+	      gfc_expr *start = ref->u.ar.start[0];
+	      gfc_expr *end = ref->u.ar.end[0];
+	      void *mem = NULL;
+
+	      /* Optimize away the (:) reference.  */
+	      if (start == NULL && end == NULL)
+		{
+		  if (e->ref == ref)
+		    e->ref = ref->next;
+		  else
+		    e->ref->next = ref->next;
+		  mem = ref;
+		}
+	      else
+		{
+		  ref->type = REF_SUBSTRING;
+		  if (start == NULL)
+		    start = gfc_get_int_expr (gfc_default_integer_kind,
+					      NULL, 1);
+		  ref->u.ss.start = start;
+		  if (end == NULL && e->ts.u.cl)
+		    end = gfc_copy_expr (e->ts.u.cl->length);
+		  ref->u.ss.end = end;
+		  ref->u.ss.length = e->ts.u.cl;
+		  e->ts.u.cl = NULL;
+		}
+	      ref = ref->next;
+	      gfc_free (mem);
+	    }
+
+	  /* Any further ref is an error.  */
+	  if (ref)
+	    {
+	      gcc_assert (ref->type == REF_ARRAY);
+	      gfc_error ("Syntax error in EQUIVALENCE statement at %L",
+			 &ref->u.ar.where);
+	      continue;
+	    }
+	}
+
+      if (gfc_resolve_expr (e) == FAILURE)
+	continue;
+
+      sym = e->symtree->n.sym;
+
+      if (sym->attr.is_protected)
+	cnt_protected++;
+      if (cnt_protected > 0 && cnt_protected != object)
+       	{
+	      gfc_error ("Either all or none of the objects in the "
+			 "EQUIVALENCE set at %L shall have the "
+			 "PROTECTED attribute",
+			 &e->where);
+	      break;
+	}
+
+      /* Shall not equivalence common block variables in a PURE procedure.  */
+      if (sym->ns->proc_name
+	  && sym->ns->proc_name->attr.pure
+	  && sym->attr.in_common)
+	{
+	  gfc_error ("Common block member '%s' at %L cannot be an EQUIVALENCE "
+		     "object in the pure procedure '%s'",
+		     sym->name, &e->where, sym->ns->proc_name->name);
+	  break;
+	}
+
+      /* Shall not be a named constant.  */
+      if (e->expr_type == EXPR_CONSTANT)
+	{
+	  gfc_error ("Named constant '%s' at %L cannot be an EQUIVALENCE "
+		     "object", sym->name, &e->where);
+	  continue;
+	}
+
+      if (e->ts.type == BT_DERIVED
+	  && resolve_equivalence_derived (e->ts.u.derived, sym, e) == FAILURE)
+	continue;
+
+      /* Check that the types correspond correctly:
+	 Note 5.28:
+	 A numeric sequence structure may be equivalenced to another sequence
+	 structure, an object of default integer type, default real type, double
+	 precision real type, default logical type such that components of the
+	 structure ultimately only become associated to objects of the same
+	 kind. A character sequence structure may be equivalenced to an object
+	 of default character kind or another character sequence structure.
+	 Other objects may be equivalenced only to objects of the same type and
+	 kind parameters.  */
+
+      /* Identical types are unconditionally OK.  */
+      if (object == 1 || gfc_compare_types (last_ts, &sym->ts))
+	goto identical_types;
+
+      last_eq_type = sequence_type (*last_ts);
+      eq_type = sequence_type (sym->ts);
+
+      /* Since the pair of objects is not of the same type, mixed or
+	 non-default sequences can be rejected.  */
+
+      msg = "Sequence %s with mixed components in EQUIVALENCE "
+	    "statement at %L with different type objects";
+      if ((object ==2
+	   && last_eq_type == SEQ_MIXED
+	   && gfc_notify_std (GFC_STD_GNU, msg, first_sym->name, last_where)
+	      == FAILURE)
+	  || (eq_type == SEQ_MIXED
+	      && gfc_notify_std (GFC_STD_GNU, msg, sym->name,
+				 &e->where) == FAILURE))
+	continue;
+
+      msg = "Non-default type object or sequence %s in EQUIVALENCE "
+	    "statement at %L with objects of different type";
+      if ((object ==2
+	   && last_eq_type == SEQ_NONDEFAULT
+	   && gfc_notify_std (GFC_STD_GNU, msg, first_sym->name,
+			      last_where) == FAILURE)
+	  || (eq_type == SEQ_NONDEFAULT
+	      && gfc_notify_std (GFC_STD_GNU, msg, sym->name,
+				 &e->where) == FAILURE))
+	continue;
+
+      msg ="Non-CHARACTER object '%s' in default CHARACTER "
+	   "EQUIVALENCE statement at %L";
+      if (last_eq_type == SEQ_CHARACTER
+	  && eq_type != SEQ_CHARACTER
+	  && gfc_notify_std (GFC_STD_GNU, msg, sym->name,
+			     &e->where) == FAILURE)
+		continue;
+
+      msg ="Non-NUMERIC object '%s' in default NUMERIC "
+	   "EQUIVALENCE statement at %L";
+      if (last_eq_type == SEQ_NUMERIC
+	  && eq_type != SEQ_NUMERIC
+	  && gfc_notify_std (GFC_STD_GNU, msg, sym->name,
+			     &e->where) == FAILURE)
+		continue;
+
+  identical_types:
+      last_ts =&sym->ts;
+      last_where = &e->where;
+
+      if (!e->ref)
+	continue;
+
+      /* Shall not be an automatic array.  */
+      if (e->ref->type == REF_ARRAY
+	  && gfc_resolve_array_spec (e->ref->u.ar.as, 1) == FAILURE)
+	{
+	  gfc_error ("Array '%s' at %L with non-constant bounds cannot be "
+		     "an EQUIVALENCE object", sym->name, &e->where);
+	  continue;
+	}
+
+      r = e->ref;
+      while (r)
+	{
+	  /* Shall not be a structure component.  */
+	  if (r->type == REF_COMPONENT)
+	    {
+	      gfc_error ("Structure component '%s' at %L cannot be an "
+			 "EQUIVALENCE object",
+			 r->u.c.component->name, &e->where);
+	      break;
+	    }
+
+	  /* A substring shall not have length zero.  */
+	  if (r->type == REF_SUBSTRING)
+	    {
+	      if (compare_bound (r->u.ss.start, r->u.ss.end) == CMP_GT)
+		{
+		  gfc_error ("Substring at %L has length zero",
+			     &r->u.ss.start->where);
+		  break;
+		}
+	    }
+	  r = r->next;
+	}
+    }
+}
+
+
+/* Resolve function and ENTRY types, issue diagnostics if needed.  */
+
+static void
+resolve_fntype (gfc_namespace *ns)
+{
+  gfc_entry_list *el;
+  gfc_symbol *sym;
+
+  if (ns->proc_name == NULL || !ns->proc_name->attr.function)
+    return;
+
+  /* If there are any entries, ns->proc_name is the entry master
+     synthetic symbol and ns->entries->sym actual FUNCTION symbol.  */
+  if (ns->entries)
+    sym = ns->entries->sym;
+  else
+    sym = ns->proc_name;
+  if (sym->result == sym
+      && sym->ts.type == BT_UNKNOWN
+      && gfc_set_default_type (sym, 0, NULL) == FAILURE
+      && !sym->attr.untyped)
+    {
+      gfc_error ("Function '%s' at %L has no IMPLICIT type",
+		 sym->name, &sym->declared_at);
+      sym->attr.untyped = 1;
+    }
+
+  if (sym->ts.type == BT_DERIVED && !sym->ts.u.derived->attr.use_assoc
+      && !sym->attr.contained
+      && !gfc_check_symbol_access (sym->ts.u.derived)
+      && gfc_check_symbol_access (sym))
+    {
+      gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PUBLIC function '%s' at "
+		      "%L of PRIVATE type '%s'", sym->name,
+		      &sym->declared_at, sym->ts.u.derived->name);
+    }
+
+    if (ns->entries)
+    for (el = ns->entries->next; el; el = el->next)
+      {
+	if (el->sym->result == el->sym
+	    && el->sym->ts.type == BT_UNKNOWN
+	    && gfc_set_default_type (el->sym, 0, NULL) == FAILURE
+	    && !el->sym->attr.untyped)
+	  {
+	    gfc_error ("ENTRY '%s' at %L has no IMPLICIT type",
+		       el->sym->name, &el->sym->declared_at);
+	    el->sym->attr.untyped = 1;
+	  }
+      }
+}
+
+
+/* 12.3.2.1.1 Defined operators.  */
+
+static gfc_try
+check_uop_procedure (gfc_symbol *sym, locus where)
+{
+  gfc_formal_arglist *formal;
+
+  if (!sym->attr.function)
+    {
+      gfc_error ("User operator procedure '%s' at %L must be a FUNCTION",
+		 sym->name, &where);
+      return FAILURE;
+    }
+
+  if (sym->ts.type == BT_CHARACTER
+      && !(sym->ts.u.cl && sym->ts.u.cl->length)
+      && !(sym->result && sym->result->ts.u.cl
+	   && sym->result->ts.u.cl->length))
+    {
+      gfc_error ("User operator procedure '%s' at %L cannot be assumed "
+		 "character length", sym->name, &where);
+      return FAILURE;
+    }
+
+  formal = sym->formal;
+  if (!formal || !formal->sym)
+    {
+      gfc_error ("User operator procedure '%s' at %L must have at least "
+		 "one argument", sym->name, &where);
+      return FAILURE;
+    }
+
+  if (formal->sym->attr.intent != INTENT_IN)
+    {
+      gfc_error ("First argument of operator interface at %L must be "
+		 "INTENT(IN)", &where);
+      return FAILURE;
+    }
+
+  if (formal->sym->attr.optional)
+    {
+      gfc_error ("First argument of operator interface at %L cannot be "
+		 "optional", &where);
+      return FAILURE;
+    }
+
+  formal = formal->next;
+  if (!formal || !formal->sym)
+    return SUCCESS;
+
+  if (formal->sym->attr.intent != INTENT_IN)
+    {
+      gfc_error ("Second argument of operator interface at %L must be "
+		 "INTENT(IN)", &where);
+      return FAILURE;
+    }
+
+  if (formal->sym->attr.optional)
+    {
+      gfc_error ("Second argument of operator interface at %L cannot be "
+		 "optional", &where);
+      return FAILURE;
+    }
+
+  if (formal->next)
+    {
+      gfc_error ("Operator interface at %L must have, at most, two "
+		 "arguments", &where);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+static void
+gfc_resolve_uops (gfc_symtree *symtree)
+{
+  gfc_interface *itr;
+
+  if (symtree == NULL)
+    return;
+
+  gfc_resolve_uops (symtree->left);
+  gfc_resolve_uops (symtree->right);
+
+  for (itr = symtree->n.uop->op; itr; itr = itr->next)
+    check_uop_procedure (itr->sym, itr->sym->declared_at);
+}
+
+
+/* Examine all of the expressions associated with a program unit,
+   assign types to all intermediate expressions, make sure that all
+   assignments are to compatible types and figure out which names
+   refer to which functions or subroutines.  It doesn't check code
+   block, which is handled by resolve_code.  */
+
+static void
+resolve_types (gfc_namespace *ns)
+{
+  gfc_namespace *n;
+  gfc_charlen *cl;
+  gfc_data *d;
+  gfc_equiv *eq;
+  gfc_namespace* old_ns = gfc_current_ns;
+
+  /* Check that all IMPLICIT types are ok.  */
+  if (!ns->seen_implicit_none)
+    {
+      unsigned letter;
+      for (letter = 0; letter != GFC_LETTERS; ++letter)
+	if (ns->set_flag[letter]
+	    && resolve_typespec_used (&ns->default_type[letter],
+				      &ns->implicit_loc[letter],
+				      NULL) == FAILURE)
+	  return;
+    }
+
+  gfc_current_ns = ns;
+
+  resolve_entries (ns);
+
+  resolve_common_vars (ns->blank_common.head, false);
+  resolve_common_blocks (ns->common_root);
+
+  resolve_contained_functions (ns);
+
+  if (ns->proc_name && ns->proc_name->attr.flavor == FL_PROCEDURE
+      && ns->proc_name->attr.if_source == IFSRC_IFBODY)
+    resolve_formal_arglist (ns->proc_name);
+
+  gfc_traverse_ns (ns, resolve_bind_c_derived_types);
+
+  for (cl = ns->cl_list; cl; cl = cl->next)
+    resolve_charlen (cl);
+
+  gfc_traverse_ns (ns, resolve_symbol);
+
+  resolve_fntype (ns);
+
+  for (n = ns->contained; n; n = n->sibling)
+    {
+      if (gfc_pure (ns->proc_name) && !gfc_pure (n->proc_name))
+	gfc_error ("Contained procedure '%s' at %L of a PURE procedure must "
+		   "also be PURE", n->proc_name->name,
+		   &n->proc_name->declared_at);
+
+      resolve_types (n);
+    }
+
+  forall_flag = 0;
+  gfc_check_interfaces (ns);
+
+  gfc_traverse_ns (ns, resolve_values);
+
+  if (ns->save_all)
+    gfc_save_all (ns);
+
+  iter_stack = NULL;
+  for (d = ns->data; d; d = d->next)
+    resolve_data (d);
+
+  iter_stack = NULL;
+  gfc_traverse_ns (ns, gfc_formalize_init_value);
+
+  gfc_traverse_ns (ns, gfc_verify_binding_labels);
+
+  if (ns->common_root != NULL)
+    gfc_traverse_symtree (ns->common_root, resolve_bind_c_comms);
+
+  for (eq = ns->equiv; eq; eq = eq->next)
+    resolve_equivalence (eq);
+
+  /* Warn about unused labels.  */
+  if (warn_unused_label)
+    warn_unused_fortran_label (ns->st_labels);
+
+  gfc_resolve_uops (ns->uop_root);
+
+  gfc_current_ns = old_ns;
+}
+
+
+/* Call resolve_code recursively.  */
+
+static void
+resolve_codes (gfc_namespace *ns)
+{
+  gfc_namespace *n;
+  bitmap_obstack old_obstack;
+
+  if (ns->resolved == 1)
+    return;
+
+  for (n = ns->contained; n; n = n->sibling)
+    resolve_codes (n);
+
+  gfc_current_ns = ns;
+
+  /* Don't clear 'cs_base' if this is the namespace of a BLOCK construct.  */
+  if (!(ns->proc_name && ns->proc_name->attr.flavor == FL_LABEL))
+    cs_base = NULL;
+
+  /* Set to an out of range value.  */
+  current_entry_id = -1;
+
+  old_obstack = labels_obstack;
+  bitmap_obstack_initialize (&labels_obstack);
+
+  resolve_code (ns->code, ns);
+
+  bitmap_obstack_release (&labels_obstack);
+  labels_obstack = old_obstack;
+}
+
+
+/* This function is called after a complete program unit has been compiled.
+   Its purpose is to examine all of the expressions associated with a program
+   unit, assign types to all intermediate expressions, make sure that all
+   assignments are to compatible types and figure out which names refer to
+   which functions or subroutines.  */
+
+void
+gfc_resolve (gfc_namespace *ns)
+{
+  gfc_namespace *old_ns;
+  code_stack *old_cs_base;
+
+  if (ns->resolved)
+    return;
+
+  ns->resolved = -1;
+  old_ns = gfc_current_ns;
+  old_cs_base = cs_base;
+
+  resolve_types (ns);
+  resolve_codes (ns);
+
+  gfc_current_ns = old_ns;
+  cs_base = old_cs_base;
+  ns->resolved = 1;
+
+  gfc_run_passes (ns);
+}
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
new file mode 100644
index 000000000..ac26a8042
--- /dev/null
+++ b/gcc/fortran/scanner.c
@@ -0,0 +1,2190 @@
+/* Character scanner.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+   2010 Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* Set of subroutines to (ultimately) return the next character to the
+   various matching subroutines.  This file's job is to read files and
+   build up lines that are parsed by the parser.  This means that we
+   handle continuation lines and "include" lines.
+
+   The first thing the scanner does is to load an entire file into
+   memory.  We load the entire file into memory for a couple reasons.
+   The first is that we want to be able to deal with nonseekable input
+   (pipes, stdin) and there is a lot of backing up involved during
+   parsing.
+
+   The second is that we want to be able to print the locus of errors,
+   and an error on line 999999 could conflict with something on line
+   one.  Given nonseekable input, we've got to store the whole thing.
+
+   One thing that helps are the column truncation limits that give us
+   an upper bound on the size of individual lines.  We don't store the
+   truncated stuff.
+
+   From the scanner's viewpoint, the higher level subroutines ask for
+   new characters and do a lot of jumping backwards.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+#include "toplev.h"	/* For set_src_pwd.  */
+#include "debug.h"
+#include "flags.h"
+#include "cpp.h"
+
+/* Structure for holding module and include file search path.  */
+typedef struct gfc_directorylist
+{
+  char *path;
+  bool use_for_modules;
+  struct gfc_directorylist *next;
+}
+gfc_directorylist;
+
+/* List of include file search directories.  */
+static gfc_directorylist *include_dirs, *intrinsic_modules_dirs;
+
+static gfc_file *file_head, *current_file;
+
+static int continue_flag, end_flag, openmp_flag, gcc_attribute_flag;
+static int continue_count, continue_line;
+static locus openmp_locus;
+static locus gcc_attribute_locus;
+
+gfc_source_form gfc_current_form;
+static gfc_linebuf *line_head, *line_tail;
+       
+locus gfc_current_locus;
+const char *gfc_source_file;
+static FILE *gfc_src_file;
+static gfc_char_t *gfc_src_preprocessor_lines[2];
+
+static struct gfc_file_change
+{
+  const char *filename;
+  gfc_linebuf *lb;
+  int line;
+} *file_changes;
+size_t file_changes_cur, file_changes_count;
+size_t file_changes_allocated;
+
+
+/* Functions dealing with our wide characters (gfc_char_t) and
+   sequences of such characters.  */
+
+int
+gfc_wide_fits_in_byte (gfc_char_t c)
+{
+  return (c <= UCHAR_MAX);
+}
+
+static inline int
+wide_is_ascii (gfc_char_t c)
+{
+  return (gfc_wide_fits_in_byte (c) && ((unsigned char) c & ~0x7f) == 0);
+}
+
+int
+gfc_wide_is_printable (gfc_char_t c)
+{
+  return (gfc_wide_fits_in_byte (c) && ISPRINT ((unsigned char) c));
+}
+
+gfc_char_t
+gfc_wide_tolower (gfc_char_t c)
+{
+  return (wide_is_ascii (c) ? (gfc_char_t) TOLOWER((unsigned char) c) : c);
+}
+
+gfc_char_t
+gfc_wide_toupper (gfc_char_t c)
+{
+  return (wide_is_ascii (c) ? (gfc_char_t) TOUPPER((unsigned char) c) : c);
+}
+
+int
+gfc_wide_is_digit (gfc_char_t c)
+{
+  return (c >= '0' && c <= '9');
+}
+
+static inline int
+wide_atoi (gfc_char_t *c)
+{
+#define MAX_DIGITS 20
+  char buf[MAX_DIGITS+1];
+  int i = 0;
+
+  while (gfc_wide_is_digit(*c) && i < MAX_DIGITS)
+    buf[i++] = *c++;
+  buf[i] = '\0';
+  return atoi (buf);
+}
+
+size_t
+gfc_wide_strlen (const gfc_char_t *str)
+{
+  size_t i;
+
+  for (i = 0; str[i]; i++)
+    ;
+
+  return i;
+}
+
+gfc_char_t *
+gfc_wide_memset (gfc_char_t *b, gfc_char_t c, size_t len)
+{
+  size_t i;
+
+  for (i = 0; i < len; i++)
+    b[i] = c;
+
+  return b;
+}
+
+static gfc_char_t *
+wide_strcpy (gfc_char_t *dest, const gfc_char_t *src)
+{
+  gfc_char_t *d;
+
+  for (d = dest; (*d = *src) != '\0'; ++src, ++d)
+    ;
+
+  return dest;
+}
+
+static gfc_char_t *
+wide_strchr (const gfc_char_t *s, gfc_char_t c)
+{
+  do {
+    if (*s == c)
+      {
+        return CONST_CAST(gfc_char_t *, s);
+      }
+  } while (*s++);
+  return 0;
+}
+
+char *
+gfc_widechar_to_char (const gfc_char_t *s, int length)
+{
+  size_t len, i;
+  char *res;
+
+  if (s == NULL)
+    return NULL;
+
+  /* Passing a negative length is used to indicate that length should be
+     calculated using gfc_wide_strlen().  */
+  len = (length >= 0 ? (size_t) length : gfc_wide_strlen (s));
+  res = XNEWVEC (char, len + 1);
+
+  for (i = 0; i < len; i++)
+    {
+      gcc_assert (gfc_wide_fits_in_byte (s[i]));
+      res[i] = (unsigned char) s[i];
+    }
+
+  res[len] = '\0';
+  return res;
+}
+
+gfc_char_t *
+gfc_char_to_widechar (const char *s)
+{
+  size_t len, i;
+  gfc_char_t *res;
+
+  if (s == NULL)
+    return NULL;
+
+  len = strlen (s);
+  res = gfc_get_wide_string (len + 1);
+
+  for (i = 0; i < len; i++)
+    res[i] = (unsigned char) s[i];
+
+  res[len] = '\0';
+  return res;
+}
+
+static int
+wide_strncmp (const gfc_char_t *s1, const char *s2, size_t n)
+{
+  gfc_char_t c1, c2;
+
+  while (n-- > 0)
+    {
+      c1 = *s1++;
+      c2 = *s2++;
+      if (c1 != c2)
+	return (c1 > c2 ? 1 : -1);
+      if (c1 == '\0')
+	return 0;
+    }
+  return 0;
+}
+
+int
+gfc_wide_strncasecmp (const gfc_char_t *s1, const char *s2, size_t n)
+{
+  gfc_char_t c1, c2;
+
+  while (n-- > 0)
+    {
+      c1 = gfc_wide_tolower (*s1++);
+      c2 = TOLOWER (*s2++);
+      if (c1 != c2)
+	return (c1 > c2 ? 1 : -1);
+      if (c1 == '\0')
+	return 0;
+    }
+  return 0;
+}
+
+
+/* Main scanner initialization.  */
+
+void
+gfc_scanner_init_1 (void)
+{
+  file_head = NULL;
+  line_head = NULL;
+  line_tail = NULL;
+
+  continue_count = 0;
+  continue_line = 0;
+
+  end_flag = 0;
+}
+
+
+/* Main scanner destructor.  */
+
+void
+gfc_scanner_done_1 (void)
+{
+  gfc_linebuf *lb;
+  gfc_file *f;
+
+  while(line_head != NULL) 
+    {
+      lb = line_head->next;
+      gfc_free(line_head);
+      line_head = lb;
+    }
+     
+  while(file_head != NULL) 
+    {
+      f = file_head->next;
+      gfc_free(file_head->filename);
+      gfc_free(file_head);
+      file_head = f;    
+    }
+}
+
+
+/* Adds path to the list pointed to by list.  */
+
+static void
+add_path_to_list (gfc_directorylist **list, const char *path,
+		  bool use_for_modules, bool head)
+{
+  gfc_directorylist *dir;
+  const char *p;
+
+  p = path;
+  while (*p == ' ' || *p == '\t')  /* someone might do "-I include" */
+    if (*p++ == '\0')
+      return;
+
+  if (head || *list == NULL)
+    {
+      dir = XCNEW (gfc_directorylist);
+      if (!head)
+        *list = dir;
+    }
+  else
+    {
+      dir = *list;
+      while (dir->next)
+	dir = dir->next;
+
+      dir->next = XCNEW (gfc_directorylist);
+      dir = dir->next;
+    }
+
+  dir->next = head ? *list : NULL;
+  if (head)
+    *list = dir;
+  dir->use_for_modules = use_for_modules;
+  dir->path = XCNEWVEC (char, strlen (p) + 2);
+  strcpy (dir->path, p);
+  strcat (dir->path, "/");	/* make '/' last character */
+}
+
+
+void
+gfc_add_include_path (const char *path, bool use_for_modules, bool file_dir)
+{
+  add_path_to_list (&include_dirs, path, use_for_modules, file_dir);
+
+  /* For '#include "..."' these directories are automatically searched.  */
+  if (!file_dir)
+    gfc_cpp_add_include_path (xstrdup(path), true);
+}
+
+
+void
+gfc_add_intrinsic_modules_path (const char *path)
+{
+  add_path_to_list (&intrinsic_modules_dirs, path, true, false);
+}
+
+
+/* Release resources allocated for options.  */
+
+void
+gfc_release_include_path (void)
+{
+  gfc_directorylist *p;
+
+  while (include_dirs != NULL)
+    {
+      p = include_dirs;
+      include_dirs = include_dirs->next;
+      gfc_free (p->path);
+      gfc_free (p);
+    }
+
+  while (intrinsic_modules_dirs != NULL)
+    {
+      p = intrinsic_modules_dirs;
+      intrinsic_modules_dirs = intrinsic_modules_dirs->next;
+      gfc_free (p->path);
+      gfc_free (p);
+    }
+
+  gfc_free (gfc_option.module_dir);
+}
+
+
+static FILE *
+open_included_file (const char *name, gfc_directorylist *list,
+		    bool module, bool system)
+{
+  char *fullname;
+  gfc_directorylist *p;
+  FILE *f;
+
+  for (p = list; p; p = p->next)
+    {
+      if (module && !p->use_for_modules)
+	continue;
+
+      fullname = (char *) alloca(strlen (p->path) + strlen (name) + 1);
+      strcpy (fullname, p->path);
+      strcat (fullname, name);
+
+      f = gfc_open_file (fullname);
+      if (f != NULL)
+	{
+	  if (gfc_cpp_makedep ())
+	    gfc_cpp_add_dep (fullname, system);
+
+	  return f;
+	}
+    }
+
+  return NULL;
+}
+
+
+/* Opens file for reading, searching through the include directories
+   given if necessary.  If the include_cwd argument is true, we try
+   to open the file in the current directory first.  */
+
+FILE *
+gfc_open_included_file (const char *name, bool include_cwd, bool module)
+{
+  FILE *f = NULL;
+
+  if (IS_ABSOLUTE_PATH (name) || include_cwd)
+    {
+      f = gfc_open_file (name);
+      if (f && gfc_cpp_makedep ())
+	gfc_cpp_add_dep (name, false);
+    }
+
+  if (!f)
+    f = open_included_file (name, include_dirs, module, false);
+
+  return f;
+}
+
+FILE *
+gfc_open_intrinsic_module (const char *name)
+{
+  FILE *f = NULL;
+
+  if (IS_ABSOLUTE_PATH (name))
+    {
+      f = gfc_open_file (name);
+      if (f && gfc_cpp_makedep ())
+	gfc_cpp_add_dep (name, true);
+    }
+
+  if (!f)
+    f = open_included_file (name, intrinsic_modules_dirs, true, true);
+
+  return f;
+}
+
+
+/* Test to see if we're at the end of the main source file.  */
+
+int
+gfc_at_end (void)
+{
+  return end_flag;
+}
+
+
+/* Test to see if we're at the end of the current file.  */
+
+int
+gfc_at_eof (void)
+{
+  if (gfc_at_end ())
+    return 1;
+
+  if (line_head == NULL)
+    return 1;			/* Null file */
+
+  if (gfc_current_locus.lb == NULL)
+    return 1;
+
+  return 0;
+}
+
+
+/* Test to see if we're at the beginning of a new line.  */
+
+int
+gfc_at_bol (void)
+{
+  if (gfc_at_eof ())
+    return 1;
+
+  return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
+}
+
+
+/* Test to see if we're at the end of a line.  */
+
+int
+gfc_at_eol (void)
+{
+  if (gfc_at_eof ())
+    return 1;
+
+  return (*gfc_current_locus.nextc == '\0');
+}
+
+static void
+add_file_change (const char *filename, int line)
+{
+  if (file_changes_count == file_changes_allocated)
+    {
+      if (file_changes_allocated)
+	file_changes_allocated *= 2;
+      else
+	file_changes_allocated = 16;
+      file_changes = XRESIZEVEC (struct gfc_file_change, file_changes,
+				 file_changes_allocated);
+    }
+  file_changes[file_changes_count].filename = filename;
+  file_changes[file_changes_count].lb = NULL;
+  file_changes[file_changes_count++].line = line;
+}
+
+static void
+report_file_change (gfc_linebuf *lb)
+{
+  size_t c = file_changes_cur;
+  while (c < file_changes_count
+	 && file_changes[c].lb == lb)
+    {
+      if (file_changes[c].filename)
+	(*debug_hooks->start_source_file) (file_changes[c].line,
+					   file_changes[c].filename);
+      else
+	(*debug_hooks->end_source_file) (file_changes[c].line);
+      ++c;
+    }
+  file_changes_cur = c;
+}
+
+void
+gfc_start_source_files (void)
+{
+  /* If the debugger wants the name of the main source file,
+     we give it.  */
+  if (debug_hooks->start_end_main_source_file)
+    (*debug_hooks->start_source_file) (0, gfc_source_file);
+
+  file_changes_cur = 0;
+  report_file_change (gfc_current_locus.lb);
+}
+
+void
+gfc_end_source_files (void)
+{
+  report_file_change (NULL);
+
+  if (debug_hooks->start_end_main_source_file)
+    (*debug_hooks->end_source_file) (0);
+}
+
+/* Advance the current line pointer to the next line.  */
+
+void
+gfc_advance_line (void)
+{
+  if (gfc_at_end ())
+    return;
+
+  if (gfc_current_locus.lb == NULL) 
+    {
+      end_flag = 1;
+      return;
+    } 
+
+  if (gfc_current_locus.lb->next
+      && !gfc_current_locus.lb->next->dbg_emitted)
+    {
+      report_file_change (gfc_current_locus.lb->next);
+      gfc_current_locus.lb->next->dbg_emitted = true;
+    }
+
+  gfc_current_locus.lb = gfc_current_locus.lb->next;
+
+  if (gfc_current_locus.lb != NULL)	 
+    gfc_current_locus.nextc = gfc_current_locus.lb->line;
+  else 
+    {
+      gfc_current_locus.nextc = NULL;
+      end_flag = 1;
+    }       
+}
+
+
+/* Get the next character from the input, advancing gfc_current_file's
+   locus.  When we hit the end of the line or the end of the file, we
+   start returning a '\n' in order to complete the current statement.
+   No Fortran line conventions are implemented here.
+
+   Requiring explicit advances to the next line prevents the parse
+   pointer from being on the wrong line if the current statement ends
+   prematurely.  */
+
+static gfc_char_t
+next_char (void)
+{
+  gfc_char_t c;
+  
+  if (gfc_current_locus.nextc == NULL)
+    return '\n';
+
+  c = *gfc_current_locus.nextc++;
+  if (c == '\0')
+    {
+      gfc_current_locus.nextc--; /* Remain on this line.  */
+      c = '\n';
+    }
+
+  return c;
+}
+
+
+/* Skip a comment.  When we come here the parse pointer is positioned
+   immediately after the comment character.  If we ever implement
+   compiler directives within comments, here is where we parse the
+   directive.  */
+
+static void
+skip_comment_line (void)
+{
+  gfc_char_t c;
+
+  do
+    {
+      c = next_char ();
+    }
+  while (c != '\n');
+
+  gfc_advance_line ();
+}
+
+
+int
+gfc_define_undef_line (void)
+{
+  char *tmp;
+
+  /* All lines beginning with '#' are either #define or #undef.  */
+  if (debug_info_level != DINFO_LEVEL_VERBOSE || gfc_peek_ascii_char () != '#')
+    return 0;
+
+  if (wide_strncmp (gfc_current_locus.nextc, "#define ", 8) == 0)
+    {
+      tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[8], -1);
+      (*debug_hooks->define) (gfc_linebuf_linenum (gfc_current_locus.lb),
+			      tmp);
+      gfc_free (tmp);
+    }
+
+  if (wide_strncmp (gfc_current_locus.nextc, "#undef ", 7) == 0)
+    {
+      tmp = gfc_widechar_to_char (&gfc_current_locus.nextc[7], -1);
+      (*debug_hooks->undef) (gfc_linebuf_linenum (gfc_current_locus.lb),
+			     tmp);
+      gfc_free (tmp);
+    }
+
+  /* Skip the rest of the line.  */
+  skip_comment_line ();
+
+  return 1;
+}
+
+
+/* Return true if GCC$ was matched.  */
+static bool
+skip_gcc_attribute (locus start)
+{
+  bool r = false;
+  char c;
+  locus old_loc = gfc_current_locus;
+
+  if ((c = next_char ()) == 'g' || c == 'G')
+    if ((c = next_char ()) == 'c' || c == 'C')
+      if ((c = next_char ()) == 'c' || c == 'C')
+	if ((c = next_char ()) == '$')
+	  r = true;
+
+  if (r == false)
+    gfc_current_locus = old_loc;
+  else
+   {
+      gcc_attribute_flag = 1;
+      gcc_attribute_locus = old_loc;
+      gfc_current_locus = start;
+   }
+
+  return r;
+}
+
+
+
+/* Comment lines are null lines, lines containing only blanks or lines
+   on which the first nonblank line is a '!'.
+   Return true if !$ openmp conditional compilation sentinel was
+   seen.  */
+
+static bool
+skip_free_comments (void)
+{
+  locus start;
+  gfc_char_t c;
+  int at_bol;
+
+  for (;;)
+    {
+      at_bol = gfc_at_bol ();
+      start = gfc_current_locus;
+      if (gfc_at_eof ())
+	break;
+
+      do
+	c = next_char ();
+      while (gfc_is_whitespace (c));
+
+      if (c == '\n')
+	{
+	  gfc_advance_line ();
+	  continue;
+	}
+
+      if (c == '!')
+	{
+	  /* Keep the !GCC$ line.  */
+		  if (at_bol && skip_gcc_attribute (start))
+	    return false;
+
+	  /* If -fopenmp, we need to handle here 2 things:
+	     1) don't treat !$omp as comments, but directives
+	     2) handle OpenMP conditional compilation, where
+		!$ should be treated as 2 spaces (for initial lines
+		only if followed by space).  */
+	  if (gfc_option.gfc_flag_openmp && at_bol)
+	    {
+	      locus old_loc = gfc_current_locus;
+	      if (next_char () == '$')
+		{
+		  c = next_char ();
+		  if (c == 'o' || c == 'O')
+		    {
+		      if (((c = next_char ()) == 'm' || c == 'M')
+			  && ((c = next_char ()) == 'p' || c == 'P'))
+			{
+			  if ((c = next_char ()) == ' ' || c == '\t'
+			      || continue_flag)
+			    {
+			      while (gfc_is_whitespace (c))
+				c = next_char ();
+			      if (c != '\n' && c != '!')
+				{
+				  openmp_flag = 1;
+				  openmp_locus = old_loc;
+				  gfc_current_locus = start;
+				  return false;
+				}
+			    }
+			  else
+			    gfc_warning_now ("!$OMP at %C starts a commented "
+					     "line as it neither is followed "
+					     "by a space nor is a "
+					     "continuation line");
+			}
+		      gfc_current_locus = old_loc;
+		      next_char ();
+		      c = next_char ();
+		    }
+		  if (continue_flag || c == ' ' || c == '\t')
+		    {
+		      gfc_current_locus = old_loc;
+		      next_char ();
+		      openmp_flag = 0;
+		      return true;
+		    }
+		}
+	      gfc_current_locus = old_loc;
+	    }
+	  skip_comment_line ();
+	  continue;
+	}
+
+      break;
+    }
+
+  if (openmp_flag && at_bol)
+    openmp_flag = 0;
+
+  gcc_attribute_flag = 0;
+  gfc_current_locus = start;
+  return false;
+}
+
+
+/* Skip comment lines in fixed source mode.  We have the same rules as
+   in skip_free_comment(), except that we can have a 'c', 'C' or '*'
+   in column 1, and a '!' cannot be in column 6.  Also, we deal with
+   lines with 'd' or 'D' in column 1, if the user requested this.  */
+
+static void
+skip_fixed_comments (void)
+{
+  locus start;
+  int col;
+  gfc_char_t c;
+
+  if (! gfc_at_bol ())
+    {
+      start = gfc_current_locus;
+      if (! gfc_at_eof ())
+	{
+	  do
+	    c = next_char ();
+	  while (gfc_is_whitespace (c));
+
+	  if (c == '\n')
+	    gfc_advance_line ();
+	  else if (c == '!')
+	    skip_comment_line ();
+	}
+
+      if (! gfc_at_bol ())
+	{
+	  gfc_current_locus = start;
+	  return;
+	}
+    }
+
+  for (;;)
+    {
+      start = gfc_current_locus;
+      if (gfc_at_eof ())
+	break;
+
+      c = next_char ();
+      if (c == '\n')
+	{
+	  gfc_advance_line ();
+	  continue;
+	}
+
+      if (c == '!' || c == 'c' || c == 'C' || c == '*')
+	{
+	  if (skip_gcc_attribute (start))
+	    {
+	      /* Canonicalize to *$omp.  */
+	      *start.nextc = '*';
+	      return;
+	    }
+
+	  /* If -fopenmp, we need to handle here 2 things:
+	     1) don't treat !$omp|c$omp|*$omp as comments, but directives
+	     2) handle OpenMP conditional compilation, where
+		!$|c$|*$ should be treated as 2 spaces if the characters
+		in columns 3 to 6 are valid fixed form label columns
+		characters.  */
+	  if (gfc_current_locus.lb != NULL
+	      && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+	    continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+
+	  if (gfc_option.gfc_flag_openmp)
+	    {
+	      if (next_char () == '$')
+		{
+		  c = next_char ();
+		  if (c == 'o' || c == 'O')
+		    {
+		      if (((c = next_char ()) == 'm' || c == 'M')
+			  && ((c = next_char ()) == 'p' || c == 'P'))
+			{
+			  c = next_char ();
+			  if (c != '\n'
+			      && ((openmp_flag && continue_flag)
+				  || c == ' ' || c == '\t' || c == '0'))
+			    {
+			      do
+				c = next_char ();
+			      while (gfc_is_whitespace (c));
+			      if (c != '\n' && c != '!')
+				{
+				  /* Canonicalize to *$omp.  */
+				  *start.nextc = '*';
+				  openmp_flag = 1;
+				  gfc_current_locus = start;
+				  return;
+				}
+			    }
+			}
+		    }
+		  else
+		    {
+		      int digit_seen = 0;
+
+		      for (col = 3; col < 6; col++, c = next_char ())
+			if (c == ' ')
+			  continue;
+			else if (c == '\t')
+			  {
+			    col = 6;
+			    break;
+			  }
+			else if (c < '0' || c > '9')
+			  break;
+			else
+			  digit_seen = 1;
+
+		      if (col == 6 && c != '\n'
+			  && ((continue_flag && !digit_seen)
+			      || c == ' ' || c == '\t' || c == '0'))
+			{
+			  gfc_current_locus = start;
+			  start.nextc[0] = ' ';
+			  start.nextc[1] = ' ';
+			  continue;
+			}
+		    }
+		}
+	      gfc_current_locus = start;
+	    }
+	  skip_comment_line ();
+	  continue;
+	}
+
+      if (gfc_option.flag_d_lines != -1 && (c == 'd' || c == 'D'))
+	{
+	  if (gfc_option.flag_d_lines == 0)
+	    {
+	      skip_comment_line ();
+	      continue;
+	    }
+	  else
+	    *start.nextc = c = ' ';
+	}
+
+      col = 1;
+
+      while (gfc_is_whitespace (c))
+	{
+	  c = next_char ();
+	  col++;
+	}
+
+      if (c == '\n')
+	{
+	  gfc_advance_line ();
+	  continue;
+	}
+
+      if (col != 6 && c == '!')
+	{
+	  if (gfc_current_locus.lb != NULL
+	      && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+	    continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+	  skip_comment_line ();
+	  continue;
+	}
+
+      break;
+    }
+
+  openmp_flag = 0;
+  gcc_attribute_flag = 0;
+  gfc_current_locus = start;
+}
+
+
+/* Skips the current line if it is a comment.  */
+
+void
+gfc_skip_comments (void)
+{
+  if (gfc_current_form == FORM_FREE)
+    skip_free_comments ();
+  else
+    skip_fixed_comments ();
+}
+
+
+/* Get the next character from the input, taking continuation lines
+   and end-of-line comments into account.  This implies that comment
+   lines between continued lines must be eaten here.  For higher-level
+   subroutines, this flattens continued lines into a single logical
+   line.  The in_string flag denotes whether we're inside a character
+   context or not.  */
+
+gfc_char_t
+gfc_next_char_literal (gfc_instring in_string)
+{
+  locus old_loc;
+  int i, prev_openmp_flag;
+  gfc_char_t c;
+
+  continue_flag = 0;
+
+restart:
+  c = next_char ();
+  if (gfc_at_end ())
+    {
+      continue_count = 0;
+      return c;
+    }
+
+  if (gfc_current_form == FORM_FREE)
+    {
+      bool openmp_cond_flag;
+
+      if (!in_string && c == '!')
+	{
+	  if (gcc_attribute_flag
+	      && memcmp (&gfc_current_locus, &gcc_attribute_locus,
+		 sizeof (gfc_current_locus)) == 0)
+	    goto done;
+
+	  if (openmp_flag
+	      && memcmp (&gfc_current_locus, &openmp_locus,
+		 sizeof (gfc_current_locus)) == 0)
+	    goto done;
+
+	  /* This line can't be continued */
+	  do
+	    {
+	      c = next_char ();
+	    }
+	  while (c != '\n');
+
+	  /* Avoid truncation warnings for comment ending lines.  */
+	  gfc_current_locus.lb->truncated = 0;
+
+	  goto done;
+	}
+
+      /* Check to see if the continuation line was truncated.  */
+      if (gfc_option.warn_line_truncation && gfc_current_locus.lb != NULL
+	  && gfc_current_locus.lb->truncated)
+	{
+	  int maxlen = gfc_option.free_line_length;
+	  gfc_current_locus.lb->truncated = 0;
+	  gfc_current_locus.nextc += maxlen;
+	  gfc_warning_now ("Line truncated at %L", &gfc_current_locus);
+	  gfc_current_locus.nextc -= maxlen;
+	}
+
+      if (c != '&')
+	goto done;
+
+      /* If the next nonblank character is a ! or \n, we've got a
+	 continuation line.  */
+      old_loc = gfc_current_locus;
+
+      c = next_char ();
+      while (gfc_is_whitespace (c))
+	c = next_char ();
+
+      /* Character constants to be continued cannot have commentary
+	 after the '&'.  */
+
+      if (in_string && c != '\n')
+	{
+	  gfc_current_locus = old_loc;
+	  c = '&';
+	  goto done;
+	}
+
+      if (c != '!' && c != '\n')
+	{
+	  gfc_current_locus = old_loc;
+	  c = '&';
+	  goto done;
+	}
+
+      prev_openmp_flag = openmp_flag;
+      continue_flag = 1;
+      if (c == '!')
+	skip_comment_line ();
+      else
+	gfc_advance_line ();
+      
+      if (gfc_at_eof())
+	goto not_continuation;
+
+      /* We've got a continuation line.  If we are on the very next line after
+	 the last continuation, increment the continuation line count and
+	 check whether the limit has been exceeded.  */
+      if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
+	{
+	  if (++continue_count == gfc_option.max_continue_free)
+	    {
+	      if (gfc_notification_std (GFC_STD_GNU) || pedantic)
+		gfc_warning ("Limit of %d continuations exceeded in "
+			     "statement at %C", gfc_option.max_continue_free);
+	    }
+	}
+
+      /* Now find where it continues. First eat any comment lines.  */
+      openmp_cond_flag = skip_free_comments ();
+
+      if (gfc_current_locus.lb != NULL
+	  && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+	continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+
+      if (prev_openmp_flag != openmp_flag)
+	{
+	  gfc_current_locus = old_loc;
+	  openmp_flag = prev_openmp_flag;
+	  c = '&';
+	  goto done;
+	}
+
+      /* Now that we have a non-comment line, probe ahead for the
+	 first non-whitespace character.  If it is another '&', then
+	 reading starts at the next character, otherwise we must back
+	 up to where the whitespace started and resume from there.  */
+
+      old_loc = gfc_current_locus;
+
+      c = next_char ();
+      while (gfc_is_whitespace (c))
+	c = next_char ();
+
+      if (openmp_flag)
+	{
+	  for (i = 0; i < 5; i++, c = next_char ())
+	    {
+	      gcc_assert (gfc_wide_tolower (c) == (unsigned char) "!$omp"[i]);
+	      if (i == 4)
+		old_loc = gfc_current_locus;
+	    }
+	  while (gfc_is_whitespace (c))
+	    c = next_char ();
+	}
+
+      if (c != '&')
+	{
+	  if (in_string)
+	    {
+	      gfc_current_locus.nextc--;
+	      if (gfc_option.warn_ampersand && in_string == INSTRING_WARN)
+		gfc_warning ("Missing '&' in continued character "
+			     "constant at %C");
+	    }
+	  /* Both !$omp and !$ -fopenmp continuation lines have & on the
+	     continuation line only optionally.  */
+	  else if (openmp_flag || openmp_cond_flag)
+	    gfc_current_locus.nextc--;
+	  else
+	    {
+	      c = ' ';
+	      gfc_current_locus = old_loc;
+	      goto done;
+	    }
+	}
+    }
+  else /* Fixed form.  */
+    {
+      /* Fixed form continuation.  */
+      if (!in_string && c == '!')
+	{
+	  /* Skip comment at end of line.  */
+	  do
+	    {
+	      c = next_char ();
+	    }
+	  while (c != '\n');
+
+	  /* Avoid truncation warnings for comment ending lines.  */
+	  gfc_current_locus.lb->truncated = 0;
+	}
+
+      if (c != '\n')
+	goto done;
+
+      /* Check to see if the continuation line was truncated.  */
+      if (gfc_option.warn_line_truncation && gfc_current_locus.lb != NULL
+	  && gfc_current_locus.lb->truncated)
+	{
+	  gfc_current_locus.lb->truncated = 0;
+	  gfc_warning_now ("Line truncated at %L", &gfc_current_locus);
+	}
+
+      prev_openmp_flag = openmp_flag;
+      continue_flag = 1;
+      old_loc = gfc_current_locus;
+
+      gfc_advance_line ();
+      skip_fixed_comments ();
+
+      /* See if this line is a continuation line.  */
+      if (openmp_flag != prev_openmp_flag)
+	{
+	  openmp_flag = prev_openmp_flag;
+	  goto not_continuation;
+	}
+
+      if (!openmp_flag)
+	for (i = 0; i < 5; i++)
+	  {
+	    c = next_char ();
+	    if (c != ' ')
+	      goto not_continuation;
+	  }
+      else
+	for (i = 0; i < 5; i++)
+	  {
+	    c = next_char ();
+	    if (gfc_wide_tolower (c) != (unsigned char) "*$omp"[i])
+	      goto not_continuation;
+	  }
+
+      c = next_char ();
+      if (c == '0' || c == ' ' || c == '\n')
+	goto not_continuation;
+
+      /* We've got a continuation line.  If we are on the very next line after
+	 the last continuation, increment the continuation line count and
+	 check whether the limit has been exceeded.  */
+      if (gfc_linebuf_linenum (gfc_current_locus.lb) == continue_line + 1)
+	{
+	  if (++continue_count == gfc_option.max_continue_fixed)
+	    {
+	      if (gfc_notification_std (GFC_STD_GNU) || pedantic)
+		gfc_warning ("Limit of %d continuations exceeded in "
+			     "statement at %C",
+			     gfc_option.max_continue_fixed);
+	    }
+	}
+
+      if (gfc_current_locus.lb != NULL
+	  && continue_line < gfc_linebuf_linenum (gfc_current_locus.lb))
+	continue_line = gfc_linebuf_linenum (gfc_current_locus.lb);
+    }
+
+  /* Ready to read first character of continuation line, which might
+     be another continuation line!  */
+  goto restart;
+
+not_continuation:
+  c = '\n';
+  gfc_current_locus = old_loc;
+
+done:
+  if (c == '\n')
+    continue_count = 0;
+  continue_flag = 0;
+  return c;
+}
+
+
+/* Get the next character of input, folded to lowercase.  In fixed
+   form mode, we also ignore spaces.  When matcher subroutines are
+   parsing character literals, they have to call
+   gfc_next_char_literal().  */
+
+gfc_char_t
+gfc_next_char (void)
+{
+  gfc_char_t c;
+
+  do
+    {
+      c = gfc_next_char_literal (NONSTRING);
+    }
+  while (gfc_current_form == FORM_FIXED && gfc_is_whitespace (c));
+
+  return gfc_wide_tolower (c);
+}
+
+char
+gfc_next_ascii_char (void)
+{
+  gfc_char_t c = gfc_next_char ();
+
+  return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
+				    : (unsigned char) UCHAR_MAX);
+}
+
+
+gfc_char_t
+gfc_peek_char (void)
+{
+  locus old_loc;
+  gfc_char_t c;
+
+  old_loc = gfc_current_locus;
+  c = gfc_next_char ();
+  gfc_current_locus = old_loc;
+
+  return c;
+}
+
+
+char
+gfc_peek_ascii_char (void)
+{
+  gfc_char_t c = gfc_peek_char ();
+
+  return (gfc_wide_fits_in_byte (c) ? (unsigned char) c
+				    : (unsigned char) UCHAR_MAX);
+}
+
+
+/* Recover from an error.  We try to get past the current statement
+   and get lined up for the next.  The next statement follows a '\n'
+   or a ';'.  We also assume that we are not within a character
+   constant, and deal with finding a '\'' or '"'.  */
+
+void
+gfc_error_recovery (void)
+{
+  gfc_char_t c, delim;
+
+  if (gfc_at_eof ())
+    return;
+
+  for (;;)
+    {
+      c = gfc_next_char ();
+      if (c == '\n' || c == ';')
+	break;
+
+      if (c != '\'' && c != '"')
+	{
+	  if (gfc_at_eof ())
+	    break;
+	  continue;
+	}
+      delim = c;
+
+      for (;;)
+	{
+	  c = next_char ();
+
+	  if (c == delim)
+	    break;
+	  if (c == '\n')
+	    return;
+	  if (c == '\\')
+	    {
+	      c = next_char ();
+	      if (c == '\n')
+		return;
+	    }
+	}
+      if (gfc_at_eof ())
+	break;
+    }
+}
+
+
+/* Read ahead until the next character to be read is not whitespace.  */
+
+void
+gfc_gobble_whitespace (void)
+{
+  static int linenum = 0;
+  locus old_loc;
+  gfc_char_t c;
+
+  do
+    {
+      old_loc = gfc_current_locus;
+      c = gfc_next_char_literal (NONSTRING);
+      /* Issue a warning for nonconforming tabs.  We keep track of the line
+	 number because the Fortran matchers will often back up and the same
+	 line will be scanned multiple times.  */
+      if (!gfc_option.warn_tabs && c == '\t')
+	{
+	  int cur_linenum = LOCATION_LINE (gfc_current_locus.lb->location);
+	  if (cur_linenum != linenum)
+	    {
+	      linenum = cur_linenum;
+	      gfc_warning_now ("Nonconforming tab character at %C");
+	    }
+	}
+    }
+  while (gfc_is_whitespace (c));
+
+  gfc_current_locus = old_loc;
+}
+
+
+/* Load a single line into pbuf.
+
+   If pbuf points to a NULL pointer, it is allocated.
+   We truncate lines that are too long, unless we're dealing with
+   preprocessor lines or if the option -ffixed-line-length-none is set,
+   in which case we reallocate the buffer to fit the entire line, if
+   need be.
+   In fixed mode, we expand a tab that occurs within the statement
+   label region to expand to spaces that leave the next character in
+   the source region.
+
+   If first_char is not NULL, it's a pointer to a single char value holding
+   the first character of the line, which has already been read by the
+   caller.  This avoids the use of ungetc().
+
+   load_line returns whether the line was truncated.
+
+   NOTE: The error machinery isn't available at this point, so we can't
+	 easily report line and column numbers consistent with other 
+	 parts of gfortran.  */
+
+static int
+load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char)
+{
+  static int linenum = 0, current_line = 1;
+  int c, maxlen, i, preprocessor_flag, buflen = *pbuflen;
+  int trunc_flag = 0, seen_comment = 0;
+  int seen_printable = 0, seen_ampersand = 0, quoted = ' ';
+  gfc_char_t *buffer;
+  bool found_tab = false;
+
+  /* Determine the maximum allowed line length.  */
+  if (gfc_current_form == FORM_FREE)
+    maxlen = gfc_option.free_line_length;
+  else if (gfc_current_form == FORM_FIXED)
+    maxlen = gfc_option.fixed_line_length;
+  else
+    maxlen = 72;
+
+  if (*pbuf == NULL)
+    {
+      /* Allocate the line buffer, storing its length into buflen.
+	 Note that if maxlen==0, indicating that arbitrary-length lines
+	 are allowed, the buffer will be reallocated if this length is
+	 insufficient; since 132 characters is the length of a standard
+	 free-form line, we use that as a starting guess.  */
+      if (maxlen > 0)
+	buflen = maxlen;
+      else
+	buflen = 132;
+
+      *pbuf = gfc_get_wide_string (buflen + 1);
+    }
+
+  i = 0;
+  buffer = *pbuf;
+
+  if (first_char)
+    c = *first_char;
+  else
+    c = getc (input);
+
+  /* In order to not truncate preprocessor lines, we have to
+     remember that this is one.  */
+  preprocessor_flag = (c == '#' ? 1 : 0);
+
+  for (;;)
+    {
+      if (c == EOF)
+	break;
+
+      if (c == '\n')
+	{
+	  /* Check for illegal use of ampersand. See F95 Standard 3.3.1.3.  */
+	  if (gfc_current_form == FORM_FREE 
+	      && !seen_printable && seen_ampersand)
+	    {
+	      if (pedantic)
+		gfc_error_now ("'&' not allowed by itself in line %d",
+			       current_line);
+	      else
+		gfc_warning_now ("'&' not allowed by itself in line %d",
+				 current_line);
+	    }
+	  break;
+	}
+
+      if (c == '\r' || c == '\0')
+	goto next_char;			/* Gobble characters.  */
+
+      if (c == '&')
+	{
+	  if (seen_ampersand)
+	    {
+	      seen_ampersand = 0;
+	      seen_printable = 1;
+	    }
+	  else
+	    seen_ampersand = 1;
+	}
+
+      if ((c != '&' && c != '!' && c != ' ') || (c == '!' && !seen_ampersand))
+	seen_printable = 1;
+
+      /* Is this a fixed-form comment?  */
+      if (gfc_current_form == FORM_FIXED && i == 0
+	  && (c == '*' || c == 'c' || c == 'd'))
+	seen_comment = 1;
+
+      if (quoted == ' ')
+	{
+	  if (c == '\'' || c == '"')
+	    quoted = c;
+	}
+      else if (c == quoted)
+	quoted = ' ';
+
+      /* Is this a free-form comment?  */
+      if (c == '!' && quoted == ' ')
+        seen_comment = 1;
+
+      /* Vendor extension: "<tab>1" marks a continuation line.  */
+      if (found_tab)
+	{
+	  found_tab = false;
+	  if (c >= '1' && c <= '9')
+	    {
+	      *(buffer-1) = c;
+	      goto next_char;
+	    }
+	}
+
+      if (gfc_current_form == FORM_FIXED && c == '\t' && i < 6)
+	{
+	  found_tab = true;
+
+	  if (!gfc_option.warn_tabs && seen_comment == 0
+	      && current_line != linenum)
+	    {
+	      linenum = current_line;
+	      gfc_warning_now ("Nonconforming tab character in column %d "
+			       "of line %d", i+1, linenum);
+	    }
+
+	  while (i < 6)
+	    {
+	      *buffer++ = ' ';
+	      i++;
+	    }
+
+	  goto next_char;
+	}
+
+      *buffer++ = c;
+      i++;
+
+      if (maxlen == 0 || preprocessor_flag)
+	{
+	  if (i >= buflen)
+	    {
+	      /* Reallocate line buffer to double size to hold the
+		overlong line.  */
+	      buflen = buflen * 2;
+	      *pbuf = XRESIZEVEC (gfc_char_t, *pbuf, (buflen + 1));
+	      buffer = (*pbuf) + i;
+	    }
+	}
+      else if (i >= maxlen)
+	{
+	  bool trunc_warn = true;
+
+	  /* Enhancement, if the very next non-space character is an ampersand
+	     or comment that we would otherwise warn about, don't mark as
+	     truncated.  */
+
+	  /* Truncate the rest of the line.  */
+	  for (;;)
+	    {
+	      c = getc (input);
+	      if (c == '\r' || c == ' ')
+	        continue;
+
+	      if (c == '\n' || c == EOF)
+		break;
+
+	      if (!trunc_warn && c != '!')
+		trunc_warn = true;
+
+	      if (trunc_warn && ((gfc_current_form == FORM_FIXED && c == '&')
+		  || c == '!'))
+		trunc_warn = false;
+
+	      if (c == '!')
+		seen_comment = 1;
+
+	      if (trunc_warn && !seen_comment)
+		trunc_flag = 1;
+	    }
+
+	  c = '\n';
+	  continue;
+	}
+
+next_char:
+      c = getc (input);
+    }
+
+  /* Pad lines to the selected line length in fixed form.  */
+  if (gfc_current_form == FORM_FIXED
+      && gfc_option.fixed_line_length != 0
+      && !preprocessor_flag
+      && c != EOF)
+    {
+      while (i++ < maxlen)
+	*buffer++ = ' ';
+    }
+
+  *buffer = '\0';
+  *pbuflen = buflen;
+  current_line++;
+
+  return trunc_flag;
+}
+
+
+/* Get a gfc_file structure, initialize it and add it to
+   the file stack.  */
+
+static gfc_file *
+get_file (const char *name, enum lc_reason reason ATTRIBUTE_UNUSED)
+{
+  gfc_file *f;
+
+  f = XCNEW (gfc_file);
+
+  f->filename = xstrdup (name);
+
+  f->next = file_head;
+  file_head = f;
+
+  f->up = current_file;
+  if (current_file != NULL)
+    f->inclusion_line = current_file->line;
+
+  linemap_add (line_table, reason, false, f->filename, 1);
+
+  return f;
+}
+
+
+/* Deal with a line from the C preprocessor. The
+   initial octothorp has already been seen.  */
+
+static void
+preprocessor_line (gfc_char_t *c)
+{
+  bool flag[5];
+  int i, line;
+  gfc_char_t *wide_filename;
+  gfc_file *f;
+  int escaped, unescape;
+  char *filename;
+
+  c++;
+  while (*c == ' ' || *c == '\t')
+    c++;
+
+  if (*c < '0' || *c > '9')
+    goto bad_cpp_line;
+
+  line = wide_atoi (c);
+
+  c = wide_strchr (c, ' ');
+  if (c == NULL)
+    {
+      /* No file name given.  Set new line number.  */
+      current_file->line = line;
+      return;
+    }
+
+  /* Skip spaces.  */
+  while (*c == ' ' || *c == '\t')
+    c++;
+
+  /* Skip quote.  */
+  if (*c != '"')
+    goto bad_cpp_line;
+  ++c;
+
+  wide_filename = c;
+
+  /* Make filename end at quote.  */
+  unescape = 0;
+  escaped = false;
+  while (*c && ! (!escaped && *c == '"'))
+    {
+      if (escaped)
+	escaped = false;
+      else if (*c == '\\')
+	{
+	  escaped = true;
+	  unescape++;
+	}
+      ++c;
+    }
+
+  if (! *c)
+    /* Preprocessor line has no closing quote.  */
+    goto bad_cpp_line;
+
+  *c++ = '\0';
+
+  /* Undo effects of cpp_quote_string.  */
+  if (unescape)
+    {
+      gfc_char_t *s = wide_filename;
+      gfc_char_t *d = gfc_get_wide_string (c - wide_filename - unescape);
+
+      wide_filename = d;
+      while (*s)
+	{
+	  if (*s == '\\')
+	    *d++ = *++s;
+	  else
+	    *d++ = *s;
+	  s++;
+	}
+      *d = '\0';
+    }
+
+  /* Get flags.  */
+
+  flag[1] = flag[2] = flag[3] = flag[4] = false;
+
+  for (;;)
+    {
+      c = wide_strchr (c, ' ');
+      if (c == NULL)
+	break;
+
+      c++;
+      i = wide_atoi (c);
+
+      if (1 <= i && i <= 4)
+	flag[i] = true;
+    }
+
+  /* Convert the filename in wide characters into a filename in narrow
+     characters.  */
+  filename = gfc_widechar_to_char (wide_filename, -1);
+
+  /* Interpret flags.  */
+
+  if (flag[1]) /* Starting new file.  */
+    {
+      f = get_file (filename, LC_RENAME);
+      add_file_change (f->filename, f->inclusion_line);
+      current_file = f;
+    }
+
+  if (flag[2]) /* Ending current file.  */
+    {
+      if (!current_file->up
+	  || strcmp (current_file->up->filename, filename) != 0)
+	{
+	  gfc_warning_now ("%s:%d: file %s left but not entered",
+			   current_file->filename, current_file->line,
+			   filename);
+	  if (unescape)
+	    gfc_free (wide_filename);
+	  gfc_free (filename);
+	  return;
+	}
+
+      add_file_change (NULL, line);
+      current_file = current_file->up;
+      linemap_add (line_table, LC_RENAME, false, current_file->filename,
+		   current_file->line);
+    }
+
+  /* The name of the file can be a temporary file produced by
+     cpp. Replace the name if it is different.  */
+
+  if (strcmp (current_file->filename, filename) != 0)
+    {
+       /* FIXME: we leak the old filename because a pointer to it may be stored
+          in the linemap.  Alternative could be using GC or updating linemap to
+          point to the new name, but there is no API for that currently. */
+      current_file->filename = xstrdup (filename);
+    }
+
+  /* Set new line number.  */
+  current_file->line = line;
+  if (unescape)
+    gfc_free (wide_filename);
+  gfc_free (filename);
+  return;
+
+ bad_cpp_line:
+  gfc_warning_now ("%s:%d: Illegal preprocessor directive",
+		   current_file->filename, current_file->line);
+  current_file->line++;
+}
+
+
+static gfc_try load_file (const char *, const char *, bool);
+
+/* include_line()-- Checks a line buffer to see if it is an include
+   line.  If so, we call load_file() recursively to load the included
+   file.  We never return a syntax error because a statement like
+   "include = 5" is perfectly legal.  We return false if no include was
+   processed or true if we matched an include.  */
+
+static bool
+include_line (gfc_char_t *line)
+{
+  gfc_char_t quote, *c, *begin, *stop;
+  char *filename;
+
+  c = line;
+
+  if (gfc_option.gfc_flag_openmp)
+    {
+      if (gfc_current_form == FORM_FREE)
+	{
+	  while (*c == ' ' || *c == '\t')
+	    c++;
+	  if (*c == '!' && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
+	    c += 3;
+	}
+      else
+	{
+	  if ((*c == '!' || *c == 'c' || *c == 'C' || *c == '*')
+	      && c[1] == '$' && (c[2] == ' ' || c[2] == '\t'))
+	    c += 3;
+	}
+    }
+
+  while (*c == ' ' || *c == '\t')
+    c++;
+
+  if (gfc_wide_strncasecmp (c, "include", 7))
+    return false;
+
+  c += 7;
+  while (*c == ' ' || *c == '\t')
+    c++;
+
+  /* Find filename between quotes.  */
+  
+  quote = *c++;
+  if (quote != '"' && quote != '\'')
+    return false;
+
+  begin = c;
+
+  while (*c != quote && *c != '\0')
+    c++;
+
+  if (*c == '\0')
+    return false;
+
+  stop = c++;
+  
+  while (*c == ' ' || *c == '\t')
+    c++;
+
+  if (*c != '\0' && *c != '!')
+    return false;
+
+  /* We have an include line at this point.  */
+
+  *stop = '\0'; /* It's ok to trash the buffer, as this line won't be
+		   read by anything else.  */
+
+  filename = gfc_widechar_to_char (begin, -1);
+  if (load_file (filename, NULL, false) == FAILURE)
+    exit (FATAL_EXIT_CODE);
+
+  gfc_free (filename);
+  return true;
+}
+
+
+/* Load a file into memory by calling load_line until the file ends.  */
+
+static gfc_try
+load_file (const char *realfilename, const char *displayedname, bool initial)
+{
+  gfc_char_t *line;
+  gfc_linebuf *b;
+  gfc_file *f;
+  FILE *input;
+  int len, line_len;
+  bool first_line;
+  const char *filename;
+
+  filename = displayedname ? displayedname : realfilename;
+
+  for (f = current_file; f; f = f->up)
+    if (strcmp (filename, f->filename) == 0)
+      {
+	fprintf (stderr, "%s:%d: Error: File '%s' is being included "
+		 "recursively\n", current_file->filename, current_file->line,
+		 filename);
+	return FAILURE;
+      }
+
+  if (initial)
+    {
+      if (gfc_src_file)
+	{
+	  input = gfc_src_file;
+	  gfc_src_file = NULL;
+	}
+      else
+	input = gfc_open_file (realfilename);
+      if (input == NULL)
+	{
+	  gfc_error_now ("Can't open file '%s'", filename);
+	  return FAILURE;
+	}
+    }
+  else
+    {
+      input = gfc_open_included_file (realfilename, false, false);
+      if (input == NULL)
+	{
+	  fprintf (stderr, "%s:%d: Error: Can't open included file '%s'\n",
+		   current_file->filename, current_file->line, filename);
+	  return FAILURE;
+	}
+    }
+
+  /* Load the file.  */
+
+  f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
+  if (!initial)
+    add_file_change (f->filename, f->inclusion_line);
+  current_file = f;
+  current_file->line = 1;
+  line = NULL;
+  line_len = 0;
+  first_line = true;
+
+  if (initial && gfc_src_preprocessor_lines[0])
+    {
+      preprocessor_line (gfc_src_preprocessor_lines[0]);
+      gfc_free (gfc_src_preprocessor_lines[0]);
+      gfc_src_preprocessor_lines[0] = NULL;
+      if (gfc_src_preprocessor_lines[1])
+	{
+	  preprocessor_line (gfc_src_preprocessor_lines[1]);
+	  gfc_free (gfc_src_preprocessor_lines[1]);
+	  gfc_src_preprocessor_lines[1] = NULL;
+	}
+    }
+
+  for (;;)
+    {
+      int trunc = load_line (input, &line, &line_len, NULL);
+
+      len = gfc_wide_strlen (line);
+      if (feof (input) && len == 0)
+	break;
+
+      /* If this is the first line of the file, it can contain a byte
+	 order mark (BOM), which we will ignore:
+	   FF FE is UTF-16 little endian,
+	   FE FF is UTF-16 big endian,
+	   EF BB BF is UTF-8.  */
+      if (first_line
+	  && ((line_len >= 2 && line[0] == (unsigned char) '\xFF'
+			     && line[1] == (unsigned char) '\xFE')
+	      || (line_len >= 2 && line[0] == (unsigned char) '\xFE'
+			        && line[1] == (unsigned char) '\xFF')
+	      || (line_len >= 3 && line[0] == (unsigned char) '\xEF'
+				&& line[1] == (unsigned char) '\xBB'
+				&& line[2] == (unsigned char) '\xBF')))
+	{
+	  int n = line[1] == (unsigned char) '\xBB' ? 3 : 2;
+	  gfc_char_t *new_char = gfc_get_wide_string (line_len);
+
+	  wide_strcpy (new_char, &line[n]);
+	  gfc_free (line);
+	  line = new_char;
+	  len -= n;
+	}
+
+      /* There are three things this line can be: a line of Fortran
+	 source, an include line or a C preprocessor directive.  */
+
+      if (line[0] == '#')
+	{
+	  /* When -g3 is specified, it's possible that we emit #define
+	     and #undef lines, which we need to pass to the middle-end
+	     so that it can emit correct debug info.  */
+	  if (debug_info_level == DINFO_LEVEL_VERBOSE
+	      && (wide_strncmp (line, "#define ", 8) == 0
+		  || wide_strncmp (line, "#undef ", 7) == 0))
+	    ;
+	  else
+	    {
+	      preprocessor_line (line);
+	      continue;
+	    }
+	}
+
+      /* Preprocessed files have preprocessor lines added before the byte
+         order mark, so first_line is not about the first line of the file
+	 but the first line that's not a preprocessor line.  */
+      first_line = false;
+
+      if (include_line (line))
+	{
+	  current_file->line++;
+	  continue;
+	}
+
+      /* Add line.  */
+
+      b = (gfc_linebuf *) gfc_getmem (gfc_linebuf_header_size
+				      + (len + 1) * sizeof (gfc_char_t));
+
+      b->location
+	= linemap_line_start (line_table, current_file->line++, 120);
+      b->file = current_file;
+      b->truncated = trunc;
+      wide_strcpy (b->line, line);
+
+      if (line_head == NULL)
+	line_head = b;
+      else
+	line_tail->next = b;
+
+      line_tail = b;
+
+      while (file_changes_cur < file_changes_count)
+	file_changes[file_changes_cur++].lb = b;
+    }
+
+  /* Release the line buffer allocated in load_line.  */
+  gfc_free (line);
+
+  fclose (input);
+
+  if (!initial)
+    add_file_change (NULL, current_file->inclusion_line + 1);
+  current_file = current_file->up;
+  linemap_add (line_table, LC_LEAVE, 0, NULL, 0);
+  return SUCCESS;
+}
+
+
+/* Open a new file and start scanning from that file. Returns SUCCESS
+   if everything went OK, FAILURE otherwise.  If form == FORM_UNKNOWN
+   it tries to determine the source form from the filename, defaulting
+   to free form.  */
+
+gfc_try
+gfc_new_file (void)
+{
+  gfc_try result;
+
+  if (gfc_cpp_enabled ())
+    {
+      result = gfc_cpp_preprocess (gfc_source_file);
+      if (!gfc_cpp_preprocess_only ())
+        result = load_file (gfc_cpp_temporary_file (), gfc_source_file, true);
+    }
+  else
+    result = load_file (gfc_source_file, NULL, true);
+
+  gfc_current_locus.lb = line_head;
+  gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
+
+#if 0 /* Debugging aid.  */
+  for (; line_head; line_head = line_head->next)
+    printf ("%s:%3d %s\n", LOCATION_FILE (line_head->location),
+	    LOCATION_LINE (line_head->location), line_head->line);
+
+  exit (SUCCESS_EXIT_CODE);
+#endif
+
+  return result;
+}
+
+static char *
+unescape_filename (const char *ptr)
+{
+  const char *p = ptr, *s;
+  char *d, *ret;
+  int escaped, unescape = 0;
+
+  /* Make filename end at quote.  */
+  escaped = false;
+  while (*p && ! (! escaped && *p == '"'))
+    {
+      if (escaped)
+	escaped = false;
+      else if (*p == '\\')
+	{
+	  escaped = true;
+	  unescape++;
+	}
+      ++p;
+    }
+
+  if (!*p || p[1])
+    return NULL;
+
+  /* Undo effects of cpp_quote_string.  */
+  s = ptr;
+  d = XCNEWVEC (char, p + 1 - ptr - unescape);
+  ret = d;
+
+  while (s != p)
+    {
+      if (*s == '\\')
+	*d++ = *++s;
+      else
+	*d++ = *s;
+      s++;
+    }
+  *d = '\0';
+  return ret;
+}
+
+/* For preprocessed files, if the first tokens are of the form # NUM.
+   handle the directives so we know the original file name.  */
+
+const char *
+gfc_read_orig_filename (const char *filename, const char **canon_source_file)
+{
+  int c, len;
+  char *dirname, *tmp;
+
+  gfc_src_file = gfc_open_file (filename);
+  if (gfc_src_file == NULL)
+    return NULL;
+
+  c = getc (gfc_src_file);
+
+  if (c != '#')
+    return NULL;
+
+  len = 0;
+  load_line (gfc_src_file, &gfc_src_preprocessor_lines[0], &len, &c);
+
+  if (wide_strncmp (gfc_src_preprocessor_lines[0], "# 1 \"", 5) != 0)
+    return NULL;
+
+  tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[0][5], -1);
+  filename = unescape_filename (tmp);
+  gfc_free (tmp);
+  if (filename == NULL)
+    return NULL;
+
+  c = getc (gfc_src_file);
+
+  if (c != '#')
+    return filename;
+
+  len = 0;
+  load_line (gfc_src_file, &gfc_src_preprocessor_lines[1], &len, &c);
+
+  if (wide_strncmp (gfc_src_preprocessor_lines[1], "# 1 \"", 5) != 0)
+    return filename;
+
+  tmp = gfc_widechar_to_char (&gfc_src_preprocessor_lines[1][5], -1);
+  dirname = unescape_filename (tmp);
+  gfc_free (tmp);
+  if (dirname == NULL)
+    return filename;
+
+  len = strlen (dirname);
+  if (len < 3 || dirname[len - 1] != '/' || dirname[len - 2] != '/')
+    {
+      gfc_free (dirname);
+      return filename;
+    }
+  dirname[len - 2] = '\0';
+  set_src_pwd (dirname);
+
+  if (! IS_ABSOLUTE_PATH (filename))
+    {
+      char *p = XCNEWVEC (char, len + strlen (filename));
+
+      memcpy (p, dirname, len - 2);
+      p[len - 2] = '/';
+      strcpy (p + len - 1, filename);
+      *canon_source_file = p;
+    }
+
+  gfc_free (dirname);
+  return filename;
+}
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
new file mode 100644
index 000000000..57ffa1b82
--- /dev/null
+++ b/gcc/fortran/simplify.c
@@ -0,0 +1,6858 @@
+/* Simplify intrinsic functions at compile-time.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+   2010, 2011 Free Software Foundation, Inc.
+   Contributed by Andy Vaught & Katherine Holcomb
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "arith.h"
+#include "intrinsic.h"
+#include "target-memory.h"
+#include "constructor.h"
+#include "version.h"  /* For version_string.  */
+
+
+gfc_expr gfc_bad_expr;
+
+
+/* Note that 'simplification' is not just transforming expressions.
+   For functions that are not simplified at compile time, range
+   checking is done if possible.
+
+   The return convention is that each simplification function returns:
+
+     A new expression node corresponding to the simplified arguments.
+     The original arguments are destroyed by the caller, and must not
+     be a part of the new expression.
+
+     NULL pointer indicating that no simplification was possible and
+     the original expression should remain intact.
+
+     An expression pointer to gfc_bad_expr (a static placeholder)
+     indicating that some error has prevented simplification.  The
+     error is generated within the function and should be propagated
+     upwards
+
+   By the time a simplification function gets control, it has been
+   decided that the function call is really supposed to be the
+   intrinsic.  No type checking is strictly necessary, since only
+   valid types will be passed on.  On the other hand, a simplification
+   subroutine may have to look at the type of an argument as part of
+   its processing.
+
+   Array arguments are only passed to these subroutines that implement
+   the simplification of transformational intrinsics.
+
+   The functions in this file don't have much comment with them, but
+   everything is reasonably straight-forward.  The Standard, chapter 13
+   is the best comment you'll find for this file anyway.  */
+
+/* Range checks an expression node.  If all goes well, returns the
+   node, otherwise returns &gfc_bad_expr and frees the node.  */
+
+static gfc_expr *
+range_check (gfc_expr *result, const char *name)
+{
+  if (result == NULL)
+    return &gfc_bad_expr;
+
+  if (result->expr_type != EXPR_CONSTANT)
+    return result;
+
+  switch (gfc_range_check (result))
+    {
+      case ARITH_OK:
+	return result;
+ 
+      case ARITH_OVERFLOW:
+	gfc_error ("Result of %s overflows its kind at %L", name,
+		   &result->where);
+	break;
+
+      case ARITH_UNDERFLOW:
+	gfc_error ("Result of %s underflows its kind at %L", name,
+		   &result->where);
+	break;
+
+      case ARITH_NAN:
+	gfc_error ("Result of %s is NaN at %L", name, &result->where);
+	break;
+
+      default:
+	gfc_error ("Result of %s gives range error for its kind at %L", name,
+		   &result->where);
+	break;
+    }
+
+  gfc_free_expr (result);
+  return &gfc_bad_expr;
+}
+
+
+/* A helper function that gets an optional and possibly missing
+   kind parameter.  Returns the kind, -1 if something went wrong.  */
+
+static int
+get_kind (bt type, gfc_expr *k, const char *name, int default_kind)
+{
+  int kind;
+
+  if (k == NULL)
+    return default_kind;
+
+  if (k->expr_type != EXPR_CONSTANT)
+    {
+      gfc_error ("KIND parameter of %s at %L must be an initialization "
+		 "expression", name, &k->where);
+      return -1;
+    }
+
+  if (gfc_extract_int (k, &kind) != NULL
+      || gfc_validate_kind (type, kind, true) < 0)
+    {
+      gfc_error ("Invalid KIND parameter of %s at %L", name, &k->where);
+      return -1;
+    }
+
+  return kind;
+}
+
+
+/* Converts an mpz_t signed variable into an unsigned one, assuming
+   two's complement representations and a binary width of bitsize.
+   The conversion is a no-op unless x is negative; otherwise, it can
+   be accomplished by masking out the high bits.  */
+
+static void
+convert_mpz_to_unsigned (mpz_t x, int bitsize)
+{
+  mpz_t mask;
+
+  if (mpz_sgn (x) < 0)
+    {
+      /* Confirm that no bits above the signed range are unset.  */
+      gcc_assert (mpz_scan0 (x, bitsize-1) == ULONG_MAX);
+
+      mpz_init_set_ui (mask, 1);
+      mpz_mul_2exp (mask, mask, bitsize);
+      mpz_sub_ui (mask, mask, 1);
+
+      mpz_and (x, x, mask);
+
+      mpz_clear (mask);
+    }
+  else
+    {
+      /* Confirm that no bits above the signed range are set.  */
+      gcc_assert (mpz_scan1 (x, bitsize-1) == ULONG_MAX);
+    }
+}
+
+
+/* Converts an mpz_t unsigned variable into a signed one, assuming
+   two's complement representations and a binary width of bitsize.
+   If the bitsize-1 bit is set, this is taken as a sign bit and
+   the number is converted to the corresponding negative number.  */
+
+static void
+convert_mpz_to_signed (mpz_t x, int bitsize)
+{
+  mpz_t mask;
+
+  /* Confirm that no bits above the unsigned range are set.  */
+  gcc_assert (mpz_scan1 (x, bitsize) == ULONG_MAX);
+
+  if (mpz_tstbit (x, bitsize - 1) == 1)
+    {
+      mpz_init_set_ui (mask, 1);
+      mpz_mul_2exp (mask, mask, bitsize);
+      mpz_sub_ui (mask, mask, 1);
+
+      /* We negate the number by hand, zeroing the high bits, that is
+	 make it the corresponding positive number, and then have it
+	 negated by GMP, giving the correct representation of the
+	 negative number.  */
+      mpz_com (x, x);
+      mpz_add_ui (x, x, 1);
+      mpz_and (x, x, mask);
+
+      mpz_neg (x, x);
+
+      mpz_clear (mask);
+    }
+}
+
+
+/* In-place convert BOZ to REAL of the specified kind.  */
+
+static gfc_expr *
+convert_boz (gfc_expr *x, int kind)
+{
+  if (x && x->ts.type == BT_INTEGER && x->is_boz)
+    {
+      gfc_typespec ts;
+      gfc_clear_ts (&ts);
+      ts.type = BT_REAL;
+      ts.kind = kind;
+
+      if (!gfc_convert_boz (x, &ts))
+	return &gfc_bad_expr;
+    }
+
+  return x;
+}
+
+
+/* Test that the expression is an constant array.  */
+
+static bool
+is_constant_array_expr (gfc_expr *e)
+{
+  gfc_constructor *c;
+
+  if (e == NULL)
+    return true;
+
+  if (e->expr_type != EXPR_ARRAY || !gfc_is_constant_expr (e))
+    return false;
+
+  for (c = gfc_constructor_first (e->value.constructor);
+       c; c = gfc_constructor_next (c))
+    if (c->expr->expr_type != EXPR_CONSTANT
+	  && c->expr->expr_type != EXPR_STRUCTURE)
+      return false;
+
+  return true;
+}
+
+
+/* Initialize a transformational result expression with a given value.  */
+
+static void
+init_result_expr (gfc_expr *e, int init, gfc_expr *array)
+{
+  if (e && e->expr_type == EXPR_ARRAY)
+    {
+      gfc_constructor *ctor = gfc_constructor_first (e->value.constructor);
+      while (ctor)
+	{
+	  init_result_expr (ctor->expr, init, array);
+	  ctor = gfc_constructor_next (ctor);
+	}
+    }
+  else if (e && e->expr_type == EXPR_CONSTANT)
+    {
+      int i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+      int length;
+      gfc_char_t *string;
+
+      switch (e->ts.type)
+	{
+	  case BT_LOGICAL:
+	    e->value.logical = (init ? 1 : 0);
+	    break;
+
+	  case BT_INTEGER:
+	    if (init == INT_MIN)
+	      mpz_set (e->value.integer, gfc_integer_kinds[i].min_int);
+	    else if (init == INT_MAX)
+	      mpz_set (e->value.integer, gfc_integer_kinds[i].huge);
+	    else
+	      mpz_set_si (e->value.integer, init);
+	    break;
+
+	  case BT_REAL:
+	    if (init == INT_MIN)
+	      {
+		mpfr_set (e->value.real, gfc_real_kinds[i].huge, GFC_RND_MODE);
+		mpfr_neg (e->value.real, e->value.real, GFC_RND_MODE);
+	      }
+	    else if (init == INT_MAX)
+	      mpfr_set (e->value.real, gfc_real_kinds[i].huge, GFC_RND_MODE);
+	    else
+	      mpfr_set_si (e->value.real, init, GFC_RND_MODE);
+	    break;
+
+	  case BT_COMPLEX:
+	    mpc_set_si (e->value.complex, init, GFC_MPC_RND_MODE);
+	    break;
+
+	  case BT_CHARACTER:
+	    if (init == INT_MIN)
+	      {
+		gfc_expr *len = gfc_simplify_len (array, NULL);
+		gfc_extract_int (len, &length);
+		string = gfc_get_wide_string (length + 1);
+		gfc_wide_memset (string, 0, length);
+	      }
+	    else if (init == INT_MAX)
+	      {
+		gfc_expr *len = gfc_simplify_len (array, NULL);
+		gfc_extract_int (len, &length);
+		string = gfc_get_wide_string (length + 1);
+		gfc_wide_memset (string, 255, length);
+	      }
+	    else
+	      {
+		length = 0;
+		string = gfc_get_wide_string (1);
+	      }
+
+	    string[length] = '\0';
+	    e->value.character.length = length;
+	    e->value.character.string = string;
+	    break;
+
+	  default:
+	    gcc_unreachable();
+	}
+    }
+  else
+    gcc_unreachable();
+}
+
+
+/* Helper function for gfc_simplify_dot_product() and gfc_simplify_matmul.  */
+
+static gfc_expr *
+compute_dot_product (gfc_expr *matrix_a, int stride_a, int offset_a,
+		     gfc_expr *matrix_b, int stride_b, int offset_b)
+{
+  gfc_expr *result, *a, *b;
+
+  result = gfc_get_constant_expr (matrix_a->ts.type, matrix_a->ts.kind,
+				  &matrix_a->where);
+  init_result_expr (result, 0, NULL);
+
+  a = gfc_constructor_lookup_expr (matrix_a->value.constructor, offset_a);
+  b = gfc_constructor_lookup_expr (matrix_b->value.constructor, offset_b);
+  while (a && b)
+    {
+      /* Copying of expressions is required as operands are free'd
+	 by the gfc_arith routines.  */
+      switch (result->ts.type)
+	{
+	  case BT_LOGICAL:
+	    result = gfc_or (result,
+			     gfc_and (gfc_copy_expr (a),
+				      gfc_copy_expr (b)));
+	    break;
+
+	  case BT_INTEGER:
+	  case BT_REAL:
+	  case BT_COMPLEX:
+	    result = gfc_add (result,
+			      gfc_multiply (gfc_copy_expr (a),
+					    gfc_copy_expr (b)));
+	    break;
+
+	  default:
+	    gcc_unreachable();
+	}
+
+      offset_a += stride_a;
+      a = gfc_constructor_lookup_expr (matrix_a->value.constructor, offset_a);
+
+      offset_b += stride_b;
+      b = gfc_constructor_lookup_expr (matrix_b->value.constructor, offset_b);
+    }
+
+  return result;
+}
+
+
+/* Build a result expression for transformational intrinsics, 
+   depending on DIM. */
+
+static gfc_expr *
+transformational_result (gfc_expr *array, gfc_expr *dim, bt type,
+			 int kind, locus* where)
+{
+  gfc_expr *result;
+  int i, nelem;
+
+  if (!dim || array->rank == 1)
+    return gfc_get_constant_expr (type, kind, where);
+
+  result = gfc_get_array_expr (type, kind, where);
+  result->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim);
+  result->rank = array->rank - 1;
+
+  /* gfc_array_size() would count the number of elements in the constructor,
+     we have not built those yet.  */
+  nelem = 1;
+  for  (i = 0; i < result->rank; ++i)
+    nelem *= mpz_get_ui (result->shape[i]);
+
+  for (i = 0; i < nelem; ++i)
+    {
+      gfc_constructor_append_expr (&result->value.constructor,
+				   gfc_get_constant_expr (type, kind, where),
+				   NULL);
+    }
+
+  return result;
+}
+
+
+typedef gfc_expr* (*transformational_op)(gfc_expr*, gfc_expr*);
+
+/* Wrapper function, implements 'op1 += 1'. Only called if MASK
+   of COUNT intrinsic is .TRUE..
+
+   Interface and implimentation mimics arith functions as
+   gfc_add, gfc_multiply, etc.  */
+
+static gfc_expr* gfc_count (gfc_expr *op1, gfc_expr *op2)
+{
+  gfc_expr *result;
+
+  gcc_assert (op1->ts.type == BT_INTEGER);
+  gcc_assert (op2->ts.type == BT_LOGICAL);
+  gcc_assert (op2->value.logical);
+
+  result = gfc_copy_expr (op1);
+  mpz_add_ui (result->value.integer, result->value.integer, 1);
+
+  gfc_free_expr (op1);
+  gfc_free_expr (op2);
+  return result;
+}
+
+
+/* Transforms an ARRAY with operation OP, according to MASK, to a
+   scalar RESULT. E.g. called if
+
+     REAL, PARAMETER :: array(n, m) = ...
+     REAL, PARAMETER :: s = SUM(array)
+
+  where OP == gfc_add().  */
+
+static gfc_expr *
+simplify_transformation_to_scalar (gfc_expr *result, gfc_expr *array, gfc_expr *mask,
+				   transformational_op op)
+{
+  gfc_expr *a, *m;
+  gfc_constructor *array_ctor, *mask_ctor;
+
+  /* Shortcut for constant .FALSE. MASK.  */
+  if (mask
+      && mask->expr_type == EXPR_CONSTANT
+      && !mask->value.logical)
+    return result;
+
+  array_ctor = gfc_constructor_first (array->value.constructor);
+  mask_ctor = NULL;
+  if (mask && mask->expr_type == EXPR_ARRAY)
+    mask_ctor = gfc_constructor_first (mask->value.constructor);
+
+  while (array_ctor)
+    {
+      a = array_ctor->expr;
+      array_ctor = gfc_constructor_next (array_ctor);
+
+      /* A constant MASK equals .TRUE. here and can be ignored.  */
+      if (mask_ctor)
+	{
+	  m = mask_ctor->expr;
+	  mask_ctor = gfc_constructor_next (mask_ctor);
+	  if (!m->value.logical)
+	    continue;
+	}
+
+      result = op (result, gfc_copy_expr (a));
+    }
+
+  return result;
+}
+
+/* Transforms an ARRAY with operation OP, according to MASK, to an
+   array RESULT. E.g. called if
+
+     REAL, PARAMETER :: array(n, m) = ...
+     REAL, PARAMETER :: s(n) = PROD(array, DIM=1)
+
+  where OP == gfc_multiply(). The result might be post processed using post_op. */ 
+
+static gfc_expr *
+simplify_transformation_to_array (gfc_expr *result, gfc_expr *array, gfc_expr *dim,
+				  gfc_expr *mask, transformational_op op,
+				  transformational_op post_op)
+{
+  mpz_t size;
+  int done, i, n, arraysize, resultsize, dim_index, dim_extent, dim_stride;
+  gfc_expr **arrayvec, **resultvec, **base, **src, **dest;
+  gfc_constructor *array_ctor, *mask_ctor, *result_ctor;
+
+  int count[GFC_MAX_DIMENSIONS], extent[GFC_MAX_DIMENSIONS],
+      sstride[GFC_MAX_DIMENSIONS], dstride[GFC_MAX_DIMENSIONS],
+      tmpstride[GFC_MAX_DIMENSIONS];
+
+  /* Shortcut for constant .FALSE. MASK.  */
+  if (mask
+      && mask->expr_type == EXPR_CONSTANT
+      && !mask->value.logical)
+    return result;
+
+  /* Build an indexed table for array element expressions to minimize
+     linked-list traversal. Masked elements are set to NULL.  */
+  gfc_array_size (array, &size);
+  arraysize = mpz_get_ui (size);
+
+  arrayvec = (gfc_expr**) gfc_getmem (sizeof (gfc_expr*) * arraysize);
+
+  array_ctor = gfc_constructor_first (array->value.constructor);
+  mask_ctor = NULL;
+  if (mask && mask->expr_type == EXPR_ARRAY)
+    mask_ctor = gfc_constructor_first (mask->value.constructor);
+
+  for (i = 0; i < arraysize; ++i)
+    {
+      arrayvec[i] = array_ctor->expr;
+      array_ctor = gfc_constructor_next (array_ctor);
+
+      if (mask_ctor)
+	{
+	  if (!mask_ctor->expr->value.logical)
+	    arrayvec[i] = NULL;
+
+	  mask_ctor = gfc_constructor_next (mask_ctor);
+	}
+    }
+
+  /* Same for the result expression.  */
+  gfc_array_size (result, &size);
+  resultsize = mpz_get_ui (size);
+  mpz_clear (size);
+
+  resultvec = (gfc_expr**) gfc_getmem (sizeof (gfc_expr*) * resultsize);
+  result_ctor = gfc_constructor_first (result->value.constructor);
+  for (i = 0; i < resultsize; ++i)
+    {
+      resultvec[i] = result_ctor->expr;
+      result_ctor = gfc_constructor_next (result_ctor);
+    }
+
+  gfc_extract_int (dim, &dim_index);
+  dim_index -= 1;               /* zero-base index */
+  dim_extent = 0;
+  dim_stride = 0;
+
+  for (i = 0, n = 0; i < array->rank; ++i)
+    {
+      count[i] = 0;
+      tmpstride[i] = (i == 0) ? 1 : tmpstride[i-1] * mpz_get_si (array->shape[i-1]);
+      if (i == dim_index)
+	{
+	  dim_extent = mpz_get_si (array->shape[i]);
+	  dim_stride = tmpstride[i];
+	  continue;
+	}
+
+      extent[n] = mpz_get_si (array->shape[i]);
+      sstride[n] = tmpstride[i];
+      dstride[n] = (n == 0) ? 1 : dstride[n-1] * extent[n-1];
+      n += 1;
+    }
+
+  done = false;
+  base = arrayvec;
+  dest = resultvec;
+  while (!done)
+    {
+      for (src = base, n = 0; n < dim_extent; src += dim_stride, ++n)
+	if (*src)
+	  *dest = op (*dest, gfc_copy_expr (*src));
+
+      count[0]++;
+      base += sstride[0];
+      dest += dstride[0];
+
+      n = 0;
+      while (!done && count[n] == extent[n])
+	{
+	  count[n] = 0;
+	  base -= sstride[n] * extent[n];
+	  dest -= dstride[n] * extent[n];
+
+	  n++;
+	  if (n < result->rank)
+	    {
+	      count [n]++;
+	      base += sstride[n];
+	      dest += dstride[n];
+	    }
+	  else
+	    done = true;
+       }
+    }
+
+  /* Place updated expression in result constructor.  */
+  result_ctor = gfc_constructor_first (result->value.constructor);
+  for (i = 0; i < resultsize; ++i)
+    {
+      if (post_op)
+	result_ctor->expr = post_op (result_ctor->expr, resultvec[i]);
+      else
+	result_ctor->expr = resultvec[i];
+      result_ctor = gfc_constructor_next (result_ctor);
+    }
+
+  gfc_free (arrayvec);
+  gfc_free (resultvec);
+  return result;
+}
+
+
+static gfc_expr *
+simplify_transformation (gfc_expr *array, gfc_expr *dim, gfc_expr *mask,
+			 int init_val, transformational_op op)
+{
+  gfc_expr *result;
+
+  if (!is_constant_array_expr (array)
+      || !gfc_is_constant_expr (dim))
+    return NULL;
+
+  if (mask
+      && !is_constant_array_expr (mask)
+      && mask->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = transformational_result (array, dim, array->ts.type,
+				    array->ts.kind, &array->where);
+  init_result_expr (result, init_val, NULL);
+
+  return !dim || array->rank == 1 ?
+    simplify_transformation_to_scalar (result, array, mask, op) :
+    simplify_transformation_to_array (result, array, dim, mask, op, NULL);
+}
+
+
+/********************** Simplification functions *****************************/
+
+gfc_expr *
+gfc_simplify_abs (gfc_expr *e)
+{
+  gfc_expr *result;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  switch (e->ts.type)
+    {
+      case BT_INTEGER:
+	result = gfc_get_constant_expr (BT_INTEGER, e->ts.kind, &e->where);
+	mpz_abs (result->value.integer, e->value.integer);
+	return range_check (result, "IABS");
+
+      case BT_REAL:
+	result = gfc_get_constant_expr (BT_REAL, e->ts.kind, &e->where);
+	mpfr_abs (result->value.real, e->value.real, GFC_RND_MODE);
+	return range_check (result, "ABS");
+
+      case BT_COMPLEX:
+	gfc_set_model_kind (e->ts.kind);
+	result = gfc_get_constant_expr (BT_REAL, e->ts.kind, &e->where);
+	mpc_abs (result->value.real, e->value.complex, GFC_RND_MODE);
+	return range_check (result, "CABS");
+
+      default:
+	gfc_internal_error ("gfc_simplify_abs(): Bad type");
+    }
+}
+
+
+static gfc_expr *
+simplify_achar_char (gfc_expr *e, gfc_expr *k, const char *name, bool ascii)
+{
+  gfc_expr *result;
+  int kind;
+  bool too_large = false;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  kind = get_kind (BT_CHARACTER, k, name, gfc_default_character_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+
+  if (mpz_cmp_si (e->value.integer, 0) < 0)
+    {
+      gfc_error ("Argument of %s function at %L is negative", name,
+		 &e->where);
+      return &gfc_bad_expr;
+    }
+
+  if (ascii && gfc_option.warn_surprising
+      && mpz_cmp_si (e->value.integer, 127) > 0)
+    gfc_warning ("Argument of %s function at %L outside of range [0,127]",
+		 name, &e->where);
+
+  if (kind == 1 && mpz_cmp_si (e->value.integer, 255) > 0)
+    too_large = true;
+  else if (kind == 4)
+    {
+      mpz_t t;
+      mpz_init_set_ui (t, 2);
+      mpz_pow_ui (t, t, 32);
+      mpz_sub_ui (t, t, 1);
+      if (mpz_cmp (e->value.integer, t) > 0)
+	too_large = true;
+      mpz_clear (t);
+    }
+
+  if (too_large)
+    {
+      gfc_error ("Argument of %s function at %L is too large for the "
+		 "collating sequence of kind %d", name, &e->where, kind);
+      return &gfc_bad_expr;
+    }
+
+  result = gfc_get_character_expr (kind, &e->where, NULL, 1);
+  result->value.character.string[0] = mpz_get_ui (e->value.integer);
+
+  return result;
+}
+
+
+
+/* We use the processor's collating sequence, because all
+   systems that gfortran currently works on are ASCII.  */
+
+gfc_expr *
+gfc_simplify_achar (gfc_expr *e, gfc_expr *k)
+{
+  return simplify_achar_char (e, k, "ACHAR", true);
+}
+
+
+gfc_expr *
+gfc_simplify_acos (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  switch (x->ts.type)
+    {
+      case BT_REAL:
+	if (mpfr_cmp_si (x->value.real, 1) > 0
+	    || mpfr_cmp_si (x->value.real, -1) < 0)
+	  {
+	    gfc_error ("Argument of ACOS at %L must be between -1 and 1",
+		       &x->where);
+	    return &gfc_bad_expr;
+	  }
+	result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+	mpfr_acos (result->value.real, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+	mpc_acos (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gfc_internal_error ("in gfc_simplify_acos(): Bad type");
+    }
+
+  return range_check (result, "ACOS");
+}
+
+gfc_expr *
+gfc_simplify_acosh (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  switch (x->ts.type)
+    {
+      case BT_REAL:
+	if (mpfr_cmp_si (x->value.real, 1) < 0)
+	  {
+	    gfc_error ("Argument of ACOSH at %L must not be less than 1",
+		       &x->where);
+	    return &gfc_bad_expr;
+	  }
+
+	result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+	mpfr_acosh (result->value.real, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+	mpc_acosh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gfc_internal_error ("in gfc_simplify_acosh(): Bad type");
+    }
+
+  return range_check (result, "ACOSH");
+}
+
+gfc_expr *
+gfc_simplify_adjustl (gfc_expr *e)
+{
+  gfc_expr *result;
+  int count, i, len;
+  gfc_char_t ch;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  len = e->value.character.length;
+
+  for (count = 0, i = 0; i < len; ++i)
+    {
+      ch = e->value.character.string[i];
+      if (ch != ' ')
+	break;
+      ++count;
+    }
+
+  result = gfc_get_character_expr (e->ts.kind, &e->where, NULL, len);
+  for (i = 0; i < len - count; ++i)
+    result->value.character.string[i] = e->value.character.string[count + i];
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_adjustr (gfc_expr *e)
+{
+  gfc_expr *result;
+  int count, i, len;
+  gfc_char_t ch;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  len = e->value.character.length;
+
+  for (count = 0, i = len - 1; i >= 0; --i)
+    {
+      ch = e->value.character.string[i];
+      if (ch != ' ')
+	break;
+      ++count;
+    }
+
+  result = gfc_get_character_expr (e->ts.kind, &e->where, NULL, len);
+  for (i = 0; i < count; ++i)
+    result->value.character.string[i] = ' ';
+
+  for (i = count; i < len; ++i)
+    result->value.character.string[i] = e->value.character.string[i - count];
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_aimag (gfc_expr *e)
+{
+  gfc_expr *result;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_REAL, e->ts.kind, &e->where);
+  mpfr_set (result->value.real, mpc_imagref (e->value.complex), GFC_RND_MODE);
+
+  return range_check (result, "AIMAG");
+}
+
+
+gfc_expr *
+gfc_simplify_aint (gfc_expr *e, gfc_expr *k)
+{
+  gfc_expr *rtrunc, *result;
+  int kind;
+
+  kind = get_kind (BT_REAL, k, "AINT", e->ts.kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  rtrunc = gfc_copy_expr (e);
+  mpfr_trunc (rtrunc->value.real, e->value.real);
+
+  result = gfc_real2real (rtrunc, kind);
+
+  gfc_free_expr (rtrunc);
+
+  return range_check (result, "AINT");
+}
+
+
+gfc_expr *
+gfc_simplify_all (gfc_expr *mask, gfc_expr *dim)
+{
+  return simplify_transformation (mask, dim, NULL, true, gfc_and);
+}
+
+
+gfc_expr *
+gfc_simplify_dint (gfc_expr *e)
+{
+  gfc_expr *rtrunc, *result;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  rtrunc = gfc_copy_expr (e);
+  mpfr_trunc (rtrunc->value.real, e->value.real);
+
+  result = gfc_real2real (rtrunc, gfc_default_double_kind);
+
+  gfc_free_expr (rtrunc);
+
+  return range_check (result, "DINT");
+}
+
+
+gfc_expr *
+gfc_simplify_anint (gfc_expr *e, gfc_expr *k)
+{
+  gfc_expr *result;
+  int kind;
+
+  kind = get_kind (BT_REAL, k, "ANINT", e->ts.kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (e->ts.type, kind, &e->where);
+  mpfr_round (result->value.real, e->value.real);
+
+  return range_check (result, "ANINT");
+}
+
+
+gfc_expr *
+gfc_simplify_and (gfc_expr *x, gfc_expr *y)
+{
+  gfc_expr *result;
+  int kind;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind;
+
+  switch (x->ts.type)
+    {
+      case BT_INTEGER:
+	result = gfc_get_constant_expr (BT_INTEGER, kind, &x->where);
+	mpz_and (result->value.integer, x->value.integer, y->value.integer);
+	return range_check (result, "AND");
+
+      case BT_LOGICAL:
+	return gfc_get_logical_expr (kind, &x->where,
+				     x->value.logical && y->value.logical);
+
+      default:
+	gcc_unreachable ();
+    }
+}
+
+
+gfc_expr *
+gfc_simplify_any (gfc_expr *mask, gfc_expr *dim)
+{
+  return simplify_transformation (mask, dim, NULL, false, gfc_or);
+}
+
+
+gfc_expr *
+gfc_simplify_dnint (gfc_expr *e)
+{
+  gfc_expr *result;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_REAL, gfc_default_double_kind, &e->where);
+  mpfr_round (result->value.real, e->value.real);
+
+  return range_check (result, "DNINT");
+}
+
+
+gfc_expr *
+gfc_simplify_asin (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  switch (x->ts.type)
+    {
+      case BT_REAL:
+	if (mpfr_cmp_si (x->value.real, 1) > 0
+	    || mpfr_cmp_si (x->value.real, -1) < 0)
+	  {
+	    gfc_error ("Argument of ASIN at %L must be between -1 and 1",
+		       &x->where);
+	    return &gfc_bad_expr;
+	  }
+	result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+	mpfr_asin (result->value.real, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+	mpc_asin (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gfc_internal_error ("in gfc_simplify_asin(): Bad type");
+    }
+
+  return range_check (result, "ASIN");
+}
+
+
+gfc_expr *
+gfc_simplify_asinh (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+  switch (x->ts.type)
+    {
+      case BT_REAL:
+	mpfr_asinh (result->value.real, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	mpc_asinh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gfc_internal_error ("in gfc_simplify_asinh(): Bad type");
+    }
+
+  return range_check (result, "ASINH");
+}
+
+
+gfc_expr *
+gfc_simplify_atan (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+  switch (x->ts.type)
+    {
+      case BT_REAL:
+	mpfr_atan (result->value.real, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	mpc_atan (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gfc_internal_error ("in gfc_simplify_atan(): Bad type");
+    }
+
+  return range_check (result, "ATAN");
+}
+
+
+gfc_expr *
+gfc_simplify_atanh (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  switch (x->ts.type)
+    {
+      case BT_REAL:
+	if (mpfr_cmp_si (x->value.real, 1) >= 0
+	    || mpfr_cmp_si (x->value.real, -1) <= 0)
+	  {
+	    gfc_error ("Argument of ATANH at %L must be inside the range -1 "
+		       "to 1", &x->where);
+	    return &gfc_bad_expr;
+	  }
+	result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+	mpfr_atanh (result->value.real, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+	mpc_atanh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gfc_internal_error ("in gfc_simplify_atanh(): Bad type");
+    }
+
+  return range_check (result, "ATANH");
+}
+
+
+gfc_expr *
+gfc_simplify_atan2 (gfc_expr *y, gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (mpfr_sgn (y->value.real) == 0 && mpfr_sgn (x->value.real) == 0)
+    {
+      gfc_error ("If first argument of ATAN2 %L is zero, then the "
+		 "second argument must not be zero", &x->where);
+      return &gfc_bad_expr;
+    }
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_atan2 (result->value.real, y->value.real, x->value.real, GFC_RND_MODE);
+
+  return range_check (result, "ATAN2");
+}
+
+
+gfc_expr *
+gfc_simplify_bessel_j0 (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_j0 (result->value.real, x->value.real, GFC_RND_MODE);
+
+  return range_check (result, "BESSEL_J0");
+}
+
+
+gfc_expr *
+gfc_simplify_bessel_j1 (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_j1 (result->value.real, x->value.real, GFC_RND_MODE);
+
+  return range_check (result, "BESSEL_J1");
+}
+
+
+gfc_expr *
+gfc_simplify_bessel_jn (gfc_expr *order, gfc_expr *x)
+{
+  gfc_expr *result;
+  long n;
+
+  if (x->expr_type != EXPR_CONSTANT || order->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  n = mpz_get_si (order->value.integer);
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_jn (result->value.real, n, x->value.real, GFC_RND_MODE);
+
+  return range_check (result, "BESSEL_JN");
+}
+
+
+/* Simplify transformational form of JN and YN.  */
+
+static gfc_expr *
+gfc_simplify_bessel_n2 (gfc_expr *order1, gfc_expr *order2, gfc_expr *x,
+			bool jn)
+{
+  gfc_expr *result;
+  gfc_expr *e;
+  long n1, n2;
+  int i;
+  mpfr_t x2rev, last1, last2;
+
+  if (x->expr_type != EXPR_CONSTANT || order1->expr_type != EXPR_CONSTANT
+      || order2->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  n1 = mpz_get_si (order1->value.integer);
+  n2 = mpz_get_si (order2->value.integer);
+  result = gfc_get_array_expr (x->ts.type, x->ts.kind, &x->where);
+  result->rank = 1;
+  result->shape = gfc_get_shape (1);
+  mpz_init_set_ui (result->shape[0], MAX (n2-n1+1, 0));
+
+  if (n2 < n1)
+    return result;
+
+  /* Special case: x == 0; it is J0(0.0) == 1, JN(N > 0, 0.0) == 0; and
+     YN(N, 0.0) = -Inf.  */
+
+  if (mpfr_cmp_ui (x->value.real, 0.0) == 0)
+    {
+      if (!jn && gfc_option.flag_range_check)
+	{
+	  gfc_error ("Result of BESSEL_YN is -INF at %L", &result->where);
+ 	  gfc_free_expr (result);
+	  return &gfc_bad_expr;
+	}
+
+      if (jn && n1 == 0)
+	{
+	  e = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+	  mpfr_set_ui (e->value.real, 1, GFC_RND_MODE);
+	  gfc_constructor_append_expr (&result->value.constructor, e,
+				       &x->where);
+	  n1++;
+	}
+
+      for (i = n1; i <= n2; i++)
+	{
+	  e = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+	  if (jn)
+	    mpfr_set_ui (e->value.real, 0, GFC_RND_MODE);
+	  else
+	    mpfr_set_inf (e->value.real, -1);
+	  gfc_constructor_append_expr (&result->value.constructor, e,
+				       &x->where);
+	}
+
+      return result;
+    }
+
+  /* Use the faster but more verbose recurrence algorithm. Bessel functions
+     are stable for downward recursion and Neumann functions are stable
+     for upward recursion. It is
+       x2rev = 2.0/x,
+       J(N-1, x) = x2rev * N * J(N, x) - J(N+1, x),
+       Y(N+1, x) = x2rev * N * Y(N, x) - Y(N-1, x).
+     Cf. http://dlmf.nist.gov/10.74#iv and http://dlmf.nist.gov/10.6#E1  */
+
+  gfc_set_model_kind (x->ts.kind);
+
+  /* Get first recursion anchor.  */
+
+  mpfr_init (last1);
+  if (jn)
+    mpfr_jn (last1, n2, x->value.real, GFC_RND_MODE);
+  else
+    mpfr_yn (last1, n1, x->value.real, GFC_RND_MODE);
+
+  e = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_set (e->value.real, last1, GFC_RND_MODE);
+  if (range_check (e, jn ? "BESSEL_JN" : "BESSEL_YN") == &gfc_bad_expr)
+    {
+      mpfr_clear (last1);
+      gfc_free_expr (e);
+      gfc_free_expr (result);
+      return &gfc_bad_expr;
+    }
+  gfc_constructor_append_expr (&result->value.constructor, e, &x->where);
+
+  if (n1 == n2)
+    {
+      mpfr_clear (last1);
+      return result;
+    }
+ 
+  /* Get second recursion anchor.  */
+
+  mpfr_init (last2);
+  if (jn)
+    mpfr_jn (last2, n2-1, x->value.real, GFC_RND_MODE);
+  else
+    mpfr_yn (last2, n1+1, x->value.real, GFC_RND_MODE);
+
+  e = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_set (e->value.real, last2, GFC_RND_MODE);
+  if (range_check (e, jn ? "BESSEL_JN" : "BESSEL_YN") == &gfc_bad_expr)
+    {
+      mpfr_clear (last1);
+      mpfr_clear (last2);
+      gfc_free_expr (e);
+      gfc_free_expr (result);
+      return &gfc_bad_expr;
+    }
+  if (jn)
+    gfc_constructor_insert_expr (&result->value.constructor, e, &x->where, -2);
+  else 
+    gfc_constructor_append_expr (&result->value.constructor, e, &x->where);
+
+  if (n1 + 1 == n2)
+    {
+      mpfr_clear (last1);
+      mpfr_clear (last2);
+      return result;
+    }
+
+  /* Start actual recursion.  */
+
+  mpfr_init (x2rev);
+  mpfr_ui_div (x2rev, 2, x->value.real, GFC_RND_MODE);
+ 
+  for (i = 2; i <= n2-n1; i++)
+    {
+      e = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+      /* Special case: For YN, if the previous N gave -INF, set
+	 also N+1 to -INF.  */
+      if (!jn && !gfc_option.flag_range_check && mpfr_inf_p (last2))
+	{
+	  mpfr_set_inf (e->value.real, -1);
+	  gfc_constructor_append_expr (&result->value.constructor, e,
+				       &x->where);
+	  continue;
+	}
+
+      mpfr_mul_si (e->value.real, x2rev, jn ? (n2-i+1) : (n1+i-1),
+		   GFC_RND_MODE);
+      mpfr_mul (e->value.real, e->value.real, last2, GFC_RND_MODE);
+      mpfr_sub (e->value.real, e->value.real, last1, GFC_RND_MODE);
+
+      if (range_check (e, jn ? "BESSEL_JN" : "BESSEL_YN") == &gfc_bad_expr)
+	goto error;
+
+      if (jn)
+	gfc_constructor_insert_expr (&result->value.constructor, e, &x->where,
+				     -i-1);
+      else
+	gfc_constructor_append_expr (&result->value.constructor, e, &x->where);
+
+      mpfr_set (last1, last2, GFC_RND_MODE);
+      mpfr_set (last2, e->value.real, GFC_RND_MODE);
+    }
+
+  mpfr_clear (last1);
+  mpfr_clear (last2);
+  mpfr_clear (x2rev);
+  return result;
+
+error:
+  mpfr_clear (last1);
+  mpfr_clear (last2);
+  mpfr_clear (x2rev);
+  gfc_free_expr (e);
+  gfc_free_expr (result);
+  return &gfc_bad_expr;
+}
+
+
+gfc_expr *
+gfc_simplify_bessel_jn2 (gfc_expr *order1, gfc_expr *order2, gfc_expr *x)
+{
+  return gfc_simplify_bessel_n2 (order1, order2, x, true);
+}
+
+
+gfc_expr *
+gfc_simplify_bessel_y0 (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_y0 (result->value.real, x->value.real, GFC_RND_MODE);
+
+  return range_check (result, "BESSEL_Y0");
+}
+
+
+gfc_expr *
+gfc_simplify_bessel_y1 (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_y1 (result->value.real, x->value.real, GFC_RND_MODE);
+
+  return range_check (result, "BESSEL_Y1");
+}
+
+
+gfc_expr *
+gfc_simplify_bessel_yn (gfc_expr *order, gfc_expr *x)
+{
+  gfc_expr *result;
+  long n;
+
+  if (x->expr_type != EXPR_CONSTANT || order->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  n = mpz_get_si (order->value.integer);
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_yn (result->value.real, n, x->value.real, GFC_RND_MODE);
+
+  return range_check (result, "BESSEL_YN");
+}
+
+
+gfc_expr *
+gfc_simplify_bessel_yn2 (gfc_expr *order1, gfc_expr *order2, gfc_expr *x)
+{
+  return gfc_simplify_bessel_n2 (order1, order2, x, false);
+}
+
+
+gfc_expr *
+gfc_simplify_bit_size (gfc_expr *e)
+{
+  int i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+  return gfc_get_int_expr (e->ts.kind, &e->where,
+			   gfc_integer_kinds[i].bit_size);
+}
+
+
+gfc_expr *
+gfc_simplify_btest (gfc_expr *e, gfc_expr *bit)
+{
+  int b;
+
+  if (e->expr_type != EXPR_CONSTANT || bit->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (gfc_extract_int (bit, &b) != NULL || b < 0)
+    return gfc_get_logical_expr (gfc_default_logical_kind, &e->where, false);
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &e->where,
+			       mpz_tstbit (e->value.integer, b));
+}
+
+
+static int
+compare_bitwise (gfc_expr *i, gfc_expr *j)
+{
+  mpz_t x, y;
+  int k, res;
+
+  gcc_assert (i->ts.type == BT_INTEGER);
+  gcc_assert (j->ts.type == BT_INTEGER);
+
+  mpz_init_set (x, i->value.integer);
+  k = gfc_validate_kind (i->ts.type, i->ts.kind, false);
+  convert_mpz_to_unsigned (x, gfc_integer_kinds[k].bit_size);
+
+  mpz_init_set (y, j->value.integer);
+  k = gfc_validate_kind (j->ts.type, j->ts.kind, false);
+  convert_mpz_to_unsigned (y, gfc_integer_kinds[k].bit_size);
+
+  res = mpz_cmp (x, y);
+  mpz_clear (x);
+  mpz_clear (y);
+  return res;
+}
+
+
+gfc_expr *
+gfc_simplify_bge (gfc_expr *i, gfc_expr *j)
+{
+  if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &i->where,
+			       compare_bitwise (i, j) >= 0);
+}
+
+
+gfc_expr *
+gfc_simplify_bgt (gfc_expr *i, gfc_expr *j)
+{
+  if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &i->where,
+			       compare_bitwise (i, j) > 0);
+}
+
+
+gfc_expr *
+gfc_simplify_ble (gfc_expr *i, gfc_expr *j)
+{
+  if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &i->where,
+			       compare_bitwise (i, j) <= 0);
+}
+
+
+gfc_expr *
+gfc_simplify_blt (gfc_expr *i, gfc_expr *j)
+{
+  if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &i->where,
+			       compare_bitwise (i, j) < 0);
+}
+
+
+gfc_expr *
+gfc_simplify_ceiling (gfc_expr *e, gfc_expr *k)
+{
+  gfc_expr *ceil, *result;
+  int kind;
+
+  kind = get_kind (BT_INTEGER, k, "CEILING", gfc_default_integer_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  ceil = gfc_copy_expr (e);
+  mpfr_ceil (ceil->value.real, e->value.real);
+
+  result = gfc_get_constant_expr (BT_INTEGER, kind, &e->where);
+  gfc_mpfr_to_mpz (result->value.integer, ceil->value.real, &e->where);
+
+  gfc_free_expr (ceil);
+
+  return range_check (result, "CEILING");
+}
+
+
+gfc_expr *
+gfc_simplify_char (gfc_expr *e, gfc_expr *k)
+{
+  return simplify_achar_char (e, k, "CHAR", false);
+}
+
+
+/* Common subroutine for simplifying CMPLX, COMPLEX and DCMPLX.  */
+
+static gfc_expr *
+simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
+{
+  gfc_expr *result;
+
+  if (convert_boz (x, kind) == &gfc_bad_expr)
+    return &gfc_bad_expr;
+
+  if (convert_boz (y, kind) == &gfc_bad_expr)
+    return &gfc_bad_expr;
+
+  if (x->expr_type != EXPR_CONSTANT
+      || (y != NULL && y->expr_type != EXPR_CONSTANT))
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_COMPLEX, kind, &x->where);
+
+  switch (x->ts.type)
+    {
+      case BT_INTEGER:
+	mpc_set_z (result->value.complex, x->value.integer, GFC_MPC_RND_MODE);
+	break;
+
+      case BT_REAL:
+	mpc_set_fr (result->value.complex, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	mpc_set (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gfc_internal_error ("gfc_simplify_dcmplx(): Bad type (x)");
+    }
+
+  if (!y)
+    return range_check (result, name);
+
+  switch (y->ts.type)
+    {
+      case BT_INTEGER:
+	mpfr_set_z (mpc_imagref (result->value.complex),
+		    y->value.integer, GFC_RND_MODE);
+	break;
+
+      case BT_REAL:
+	mpfr_set (mpc_imagref (result->value.complex),
+		  y->value.real, GFC_RND_MODE);
+	break;
+
+      default:
+	gfc_internal_error ("gfc_simplify_dcmplx(): Bad type (y)");
+    }
+
+  return range_check (result, name);
+}
+
+
+gfc_expr *
+gfc_simplify_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *k)
+{
+  int kind;
+
+  kind = get_kind (BT_REAL, k, "CMPLX", gfc_default_complex_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+
+  return simplify_cmplx ("CMPLX", x, y, kind);
+}
+
+
+gfc_expr *
+gfc_simplify_complex (gfc_expr *x, gfc_expr *y)
+{
+  int kind;
+
+  if (x->ts.type == BT_INTEGER && y->ts.type == BT_INTEGER)
+    kind = gfc_default_complex_kind;
+  else if (x->ts.type == BT_REAL || y->ts.type == BT_INTEGER)
+    kind = x->ts.kind;
+  else if (x->ts.type == BT_INTEGER || y->ts.type == BT_REAL)
+    kind = y->ts.kind;
+  else if (x->ts.type == BT_REAL && y->ts.type == BT_REAL)
+    kind = (x->ts.kind > y->ts.kind) ? x->ts.kind : y->ts.kind;
+  else
+    gcc_unreachable ();
+
+  return simplify_cmplx ("COMPLEX", x, y, kind);
+}
+
+
+gfc_expr *
+gfc_simplify_conjg (gfc_expr *e)
+{
+  gfc_expr *result;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_copy_expr (e);
+  mpc_conj (result->value.complex, result->value.complex, GFC_MPC_RND_MODE);
+
+  return range_check (result, "CONJG");
+}
+
+
+gfc_expr *
+gfc_simplify_cos (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+  switch (x->ts.type)
+    {
+      case BT_REAL:
+	mpfr_cos (result->value.real, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	gfc_set_model_kind (x->ts.kind);
+	mpc_cos (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gfc_internal_error ("in gfc_simplify_cos(): Bad type");
+    }
+
+  return range_check (result, "COS");
+}
+
+
+gfc_expr *
+gfc_simplify_cosh (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+  switch (x->ts.type)
+    {
+      case BT_REAL:
+	mpfr_cosh (result->value.real, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	mpc_cosh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+	
+      default:
+	gcc_unreachable ();
+    }
+
+  return range_check (result, "COSH");
+}
+
+
+gfc_expr *
+gfc_simplify_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
+{
+  gfc_expr *result;
+
+  if (!is_constant_array_expr (mask)
+      || !gfc_is_constant_expr (dim)
+      || !gfc_is_constant_expr (kind))
+    return NULL;
+
+  result = transformational_result (mask, dim,
+				    BT_INTEGER,
+				    get_kind (BT_INTEGER, kind, "COUNT",
+					      gfc_default_integer_kind),
+				    &mask->where);
+
+  init_result_expr (result, 0, NULL);
+
+  /* Passing MASK twice, once as data array, once as mask.
+     Whenever gfc_count is called, '1' is added to the result.  */
+  return !dim || mask->rank == 1 ?
+    simplify_transformation_to_scalar (result, mask, mask, gfc_count) :
+    simplify_transformation_to_array (result, mask, dim, mask, gfc_count, NULL);
+}
+
+
+gfc_expr *
+gfc_simplify_dcmplx (gfc_expr *x, gfc_expr *y)
+{
+  return simplify_cmplx ("DCMPLX", x, y, gfc_default_double_kind);
+}
+
+
+gfc_expr *
+gfc_simplify_dble (gfc_expr *e)
+{
+  gfc_expr *result = NULL;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (convert_boz (e, gfc_default_double_kind) == &gfc_bad_expr)
+    return &gfc_bad_expr;
+
+  result = gfc_convert_constant (e, BT_REAL, gfc_default_double_kind);
+  if (result == &gfc_bad_expr)
+    return &gfc_bad_expr;
+
+  return range_check (result, "DBLE");
+}
+
+
+gfc_expr *
+gfc_simplify_digits (gfc_expr *x)
+{
+  int i, digits;
+
+  i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
+
+  switch (x->ts.type)
+    {
+      case BT_INTEGER:
+	digits = gfc_integer_kinds[i].digits;
+	break;
+
+      case BT_REAL:
+      case BT_COMPLEX:
+	digits = gfc_real_kinds[i].digits;
+	break;
+
+      default:
+	gcc_unreachable ();
+    }
+
+  return gfc_get_int_expr (gfc_default_integer_kind, NULL, digits);
+}
+
+
+gfc_expr *
+gfc_simplify_dim (gfc_expr *x, gfc_expr *y)
+{
+  gfc_expr *result;
+  int kind;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind;
+  result = gfc_get_constant_expr (x->ts.type, kind, &x->where);
+
+  switch (x->ts.type)
+    {
+      case BT_INTEGER:
+	if (mpz_cmp (x->value.integer, y->value.integer) > 0)
+	  mpz_sub (result->value.integer, x->value.integer, y->value.integer);
+	else
+	  mpz_set_ui (result->value.integer, 0);
+
+	break;
+
+      case BT_REAL:
+	if (mpfr_cmp (x->value.real, y->value.real) > 0)
+	  mpfr_sub (result->value.real, x->value.real, y->value.real,
+		    GFC_RND_MODE);
+	else
+	  mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+
+	break;
+
+      default:
+	gfc_internal_error ("gfc_simplify_dim(): Bad type");
+    }
+
+  return range_check (result, "DIM");
+}
+
+
+gfc_expr*
+gfc_simplify_dot_product (gfc_expr *vector_a, gfc_expr *vector_b)
+{
+  if (!is_constant_array_expr (vector_a)
+      || !is_constant_array_expr (vector_b))
+    return NULL;
+
+  gcc_assert (vector_a->rank == 1);
+  gcc_assert (vector_b->rank == 1);
+  gcc_assert (gfc_compare_types (&vector_a->ts, &vector_b->ts));
+
+  return compute_dot_product (vector_a, 1, 0, vector_b, 1, 0);
+}
+
+
+gfc_expr *
+gfc_simplify_dprod (gfc_expr *x, gfc_expr *y)
+{
+  gfc_expr *a1, *a2, *result;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  a1 = gfc_real2real (x, gfc_default_double_kind);
+  a2 = gfc_real2real (y, gfc_default_double_kind);
+
+  result = gfc_get_constant_expr (BT_REAL, gfc_default_double_kind, &x->where);
+  mpfr_mul (result->value.real, a1->value.real, a2->value.real, GFC_RND_MODE);
+
+  gfc_free_expr (a2);
+  gfc_free_expr (a1);
+
+  return range_check (result, "DPROD");
+}
+
+
+static gfc_expr *
+simplify_dshift (gfc_expr *arg1, gfc_expr *arg2, gfc_expr *shiftarg,
+		      bool right)
+{
+  gfc_expr *result;
+  int i, k, size, shift;
+
+  if (arg1->expr_type != EXPR_CONSTANT || arg2->expr_type != EXPR_CONSTANT
+      || shiftarg->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  k = gfc_validate_kind (BT_INTEGER, arg1->ts.kind, false);
+  size = gfc_integer_kinds[k].bit_size;
+
+  if (gfc_extract_int (shiftarg, &shift) != NULL)
+    {
+      gfc_error ("Invalid SHIFT argument of DSHIFTL at %L", &shiftarg->where);
+      return &gfc_bad_expr;
+    }
+
+  gcc_assert (shift >= 0 && shift <= size);
+
+  /* DSHIFTR(I,J,SHIFT) = DSHIFTL(I,J,SIZE-SHIFT).  */
+  if (right)
+    shift = size - shift;
+
+  result = gfc_get_constant_expr (BT_INTEGER, arg1->ts.kind, &arg1->where);
+  mpz_set_ui (result->value.integer, 0);
+
+  for (i = 0; i < shift; i++)
+    if (mpz_tstbit (arg2->value.integer, size - shift + i))
+      mpz_setbit (result->value.integer, i);
+
+  for (i = 0; i < size - shift; i++)
+    if (mpz_tstbit (arg1->value.integer, i))
+      mpz_setbit (result->value.integer, shift + i);
+
+  /* Convert to a signed value.  */
+  convert_mpz_to_signed (result->value.integer, size);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_dshiftr (gfc_expr *arg1, gfc_expr *arg2, gfc_expr *shiftarg)
+{
+  return simplify_dshift (arg1, arg2, shiftarg, true);
+}
+
+
+gfc_expr *
+gfc_simplify_dshiftl (gfc_expr *arg1, gfc_expr *arg2, gfc_expr *shiftarg)
+{
+  return simplify_dshift (arg1, arg2, shiftarg, false);
+}
+
+
+gfc_expr *
+gfc_simplify_erf (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_erf (result->value.real, x->value.real, GFC_RND_MODE);
+
+  return range_check (result, "ERF");
+}
+
+
+gfc_expr *
+gfc_simplify_erfc (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_erfc (result->value.real, x->value.real, GFC_RND_MODE);
+
+  return range_check (result, "ERFC");
+}
+
+
+/* Helper functions to simplify ERFC_SCALED(x) = ERFC(x) * EXP(X**2).  */
+
+#define MAX_ITER 200
+#define ARG_LIMIT 12
+
+/* Calculate ERFC_SCALED directly by its definition:
+
+     ERFC_SCALED(x) = ERFC(x) * EXP(X**2)
+
+   using a large precision for intermediate results.  This is used for all
+   but large values of the argument.  */
+static void
+fullprec_erfc_scaled (mpfr_t res, mpfr_t arg)
+{
+  mp_prec_t prec;
+  mpfr_t a, b;
+
+  prec = mpfr_get_default_prec ();
+  mpfr_set_default_prec (10 * prec);
+
+  mpfr_init (a);
+  mpfr_init (b);
+
+  mpfr_set (a, arg, GFC_RND_MODE);
+  mpfr_sqr (b, a, GFC_RND_MODE);
+  mpfr_exp (b, b, GFC_RND_MODE);
+  mpfr_erfc (a, a, GFC_RND_MODE);
+  mpfr_mul (a, a, b, GFC_RND_MODE);
+
+  mpfr_set (res, a, GFC_RND_MODE);
+  mpfr_set_default_prec (prec);
+
+  mpfr_clear (a);
+  mpfr_clear (b);
+}
+
+/* Calculate ERFC_SCALED using a power series expansion in 1/arg:
+
+    ERFC_SCALED(x) = 1 / (x * sqrt(pi))
+                     * (1 + Sum_n (-1)**n * (1 * 3 * 5 * ... * (2n-1))
+                                          / (2 * x**2)**n)
+
+  This is used for large values of the argument.  Intermediate calculations
+  are performed with twice the precision.  We don't do a fixed number of
+  iterations of the sum, but stop when it has converged to the required
+  precision.  */
+static void
+asympt_erfc_scaled (mpfr_t res, mpfr_t arg)
+{
+  mpfr_t sum, x, u, v, w, oldsum, sumtrunc;
+  mpz_t num;
+  mp_prec_t prec;
+  unsigned i;
+
+  prec = mpfr_get_default_prec ();
+  mpfr_set_default_prec (2 * prec);
+
+  mpfr_init (sum);
+  mpfr_init (x);
+  mpfr_init (u);
+  mpfr_init (v);
+  mpfr_init (w);
+  mpz_init (num);
+
+  mpfr_init (oldsum);
+  mpfr_init (sumtrunc);
+  mpfr_set_prec (oldsum, prec);
+  mpfr_set_prec (sumtrunc, prec);
+
+  mpfr_set (x, arg, GFC_RND_MODE);
+  mpfr_set_ui (sum, 1, GFC_RND_MODE);
+  mpz_set_ui (num, 1);
+
+  mpfr_set (u, x, GFC_RND_MODE);
+  mpfr_sqr (u, u, GFC_RND_MODE);
+  mpfr_mul_ui (u, u, 2, GFC_RND_MODE);
+  mpfr_pow_si (u, u, -1, GFC_RND_MODE);
+
+  for (i = 1; i < MAX_ITER; i++)
+  {
+    mpfr_set (oldsum, sum, GFC_RND_MODE);
+
+    mpz_mul_ui (num, num, 2 * i - 1);
+    mpz_neg (num, num);
+
+    mpfr_set (w, u, GFC_RND_MODE);
+    mpfr_pow_ui (w, w, i, GFC_RND_MODE);
+
+    mpfr_set_z (v, num, GFC_RND_MODE);
+    mpfr_mul (v, v, w, GFC_RND_MODE);
+
+    mpfr_add (sum, sum, v, GFC_RND_MODE);
+
+    mpfr_set (sumtrunc, sum, GFC_RND_MODE);
+    if (mpfr_cmp (sumtrunc, oldsum) == 0)
+      break;
+  }
+
+  /* We should have converged by now; otherwise, ARG_LIMIT is probably
+     set too low.  */
+  gcc_assert (i < MAX_ITER);
+
+  /* Divide by x * sqrt(Pi).  */
+  mpfr_const_pi (u, GFC_RND_MODE);
+  mpfr_sqrt (u, u, GFC_RND_MODE);
+  mpfr_mul (u, u, x, GFC_RND_MODE);
+  mpfr_div (sum, sum, u, GFC_RND_MODE);
+
+  mpfr_set (res, sum, GFC_RND_MODE);
+  mpfr_set_default_prec (prec);
+
+  mpfr_clears (sum, x, u, v, w, oldsum, sumtrunc, NULL);
+  mpz_clear (num);
+}
+
+
+gfc_expr *
+gfc_simplify_erfc_scaled (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  if (mpfr_cmp_d (x->value.real, ARG_LIMIT) >= 0)
+    asympt_erfc_scaled (result->value.real, x->value.real);
+  else
+    fullprec_erfc_scaled (result->value.real, x->value.real);
+
+  return range_check (result, "ERFC_SCALED");
+}
+
+#undef MAX_ITER
+#undef ARG_LIMIT
+
+
+gfc_expr *
+gfc_simplify_epsilon (gfc_expr *e)
+{
+  gfc_expr *result;
+  int i;
+
+  i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+
+  result = gfc_get_constant_expr (BT_REAL, e->ts.kind, &e->where);
+  mpfr_set (result->value.real, gfc_real_kinds[i].epsilon, GFC_RND_MODE);
+
+  return range_check (result, "EPSILON");
+}
+
+
+gfc_expr *
+gfc_simplify_exp (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+  switch (x->ts.type)
+    {
+      case BT_REAL:
+	mpfr_exp (result->value.real, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	gfc_set_model_kind (x->ts.kind);
+	mpc_exp (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gfc_internal_error ("in gfc_simplify_exp(): Bad type");
+    }
+
+  return range_check (result, "EXP");
+}
+
+
+gfc_expr *
+gfc_simplify_exponent (gfc_expr *x)
+{
+  int i;
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
+				  &x->where);
+
+  gfc_set_model (x->value.real);
+
+  if (mpfr_sgn (x->value.real) == 0)
+    {
+      mpz_set_ui (result->value.integer, 0);
+      return result;
+    }
+
+  i = (int) mpfr_get_exp (x->value.real);
+  mpz_set_si (result->value.integer, i);
+
+  return range_check (result, "EXPONENT");
+}
+
+
+gfc_expr *
+gfc_simplify_float (gfc_expr *a)
+{
+  gfc_expr *result;
+
+  if (a->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (a->is_boz)
+    {
+      if (convert_boz (a, gfc_default_real_kind) == &gfc_bad_expr)
+	return &gfc_bad_expr;
+
+      result = gfc_copy_expr (a);
+    }
+  else
+    result = gfc_int2real (a, gfc_default_real_kind);
+
+  return range_check (result, "FLOAT");
+}
+
+
+static bool
+is_last_ref_vtab (gfc_expr *e)
+{
+  gfc_ref *ref;
+  gfc_component *comp = NULL;
+
+  if (e->expr_type != EXPR_VARIABLE)
+    return false;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT)
+      comp = ref->u.c.component;
+
+  if (!e->ref || !comp)
+    return e->symtree->n.sym->attr.vtab;
+
+  if (comp->name[0] == '_' && strcmp (comp->name, "_vptr") == 0)
+    return true;
+
+  return false;
+}
+
+
+gfc_expr *
+gfc_simplify_extends_type_of (gfc_expr *a, gfc_expr *mold)
+{
+  /* Avoid simplification of resolved symbols.  */
+  if (is_last_ref_vtab (a) || is_last_ref_vtab (mold))
+    return NULL;
+
+  if (a->ts.type == BT_DERIVED && mold->ts.type == BT_DERIVED)
+    return gfc_get_logical_expr (gfc_default_logical_kind, &a->where,
+				 gfc_type_is_extension_of (mold->ts.u.derived,
+							   a->ts.u.derived));
+  /* Return .false. if the dynamic type can never be the same.  */
+  if ((a->ts.type == BT_CLASS && mold->ts.type == BT_CLASS
+       && !gfc_type_is_extension_of
+			(mold->ts.u.derived->components->ts.u.derived,
+			 a->ts.u.derived->components->ts.u.derived)
+       && !gfc_type_is_extension_of
+			(a->ts.u.derived->components->ts.u.derived,
+			 mold->ts.u.derived->components->ts.u.derived))
+      || (a->ts.type == BT_DERIVED && mold->ts.type == BT_CLASS
+	  && !gfc_type_is_extension_of
+			(a->ts.u.derived,
+			 mold->ts.u.derived->components->ts.u.derived)
+	  && !gfc_type_is_extension_of
+			(mold->ts.u.derived->components->ts.u.derived,
+			 a->ts.u.derived))
+      || (a->ts.type == BT_CLASS && mold->ts.type == BT_DERIVED
+	  && !gfc_type_is_extension_of
+			(mold->ts.u.derived,
+			 a->ts.u.derived->components->ts.u.derived)))
+    return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, false);
+
+  if (mold->ts.type == BT_DERIVED
+      && gfc_type_is_extension_of (mold->ts.u.derived,
+				   a->ts.u.derived->components->ts.u.derived))
+    return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, true);
+
+  return NULL;
+}
+
+
+gfc_expr *
+gfc_simplify_same_type_as (gfc_expr *a, gfc_expr *b)
+{
+  /* Avoid simplification of resolved symbols.  */
+  if (is_last_ref_vtab (a) || is_last_ref_vtab (b))
+    return NULL;
+
+  /* Return .false. if the dynamic type can never be the
+     same.  */
+  if ((a->ts.type == BT_CLASS || b->ts.type == BT_CLASS)
+      && !gfc_type_compatible (&a->ts, &b->ts)
+      && !gfc_type_compatible (&b->ts, &a->ts))
+    return gfc_get_logical_expr (gfc_default_logical_kind, &a->where, false);
+
+  if (a->ts.type != BT_DERIVED || b->ts.type != BT_DERIVED)
+     return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &a->where,
+			       gfc_compare_derived_types (a->ts.u.derived,
+							  b->ts.u.derived));
+}
+
+
+gfc_expr *
+gfc_simplify_floor (gfc_expr *e, gfc_expr *k)
+{
+  gfc_expr *result;
+  mpfr_t floor;
+  int kind;
+
+  kind = get_kind (BT_INTEGER, k, "FLOOR", gfc_default_integer_kind);
+  if (kind == -1)
+    gfc_internal_error ("gfc_simplify_floor(): Bad kind");
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  gfc_set_model_kind (kind);
+
+  mpfr_init (floor);
+  mpfr_floor (floor, e->value.real);
+
+  result = gfc_get_constant_expr (BT_INTEGER, kind, &e->where);
+  gfc_mpfr_to_mpz (result->value.integer, floor, &e->where);
+
+  mpfr_clear (floor);
+
+  return range_check (result, "FLOOR");
+}
+
+
+gfc_expr *
+gfc_simplify_fraction (gfc_expr *x)
+{
+  gfc_expr *result;
+  mpfr_t absv, exp, pow2;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_REAL, x->ts.kind, &x->where);
+
+  if (mpfr_sgn (x->value.real) == 0)
+    {
+      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+      return result;
+    }
+
+  gfc_set_model_kind (x->ts.kind);
+  mpfr_init (exp);
+  mpfr_init (absv);
+  mpfr_init (pow2);
+
+  mpfr_abs (absv, x->value.real, GFC_RND_MODE);
+  mpfr_log2 (exp, absv, GFC_RND_MODE);
+
+  mpfr_trunc (exp, exp);
+  mpfr_add_ui (exp, exp, 1, GFC_RND_MODE);
+
+  mpfr_ui_pow (pow2, 2, exp, GFC_RND_MODE);
+
+  mpfr_div (result->value.real, absv, pow2, GFC_RND_MODE);
+
+  mpfr_clears (exp, absv, pow2, NULL);
+
+  return range_check (result, "FRACTION");
+}
+
+
+gfc_expr *
+gfc_simplify_gamma (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_gamma (result->value.real, x->value.real, GFC_RND_MODE);
+
+  return range_check (result, "GAMMA");
+}
+
+
+gfc_expr *
+gfc_simplify_huge (gfc_expr *e)
+{
+  gfc_expr *result;
+  int i;
+
+  i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+  result = gfc_get_constant_expr (e->ts.type, e->ts.kind, &e->where);
+
+  switch (e->ts.type)
+    {
+      case BT_INTEGER:
+	mpz_set (result->value.integer, gfc_integer_kinds[i].huge);
+	break;
+
+      case BT_REAL:
+	mpfr_set (result->value.real, gfc_real_kinds[i].huge, GFC_RND_MODE);
+	break;
+
+      default:
+	gcc_unreachable ();
+    }
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_hypot (gfc_expr *x, gfc_expr *y)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_hypot (result->value.real, x->value.real, y->value.real, GFC_RND_MODE);
+  return range_check (result, "HYPOT");
+}
+
+
+/* We use the processor's collating sequence, because all
+   systems that gfortran currently works on are ASCII.  */
+
+gfc_expr *
+gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
+{
+  gfc_expr *result;
+  gfc_char_t index;
+  int k;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (e->value.character.length != 1)
+    {
+      gfc_error ("Argument of IACHAR at %L must be of length one", &e->where);
+      return &gfc_bad_expr;
+    }
+
+  index = e->value.character.string[0];
+
+  if (gfc_option.warn_surprising && index > 127)
+    gfc_warning ("Argument of IACHAR function at %L outside of range 0..127",
+		 &e->where);
+
+  k = get_kind (BT_INTEGER, kind, "IACHAR", gfc_default_integer_kind);
+  if (k == -1)
+    return &gfc_bad_expr;
+
+  result = gfc_get_int_expr (k, &e->where, index);
+
+  return range_check (result, "IACHAR");
+}
+
+
+static gfc_expr *
+do_bit_and (gfc_expr *result, gfc_expr *e)
+{
+  gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT);
+  gcc_assert (result->ts.type == BT_INTEGER
+	      && result->expr_type == EXPR_CONSTANT);
+
+  mpz_and (result->value.integer, result->value.integer, e->value.integer);
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_iall (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+  return simplify_transformation (array, dim, mask, -1, do_bit_and);
+}
+
+
+static gfc_expr *
+do_bit_ior (gfc_expr *result, gfc_expr *e)
+{
+  gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT);
+  gcc_assert (result->ts.type == BT_INTEGER
+	      && result->expr_type == EXPR_CONSTANT);
+
+  mpz_ior (result->value.integer, result->value.integer, e->value.integer);
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_iany (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+  return simplify_transformation (array, dim, mask, 0, do_bit_ior);
+}
+
+
+gfc_expr *
+gfc_simplify_iand (gfc_expr *x, gfc_expr *y)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_INTEGER, x->ts.kind, &x->where);
+  mpz_and (result->value.integer, x->value.integer, y->value.integer);
+
+  return range_check (result, "IAND");
+}
+
+
+gfc_expr *
+gfc_simplify_ibclr (gfc_expr *x, gfc_expr *y)
+{
+  gfc_expr *result;
+  int k, pos;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (gfc_extract_int (y, &pos) != NULL || pos < 0)
+    {
+      gfc_error ("Invalid second argument of IBCLR at %L", &y->where);
+      return &gfc_bad_expr;
+    }
+
+  k = gfc_validate_kind (x->ts.type, x->ts.kind, false);
+
+  if (pos >= gfc_integer_kinds[k].bit_size)
+    {
+      gfc_error ("Second argument of IBCLR exceeds bit size at %L",
+		 &y->where);
+      return &gfc_bad_expr;
+    }
+
+  result = gfc_copy_expr (x);
+
+  convert_mpz_to_unsigned (result->value.integer,
+			   gfc_integer_kinds[k].bit_size);
+
+  mpz_clrbit (result->value.integer, pos);
+
+  convert_mpz_to_signed (result->value.integer,
+			 gfc_integer_kinds[k].bit_size);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_ibits (gfc_expr *x, gfc_expr *y, gfc_expr *z)
+{
+  gfc_expr *result;
+  int pos, len;
+  int i, k, bitsize;
+  int *bits;
+
+  if (x->expr_type != EXPR_CONSTANT
+      || y->expr_type != EXPR_CONSTANT
+      || z->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (gfc_extract_int (y, &pos) != NULL || pos < 0)
+    {
+      gfc_error ("Invalid second argument of IBITS at %L", &y->where);
+      return &gfc_bad_expr;
+    }
+
+  if (gfc_extract_int (z, &len) != NULL || len < 0)
+    {
+      gfc_error ("Invalid third argument of IBITS at %L", &z->where);
+      return &gfc_bad_expr;
+    }
+
+  k = gfc_validate_kind (BT_INTEGER, x->ts.kind, false);
+
+  bitsize = gfc_integer_kinds[k].bit_size;
+
+  if (pos + len > bitsize)
+    {
+      gfc_error ("Sum of second and third arguments of IBITS exceeds "
+		 "bit size at %L", &y->where);
+      return &gfc_bad_expr;
+    }
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  convert_mpz_to_unsigned (result->value.integer,
+			   gfc_integer_kinds[k].bit_size);
+
+  bits = XCNEWVEC (int, bitsize);
+
+  for (i = 0; i < bitsize; i++)
+    bits[i] = 0;
+
+  for (i = 0; i < len; i++)
+    bits[i] = mpz_tstbit (x->value.integer, i + pos);
+
+  for (i = 0; i < bitsize; i++)
+    {
+      if (bits[i] == 0)
+	mpz_clrbit (result->value.integer, i);
+      else if (bits[i] == 1)
+	mpz_setbit (result->value.integer, i);
+      else
+	gfc_internal_error ("IBITS: Bad bit");
+    }
+
+  gfc_free (bits);
+
+  convert_mpz_to_signed (result->value.integer,
+			 gfc_integer_kinds[k].bit_size);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_ibset (gfc_expr *x, gfc_expr *y)
+{
+  gfc_expr *result;
+  int k, pos;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (gfc_extract_int (y, &pos) != NULL || pos < 0)
+    {
+      gfc_error ("Invalid second argument of IBSET at %L", &y->where);
+      return &gfc_bad_expr;
+    }
+
+  k = gfc_validate_kind (x->ts.type, x->ts.kind, false);
+
+  if (pos >= gfc_integer_kinds[k].bit_size)
+    {
+      gfc_error ("Second argument of IBSET exceeds bit size at %L",
+		 &y->where);
+      return &gfc_bad_expr;
+    }
+
+  result = gfc_copy_expr (x);
+
+  convert_mpz_to_unsigned (result->value.integer,
+			   gfc_integer_kinds[k].bit_size);
+
+  mpz_setbit (result->value.integer, pos);
+
+  convert_mpz_to_signed (result->value.integer,
+			 gfc_integer_kinds[k].bit_size);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_ichar (gfc_expr *e, gfc_expr *kind)
+{
+  gfc_expr *result;
+  gfc_char_t index;
+  int k;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (e->value.character.length != 1)
+    {
+      gfc_error ("Argument of ICHAR at %L must be of length one", &e->where);
+      return &gfc_bad_expr;
+    }
+
+  index = e->value.character.string[0];
+
+  k = get_kind (BT_INTEGER, kind, "ICHAR", gfc_default_integer_kind);
+  if (k == -1)
+    return &gfc_bad_expr;
+
+  result = gfc_get_int_expr (k, &e->where, index);
+
+  return range_check (result, "ICHAR");
+}
+
+
+gfc_expr *
+gfc_simplify_ieor (gfc_expr *x, gfc_expr *y)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_INTEGER, x->ts.kind, &x->where);
+  mpz_xor (result->value.integer, x->value.integer, y->value.integer);
+
+  return range_check (result, "IEOR");
+}
+
+
+gfc_expr *
+gfc_simplify_index (gfc_expr *x, gfc_expr *y, gfc_expr *b, gfc_expr *kind)
+{
+  gfc_expr *result;
+  int back, len, lensub;
+  int i, j, k, count, index = 0, start;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT 
+      || ( b != NULL && b->expr_type !=  EXPR_CONSTANT))
+    return NULL;
+
+  if (b != NULL && b->value.logical != 0)
+    back = 1;
+  else
+    back = 0;
+
+  k = get_kind (BT_INTEGER, kind, "INDEX", gfc_default_integer_kind); 
+  if (k == -1)
+    return &gfc_bad_expr;
+
+  result = gfc_get_constant_expr (BT_INTEGER, k, &x->where);
+
+  len = x->value.character.length;
+  lensub = y->value.character.length;
+
+  if (len < lensub)
+    {
+      mpz_set_si (result->value.integer, 0);
+      return result;
+    }
+
+  if (back == 0)
+    {
+      if (lensub == 0)
+	{
+	  mpz_set_si (result->value.integer, 1);
+	  return result;
+	}
+      else if (lensub == 1)
+	{
+	  for (i = 0; i < len; i++)
+	    {
+	      for (j = 0; j < lensub; j++)
+		{
+		  if (y->value.character.string[j]
+		      == x->value.character.string[i])
+		    {
+		      index = i + 1;
+		      goto done;
+		    }
+		}
+	    }
+	}
+      else
+	{
+	  for (i = 0; i < len; i++)
+	    {
+	      for (j = 0; j < lensub; j++)
+		{
+		  if (y->value.character.string[j]
+		      == x->value.character.string[i])
+		    {
+		      start = i;
+		      count = 0;
+
+		      for (k = 0; k < lensub; k++)
+			{
+			  if (y->value.character.string[k]
+			      == x->value.character.string[k + start])
+			    count++;
+			}
+
+		      if (count == lensub)
+			{
+			  index = start + 1;
+			  goto done;
+			}
+		    }
+		}
+	    }
+	}
+
+    }
+  else
+    {
+      if (lensub == 0)
+	{
+	  mpz_set_si (result->value.integer, len + 1);
+	  return result;
+	}
+      else if (lensub == 1)
+	{
+	  for (i = 0; i < len; i++)
+	    {
+	      for (j = 0; j < lensub; j++)
+		{
+		  if (y->value.character.string[j]
+		      == x->value.character.string[len - i])
+		    {
+		      index = len - i + 1;
+		      goto done;
+		    }
+		}
+	    }
+	}
+      else
+	{
+	  for (i = 0; i < len; i++)
+	    {
+	      for (j = 0; j < lensub; j++)
+		{
+		  if (y->value.character.string[j]
+		      == x->value.character.string[len - i])
+		    {
+		      start = len - i;
+		      if (start <= len - lensub)
+			{
+			  count = 0;
+			  for (k = 0; k < lensub; k++)
+			    if (y->value.character.string[k]
+			        == x->value.character.string[k + start])
+			      count++;
+
+			  if (count == lensub)
+			    {
+			      index = start + 1;
+			      goto done;
+			    }
+			}
+		      else
+			{
+			  continue;
+			}
+		    }
+		}
+	    }
+	}
+    }
+
+done:
+  mpz_set_si (result->value.integer, index);
+  return range_check (result, "INDEX");
+}
+
+
+static gfc_expr *
+simplify_intconv (gfc_expr *e, int kind, const char *name)
+{
+  gfc_expr *result = NULL;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_convert_constant (e, BT_INTEGER, kind);
+  if (result == &gfc_bad_expr)
+    return &gfc_bad_expr;
+
+  return range_check (result, name);
+}
+
+
+gfc_expr *
+gfc_simplify_int (gfc_expr *e, gfc_expr *k)
+{
+  int kind;
+
+  kind = get_kind (BT_INTEGER, k, "INT", gfc_default_integer_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+
+  return simplify_intconv (e, kind, "INT");
+}
+
+gfc_expr *
+gfc_simplify_int2 (gfc_expr *e)
+{
+  return simplify_intconv (e, 2, "INT2");
+}
+
+
+gfc_expr *
+gfc_simplify_int8 (gfc_expr *e)
+{
+  return simplify_intconv (e, 8, "INT8");
+}
+
+
+gfc_expr *
+gfc_simplify_long (gfc_expr *e)
+{
+  return simplify_intconv (e, 4, "LONG");
+}
+
+
+gfc_expr *
+gfc_simplify_ifix (gfc_expr *e)
+{
+  gfc_expr *rtrunc, *result;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  rtrunc = gfc_copy_expr (e);
+  mpfr_trunc (rtrunc->value.real, e->value.real);
+
+  result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
+				  &e->where);
+  gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real, &e->where);
+
+  gfc_free_expr (rtrunc);
+
+  return range_check (result, "IFIX");
+}
+
+
+gfc_expr *
+gfc_simplify_idint (gfc_expr *e)
+{
+  gfc_expr *rtrunc, *result;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  rtrunc = gfc_copy_expr (e);
+  mpfr_trunc (rtrunc->value.real, e->value.real);
+
+  result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
+				  &e->where);
+  gfc_mpfr_to_mpz (result->value.integer, rtrunc->value.real, &e->where);
+
+  gfc_free_expr (rtrunc);
+
+  return range_check (result, "IDINT");
+}
+
+
+gfc_expr *
+gfc_simplify_ior (gfc_expr *x, gfc_expr *y)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_INTEGER, x->ts.kind, &x->where);
+  mpz_ior (result->value.integer, x->value.integer, y->value.integer);
+
+  return range_check (result, "IOR");
+}
+
+
+static gfc_expr *
+do_bit_xor (gfc_expr *result, gfc_expr *e)
+{
+  gcc_assert (e->ts.type == BT_INTEGER && e->expr_type == EXPR_CONSTANT);
+  gcc_assert (result->ts.type == BT_INTEGER
+	      && result->expr_type == EXPR_CONSTANT);
+
+  mpz_xor (result->value.integer, result->value.integer, e->value.integer);
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_iparity (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+  return simplify_transformation (array, dim, mask, 0, do_bit_xor);
+}
+
+
+
+gfc_expr *
+gfc_simplify_is_iostat_end (gfc_expr *x)
+{
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &x->where,
+			       mpz_cmp_si (x->value.integer,
+					   LIBERROR_END) == 0);
+}
+
+
+gfc_expr *
+gfc_simplify_is_iostat_eor (gfc_expr *x)
+{
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &x->where,
+			       mpz_cmp_si (x->value.integer,
+					   LIBERROR_EOR) == 0);
+}
+
+
+gfc_expr *
+gfc_simplify_isnan (gfc_expr *x)
+{
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &x->where,
+			       mpfr_nan_p (x->value.real));
+}
+
+
+/* Performs a shift on its first argument.  Depending on the last
+   argument, the shift can be arithmetic, i.e. with filling from the
+   left like in the SHIFTA intrinsic.  */
+static gfc_expr *
+simplify_shift (gfc_expr *e, gfc_expr *s, const char *name,
+		bool arithmetic, int direction)
+{
+  gfc_expr *result;
+  int ashift, *bits, i, k, bitsize, shift;
+
+  if (e->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
+    return NULL;
+  if (gfc_extract_int (s, &shift) != NULL)
+    {
+      gfc_error ("Invalid second argument of %s at %L", name, &s->where);
+      return &gfc_bad_expr;
+    }
+
+  k = gfc_validate_kind (BT_INTEGER, e->ts.kind, false);
+  bitsize = gfc_integer_kinds[k].bit_size;
+
+  result = gfc_get_constant_expr (e->ts.type, e->ts.kind, &e->where);
+
+  if (shift == 0)
+    {
+      mpz_set (result->value.integer, e->value.integer);
+      return result;
+    }
+
+  if (direction > 0 && shift < 0)
+    {
+      /* Left shift, as in SHIFTL.  */
+      gfc_error ("Second argument of %s is negative at %L", name, &e->where);
+      return &gfc_bad_expr;
+    }
+  else if (direction < 0)
+    {
+      /* Right shift, as in SHIFTR or SHIFTA.  */
+      if (shift < 0)
+	{
+	  gfc_error ("Second argument of %s is negative at %L",
+		     name, &e->where);
+	  return &gfc_bad_expr;
+	}
+
+      shift = -shift;
+    }
+
+  ashift = (shift >= 0 ? shift : -shift);
+
+  if (ashift > bitsize)
+    {
+      gfc_error ("Magnitude of second argument of %s exceeds bit size "
+		 "at %L", name, &e->where);
+      return &gfc_bad_expr;
+    }
+
+  bits = XCNEWVEC (int, bitsize);
+
+  for (i = 0; i < bitsize; i++)
+    bits[i] = mpz_tstbit (e->value.integer, i);
+
+  if (shift > 0)
+    {
+      /* Left shift.  */
+      for (i = 0; i < shift; i++)
+	mpz_clrbit (result->value.integer, i);
+
+      for (i = 0; i < bitsize - shift; i++)
+	{
+	  if (bits[i] == 0)
+	    mpz_clrbit (result->value.integer, i + shift);
+	  else
+	    mpz_setbit (result->value.integer, i + shift);
+	}
+    }
+  else
+    {
+      /* Right shift.  */
+      if (arithmetic && bits[bitsize - 1])
+	for (i = bitsize - 1; i >= bitsize - ashift; i--)
+	  mpz_setbit (result->value.integer, i);
+      else
+	for (i = bitsize - 1; i >= bitsize - ashift; i--)
+	  mpz_clrbit (result->value.integer, i);
+
+      for (i = bitsize - 1; i >= ashift; i--)
+	{
+	  if (bits[i] == 0)
+	    mpz_clrbit (result->value.integer, i - ashift);
+	  else
+	    mpz_setbit (result->value.integer, i - ashift);
+	}
+    }
+
+  convert_mpz_to_signed (result->value.integer, bitsize);
+  gfc_free (bits);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_ishft (gfc_expr *e, gfc_expr *s)
+{
+  return simplify_shift (e, s, "ISHFT", false, 0);
+}
+
+
+gfc_expr *
+gfc_simplify_lshift (gfc_expr *e, gfc_expr *s)
+{
+  return simplify_shift (e, s, "LSHIFT", false, 1);
+}
+
+
+gfc_expr *
+gfc_simplify_rshift (gfc_expr *e, gfc_expr *s)
+{
+  return simplify_shift (e, s, "RSHIFT", true, -1);
+}
+
+
+gfc_expr *
+gfc_simplify_shifta (gfc_expr *e, gfc_expr *s)
+{
+  return simplify_shift (e, s, "SHIFTA", true, -1);
+}
+
+
+gfc_expr *
+gfc_simplify_shiftl (gfc_expr *e, gfc_expr *s)
+{
+  return simplify_shift (e, s, "SHIFTL", false, 1);
+}
+
+
+gfc_expr *
+gfc_simplify_shiftr (gfc_expr *e, gfc_expr *s)
+{
+  return simplify_shift (e, s, "SHIFTR", false, -1);
+}
+
+
+gfc_expr *
+gfc_simplify_ishftc (gfc_expr *e, gfc_expr *s, gfc_expr *sz)
+{
+  gfc_expr *result;
+  int shift, ashift, isize, ssize, delta, k;
+  int i, *bits;
+
+  if (e->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (gfc_extract_int (s, &shift) != NULL)
+    {
+      gfc_error ("Invalid second argument of ISHFTC at %L", &s->where);
+      return &gfc_bad_expr;
+    }
+
+  k = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+  isize = gfc_integer_kinds[k].bit_size;
+
+  if (sz != NULL)
+    {
+      if (sz->expr_type != EXPR_CONSTANT)
+	return NULL;
+
+      if (gfc_extract_int (sz, &ssize) != NULL || ssize <= 0)
+	{
+	  gfc_error ("Invalid third argument of ISHFTC at %L", &sz->where);
+	  return &gfc_bad_expr;
+	}
+
+      if (ssize > isize)
+	{
+	  gfc_error ("Magnitude of third argument of ISHFTC exceeds "
+		     "BIT_SIZE of first argument at %L", &s->where);
+	  return &gfc_bad_expr;
+	}
+    }
+  else
+    ssize = isize;
+
+  if (shift >= 0)
+    ashift = shift;
+  else
+    ashift = -shift;
+
+  if (ashift > ssize)
+    {
+      if (sz != NULL)
+	gfc_error ("Magnitude of second argument of ISHFTC exceeds "
+		   "third argument at %L", &s->where);
+      else
+	gfc_error ("Magnitude of second argument of ISHFTC exceeds "
+		   "BIT_SIZE of first argument at %L", &s->where);
+      return &gfc_bad_expr;
+    }
+
+  result = gfc_get_constant_expr (e->ts.type, e->ts.kind, &e->where);
+
+  mpz_set (result->value.integer, e->value.integer);
+
+  if (shift == 0)
+    return result;
+
+  convert_mpz_to_unsigned (result->value.integer, isize);
+
+  bits = XCNEWVEC (int, ssize);
+
+  for (i = 0; i < ssize; i++)
+    bits[i] = mpz_tstbit (e->value.integer, i);
+
+  delta = ssize - ashift;
+
+  if (shift > 0)
+    {
+      for (i = 0; i < delta; i++)
+	{
+	  if (bits[i] == 0)
+	    mpz_clrbit (result->value.integer, i + shift);
+	  else
+	    mpz_setbit (result->value.integer, i + shift);
+	}
+
+      for (i = delta; i < ssize; i++)
+	{
+	  if (bits[i] == 0)
+	    mpz_clrbit (result->value.integer, i - delta);
+	  else
+	    mpz_setbit (result->value.integer, i - delta);
+	}
+    }
+  else
+    {
+      for (i = 0; i < ashift; i++)
+	{
+	  if (bits[i] == 0)
+	    mpz_clrbit (result->value.integer, i + delta);
+	  else
+	    mpz_setbit (result->value.integer, i + delta);
+	}
+
+      for (i = ashift; i < ssize; i++)
+	{
+	  if (bits[i] == 0)
+	    mpz_clrbit (result->value.integer, i + shift);
+	  else
+	    mpz_setbit (result->value.integer, i + shift);
+	}
+    }
+
+  convert_mpz_to_signed (result->value.integer, isize);
+
+  gfc_free (bits);
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_kind (gfc_expr *e)
+{
+  return gfc_get_int_expr (gfc_default_integer_kind, NULL, e->ts.kind);
+}
+
+
+static gfc_expr *
+simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
+		    gfc_array_spec *as, gfc_ref *ref, bool coarray)
+{
+  gfc_expr *l, *u, *result;
+  int k;
+
+  k = get_kind (BT_INTEGER, kind, upper ? "UBOUND" : "LBOUND",
+		gfc_default_integer_kind); 
+  if (k == -1)
+    return &gfc_bad_expr;
+
+  result = gfc_get_constant_expr (BT_INTEGER, k, &array->where);
+
+  /* For non-variables, LBOUND(expr, DIM=n) = 1 and
+     UBOUND(expr, DIM=n) = SIZE(expr, DIM=n).  */
+  if (!coarray && array->expr_type != EXPR_VARIABLE)
+    {
+      if (upper)
+	{
+	  gfc_expr* dim = result;
+	  mpz_set_si (dim->value.integer, d);
+
+	  result = gfc_simplify_size (array, dim, kind);
+	  gfc_free_expr (dim);
+	  if (!result)
+	    goto returnNull;
+	}
+      else
+	mpz_set_si (result->value.integer, 1);
+
+      goto done;
+    }
+
+  /* Otherwise, we have a variable expression.  */
+  gcc_assert (array->expr_type == EXPR_VARIABLE);
+  gcc_assert (as);
+
+  if (gfc_resolve_array_spec (as, 0) == FAILURE)
+    return NULL;
+
+  /* The last dimension of an assumed-size array is special.  */
+  if ((!coarray && d == as->rank && as->type == AS_ASSUMED_SIZE && !upper)
+      || (coarray && d == as->rank + as->corank))
+    {
+      if (as->lower[d-1]->expr_type == EXPR_CONSTANT)
+	{
+	  gfc_free_expr (result);
+	  return gfc_copy_expr (as->lower[d-1]);
+	}
+
+      goto returnNull;
+    }
+
+  result = gfc_get_constant_expr (BT_INTEGER, k, &array->where);
+
+  /* Then, we need to know the extent of the given dimension.  */
+  if (coarray || ref->u.ar.type == AR_FULL)
+    {
+      l = as->lower[d-1];
+      u = as->upper[d-1];
+
+      if (l->expr_type != EXPR_CONSTANT || u == NULL
+	  || u->expr_type != EXPR_CONSTANT)
+	goto returnNull;
+
+      if (mpz_cmp (l->value.integer, u->value.integer) > 0)
+	{
+	  /* Zero extent.  */
+	  if (upper)
+	    mpz_set_si (result->value.integer, 0);
+	  else
+	    mpz_set_si (result->value.integer, 1);
+	}
+      else
+	{
+	  /* Nonzero extent.  */
+	  if (upper)
+	    mpz_set (result->value.integer, u->value.integer);
+	  else
+	    mpz_set (result->value.integer, l->value.integer);
+	}
+    }
+  else
+    {
+      if (upper)
+	{
+	  if (gfc_ref_dimen_size (&ref->u.ar, d-1, &result->value.integer, NULL)
+	      != SUCCESS)
+	    goto returnNull;
+	}
+      else
+	mpz_set_si (result->value.integer, (long int) 1);
+    }
+
+done:
+  return range_check (result, upper ? "UBOUND" : "LBOUND");
+
+returnNull:
+  gfc_free_expr (result);
+  return NULL;
+}
+
+
+static gfc_expr *
+simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
+{
+  gfc_ref *ref;
+  gfc_array_spec *as;
+  int d;
+
+  if (array->expr_type != EXPR_VARIABLE)
+    {
+      as = NULL;
+      ref = NULL;
+      goto done;
+    }
+
+  /* Follow any component references.  */
+  as = array->symtree->n.sym->as;
+  for (ref = array->ref; ref; ref = ref->next)
+    {
+      switch (ref->type)
+	{
+	case REF_ARRAY:
+	  switch (ref->u.ar.type)
+	    {
+	    case AR_ELEMENT:
+	      as = NULL;
+	      continue;
+
+	    case AR_FULL:
+	      /* We're done because 'as' has already been set in the
+		 previous iteration.  */
+	      if (!ref->next)
+		goto done;
+
+	    /* Fall through.  */
+
+	    case AR_UNKNOWN:
+	      return NULL;
+
+	    case AR_SECTION:
+	      as = ref->u.ar.as;
+	      goto done;
+	    }
+
+	  gcc_unreachable ();
+
+	case REF_COMPONENT:
+	  as = ref->u.c.component->as;
+	  continue;
+
+	case REF_SUBSTRING:
+	  continue;
+	}
+    }
+
+  gcc_unreachable ();
+
+ done:
+
+  if (as && (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE))
+    return NULL;
+
+  if (dim == NULL)
+    {
+      /* Multi-dimensional bounds.  */
+      gfc_expr *bounds[GFC_MAX_DIMENSIONS];
+      gfc_expr *e;
+      int k;
+
+      /* UBOUND(ARRAY) is not valid for an assumed-size array.  */
+      if (upper && as && as->type == AS_ASSUMED_SIZE)
+	{
+	  /* An error message will be emitted in
+	     check_assumed_size_reference (resolve.c).  */
+	  return &gfc_bad_expr;
+	}
+
+      /* Simplify the bounds for each dimension.  */
+      for (d = 0; d < array->rank; d++)
+	{
+	  bounds[d] = simplify_bound_dim (array, kind, d + 1, upper, as, ref,
+					  false);
+	  if (bounds[d] == NULL || bounds[d] == &gfc_bad_expr)
+	    {
+	      int j;
+
+	      for (j = 0; j < d; j++)
+		gfc_free_expr (bounds[j]);
+	      return bounds[d];
+	    }
+	}
+
+      /* Allocate the result expression.  */
+      k = get_kind (BT_INTEGER, kind, upper ? "UBOUND" : "LBOUND",
+		    gfc_default_integer_kind);
+      if (k == -1)
+	return &gfc_bad_expr;
+
+      e = gfc_get_array_expr (BT_INTEGER, k, &array->where);
+
+      /* The result is a rank 1 array; its size is the rank of the first
+	 argument to {L,U}BOUND.  */
+      e->rank = 1;
+      e->shape = gfc_get_shape (1);
+      mpz_init_set_ui (e->shape[0], array->rank);
+
+      /* Create the constructor for this array.  */
+      for (d = 0; d < array->rank; d++)
+	gfc_constructor_append_expr (&e->value.constructor,
+				     bounds[d], &e->where);
+
+      return e;
+    }
+  else
+    {
+      /* A DIM argument is specified.  */
+      if (dim->expr_type != EXPR_CONSTANT)
+	return NULL;
+
+      d = mpz_get_si (dim->value.integer);
+
+      if (d < 1 || d > array->rank
+	  || (d == array->rank && as && as->type == AS_ASSUMED_SIZE && upper))
+	{
+	  gfc_error ("DIM argument at %L is out of bounds", &dim->where);
+	  return &gfc_bad_expr;
+	}
+
+      return simplify_bound_dim (array, kind, d, upper, as, ref, false);
+    }
+}
+
+
+static gfc_expr *
+simplify_cobound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper)
+{
+  gfc_ref *ref;
+  gfc_array_spec *as;
+  int d;
+
+  if (array->expr_type != EXPR_VARIABLE)
+    return NULL;
+
+  /* Follow any component references.  */
+  as = array->symtree->n.sym->as;
+  for (ref = array->ref; ref; ref = ref->next)
+    {
+      switch (ref->type)
+	{
+	case REF_ARRAY:
+	  switch (ref->u.ar.type)
+	    {
+	    case AR_ELEMENT:
+	      if (ref->next == NULL)
+		{
+		  gcc_assert (ref->u.ar.as->corank > 0
+			      && ref->u.ar.as->rank == 0);
+		  as = ref->u.ar.as;
+		  goto done;
+		}
+	      as = NULL;
+	      continue;
+
+	    case AR_FULL:
+	      /* We're done because 'as' has already been set in the
+		 previous iteration.  */
+	      if (!ref->next)
+	        goto done;
+
+	    /* Fall through.  */
+
+	    case AR_UNKNOWN:
+	      return NULL;
+
+	    case AR_SECTION:
+	      as = ref->u.ar.as;
+	      goto done;
+	    }
+
+	  gcc_unreachable ();
+
+	case REF_COMPONENT:
+	  as = ref->u.c.component->as;
+	  continue;
+
+	case REF_SUBSTRING:
+	  continue;
+	}
+    }
+
+  gcc_unreachable ();
+
+ done:
+
+  if (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE)
+    return NULL;
+
+  if (dim == NULL)
+    {
+      /* Multi-dimensional cobounds.  */
+      gfc_expr *bounds[GFC_MAX_DIMENSIONS];
+      gfc_expr *e;
+      int k;
+
+      /* Simplify the cobounds for each dimension.  */
+      for (d = 0; d < as->corank; d++)
+	{
+	  bounds[d] = simplify_bound_dim (array, kind, d + 1 + array->rank,
+					  upper, as, ref, true);
+	  if (bounds[d] == NULL || bounds[d] == &gfc_bad_expr)
+	    {
+	      int j;
+
+	      for (j = 0; j < d; j++)
+		gfc_free_expr (bounds[j]);
+	      return bounds[d];
+	    }
+	}
+
+      /* Allocate the result expression.  */
+      e = gfc_get_expr ();
+      e->where = array->where;
+      e->expr_type = EXPR_ARRAY;
+      e->ts.type = BT_INTEGER;
+      k = get_kind (BT_INTEGER, kind, upper ? "UCOBOUND" : "LCOBOUND",
+		    gfc_default_integer_kind); 
+      if (k == -1)
+	{
+	  gfc_free_expr (e);
+	  return &gfc_bad_expr;
+	}
+      e->ts.kind = k;
+
+      /* The result is a rank 1 array; its size is the rank of the first
+	 argument to {L,U}COBOUND.  */
+      e->rank = 1;
+      e->shape = gfc_get_shape (1);
+      mpz_init_set_ui (e->shape[0], as->corank);
+
+      /* Create the constructor for this array.  */
+      for (d = 0; d < as->corank; d++)
+	gfc_constructor_append_expr (&e->value.constructor,
+				     bounds[d], &e->where);
+      return e;
+    }
+  else
+    {
+      /* A DIM argument is specified.  */
+      if (dim->expr_type != EXPR_CONSTANT)
+	return NULL;
+
+      d = mpz_get_si (dim->value.integer);
+
+      if (d < 1 || d > as->corank)
+	{
+	  gfc_error ("DIM argument at %L is out of bounds", &dim->where);
+	  return &gfc_bad_expr;
+	}
+
+      return simplify_bound_dim (array, kind, d+array->rank, upper, as, ref, true);
+    }
+}
+
+
+gfc_expr *
+gfc_simplify_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+  return simplify_bound (array, dim, kind, 0);
+}
+
+
+gfc_expr *
+gfc_simplify_lcobound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+  gfc_expr *e;
+  /* return simplify_cobound (array, dim, kind, 0);*/
+
+  e = simplify_cobound (array, dim, kind, 0);
+  if (e != NULL)
+    return e;
+
+  gfc_error ("Not yet implemented: LCOBOUND for coarray with non-constant "
+	     "cobounds at %L", &array->where);
+  return &gfc_bad_expr;
+}
+
+gfc_expr *
+gfc_simplify_leadz (gfc_expr *e)
+{
+  unsigned long lz, bs;
+  int i;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+  bs = gfc_integer_kinds[i].bit_size;
+  if (mpz_cmp_si (e->value.integer, 0) == 0)
+    lz = bs;
+  else if (mpz_cmp_si (e->value.integer, 0) < 0)
+    lz = 0;
+  else
+    lz = bs - mpz_sizeinbase (e->value.integer, 2);
+
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where, lz);
+}
+
+
+gfc_expr *
+gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
+{
+  gfc_expr *result;
+  int k = get_kind (BT_INTEGER, kind, "LEN", gfc_default_integer_kind);
+
+  if (k == -1)
+    return &gfc_bad_expr;
+
+  if (e->expr_type == EXPR_CONSTANT)
+    {
+      result = gfc_get_constant_expr (BT_INTEGER, k, &e->where);
+      mpz_set_si (result->value.integer, e->value.character.length);
+      return range_check (result, "LEN");
+    }
+  else if (e->ts.u.cl != NULL && e->ts.u.cl->length != NULL
+	   && e->ts.u.cl->length->expr_type == EXPR_CONSTANT
+	   && e->ts.u.cl->length->ts.type == BT_INTEGER)
+    {
+      result = gfc_get_constant_expr (BT_INTEGER, k, &e->where);
+      mpz_set (result->value.integer, e->ts.u.cl->length->value.integer);
+      return range_check (result, "LEN");
+    }
+  else
+    return NULL;
+}
+
+
+gfc_expr *
+gfc_simplify_len_trim (gfc_expr *e, gfc_expr *kind)
+{
+  gfc_expr *result;
+  int count, len, i;
+  int k = get_kind (BT_INTEGER, kind, "LEN_TRIM", gfc_default_integer_kind);
+
+  if (k == -1)
+    return &gfc_bad_expr;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  len = e->value.character.length;
+  for (count = 0, i = 1; i <= len; i++)
+    if (e->value.character.string[len - i] == ' ')
+      count++;
+    else
+      break;
+
+  result = gfc_get_int_expr (k, &e->where, len - count);
+  return range_check (result, "LEN_TRIM");
+}
+
+gfc_expr *
+gfc_simplify_lgamma (gfc_expr *x)
+{
+  gfc_expr *result;
+  int sg;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_lgamma (result->value.real, &sg, x->value.real, GFC_RND_MODE);
+
+  return range_check (result, "LGAMMA");
+}
+
+
+gfc_expr *
+gfc_simplify_lge (gfc_expr *a, gfc_expr *b)
+{
+  if (a->expr_type != EXPR_CONSTANT || b->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &a->where,
+			       gfc_compare_string (a, b) >= 0);
+}
+
+
+gfc_expr *
+gfc_simplify_lgt (gfc_expr *a, gfc_expr *b)
+{
+  if (a->expr_type != EXPR_CONSTANT || b->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &a->where,
+			       gfc_compare_string (a, b) > 0);
+}
+
+
+gfc_expr *
+gfc_simplify_lle (gfc_expr *a, gfc_expr *b)
+{
+  if (a->expr_type != EXPR_CONSTANT || b->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &a->where,
+			       gfc_compare_string (a, b) <= 0);
+}
+
+
+gfc_expr *
+gfc_simplify_llt (gfc_expr *a, gfc_expr *b)
+{
+  if (a->expr_type != EXPR_CONSTANT || b->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (gfc_default_logical_kind, &a->where,
+			       gfc_compare_string (a, b) < 0);
+}
+
+
+gfc_expr *
+gfc_simplify_log (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+  switch (x->ts.type)
+    {
+    case BT_REAL:
+      if (mpfr_sgn (x->value.real) <= 0)
+	{
+	  gfc_error ("Argument of LOG at %L cannot be less than or equal "
+		     "to zero", &x->where);
+	  gfc_free_expr (result);
+	  return &gfc_bad_expr;
+	}
+
+      mpfr_log (result->value.real, x->value.real, GFC_RND_MODE);
+      break;
+
+    case BT_COMPLEX:
+      if ((mpfr_sgn (mpc_realref (x->value.complex)) == 0)
+	  && (mpfr_sgn (mpc_imagref (x->value.complex)) == 0))
+	{
+	  gfc_error ("Complex argument of LOG at %L cannot be zero",
+		     &x->where);
+	  gfc_free_expr (result);
+	  return &gfc_bad_expr;
+	}
+
+      gfc_set_model_kind (x->ts.kind);
+      mpc_log (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+      break;
+
+    default:
+      gfc_internal_error ("gfc_simplify_log: bad type");
+    }
+
+  return range_check (result, "LOG");
+}
+
+
+gfc_expr *
+gfc_simplify_log10 (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (mpfr_sgn (x->value.real) <= 0)
+    {
+      gfc_error ("Argument of LOG10 at %L cannot be less than or equal "
+		 "to zero", &x->where);
+      return &gfc_bad_expr;
+    }
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+  mpfr_log10 (result->value.real, x->value.real, GFC_RND_MODE);
+
+  return range_check (result, "LOG10");
+}
+
+
+gfc_expr *
+gfc_simplify_logical (gfc_expr *e, gfc_expr *k)
+{
+  int kind;
+
+  kind = get_kind (BT_LOGICAL, k, "LOGICAL", gfc_default_logical_kind);
+  if (kind < 0)
+    return &gfc_bad_expr;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_get_logical_expr (kind, &e->where, e->value.logical);
+}
+
+
+gfc_expr*
+gfc_simplify_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
+{
+  gfc_expr *result;
+  int row, result_rows, col, result_columns;
+  int stride_a, offset_a, stride_b, offset_b;
+
+  if (!is_constant_array_expr (matrix_a)
+      || !is_constant_array_expr (matrix_b))
+    return NULL;
+
+  gcc_assert (gfc_compare_types (&matrix_a->ts, &matrix_b->ts));
+  result = gfc_get_array_expr (matrix_a->ts.type,
+			       matrix_a->ts.kind,
+			       &matrix_a->where);
+
+  if (matrix_a->rank == 1 && matrix_b->rank == 2)
+    {
+      result_rows = 1;
+      result_columns = mpz_get_si (matrix_b->shape[1]);
+      stride_a = 1;
+      stride_b = mpz_get_si (matrix_b->shape[0]);
+
+      result->rank = 1;
+      result->shape = gfc_get_shape (result->rank);
+      mpz_init_set_si (result->shape[0], result_columns);
+    }
+  else if (matrix_a->rank == 2 && matrix_b->rank == 1)
+    {
+      result_rows = mpz_get_si (matrix_a->shape[0]);
+      result_columns = 1;
+      stride_a = mpz_get_si (matrix_a->shape[0]);
+      stride_b = 1;
+
+      result->rank = 1;
+      result->shape = gfc_get_shape (result->rank);
+      mpz_init_set_si (result->shape[0], result_rows);
+    }
+  else if (matrix_a->rank == 2 && matrix_b->rank == 2)
+    {
+      result_rows = mpz_get_si (matrix_a->shape[0]);
+      result_columns = mpz_get_si (matrix_b->shape[1]);
+      stride_a = mpz_get_si (matrix_a->shape[0]);
+      stride_b = mpz_get_si (matrix_b->shape[0]);
+
+      result->rank = 2;
+      result->shape = gfc_get_shape (result->rank);
+      mpz_init_set_si (result->shape[0], result_rows);
+      mpz_init_set_si (result->shape[1], result_columns);
+    }
+  else
+    gcc_unreachable();
+
+  offset_a = offset_b = 0;
+  for (col = 0; col < result_columns; ++col)
+    {
+      offset_a = 0;
+
+      for (row = 0; row < result_rows; ++row)
+	{
+	  gfc_expr *e = compute_dot_product (matrix_a, stride_a, offset_a,
+					     matrix_b, 1, offset_b);
+	  gfc_constructor_append_expr (&result->value.constructor,
+				       e, NULL);
+
+	  offset_a += 1;
+        }
+
+      offset_b += stride_b;
+    }
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_maskr (gfc_expr *i, gfc_expr *kind_arg)
+{
+  gfc_expr *result;
+  int kind, arg, k;
+  const char *s;
+
+  if (i->expr_type != EXPR_CONSTANT)
+    return NULL;
+ 
+  kind = get_kind (BT_INTEGER, kind_arg, "MASKR", gfc_default_integer_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+  k = gfc_validate_kind (BT_INTEGER, kind, false);
+
+  s = gfc_extract_int (i, &arg);
+  gcc_assert (!s);
+
+  result = gfc_get_constant_expr (BT_INTEGER, kind, &i->where);
+
+  /* MASKR(n) = 2^n - 1 */
+  mpz_set_ui (result->value.integer, 1);
+  mpz_mul_2exp (result->value.integer, result->value.integer, arg);
+  mpz_sub_ui (result->value.integer, result->value.integer, 1);
+
+  convert_mpz_to_signed (result->value.integer, gfc_integer_kinds[k].bit_size);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_maskl (gfc_expr *i, gfc_expr *kind_arg)
+{
+  gfc_expr *result;
+  int kind, arg, k;
+  const char *s;
+  mpz_t z;
+
+  if (i->expr_type != EXPR_CONSTANT)
+    return NULL;
+ 
+  kind = get_kind (BT_INTEGER, kind_arg, "MASKL", gfc_default_integer_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+  k = gfc_validate_kind (BT_INTEGER, kind, false);
+
+  s = gfc_extract_int (i, &arg);
+  gcc_assert (!s);
+
+  result = gfc_get_constant_expr (BT_INTEGER, kind, &i->where);
+
+  /* MASKL(n) = 2^bit_size - 2^(bit_size - n) */
+  mpz_init_set_ui (z, 1);
+  mpz_mul_2exp (z, z, gfc_integer_kinds[k].bit_size);
+  mpz_set_ui (result->value.integer, 1);
+  mpz_mul_2exp (result->value.integer, result->value.integer,
+		gfc_integer_kinds[k].bit_size - arg);
+  mpz_sub (result->value.integer, z, result->value.integer);
+  mpz_clear (z);
+
+  convert_mpz_to_signed (result->value.integer, gfc_integer_kinds[k].bit_size);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
+{
+  if (tsource->expr_type != EXPR_CONSTANT
+      || fsource->expr_type != EXPR_CONSTANT
+      || mask->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  return gfc_copy_expr (mask->value.logical ? tsource : fsource);
+}
+
+
+gfc_expr *
+gfc_simplify_merge_bits (gfc_expr *i, gfc_expr *j, gfc_expr *mask_expr)
+{
+  mpz_t arg1, arg2, mask;
+  gfc_expr *result;
+
+  if (i->expr_type != EXPR_CONSTANT || j->expr_type != EXPR_CONSTANT
+      || mask_expr->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_INTEGER, i->ts.kind, &i->where);
+
+  /* Convert all argument to unsigned.  */
+  mpz_init_set (arg1, i->value.integer);
+  mpz_init_set (arg2, j->value.integer);
+  mpz_init_set (mask, mask_expr->value.integer);
+
+  /* MERGE_BITS(I,J,MASK) = IOR (IAND (I, MASK), IAND (J, NOT (MASK))).  */
+  mpz_and (arg1, arg1, mask);
+  mpz_com (mask, mask);
+  mpz_and (arg2, arg2, mask);
+  mpz_ior (result->value.integer, arg1, arg2);
+
+  mpz_clear (arg1);
+  mpz_clear (arg2);
+  mpz_clear (mask);
+
+  return result;
+}
+
+
+/* Selects between current value and extremum for simplify_min_max
+   and simplify_minval_maxval.  */
+static void
+min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign)
+{
+  switch (arg->ts.type)
+    {
+      case BT_INTEGER:
+	if (mpz_cmp (arg->value.integer,
+			extremum->value.integer) * sign > 0)
+	mpz_set (extremum->value.integer, arg->value.integer);
+	break;
+
+      case BT_REAL:
+	/* We need to use mpfr_min and mpfr_max to treat NaN properly.  */
+	if (sign > 0)
+	  mpfr_max (extremum->value.real, extremum->value.real,
+		      arg->value.real, GFC_RND_MODE);
+	else
+	  mpfr_min (extremum->value.real, extremum->value.real,
+		      arg->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_CHARACTER:
+#define LENGTH(x) ((x)->value.character.length)
+#define STRING(x) ((x)->value.character.string)
+	if (LENGTH(extremum) < LENGTH(arg))
+	  {
+	    gfc_char_t *tmp = STRING(extremum);
+
+	    STRING(extremum) = gfc_get_wide_string (LENGTH(arg) + 1);
+	    memcpy (STRING(extremum), tmp,
+		      LENGTH(extremum) * sizeof (gfc_char_t));
+	    gfc_wide_memset (&STRING(extremum)[LENGTH(extremum)], ' ',
+			       LENGTH(arg) - LENGTH(extremum));
+	    STRING(extremum)[LENGTH(arg)] = '\0';  /* For debugger  */
+	    LENGTH(extremum) = LENGTH(arg);
+	    gfc_free (tmp);
+	  }
+
+	if (gfc_compare_string (arg, extremum) * sign > 0)
+	  {
+	    gfc_free (STRING(extremum));
+	    STRING(extremum) = gfc_get_wide_string (LENGTH(extremum) + 1);
+	    memcpy (STRING(extremum), STRING(arg),
+		      LENGTH(arg) * sizeof (gfc_char_t));
+	    gfc_wide_memset (&STRING(extremum)[LENGTH(arg)], ' ',
+			       LENGTH(extremum) - LENGTH(arg));
+	    STRING(extremum)[LENGTH(extremum)] = '\0';  /* For debugger  */
+	  }
+#undef LENGTH
+#undef STRING
+	break;
+	      
+      default:
+	gfc_internal_error ("simplify_min_max(): Bad type in arglist");
+    }
+}
+
+
+/* This function is special since MAX() can take any number of
+   arguments.  The simplified expression is a rewritten version of the
+   argument list containing at most one constant element.  Other
+   constant elements are deleted.  Because the argument list has
+   already been checked, this function always succeeds.  sign is 1 for
+   MAX(), -1 for MIN().  */
+
+static gfc_expr *
+simplify_min_max (gfc_expr *expr, int sign)
+{
+  gfc_actual_arglist *arg, *last, *extremum;
+  gfc_intrinsic_sym * specific;
+
+  last = NULL;
+  extremum = NULL;
+  specific = expr->value.function.isym;
+
+  arg = expr->value.function.actual;
+
+  for (; arg; last = arg, arg = arg->next)
+    {
+      if (arg->expr->expr_type != EXPR_CONSTANT)
+	continue;
+
+      if (extremum == NULL)
+	{
+	  extremum = arg;
+	  continue;
+	}
+
+      min_max_choose (arg->expr, extremum->expr, sign);
+
+      /* Delete the extra constant argument.  */
+      if (last == NULL)
+	expr->value.function.actual = arg->next;
+      else
+	last->next = arg->next;
+
+      arg->next = NULL;
+      gfc_free_actual_arglist (arg);
+      arg = last;
+    }
+
+  /* If there is one value left, replace the function call with the
+     expression.  */
+  if (expr->value.function.actual->next != NULL)
+    return NULL;
+
+  /* Convert to the correct type and kind.  */
+  if (expr->ts.type != BT_UNKNOWN) 
+    return gfc_convert_constant (expr->value.function.actual->expr,
+	expr->ts.type, expr->ts.kind);
+
+  if (specific->ts.type != BT_UNKNOWN) 
+    return gfc_convert_constant (expr->value.function.actual->expr,
+	specific->ts.type, specific->ts.kind); 
+ 
+  return gfc_copy_expr (expr->value.function.actual->expr);
+}
+
+
+gfc_expr *
+gfc_simplify_min (gfc_expr *e)
+{
+  return simplify_min_max (e, -1);
+}
+
+
+gfc_expr *
+gfc_simplify_max (gfc_expr *e)
+{
+  return simplify_min_max (e, 1);
+}
+
+
+/* This is a simplified version of simplify_min_max to provide
+   simplification of minval and maxval for a vector.  */
+
+static gfc_expr *
+simplify_minval_maxval (gfc_expr *expr, int sign)
+{
+  gfc_constructor *c, *extremum;
+  gfc_intrinsic_sym * specific;
+
+  extremum = NULL;
+  specific = expr->value.function.isym;
+
+  for (c = gfc_constructor_first (expr->value.constructor);
+       c; c = gfc_constructor_next (c))
+    {
+      if (c->expr->expr_type != EXPR_CONSTANT)
+	return NULL;
+
+      if (extremum == NULL)
+	{
+	  extremum = c;
+	  continue;
+	}
+
+      min_max_choose (c->expr, extremum->expr, sign);
+     }
+
+  if (extremum == NULL)
+    return NULL;
+
+  /* Convert to the correct type and kind.  */
+  if (expr->ts.type != BT_UNKNOWN) 
+    return gfc_convert_constant (extremum->expr,
+	expr->ts.type, expr->ts.kind);
+
+  if (specific->ts.type != BT_UNKNOWN) 
+    return gfc_convert_constant (extremum->expr,
+	specific->ts.type, specific->ts.kind); 
+ 
+  return gfc_copy_expr (extremum->expr);
+}
+
+
+gfc_expr *
+gfc_simplify_minval (gfc_expr *array, gfc_expr* dim, gfc_expr *mask)
+{
+  if (array->expr_type != EXPR_ARRAY || array->rank != 1 || dim || mask)
+    return NULL;
+
+  return simplify_minval_maxval (array, -1);
+}
+
+
+gfc_expr *
+gfc_simplify_maxval (gfc_expr *array, gfc_expr* dim, gfc_expr *mask)
+{
+  if (array->expr_type != EXPR_ARRAY || array->rank != 1 || dim || mask)
+    return NULL;
+
+  return simplify_minval_maxval (array, 1);
+}
+
+
+gfc_expr *
+gfc_simplify_maxexponent (gfc_expr *x)
+{
+  int i = gfc_validate_kind (BT_REAL, x->ts.kind, false);
+  return gfc_get_int_expr (gfc_default_integer_kind, &x->where,
+			   gfc_real_kinds[i].max_exponent);
+}
+
+
+gfc_expr *
+gfc_simplify_minexponent (gfc_expr *x)
+{
+  int i = gfc_validate_kind (BT_REAL, x->ts.kind, false);
+  return gfc_get_int_expr (gfc_default_integer_kind, &x->where,
+			   gfc_real_kinds[i].min_exponent);
+}
+
+
+gfc_expr *
+gfc_simplify_mod (gfc_expr *a, gfc_expr *p)
+{
+  gfc_expr *result;
+  mpfr_t tmp;
+  int kind;
+
+  if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind;
+  result = gfc_get_constant_expr (a->ts.type, kind, &a->where);
+
+  switch (a->ts.type)
+    {
+      case BT_INTEGER:
+	if (mpz_cmp_ui (p->value.integer, 0) == 0)
+	  {
+	    /* Result is processor-dependent.  */
+	    gfc_error ("Second argument MOD at %L is zero", &a->where);
+	    gfc_free_expr (result);
+	    return &gfc_bad_expr;
+	  }
+	mpz_tdiv_r (result->value.integer, a->value.integer, p->value.integer);
+	break;
+
+      case BT_REAL:
+	if (mpfr_cmp_ui (p->value.real, 0) == 0)
+	  {
+	    /* Result is processor-dependent.  */
+	    gfc_error ("Second argument of MOD at %L is zero", &p->where);
+	    gfc_free_expr (result);
+	    return &gfc_bad_expr;
+	  }
+
+	gfc_set_model_kind (kind);
+	mpfr_init (tmp);
+	mpfr_div (tmp, a->value.real, p->value.real, GFC_RND_MODE);
+	mpfr_trunc (tmp, tmp);
+	mpfr_mul (tmp, tmp, p->value.real, GFC_RND_MODE);
+	mpfr_sub (result->value.real, a->value.real, tmp, GFC_RND_MODE);
+	mpfr_clear (tmp);
+	break;
+
+      default:
+	gfc_internal_error ("gfc_simplify_mod(): Bad arguments");
+    }
+
+  return range_check (result, "MOD");
+}
+
+
+gfc_expr *
+gfc_simplify_modulo (gfc_expr *a, gfc_expr *p)
+{
+  gfc_expr *result;
+  mpfr_t tmp;
+  int kind;
+
+  if (a->expr_type != EXPR_CONSTANT || p->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  kind = a->ts.kind > p->ts.kind ? a->ts.kind : p->ts.kind;
+  result = gfc_get_constant_expr (a->ts.type, kind, &a->where);
+
+  switch (a->ts.type)
+    {
+      case BT_INTEGER:
+	if (mpz_cmp_ui (p->value.integer, 0) == 0)
+	  {
+	    /* Result is processor-dependent. This processor just opts
+	      to not handle it at all.  */
+	    gfc_error ("Second argument of MODULO at %L is zero", &a->where);
+	    gfc_free_expr (result);
+	    return &gfc_bad_expr;
+	  }
+	mpz_fdiv_r (result->value.integer, a->value.integer, p->value.integer);
+
+	break;
+
+      case BT_REAL:
+	if (mpfr_cmp_ui (p->value.real, 0) == 0)
+	  {
+	    /* Result is processor-dependent.  */
+	    gfc_error ("Second argument of MODULO at %L is zero", &p->where);
+	    gfc_free_expr (result);
+	    return &gfc_bad_expr;
+	  }
+
+	gfc_set_model_kind (kind);
+	mpfr_init (tmp);
+	mpfr_div (tmp, a->value.real, p->value.real, GFC_RND_MODE);
+	mpfr_floor (tmp, tmp);
+	mpfr_mul (tmp, tmp, p->value.real, GFC_RND_MODE);
+	mpfr_sub (result->value.real, a->value.real, tmp, GFC_RND_MODE);
+	mpfr_clear (tmp);
+	break;
+
+      default:
+	gfc_internal_error ("gfc_simplify_modulo(): Bad arguments");
+    }
+
+  return range_check (result, "MODULO");
+}
+
+
+/* Exists for the sole purpose of consistency with other intrinsics.  */
+gfc_expr *
+gfc_simplify_mvbits (gfc_expr *f  ATTRIBUTE_UNUSED,
+		     gfc_expr *fp ATTRIBUTE_UNUSED,
+		     gfc_expr *l  ATTRIBUTE_UNUSED,
+		     gfc_expr *to ATTRIBUTE_UNUSED,
+		     gfc_expr *tp ATTRIBUTE_UNUSED)
+{
+  return NULL;
+}
+
+
+gfc_expr *
+gfc_simplify_nearest (gfc_expr *x, gfc_expr *s)
+{
+  gfc_expr *result;
+  mp_exp_t emin, emax;
+  int kind;
+
+  if (x->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (mpfr_sgn (s->value.real) == 0)
+    {
+      gfc_error ("Second argument of NEAREST at %L shall not be zero",
+		 &s->where);
+      return &gfc_bad_expr;
+    }
+
+  result = gfc_copy_expr (x);
+
+  /* Save current values of emin and emax.  */
+  emin = mpfr_get_emin ();
+  emax = mpfr_get_emax ();
+
+  /* Set emin and emax for the current model number.  */
+  kind = gfc_validate_kind (BT_REAL, x->ts.kind, 0);
+  mpfr_set_emin ((mp_exp_t) gfc_real_kinds[kind].min_exponent -
+		mpfr_get_prec(result->value.real) + 1);
+  mpfr_set_emax ((mp_exp_t) gfc_real_kinds[kind].max_exponent - 1);
+  mpfr_check_range (result->value.real, 0, GMP_RNDU);
+
+  if (mpfr_sgn (s->value.real) > 0)
+    {
+      mpfr_nextabove (result->value.real);
+      mpfr_subnormalize (result->value.real, 0, GMP_RNDU);
+    }
+  else
+    {
+      mpfr_nextbelow (result->value.real);
+      mpfr_subnormalize (result->value.real, 0, GMP_RNDD);
+    }
+
+  mpfr_set_emin (emin);
+  mpfr_set_emax (emax);
+
+  /* Only NaN can occur. Do not use range check as it gives an
+     error for denormal numbers.  */
+  if (mpfr_nan_p (result->value.real) && gfc_option.flag_range_check)
+    {
+      gfc_error ("Result of NEAREST is NaN at %L", &result->where);
+      gfc_free_expr (result);
+      return &gfc_bad_expr;
+    }
+
+  return result;
+}
+
+
+static gfc_expr *
+simplify_nint (const char *name, gfc_expr *e, gfc_expr *k)
+{
+  gfc_expr *itrunc, *result;
+  int kind;
+
+  kind = get_kind (BT_INTEGER, k, name, gfc_default_integer_kind);
+  if (kind == -1)
+    return &gfc_bad_expr;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  itrunc = gfc_copy_expr (e);
+  mpfr_round (itrunc->value.real, e->value.real);
+
+  result = gfc_get_constant_expr (BT_INTEGER, kind, &e->where);
+  gfc_mpfr_to_mpz (result->value.integer, itrunc->value.real, &e->where);
+
+  gfc_free_expr (itrunc);
+
+  return range_check (result, name);
+}
+
+
+gfc_expr *
+gfc_simplify_new_line (gfc_expr *e)
+{
+  gfc_expr *result;
+
+  result = gfc_get_character_expr (e->ts.kind, &e->where, NULL, 1);
+  result->value.character.string[0] = '\n';
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_nint (gfc_expr *e, gfc_expr *k)
+{
+  return simplify_nint ("NINT", e, k);
+}
+
+
+gfc_expr *
+gfc_simplify_idnint (gfc_expr *e)
+{
+  return simplify_nint ("IDNINT", e, NULL);
+}
+
+
+static gfc_expr *
+add_squared (gfc_expr *result, gfc_expr *e)
+{
+  mpfr_t tmp;
+
+  gcc_assert (e->ts.type == BT_REAL && e->expr_type == EXPR_CONSTANT);
+  gcc_assert (result->ts.type == BT_REAL
+	      && result->expr_type == EXPR_CONSTANT);
+
+  gfc_set_model_kind (result->ts.kind);
+  mpfr_init (tmp);
+  mpfr_pow_ui (tmp, e->value.real, 2, GFC_RND_MODE);
+  mpfr_add (result->value.real, result->value.real, tmp,
+	    GFC_RND_MODE);
+  mpfr_clear (tmp);
+
+  return result;
+}
+
+
+static gfc_expr *
+do_sqrt (gfc_expr *result, gfc_expr *e)
+{
+  gcc_assert (e->ts.type == BT_REAL && e->expr_type == EXPR_CONSTANT);
+  gcc_assert (result->ts.type == BT_REAL
+	      && result->expr_type == EXPR_CONSTANT);
+
+  mpfr_set (result->value.real, e->value.real, GFC_RND_MODE);
+  mpfr_sqrt (result->value.real, result->value.real, GFC_RND_MODE);
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_norm2 (gfc_expr *e, gfc_expr *dim)
+{
+  gfc_expr *result;
+
+  if (!is_constant_array_expr (e)
+      || (dim != NULL && !gfc_is_constant_expr (dim)))
+    return NULL;
+
+  result = transformational_result (e, dim, e->ts.type, e->ts.kind, &e->where);
+  init_result_expr (result, 0, NULL);
+
+  if (!dim || e->rank == 1)
+    {
+      result = simplify_transformation_to_scalar (result, e, NULL,
+						  add_squared);
+      mpfr_sqrt (result->value.real, result->value.real, GFC_RND_MODE);
+    }
+  else
+    result = simplify_transformation_to_array (result, e, dim, NULL,
+					       add_squared, &do_sqrt);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_not (gfc_expr *e)
+{
+  gfc_expr *result;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (e->ts.type, e->ts.kind, &e->where);
+  mpz_com (result->value.integer, e->value.integer);
+
+  return range_check (result, "NOT");
+}
+
+
+gfc_expr *
+gfc_simplify_null (gfc_expr *mold)
+{
+  gfc_expr *result;
+
+  if (mold)
+    {
+      result = gfc_copy_expr (mold);
+      result->expr_type = EXPR_NULL;
+    }
+  else
+    result = gfc_get_null_expr (NULL);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_num_images (void)
+{
+  gfc_expr *result;
+
+  if (gfc_option.coarray == GFC_FCOARRAY_NONE)
+    {
+      gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
+      return &gfc_bad_expr;
+    }
+
+  /* FIXME: gfc_current_locus is wrong.  */
+  result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
+				  &gfc_current_locus);
+  mpz_set_si (result->value.integer, 1);
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_or (gfc_expr *x, gfc_expr *y)
+{
+  gfc_expr *result;
+  int kind;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind;
+
+  switch (x->ts.type)
+    {
+      case BT_INTEGER:
+	result = gfc_get_constant_expr (BT_INTEGER, kind, &x->where);
+	mpz_ior (result->value.integer, x->value.integer, y->value.integer);
+	return range_check (result, "OR");
+
+      case BT_LOGICAL:
+	return gfc_get_logical_expr (kind, &x->where,
+				     x->value.logical || y->value.logical);
+      default:
+	gcc_unreachable();
+    }
+}
+
+
+gfc_expr *
+gfc_simplify_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector)
+{
+  gfc_expr *result;
+  gfc_constructor *array_ctor, *mask_ctor, *vector_ctor;
+
+  if (!is_constant_array_expr(array)
+      || !is_constant_array_expr(vector)
+      || (!gfc_is_constant_expr (mask)
+          && !is_constant_array_expr(mask)))
+    return NULL;
+
+  result = gfc_get_array_expr (array->ts.type, array->ts.kind, &array->where);
+  if (array->ts.type == BT_DERIVED)
+    result->ts.u.derived = array->ts.u.derived;
+
+  array_ctor = gfc_constructor_first (array->value.constructor);
+  vector_ctor = vector
+		  ? gfc_constructor_first (vector->value.constructor)
+		  : NULL;
+
+  if (mask->expr_type == EXPR_CONSTANT
+      && mask->value.logical)
+    {
+      /* Copy all elements of ARRAY to RESULT.  */
+      while (array_ctor)
+	{
+	  gfc_constructor_append_expr (&result->value.constructor,
+				       gfc_copy_expr (array_ctor->expr),
+				       NULL);
+
+	  array_ctor = gfc_constructor_next (array_ctor);
+	  vector_ctor = gfc_constructor_next (vector_ctor);
+	}
+    }
+  else if (mask->expr_type == EXPR_ARRAY)
+    {
+      /* Copy only those elements of ARRAY to RESULT whose 
+	 MASK equals .TRUE..  */
+      mask_ctor = gfc_constructor_first (mask->value.constructor);
+      while (mask_ctor)
+	{
+	  if (mask_ctor->expr->value.logical)
+	    {
+	      gfc_constructor_append_expr (&result->value.constructor,
+					   gfc_copy_expr (array_ctor->expr),
+					   NULL);
+	      vector_ctor = gfc_constructor_next (vector_ctor);
+	    }
+
+	  array_ctor = gfc_constructor_next (array_ctor);
+	  mask_ctor = gfc_constructor_next (mask_ctor);
+	}
+    }
+
+  /* Append any left-over elements from VECTOR to RESULT.  */
+  while (vector_ctor)
+    {
+      gfc_constructor_append_expr (&result->value.constructor,
+				   gfc_copy_expr (vector_ctor->expr),
+				   NULL);
+      vector_ctor = gfc_constructor_next (vector_ctor);
+    }
+
+  result->shape = gfc_get_shape (1);
+  gfc_array_size (result, &result->shape[0]);
+
+  if (array->ts.type == BT_CHARACTER)
+    result->ts.u.cl = array->ts.u.cl;
+
+  return result;
+}
+
+
+static gfc_expr *
+do_xor (gfc_expr *result, gfc_expr *e)
+{
+  gcc_assert (e->ts.type == BT_LOGICAL && e->expr_type == EXPR_CONSTANT);
+  gcc_assert (result->ts.type == BT_LOGICAL
+	      && result->expr_type == EXPR_CONSTANT);
+
+  result->value.logical = result->value.logical != e->value.logical;
+  return result;
+}
+
+
+
+gfc_expr *
+gfc_simplify_parity (gfc_expr *e, gfc_expr *dim)
+{
+  return simplify_transformation (e, dim, NULL, 0, do_xor);
+}
+
+
+gfc_expr *
+gfc_simplify_popcnt (gfc_expr *e)
+{
+  int res, k;
+  mpz_t x;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  k = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+
+  /* Convert argument to unsigned, then count the '1' bits.  */
+  mpz_init_set (x, e->value.integer);
+  convert_mpz_to_unsigned (x, gfc_integer_kinds[k].bit_size);
+  res = mpz_popcount (x);
+  mpz_clear (x);
+
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where, res);
+}
+
+
+gfc_expr *
+gfc_simplify_poppar (gfc_expr *e)
+{
+  gfc_expr *popcnt;
+  const char *s;
+  int i;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  popcnt = gfc_simplify_popcnt (e);
+  gcc_assert (popcnt);
+
+  s = gfc_extract_int (popcnt, &i);
+  gcc_assert (!s);
+
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where, i % 2);
+}
+
+
+gfc_expr *
+gfc_simplify_precision (gfc_expr *e)
+{
+  int i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where,
+			   gfc_real_kinds[i].precision);
+}
+
+
+gfc_expr *
+gfc_simplify_product (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+  return simplify_transformation (array, dim, mask, 1, gfc_multiply);
+}
+
+
+gfc_expr *
+gfc_simplify_radix (gfc_expr *e)
+{
+  int i;
+  i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+
+  switch (e->ts.type)
+    {
+      case BT_INTEGER:
+	i = gfc_integer_kinds[i].radix;
+	break;
+
+      case BT_REAL:
+	i = gfc_real_kinds[i].radix;
+	break;
+
+      default:
+	gcc_unreachable ();
+    }
+
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where, i);
+}
+
+
+gfc_expr *
+gfc_simplify_range (gfc_expr *e)
+{
+  int i;
+  i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+
+  switch (e->ts.type)
+    {
+      case BT_INTEGER:
+	i = gfc_integer_kinds[i].range;
+	break;
+
+      case BT_REAL:
+      case BT_COMPLEX:
+	i = gfc_real_kinds[i].range;
+	break;
+
+      default:
+	gcc_unreachable ();
+    }
+
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where, i);
+}
+
+
+gfc_expr *
+gfc_simplify_real (gfc_expr *e, gfc_expr *k)
+{
+  gfc_expr *result = NULL;
+  int kind;
+
+  if (e->ts.type == BT_COMPLEX)
+    kind = get_kind (BT_REAL, k, "REAL", e->ts.kind);
+  else
+    kind = get_kind (BT_REAL, k, "REAL", gfc_default_real_kind);
+
+  if (kind == -1)
+    return &gfc_bad_expr;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (convert_boz (e, kind) == &gfc_bad_expr)
+    return &gfc_bad_expr;
+
+  result = gfc_convert_constant (e, BT_REAL, kind);
+  if (result == &gfc_bad_expr)
+    return &gfc_bad_expr;
+
+  return range_check (result, "REAL");
+}
+
+
+gfc_expr *
+gfc_simplify_realpart (gfc_expr *e)
+{
+  gfc_expr *result;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_REAL, e->ts.kind, &e->where);
+  mpc_real (result->value.real, e->value.complex, GFC_RND_MODE);
+
+  return range_check (result, "REALPART");
+}
+
+gfc_expr *
+gfc_simplify_repeat (gfc_expr *e, gfc_expr *n)
+{
+  gfc_expr *result;
+  int i, j, len, ncop, nlen;
+  mpz_t ncopies;
+  bool have_length = false;
+
+  /* If NCOPIES isn't a constant, there's nothing we can do.  */
+  if (n->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  /* If NCOPIES is negative, it's an error.  */
+  if (mpz_sgn (n->value.integer) < 0)
+    {
+      gfc_error ("Argument NCOPIES of REPEAT intrinsic is negative at %L",
+		 &n->where);
+      return &gfc_bad_expr;
+    }
+
+  /* If we don't know the character length, we can do no more.  */
+  if (e->ts.u.cl && e->ts.u.cl->length
+	&& e->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+    {
+      len = mpz_get_si (e->ts.u.cl->length->value.integer);
+      have_length = true;
+    }
+  else if (e->expr_type == EXPR_CONSTANT
+	     && (e->ts.u.cl == NULL || e->ts.u.cl->length == NULL))
+    {
+      len = e->value.character.length;
+    }
+  else
+    return NULL;
+
+  /* If the source length is 0, any value of NCOPIES is valid
+     and everything behaves as if NCOPIES == 0.  */
+  mpz_init (ncopies);
+  if (len == 0)
+    mpz_set_ui (ncopies, 0);
+  else
+    mpz_set (ncopies, n->value.integer);
+
+  /* Check that NCOPIES isn't too large.  */
+  if (len)
+    {
+      mpz_t max, mlen;
+      int i;
+
+      /* Compute the maximum value allowed for NCOPIES: huge(cl) / len.  */
+      mpz_init (max);
+      i = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+
+      if (have_length)
+	{
+	  mpz_tdiv_q (max, gfc_integer_kinds[i].huge,
+		      e->ts.u.cl->length->value.integer);
+	}
+      else
+	{
+	  mpz_init_set_si (mlen, len);
+	  mpz_tdiv_q (max, gfc_integer_kinds[i].huge, mlen);
+	  mpz_clear (mlen);
+	}
+
+      /* The check itself.  */
+      if (mpz_cmp (ncopies, max) > 0)
+	{
+	  mpz_clear (max);
+	  mpz_clear (ncopies);
+	  gfc_error ("Argument NCOPIES of REPEAT intrinsic is too large at %L",
+		     &n->where);
+	  return &gfc_bad_expr;
+	}
+
+      mpz_clear (max);
+    }
+  mpz_clear (ncopies);
+
+  /* For further simplification, we need the character string to be
+     constant.  */
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (len || 
+      (e->ts.u.cl->length && 
+       mpz_sgn (e->ts.u.cl->length->value.integer)) != 0)
+    {
+      const char *res = gfc_extract_int (n, &ncop);
+      gcc_assert (res == NULL);
+    }
+  else
+    ncop = 0;
+
+  len = e->value.character.length;
+  nlen = ncop * len;
+
+  result = gfc_get_constant_expr (BT_CHARACTER, e->ts.kind, &e->where);
+
+  if (ncop == 0)
+    return gfc_get_character_expr (e->ts.kind, &e->where, NULL, 0);
+
+  len = e->value.character.length;
+  nlen = ncop * len;
+
+  result = gfc_get_character_expr (e->ts.kind, &e->where, NULL, nlen);
+  for (i = 0; i < ncop; i++)
+    for (j = 0; j < len; j++)
+      result->value.character.string[j+i*len]= e->value.character.string[j];
+
+  result->value.character.string[nlen] = '\0';	/* For debugger */
+  return result;
+}
+
+
+/* This one is a bear, but mainly has to do with shuffling elements.  */
+
+gfc_expr *
+gfc_simplify_reshape (gfc_expr *source, gfc_expr *shape_exp,
+		      gfc_expr *pad, gfc_expr *order_exp)
+{
+  int order[GFC_MAX_DIMENSIONS], shape[GFC_MAX_DIMENSIONS];
+  int i, rank, npad, x[GFC_MAX_DIMENSIONS];
+  mpz_t index, size;
+  unsigned long j;
+  size_t nsource;
+  gfc_expr *e, *result;
+
+  /* Check that argument expression types are OK.  */
+  if (!is_constant_array_expr (source)
+      || !is_constant_array_expr (shape_exp)
+      || !is_constant_array_expr (pad)
+      || !is_constant_array_expr (order_exp))
+    return NULL;
+
+  /* Proceed with simplification, unpacking the array.  */
+
+  mpz_init (index);
+  rank = 0;
+
+  for (;;)
+    {
+      e = gfc_constructor_lookup_expr (shape_exp->value.constructor, rank);
+      if (e == NULL)
+	break;
+
+      gfc_extract_int (e, &shape[rank]);
+
+      gcc_assert (rank >= 0 && rank < GFC_MAX_DIMENSIONS);
+      gcc_assert (shape[rank] >= 0);
+
+      rank++;
+    }
+
+  gcc_assert (rank > 0);
+
+  /* Now unpack the order array if present.  */
+  if (order_exp == NULL)
+    {
+      for (i = 0; i < rank; i++)
+	order[i] = i;
+    }
+  else
+    {
+      for (i = 0; i < rank; i++)
+	x[i] = 0;
+
+      for (i = 0; i < rank; i++)
+	{
+	  e = gfc_constructor_lookup_expr (order_exp->value.constructor, i);
+	  gcc_assert (e);
+
+	  gfc_extract_int (e, &order[i]);
+
+	  gcc_assert (order[i] >= 1 && order[i] <= rank);
+	  order[i]--;
+	  gcc_assert (x[order[i]] == 0);
+	  x[order[i]] = 1;
+	}
+    }
+
+  /* Count the elements in the source and padding arrays.  */
+
+  npad = 0;
+  if (pad != NULL)
+    {
+      gfc_array_size (pad, &size);
+      npad = mpz_get_ui (size);
+      mpz_clear (size);
+    }
+
+  gfc_array_size (source, &size);
+  nsource = mpz_get_ui (size);
+  mpz_clear (size);
+
+  /* If it weren't for that pesky permutation we could just loop
+     through the source and round out any shortage with pad elements.
+     But no, someone just had to have the compiler do something the
+     user should be doing.  */
+
+  for (i = 0; i < rank; i++)
+    x[i] = 0;
+
+  result = gfc_get_array_expr (source->ts.type, source->ts.kind,
+			       &source->where);
+  if (source->ts.type == BT_DERIVED)
+    result->ts.u.derived = source->ts.u.derived;
+  result->rank = rank;
+  result->shape = gfc_get_shape (rank);
+  for (i = 0; i < rank; i++)
+    mpz_init_set_ui (result->shape[i], shape[i]);
+
+  while (nsource > 0 || npad > 0)
+    {
+      /* Figure out which element to extract.  */
+      mpz_set_ui (index, 0);
+
+      for (i = rank - 1; i >= 0; i--)
+	{
+	  mpz_add_ui (index, index, x[order[i]]);
+	  if (i != 0)
+	    mpz_mul_ui (index, index, shape[order[i - 1]]);
+	}
+
+      if (mpz_cmp_ui (index, INT_MAX) > 0)
+	gfc_internal_error ("Reshaped array too large at %C");
+
+      j = mpz_get_ui (index);
+
+      if (j < nsource)
+	e = gfc_constructor_lookup_expr (source->value.constructor, j);
+      else
+	{
+	  gcc_assert (npad > 0);
+
+	  j = j - nsource;
+	  j = j % npad;
+	  e = gfc_constructor_lookup_expr (pad->value.constructor, j);
+	}
+      gcc_assert (e);
+
+      gfc_constructor_append_expr (&result->value.constructor,
+				   gfc_copy_expr (e), &e->where);
+
+      /* Calculate the next element.  */
+      i = 0;
+
+inc:
+      if (++x[i] < shape[i])
+	continue;
+      x[i++] = 0;
+      if (i < rank)
+	goto inc;
+
+      break;
+    }
+
+  mpz_clear (index);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_rrspacing (gfc_expr *x)
+{
+  gfc_expr *result;
+  int i;
+  long int e, p;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
+
+  result = gfc_get_constant_expr (BT_REAL, x->ts.kind, &x->where);
+  mpfr_abs (result->value.real, x->value.real, GFC_RND_MODE);
+
+  /* Special case x = -0 and 0.  */
+  if (mpfr_sgn (result->value.real) == 0)
+    {
+      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+      return result;
+    }
+
+  /* | x * 2**(-e) | * 2**p.  */
+  e = - (long int) mpfr_get_exp (x->value.real);
+  mpfr_mul_2si (result->value.real, result->value.real, e, GFC_RND_MODE);
+
+  p = (long int) gfc_real_kinds[i].digits;
+  mpfr_mul_2si (result->value.real, result->value.real, p, GFC_RND_MODE);
+
+  return range_check (result, "RRSPACING");
+}
+
+
+gfc_expr *
+gfc_simplify_scale (gfc_expr *x, gfc_expr *i)
+{
+  int k, neg_flag, power, exp_range;
+  mpfr_t scale, radix;
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT || i->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_REAL, x->ts.kind, &x->where);
+
+  if (mpfr_sgn (x->value.real) == 0)
+    {
+      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+      return result;
+    }
+
+  k = gfc_validate_kind (BT_REAL, x->ts.kind, false);
+
+  exp_range = gfc_real_kinds[k].max_exponent - gfc_real_kinds[k].min_exponent;
+
+  /* This check filters out values of i that would overflow an int.  */
+  if (mpz_cmp_si (i->value.integer, exp_range + 2) > 0
+      || mpz_cmp_si (i->value.integer, -exp_range - 2) < 0)
+    {
+      gfc_error ("Result of SCALE overflows its kind at %L", &result->where);
+      gfc_free_expr (result);
+      return &gfc_bad_expr;
+    }
+
+  /* Compute scale = radix ** power.  */
+  power = mpz_get_si (i->value.integer);
+
+  if (power >= 0)
+    neg_flag = 0;
+  else
+    {
+      neg_flag = 1;
+      power = -power;
+    }
+
+  gfc_set_model_kind (x->ts.kind);
+  mpfr_init (scale);
+  mpfr_init (radix);
+  mpfr_set_ui (radix, gfc_real_kinds[k].radix, GFC_RND_MODE);
+  mpfr_pow_ui (scale, radix, power, GFC_RND_MODE);
+
+  if (neg_flag)
+    mpfr_div (result->value.real, x->value.real, scale, GFC_RND_MODE);
+  else
+    mpfr_mul (result->value.real, x->value.real, scale, GFC_RND_MODE);
+
+  mpfr_clears (scale, radix, NULL);
+
+  return range_check (result, "SCALE");
+}
+
+
+/* Variants of strspn and strcspn that operate on wide characters.  */
+
+static size_t
+wide_strspn (const gfc_char_t *s1, const gfc_char_t *s2)
+{
+  size_t i = 0;
+  const gfc_char_t *c;
+
+  while (s1[i])
+    {
+      for (c = s2; *c; c++)
+	{
+	  if (s1[i] == *c)
+	    break;
+	}
+      if (*c == '\0')
+	break;
+      i++;
+    }
+
+  return i;
+}
+
+static size_t
+wide_strcspn (const gfc_char_t *s1, const gfc_char_t *s2)
+{
+  size_t i = 0;
+  const gfc_char_t *c;
+
+  while (s1[i])
+    {
+      for (c = s2; *c; c++)
+	{
+	  if (s1[i] == *c)
+	    break;
+	}
+      if (*c)
+	break;
+      i++;
+    }
+
+  return i;
+}
+
+
+gfc_expr *
+gfc_simplify_scan (gfc_expr *e, gfc_expr *c, gfc_expr *b, gfc_expr *kind)
+{
+  gfc_expr *result;
+  int back;
+  size_t i;
+  size_t indx, len, lenc;
+  int k = get_kind (BT_INTEGER, kind, "SCAN", gfc_default_integer_kind);
+
+  if (k == -1)
+    return &gfc_bad_expr;
+
+  if (e->expr_type != EXPR_CONSTANT || c->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (b != NULL && b->value.logical != 0)
+    back = 1;
+  else
+    back = 0;
+
+  len = e->value.character.length;
+  lenc = c->value.character.length;
+
+  if (len == 0 || lenc == 0)
+    {
+      indx = 0;
+    }
+  else
+    {
+      if (back == 0)
+	{
+	  indx = wide_strcspn (e->value.character.string,
+			       c->value.character.string) + 1;
+	  if (indx > len)
+	    indx = 0;
+	}
+      else
+	{
+	  i = 0;
+	  for (indx = len; indx > 0; indx--)
+	    {
+	      for (i = 0; i < lenc; i++)
+		{
+		  if (c->value.character.string[i]
+		      == e->value.character.string[indx - 1])
+		    break;
+		}
+	      if (i < lenc)
+		break;
+	    }
+	}
+    }
+
+  result = gfc_get_int_expr (k, &e->where, indx);
+  return range_check (result, "SCAN");
+}
+
+
+gfc_expr *
+gfc_simplify_selected_char_kind (gfc_expr *e)
+{
+  int kind;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (gfc_compare_with_Cstring (e, "ascii", false) == 0
+      || gfc_compare_with_Cstring (e, "default", false) == 0)
+    kind = 1;
+  else if (gfc_compare_with_Cstring (e, "iso_10646", false) == 0)
+    kind = 4;
+  else
+    kind = -1;
+
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where, kind);
+}
+
+
+gfc_expr *
+gfc_simplify_selected_int_kind (gfc_expr *e)
+{
+  int i, kind, range;
+
+  if (e->expr_type != EXPR_CONSTANT || gfc_extract_int (e, &range) != NULL)
+    return NULL;
+
+  kind = INT_MAX;
+
+  for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+    if (gfc_integer_kinds[i].range >= range
+	&& gfc_integer_kinds[i].kind < kind)
+      kind = gfc_integer_kinds[i].kind;
+
+  if (kind == INT_MAX)
+    kind = -1;
+
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where, kind);
+}
+
+
+gfc_expr *
+gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx)
+{
+  int range, precision, radix, i, kind, found_precision, found_range,
+      found_radix;
+  locus *loc = &gfc_current_locus;
+
+  if (p == NULL)
+    precision = 0;
+  else
+    {
+      if (p->expr_type != EXPR_CONSTANT
+	  || gfc_extract_int (p, &precision) != NULL)
+	return NULL;
+      loc = &p->where;
+    }
+
+  if (q == NULL)
+    range = 0;
+  else
+    {
+      if (q->expr_type != EXPR_CONSTANT
+	  || gfc_extract_int (q, &range) != NULL)
+	return NULL;
+
+      if (!loc)
+	loc = &q->where;
+    }
+
+  if (rdx == NULL)
+    radix = 0;
+  else
+    {
+      if (rdx->expr_type != EXPR_CONSTANT
+	  || gfc_extract_int (rdx, &radix) != NULL)
+	return NULL;
+
+      if (!loc)
+	loc = &rdx->where;
+    }
+
+  kind = INT_MAX;
+  found_precision = 0;
+  found_range = 0;
+  found_radix = 0;
+
+  for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+    {
+      if (gfc_real_kinds[i].precision >= precision)
+	found_precision = 1;
+
+      if (gfc_real_kinds[i].range >= range)
+	found_range = 1;
+
+      if (gfc_real_kinds[i].radix >= radix)
+	found_radix = 1;
+
+      if (gfc_real_kinds[i].precision >= precision
+	  && gfc_real_kinds[i].range >= range
+	  && gfc_real_kinds[i].radix >= radix && gfc_real_kinds[i].kind < kind)
+	kind = gfc_real_kinds[i].kind;
+    }
+
+  if (kind == INT_MAX)
+    {
+      if (found_radix && found_range && !found_precision)
+	kind = -1;
+      else if (found_radix && found_precision && !found_range)
+	kind = -2;
+      else if (found_radix && !found_precision && !found_range)
+	kind = -3;
+      else if (found_radix)
+	kind = -4;
+      else
+	kind = -5;
+    }
+
+  return gfc_get_int_expr (gfc_default_integer_kind, loc, kind);
+}
+
+
+gfc_expr *
+gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i)
+{
+  gfc_expr *result;
+  mpfr_t exp, absv, log2, pow2, frac;
+  unsigned long exp2;
+
+  if (x->expr_type != EXPR_CONSTANT || i->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (BT_REAL, x->ts.kind, &x->where);
+
+  if (mpfr_sgn (x->value.real) == 0)
+    {
+      mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
+      return result;
+    }
+
+  gfc_set_model_kind (x->ts.kind);
+  mpfr_init (absv);
+  mpfr_init (log2);
+  mpfr_init (exp);
+  mpfr_init (pow2);
+  mpfr_init (frac);
+
+  mpfr_abs (absv, x->value.real, GFC_RND_MODE);
+  mpfr_log2 (log2, absv, GFC_RND_MODE);
+
+  mpfr_trunc (log2, log2);
+  mpfr_add_ui (exp, log2, 1, GFC_RND_MODE);
+
+  /* Old exponent value, and fraction.  */
+  mpfr_ui_pow (pow2, 2, exp, GFC_RND_MODE);
+
+  mpfr_div (frac, absv, pow2, GFC_RND_MODE);
+
+  /* New exponent.  */
+  exp2 = (unsigned long) mpz_get_d (i->value.integer);
+  mpfr_mul_2exp (result->value.real, frac, exp2, GFC_RND_MODE);
+
+  mpfr_clears (absv, log2, pow2, frac, NULL);
+
+  return range_check (result, "SET_EXPONENT");
+}
+
+
+gfc_expr *
+gfc_simplify_shape (gfc_expr *source, gfc_expr *kind)
+{
+  mpz_t shape[GFC_MAX_DIMENSIONS];
+  gfc_expr *result, *e, *f;
+  gfc_array_ref *ar;
+  int n;
+  gfc_try t;
+  int k = get_kind (BT_INTEGER, kind, "SHAPE", gfc_default_integer_kind);
+
+  result = gfc_get_array_expr (BT_INTEGER, k, &source->where);
+
+  if (source->rank == 0)
+    return result;
+
+  if (source->expr_type == EXPR_VARIABLE)
+    {
+      ar = gfc_find_array_ref (source);
+      t = gfc_array_ref_shape (ar, shape);
+    }
+  else if (source->shape)
+    {
+      t = SUCCESS;
+      for (n = 0; n < source->rank; n++)
+	{
+	  mpz_init (shape[n]);
+	  mpz_set (shape[n], source->shape[n]);
+	}
+    }
+  else
+    t = FAILURE;
+
+  for (n = 0; n < source->rank; n++)
+    {
+      e = gfc_get_constant_expr (BT_INTEGER, k, &source->where);
+
+      if (t == SUCCESS)
+	{
+	  mpz_set (e->value.integer, shape[n]);
+	  mpz_clear (shape[n]);
+	}
+      else
+	{
+	  mpz_set_ui (e->value.integer, n + 1);
+
+	  f = gfc_simplify_size (source, e, NULL);
+	  gfc_free_expr (e);
+	  if (f == NULL)
+	    {
+	      gfc_free_expr (result);
+	      return NULL;
+	    }
+	  else
+	    e = f;
+	}
+
+      gfc_constructor_append_expr (&result->value.constructor, e, NULL);
+    }
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+  mpz_t size;
+  gfc_expr *return_value;
+  int d;
+  int k = get_kind (BT_INTEGER, kind, "SIZE", gfc_default_integer_kind);
+
+  if (k == -1)
+    return &gfc_bad_expr;
+
+  /* For unary operations, the size of the result is given by the size
+     of the operand.  For binary ones, it's the size of the first operand
+     unless it is scalar, then it is the size of the second.  */
+  if (array->expr_type == EXPR_OP && !array->value.op.uop)
+    {
+      gfc_expr* replacement;
+      gfc_expr* simplified;
+
+      switch (array->value.op.op)
+	{
+	  /* Unary operations.  */
+	  case INTRINSIC_NOT:
+	  case INTRINSIC_UPLUS:
+	  case INTRINSIC_UMINUS:
+	  case INTRINSIC_PARENTHESES:
+	    replacement = array->value.op.op1;
+	    break;
+
+	  /* Binary operations.  If any one of the operands is scalar, take
+	     the other one's size.  If both of them are arrays, it does not
+	     matter -- try to find one with known shape, if possible.  */
+	  default:
+	    if (array->value.op.op1->rank == 0)
+	      replacement = array->value.op.op2;
+	    else if (array->value.op.op2->rank == 0)
+	      replacement = array->value.op.op1;
+	    else
+	      {
+		simplified = gfc_simplify_size (array->value.op.op1, dim, kind);
+		if (simplified)
+		  return simplified;
+
+		replacement = array->value.op.op2;
+	      }
+	    break;
+	}
+
+      /* Try to reduce it directly if possible.  */
+      simplified = gfc_simplify_size (replacement, dim, kind);
+
+      /* Otherwise, we build a new SIZE call.  This is hopefully at least
+	 simpler than the original one.  */
+      if (!simplified)
+	simplified = gfc_build_intrinsic_call (gfc_current_ns,
+					       GFC_ISYM_SIZE, "size",
+					       array->where, 3,
+					       gfc_copy_expr (replacement),
+					       gfc_copy_expr (dim),
+					       gfc_copy_expr (kind));
+
+      return simplified;
+    }
+
+  if (dim == NULL)
+    {
+      if (gfc_array_size (array, &size) == FAILURE)
+	return NULL;
+    }
+  else
+    {
+      if (dim->expr_type != EXPR_CONSTANT)
+	return NULL;
+
+      d = mpz_get_ui (dim->value.integer) - 1;
+      if (gfc_array_dimen_size (array, d, &size) == FAILURE)
+	return NULL;
+    }
+
+  return_value = gfc_get_int_expr (k, &array->where, mpz_get_si (size));
+  mpz_clear (size);
+  return return_value;
+}
+
+
+gfc_expr *
+gfc_simplify_sign (gfc_expr *x, gfc_expr *y)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+  switch (x->ts.type)
+    {
+      case BT_INTEGER:
+	mpz_abs (result->value.integer, x->value.integer);
+	if (mpz_sgn (y->value.integer) < 0)
+	  mpz_neg (result->value.integer, result->value.integer);
+	break;
+
+      case BT_REAL:
+	if (gfc_option.flag_sign_zero)
+	  mpfr_copysign (result->value.real, x->value.real, y->value.real,
+			GFC_RND_MODE);
+	else
+	  mpfr_setsign (result->value.real, x->value.real,
+			mpfr_sgn (y->value.real) < 0 ? 1 : 0, GFC_RND_MODE);
+	break;
+
+      default:
+	gfc_internal_error ("Bad type in gfc_simplify_sign");
+    }
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_sin (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+  switch (x->ts.type)
+    {
+      case BT_REAL:
+	mpfr_sin (result->value.real, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	gfc_set_model (x->value.real);
+	mpc_sin (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gfc_internal_error ("in gfc_simplify_sin(): Bad type");
+    }
+
+  return range_check (result, "SIN");
+}
+
+
+gfc_expr *
+gfc_simplify_sinh (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+  switch (x->ts.type)
+    {
+      case BT_REAL:
+	mpfr_sinh (result->value.real, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	mpc_sinh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gcc_unreachable ();
+    }
+
+  return range_check (result, "SINH");
+}
+
+
+/* The argument is always a double precision real that is converted to
+   single precision.  TODO: Rounding!  */
+
+gfc_expr *
+gfc_simplify_sngl (gfc_expr *a)
+{
+  gfc_expr *result;
+
+  if (a->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_real2real (a, gfc_default_real_kind);
+  return range_check (result, "SNGL");
+}
+
+
+gfc_expr *
+gfc_simplify_spacing (gfc_expr *x)
+{
+  gfc_expr *result;
+  int i;
+  long int en, ep;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  i = gfc_validate_kind (x->ts.type, x->ts.kind, false);
+
+  result = gfc_get_constant_expr (BT_REAL, x->ts.kind, &x->where);
+
+  /* Special case x = 0 and -0.  */
+  mpfr_abs (result->value.real, x->value.real, GFC_RND_MODE);
+  if (mpfr_sgn (result->value.real) == 0)
+    {
+      mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE);
+      return result;
+    }
+
+  /* In the Fortran 95 standard, the result is b**(e - p) where b, e, and p
+     are the radix, exponent of x, and precision.  This excludes the 
+     possibility of subnormal numbers.  Fortran 2003 states the result is
+     b**max(e - p, emin - 1).  */
+
+  ep = (long int) mpfr_get_exp (x->value.real) - gfc_real_kinds[i].digits;
+  en = (long int) gfc_real_kinds[i].min_exponent - 1;
+  en = en > ep ? en : ep;
+
+  mpfr_set_ui (result->value.real, 1, GFC_RND_MODE);
+  mpfr_mul_2si (result->value.real, result->value.real, en, GFC_RND_MODE);
+
+  return range_check (result, "SPACING");
+}
+
+
+gfc_expr *
+gfc_simplify_spread (gfc_expr *source, gfc_expr *dim_expr, gfc_expr *ncopies_expr)
+{
+  gfc_expr *result = 0L;
+  int i, j, dim, ncopies;
+  mpz_t size;
+
+  if ((!gfc_is_constant_expr (source)
+       && !is_constant_array_expr (source))
+      || !gfc_is_constant_expr (dim_expr)
+      || !gfc_is_constant_expr (ncopies_expr))
+    return NULL;
+
+  gcc_assert (dim_expr->ts.type == BT_INTEGER);
+  gfc_extract_int (dim_expr, &dim);
+  dim -= 1;   /* zero-base DIM */
+
+  gcc_assert (ncopies_expr->ts.type == BT_INTEGER);
+  gfc_extract_int (ncopies_expr, &ncopies);
+  ncopies = MAX (ncopies, 0);
+
+  /* Do not allow the array size to exceed the limit for an array
+     constructor.  */
+  if (source->expr_type == EXPR_ARRAY)
+    {
+      if (gfc_array_size (source, &size) == FAILURE)
+	gfc_internal_error ("Failure getting length of a constant array.");
+    }
+  else
+    mpz_init_set_ui (size, 1);
+
+  if (mpz_get_si (size)*ncopies > gfc_option.flag_max_array_constructor)
+    return NULL;
+
+  if (source->expr_type == EXPR_CONSTANT)
+    {
+      gcc_assert (dim == 0);
+
+      result = gfc_get_array_expr (source->ts.type, source->ts.kind,
+				   &source->where);
+      if (source->ts.type == BT_DERIVED)
+	result->ts.u.derived = source->ts.u.derived;
+      result->rank = 1;
+      result->shape = gfc_get_shape (result->rank);
+      mpz_init_set_si (result->shape[0], ncopies);
+
+      for (i = 0; i < ncopies; ++i)
+        gfc_constructor_append_expr (&result->value.constructor,
+				     gfc_copy_expr (source), NULL);
+    }
+  else if (source->expr_type == EXPR_ARRAY)
+    {
+      int offset, rstride[GFC_MAX_DIMENSIONS], extent[GFC_MAX_DIMENSIONS];
+      gfc_constructor *source_ctor;
+
+      gcc_assert (source->rank < GFC_MAX_DIMENSIONS);
+      gcc_assert (dim >= 0 && dim <= source->rank);
+
+      result = gfc_get_array_expr (source->ts.type, source->ts.kind,
+				   &source->where);
+      if (source->ts.type == BT_DERIVED)
+	result->ts.u.derived = source->ts.u.derived;
+      result->rank = source->rank + 1;
+      result->shape = gfc_get_shape (result->rank);
+
+      for (i = 0, j = 0; i < result->rank; ++i)
+	{
+	  if (i != dim)
+	    mpz_init_set (result->shape[i], source->shape[j++]);
+	  else
+	    mpz_init_set_si (result->shape[i], ncopies);
+
+	  extent[i] = mpz_get_si (result->shape[i]);
+	  rstride[i] = (i == 0) ? 1 : rstride[i-1] * extent[i-1];
+	}
+
+      offset = 0;
+      for (source_ctor = gfc_constructor_first (source->value.constructor);
+           source_ctor; source_ctor = gfc_constructor_next (source_ctor))
+	{
+	  for (i = 0; i < ncopies; ++i)
+	    gfc_constructor_insert_expr (&result->value.constructor,
+					 gfc_copy_expr (source_ctor->expr),
+					 NULL, offset + i * rstride[dim]);
+
+	  offset += (dim == 0 ? ncopies : 1);
+	}
+    }
+  else
+    /* FIXME: Returning here avoids a regression in array_simplify_1.f90.
+       Replace NULL with gcc_unreachable() after implementing
+       gfc_simplify_cshift(). */
+    return NULL;
+
+  if (source->ts.type == BT_CHARACTER)
+    result->ts.u.cl = source->ts.u.cl;
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_sqrt (gfc_expr *e)
+{
+  gfc_expr *result = NULL;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  switch (e->ts.type)
+    {
+      case BT_REAL:
+	if (mpfr_cmp_si (e->value.real, 0) < 0)
+	  {
+	    gfc_error ("Argument of SQRT at %L has a negative value",
+		       &e->where);
+	    return &gfc_bad_expr;
+	  }
+	result = gfc_get_constant_expr (e->ts.type, e->ts.kind, &e->where);
+	mpfr_sqrt (result->value.real, e->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	gfc_set_model (e->value.real);
+
+	result = gfc_get_constant_expr (e->ts.type, e->ts.kind, &e->where);
+	mpc_sqrt (result->value.complex, e->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gfc_internal_error ("invalid argument of SQRT at %L", &e->where);
+    }
+
+  return range_check (result, "SQRT");
+}
+
+
+gfc_expr *
+gfc_simplify_sum (gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+  return simplify_transformation (array, dim, mask, 0, gfc_add);
+}
+
+
+gfc_expr *
+gfc_simplify_tan (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+  switch (x->ts.type)
+    {
+      case BT_REAL:
+	mpfr_tan (result->value.real, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	mpc_tan (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gcc_unreachable ();
+    }
+
+  return range_check (result, "TAN");
+}
+
+
+gfc_expr *
+gfc_simplify_tanh (gfc_expr *x)
+{
+  gfc_expr *result;
+
+  if (x->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  result = gfc_get_constant_expr (x->ts.type, x->ts.kind, &x->where);
+
+  switch (x->ts.type)
+    {
+      case BT_REAL:
+	mpfr_tanh (result->value.real, x->value.real, GFC_RND_MODE);
+	break;
+
+      case BT_COMPLEX:
+	mpc_tanh (result->value.complex, x->value.complex, GFC_MPC_RND_MODE);
+	break;
+
+      default:
+	gcc_unreachable ();
+    }
+
+  return range_check (result, "TANH");
+}
+
+
+gfc_expr *
+gfc_simplify_tiny (gfc_expr *e)
+{
+  gfc_expr *result;
+  int i;
+
+  i = gfc_validate_kind (BT_REAL, e->ts.kind, false);
+
+  result = gfc_get_constant_expr (BT_REAL, e->ts.kind, &e->where);
+  mpfr_set (result->value.real, gfc_real_kinds[i].tiny, GFC_RND_MODE);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_trailz (gfc_expr *e)
+{
+  unsigned long tz, bs;
+  int i;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  i = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+  bs = gfc_integer_kinds[i].bit_size;
+  tz = mpz_scan1 (e->value.integer, 0);
+
+  return gfc_get_int_expr (gfc_default_integer_kind,
+			   &e->where, MIN (tz, bs));
+}
+
+
+gfc_expr *
+gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
+{
+  gfc_expr *result;
+  gfc_expr *mold_element;
+  size_t source_size;
+  size_t result_size;
+  size_t result_elt_size;
+  size_t buffer_size;
+  mpz_t tmp;
+  unsigned char *buffer;
+
+  if (!gfc_is_constant_expr (source)
+	|| (gfc_init_expr_flag && !gfc_is_constant_expr (mold))
+	|| !gfc_is_constant_expr (size))
+    return NULL;
+
+  if (source->expr_type == EXPR_FUNCTION)
+    return NULL;
+
+  /* Calculate the size of the source.  */
+  if (source->expr_type == EXPR_ARRAY
+      && gfc_array_size (source, &tmp) == FAILURE)
+    gfc_internal_error ("Failure getting length of a constant array.");
+
+  source_size = gfc_target_expr_size (source);
+
+  /* Create an empty new expression with the appropriate characteristics.  */
+  result = gfc_get_constant_expr (mold->ts.type, mold->ts.kind,
+				  &source->where);
+  result->ts = mold->ts;
+
+  mold_element = mold->expr_type == EXPR_ARRAY
+		 ? gfc_constructor_first (mold->value.constructor)->expr
+		 : mold;
+
+  /* Set result character length, if needed.  Note that this needs to be
+     set even for array expressions, in order to pass this information into 
+     gfc_target_interpret_expr.  */
+  if (result->ts.type == BT_CHARACTER && gfc_is_constant_expr (mold_element))
+    result->value.character.length = mold_element->value.character.length;
+  
+  /* Set the number of elements in the result, and determine its size.  */
+  result_elt_size = gfc_target_expr_size (mold_element);
+  if (result_elt_size == 0)
+    {
+      gfc_free_expr (result);
+      return NULL;
+    }
+
+  if (mold->expr_type == EXPR_ARRAY || mold->rank || size)
+    {
+      int result_length;
+
+      result->expr_type = EXPR_ARRAY;
+      result->rank = 1;
+
+      if (size)
+	result_length = (size_t)mpz_get_ui (size->value.integer);
+      else
+	{
+	  result_length = source_size / result_elt_size;
+	  if (result_length * result_elt_size < source_size)
+	    result_length += 1;
+	}
+
+      result->shape = gfc_get_shape (1);
+      mpz_init_set_ui (result->shape[0], result_length);
+
+      result_size = result_length * result_elt_size;
+    }
+  else
+    {
+      result->rank = 0;
+      result_size = result_elt_size;
+    }
+
+  if (gfc_option.warn_surprising && source_size < result_size)
+    gfc_warning("Intrinsic TRANSFER at %L has partly undefined result: "
+		"source size %ld < result size %ld", &source->where,
+		(long) source_size, (long) result_size);
+
+  /* Allocate the buffer to store the binary version of the source.  */
+  buffer_size = MAX (source_size, result_size);
+  buffer = (unsigned char*)alloca (buffer_size);
+  memset (buffer, 0, buffer_size);
+
+  /* Now write source to the buffer.  */
+  gfc_target_encode_expr (source, buffer, buffer_size);
+
+  /* And read the buffer back into the new expression.  */
+  gfc_target_interpret_expr (buffer, buffer_size, result);
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_transpose (gfc_expr *matrix)
+{
+  int row, matrix_rows, col, matrix_cols;
+  gfc_expr *result;
+
+  if (!is_constant_array_expr (matrix))
+    return NULL;
+
+  gcc_assert (matrix->rank == 2);
+
+  result = gfc_get_array_expr (matrix->ts.type, matrix->ts.kind,
+			       &matrix->where);
+  result->rank = 2;
+  result->shape = gfc_get_shape (result->rank);
+  mpz_set (result->shape[0], matrix->shape[1]);
+  mpz_set (result->shape[1], matrix->shape[0]);
+
+  if (matrix->ts.type == BT_CHARACTER)
+    result->ts.u.cl = matrix->ts.u.cl;
+  else if (matrix->ts.type == BT_DERIVED)
+    result->ts.u.derived = matrix->ts.u.derived;
+
+  matrix_rows = mpz_get_si (matrix->shape[0]);
+  matrix_cols = mpz_get_si (matrix->shape[1]);
+  for (row = 0; row < matrix_rows; ++row)
+    for (col = 0; col < matrix_cols; ++col)
+      {
+	gfc_expr *e = gfc_constructor_lookup_expr (matrix->value.constructor,
+						   col * matrix_rows + row);
+	gfc_constructor_insert_expr (&result->value.constructor, 
+				     gfc_copy_expr (e), &matrix->where,
+				     row * matrix_cols + col);
+      }
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_trim (gfc_expr *e)
+{
+  gfc_expr *result;
+  int count, i, len, lentrim;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  len = e->value.character.length;
+  for (count = 0, i = 1; i <= len; ++i)
+    {
+      if (e->value.character.string[len - i] == ' ')
+	count++;
+      else
+	break;
+    }
+
+  lentrim = len - count;
+
+  result = gfc_get_character_expr (e->ts.kind, &e->where, NULL, lentrim);
+  for (i = 0; i < lentrim; i++)
+    result->value.character.string[i] = e->value.character.string[i];
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub)
+{
+  gfc_expr *result;
+  gfc_ref *ref;
+  gfc_array_spec *as;
+  gfc_constructor *sub_cons;
+  bool first_image;
+  int d;
+
+  if (!is_constant_array_expr (sub))
+    goto not_implemented; /* return NULL;*/
+
+  /* Follow any component references.  */
+  as = coarray->symtree->n.sym->as;
+  for (ref = coarray->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT)
+      as = ref->u.ar.as;
+
+  if (as->type == AS_DEFERRED)
+    goto not_implemented; /* return NULL;*/
+
+  /* "valid sequence of cosubscripts" are required; thus, return 0 unless
+     the cosubscript addresses the first image.  */
+
+  sub_cons = gfc_constructor_first (sub->value.constructor);
+  first_image = true;
+
+  for (d = 1; d <= as->corank; d++)
+    {
+      gfc_expr *ca_bound;
+      int cmp;
+
+      if (sub_cons == NULL)
+	{
+	  gfc_error ("Too few elements in expression for SUB= argument at %L",
+		     &sub->where);
+	  return &gfc_bad_expr;
+	}
+
+      ca_bound = simplify_bound_dim (coarray, NULL, d + as->rank, 0, as,
+				     NULL, true);
+      if (ca_bound == NULL)
+	goto not_implemented; /* return NULL */
+
+      if (ca_bound == &gfc_bad_expr)
+	return ca_bound;
+
+      cmp = mpz_cmp (ca_bound->value.integer, sub_cons->expr->value.integer);
+
+      if (cmp == 0)
+	{
+          gfc_free_expr (ca_bound);
+	  sub_cons = gfc_constructor_next (sub_cons);
+	  continue;
+	}
+
+      first_image = false;
+
+      if (cmp > 0)
+	{
+	  gfc_error ("Out of bounds in IMAGE_INDEX at %L for dimension %d, "
+		     "SUB has %ld and COARRAY lower bound is %ld)",
+		     &coarray->where, d,
+		     mpz_get_si (sub_cons->expr->value.integer),
+		     mpz_get_si (ca_bound->value.integer));
+	  gfc_free_expr (ca_bound);
+	  return &gfc_bad_expr;
+	}
+
+      gfc_free_expr (ca_bound);
+
+      /* Check whether upperbound is valid for the multi-images case.  */
+      if (d < as->corank)
+	{
+	  ca_bound = simplify_bound_dim (coarray, NULL, d + as->rank, 1, as,
+					 NULL, true);
+	  if (ca_bound == &gfc_bad_expr)
+	    return ca_bound;
+
+	  if (ca_bound && ca_bound->expr_type == EXPR_CONSTANT
+	      && mpz_cmp (ca_bound->value.integer,
+			  sub_cons->expr->value.integer) < 0)
+	  {
+	    gfc_error ("Out of bounds in IMAGE_INDEX at %L for dimension %d, "
+		       "SUB has %ld and COARRAY upper bound is %ld)",
+		       &coarray->where, d,
+		       mpz_get_si (sub_cons->expr->value.integer),
+		       mpz_get_si (ca_bound->value.integer));
+	    gfc_free_expr (ca_bound);
+	    return &gfc_bad_expr;
+	  }
+
+	  if (ca_bound)
+	    gfc_free_expr (ca_bound);
+	}
+
+      sub_cons = gfc_constructor_next (sub_cons);
+    }
+
+  if (sub_cons != NULL)
+    {
+      gfc_error ("Too many elements in expression for SUB= argument at %L",
+		 &sub->where);
+      return &gfc_bad_expr;
+    }
+
+  result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
+				  &gfc_current_locus);
+  if (first_image)
+    mpz_set_si (result->value.integer, 1);
+  else
+    mpz_set_si (result->value.integer, 0);
+
+  return result;
+
+not_implemented:
+  gfc_error ("Not yet implemented: IMAGE_INDEX for coarray with non-constant "
+	     "cobounds at %L", &coarray->where);
+  return &gfc_bad_expr;
+}
+
+
+gfc_expr *
+gfc_simplify_this_image (gfc_expr *coarray, gfc_expr *dim)
+{
+  gfc_ref *ref;
+  gfc_array_spec *as;
+  int d;
+
+  if (coarray == NULL)
+    {
+      gfc_expr *result;
+      /* FIXME: gfc_current_locus is wrong.  */
+      result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
+				      &gfc_current_locus);
+      mpz_set_si (result->value.integer, 1);
+      return result;
+    }
+
+  gcc_assert (coarray->expr_type == EXPR_VARIABLE);
+
+  /* Follow any component references.  */
+  as = coarray->symtree->n.sym->as;
+  for (ref = coarray->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT)
+      as = ref->u.ar.as;
+
+  if (as->type == AS_DEFERRED)
+    goto not_implemented; /* return NULL;*/
+
+  if (dim == NULL)
+    {
+      /* Multi-dimensional bounds.  */
+      gfc_expr *bounds[GFC_MAX_DIMENSIONS];
+      gfc_expr *e;
+
+      /* Simplify the bounds for each dimension.  */
+      for (d = 0; d < as->corank; d++)
+	{
+	  bounds[d] = simplify_bound_dim (coarray, NULL, d + as->rank + 1, 0,
+					  as, NULL, true);
+	  if (bounds[d] == NULL || bounds[d] == &gfc_bad_expr)
+	    {
+	      int j;
+
+	      for (j = 0; j < d; j++)
+		gfc_free_expr (bounds[j]);
+	      if (bounds[d] == NULL)
+		goto not_implemented;
+	      return bounds[d];
+	    }
+	}
+
+      /* Allocate the result expression.  */
+      e = gfc_get_expr ();
+      e->where = coarray->where;
+      e->expr_type = EXPR_ARRAY;
+      e->ts.type = BT_INTEGER;
+      e->ts.kind = gfc_default_integer_kind;
+
+      e->rank = 1;
+      e->shape = gfc_get_shape (1);
+      mpz_init_set_ui (e->shape[0], as->corank);
+
+      /* Create the constructor for this array.  */
+      for (d = 0; d < as->corank; d++)
+        gfc_constructor_append_expr (&e->value.constructor,
+                                     bounds[d], &e->where);
+
+      return e;
+    }
+  else
+    {
+      gfc_expr *e;
+      /* A DIM argument is specified.  */
+      if (dim->expr_type != EXPR_CONSTANT)
+	goto not_implemented; /*return NULL;*/
+
+      d = mpz_get_si (dim->value.integer);
+
+      if (d < 1 || d > as->corank)
+	{
+	  gfc_error ("DIM argument at %L is out of bounds", &dim->where);
+	  return &gfc_bad_expr;
+	}
+
+      /*return simplify_bound_dim (coarray, NULL, d + as->rank, 0, as, NULL, true);*/
+      e = simplify_bound_dim (coarray, NULL, d + as->rank, 0, as, NULL, true);
+      if (e != NULL)
+	return e;
+      else
+	goto not_implemented;
+   }
+
+not_implemented:
+  gfc_error ("Not yet implemented: THIS_IMAGE for coarray with non-constant "
+	     "cobounds at %L", &coarray->where);
+  return &gfc_bad_expr;
+}
+
+
+gfc_expr *
+gfc_simplify_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+  return simplify_bound (array, dim, kind, 1);
+}
+
+gfc_expr *
+gfc_simplify_ucobound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+  gfc_expr *e;
+  /* return simplify_cobound (array, dim, kind, 1);*/
+
+  e = simplify_cobound (array, dim, kind, 1);
+  if (e != NULL)
+    return e;
+
+  gfc_error ("Not yet implemented: UCOBOUND for coarray with non-constant "
+	     "cobounds at %L", &array->where);
+  return &gfc_bad_expr;
+}
+
+
+gfc_expr *
+gfc_simplify_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
+{
+  gfc_expr *result, *e;
+  gfc_constructor *vector_ctor, *mask_ctor, *field_ctor;
+
+  if (!is_constant_array_expr (vector)
+      || !is_constant_array_expr (mask)
+      || (!gfc_is_constant_expr (field)
+	  && !is_constant_array_expr(field)))
+    return NULL;
+
+  result = gfc_get_array_expr (vector->ts.type, vector->ts.kind,
+			       &vector->where);
+  if (vector->ts.type == BT_DERIVED)
+    result->ts.u.derived = vector->ts.u.derived;
+  result->rank = mask->rank;
+  result->shape = gfc_copy_shape (mask->shape, mask->rank);
+
+  if (vector->ts.type == BT_CHARACTER)
+    result->ts.u.cl = vector->ts.u.cl;
+
+  vector_ctor = gfc_constructor_first (vector->value.constructor);
+  mask_ctor = gfc_constructor_first (mask->value.constructor);
+  field_ctor
+    = field->expr_type == EXPR_ARRAY
+			    ? gfc_constructor_first (field->value.constructor)
+			    : NULL;
+
+  while (mask_ctor)
+    {
+      if (mask_ctor->expr->value.logical)
+	{
+	  gcc_assert (vector_ctor);
+	  e = gfc_copy_expr (vector_ctor->expr);
+	  vector_ctor = gfc_constructor_next (vector_ctor);
+	}
+      else if (field->expr_type == EXPR_ARRAY)
+	e = gfc_copy_expr (field_ctor->expr);
+      else
+	e = gfc_copy_expr (field);
+
+      gfc_constructor_append_expr (&result->value.constructor, e, NULL);
+
+      mask_ctor = gfc_constructor_next (mask_ctor);
+      field_ctor = gfc_constructor_next (field_ctor);
+    }
+
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_verify (gfc_expr *s, gfc_expr *set, gfc_expr *b, gfc_expr *kind)
+{
+  gfc_expr *result;
+  int back;
+  size_t index, len, lenset;
+  size_t i;
+  int k = get_kind (BT_INTEGER, kind, "VERIFY", gfc_default_integer_kind);
+
+  if (k == -1)
+    return &gfc_bad_expr;
+
+  if (s->expr_type != EXPR_CONSTANT || set->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (b != NULL && b->value.logical != 0)
+    back = 1;
+  else
+    back = 0;
+
+  result = gfc_get_constant_expr (BT_INTEGER, k, &s->where);
+
+  len = s->value.character.length;
+  lenset = set->value.character.length;
+
+  if (len == 0)
+    {
+      mpz_set_ui (result->value.integer, 0);
+      return result;
+    }
+
+  if (back == 0)
+    {
+      if (lenset == 0)
+	{
+	  mpz_set_ui (result->value.integer, 1);
+	  return result;
+	}
+
+      index = wide_strspn (s->value.character.string,
+			   set->value.character.string) + 1;
+      if (index > len)
+	index = 0;
+
+    }
+  else
+    {
+      if (lenset == 0)
+	{
+	  mpz_set_ui (result->value.integer, len);
+	  return result;
+	}
+      for (index = len; index > 0; index --)
+	{
+	  for (i = 0; i < lenset; i++)
+	    {
+	      if (s->value.character.string[index - 1]
+		  == set->value.character.string[i])
+		break;
+	    }
+	  if (i == lenset)
+	    break;
+	}
+    }
+
+  mpz_set_ui (result->value.integer, index);
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_xor (gfc_expr *x, gfc_expr *y)
+{
+  gfc_expr *result;
+  int kind;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind;
+
+  switch (x->ts.type)
+    {
+      case BT_INTEGER:
+	result = gfc_get_constant_expr (BT_INTEGER, kind, &x->where);
+	mpz_xor (result->value.integer, x->value.integer, y->value.integer);
+	return range_check (result, "XOR");
+
+      case BT_LOGICAL:
+	return gfc_get_logical_expr (kind, &x->where,
+				     (x->value.logical && !y->value.logical)
+				     || (!x->value.logical && y->value.logical));
+
+      default:
+	gcc_unreachable ();
+    }
+}
+
+
+/****************** Constant simplification *****************/
+
+/* Master function to convert one constant to another.  While this is
+   used as a simplification function, it requires the destination type
+   and kind information which is supplied by a special case in
+   do_simplify().  */
+
+gfc_expr *
+gfc_convert_constant (gfc_expr *e, bt type, int kind)
+{
+  gfc_expr *g, *result, *(*f) (gfc_expr *, int);
+  gfc_constructor *c;
+
+  switch (e->ts.type)
+    {
+    case BT_INTEGER:
+      switch (type)
+	{
+	case BT_INTEGER:
+	  f = gfc_int2int;
+	  break;
+	case BT_REAL:
+	  f = gfc_int2real;
+	  break;
+	case BT_COMPLEX:
+	  f = gfc_int2complex;
+	  break;
+	case BT_LOGICAL:
+	  f = gfc_int2log;
+	  break;
+	default:
+	  goto oops;
+	}
+      break;
+
+    case BT_REAL:
+      switch (type)
+	{
+	case BT_INTEGER:
+	  f = gfc_real2int;
+	  break;
+	case BT_REAL:
+	  f = gfc_real2real;
+	  break;
+	case BT_COMPLEX:
+	  f = gfc_real2complex;
+	  break;
+	default:
+	  goto oops;
+	}
+      break;
+
+    case BT_COMPLEX:
+      switch (type)
+	{
+	case BT_INTEGER:
+	  f = gfc_complex2int;
+	  break;
+	case BT_REAL:
+	  f = gfc_complex2real;
+	  break;
+	case BT_COMPLEX:
+	  f = gfc_complex2complex;
+	  break;
+
+	default:
+	  goto oops;
+	}
+      break;
+
+    case BT_LOGICAL:
+      switch (type)
+	{
+	case BT_INTEGER:
+	  f = gfc_log2int;
+	  break;
+	case BT_LOGICAL:
+	  f = gfc_log2log;
+	  break;
+	default:
+	  goto oops;
+	}
+      break;
+
+    case BT_HOLLERITH:
+      switch (type)
+	{
+	case BT_INTEGER:
+	  f = gfc_hollerith2int;
+	  break;
+
+	case BT_REAL:
+	  f = gfc_hollerith2real;
+	  break;
+
+	case BT_COMPLEX:
+	  f = gfc_hollerith2complex;
+	  break;
+
+	case BT_CHARACTER:
+	  f = gfc_hollerith2character;
+	  break;
+
+	case BT_LOGICAL:
+	  f = gfc_hollerith2logical;
+	  break;
+
+	default:
+	  goto oops;
+	}
+      break;
+
+    default:
+    oops:
+      gfc_internal_error ("gfc_convert_constant(): Unexpected type");
+    }
+
+  result = NULL;
+
+  switch (e->expr_type)
+    {
+    case EXPR_CONSTANT:
+      result = f (e, kind);
+      if (result == NULL)
+	return &gfc_bad_expr;
+      break;
+
+    case EXPR_ARRAY:
+      if (!gfc_is_constant_expr (e))
+	break;
+
+      result = gfc_get_array_expr (type, kind, &e->where);
+      result->shape = gfc_copy_shape (e->shape, e->rank);
+      result->rank = e->rank;
+
+      for (c = gfc_constructor_first (e->value.constructor);
+	   c; c = gfc_constructor_next (c))
+	{
+	  gfc_expr *tmp;
+	  if (c->iterator == NULL)
+	    tmp = f (c->expr, kind);
+	  else
+	    {
+	      g = gfc_convert_constant (c->expr, type, kind);
+	      if (g == &gfc_bad_expr)
+	        {
+		  gfc_free_expr (result);
+		  return g;
+		}
+	      tmp = g;
+	    }
+
+	  if (tmp == NULL)
+	    {
+	      gfc_free_expr (result);
+	      return NULL;
+	    }
+
+	  gfc_constructor_append_expr (&result->value.constructor,
+				       tmp, &c->where);
+	}
+
+      break;
+
+    default:
+      break;
+    }
+
+  return result;
+}
+
+
+/* Function for converting character constants.  */
+gfc_expr *
+gfc_convert_char_constant (gfc_expr *e, bt type ATTRIBUTE_UNUSED, int kind)
+{
+  gfc_expr *result;
+  int i;
+
+  if (!gfc_is_constant_expr (e))
+    return NULL;
+
+  if (e->expr_type == EXPR_CONSTANT)
+    {
+      /* Simple case of a scalar.  */
+      result = gfc_get_constant_expr (BT_CHARACTER, kind, &e->where);
+      if (result == NULL)
+	return &gfc_bad_expr;
+
+      result->value.character.length = e->value.character.length;
+      result->value.character.string
+	= gfc_get_wide_string (e->value.character.length + 1);
+      memcpy (result->value.character.string, e->value.character.string,
+	      (e->value.character.length + 1) * sizeof (gfc_char_t));
+
+      /* Check we only have values representable in the destination kind.  */
+      for (i = 0; i < result->value.character.length; i++)
+	if (!gfc_check_character_range (result->value.character.string[i],
+					kind))
+	  {
+	    gfc_error ("Character '%s' in string at %L cannot be converted "
+		       "into character kind %d",
+		       gfc_print_wide_char (result->value.character.string[i]),
+		       &e->where, kind);
+	    return &gfc_bad_expr;
+	  }
+
+      return result;
+    }
+  else if (e->expr_type == EXPR_ARRAY)
+    {
+      /* For an array constructor, we convert each constructor element.  */
+      gfc_constructor *c;
+
+      result = gfc_get_array_expr (type, kind, &e->where);
+      result->shape = gfc_copy_shape (e->shape, e->rank);
+      result->rank = e->rank;
+      result->ts.u.cl = e->ts.u.cl;
+
+      for (c = gfc_constructor_first (e->value.constructor);
+	   c; c = gfc_constructor_next (c))
+	{
+	  gfc_expr *tmp = gfc_convert_char_constant (c->expr, type, kind);
+	  if (tmp == &gfc_bad_expr)
+	    {
+	      gfc_free_expr (result);
+	      return &gfc_bad_expr;
+	    }
+
+	  if (tmp == NULL)
+	    {
+	      gfc_free_expr (result);
+	      return NULL;
+	    }
+
+	  gfc_constructor_append_expr (&result->value.constructor,
+				       tmp, &c->where);
+	}
+
+      return result;
+    }
+  else
+    return NULL;
+}
+
+
+gfc_expr *
+gfc_simplify_compiler_options (void)
+{
+  char *str;
+  gfc_expr *result;
+
+  str = gfc_get_option_string ();
+  result = gfc_get_character_expr (gfc_default_character_kind,
+				   &gfc_current_locus, str, strlen (str));
+  gfc_free (str);
+  return result;
+}
+
+
+gfc_expr *
+gfc_simplify_compiler_version (void)
+{
+  char *buffer;
+  size_t len;
+
+  len = strlen ("GCC version ") + strlen (version_string);
+  buffer = XALLOCAVEC (char, len + 1);
+  snprintf (buffer, len + 1, "GCC version %s", version_string);
+  return gfc_get_character_expr (gfc_default_character_kind,
+                                &gfc_current_locus, buffer, len);
+}
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
new file mode 100644
index 000000000..28d69b929
--- /dev/null
+++ b/gcc/fortran/st.c
@@ -0,0 +1,246 @@
+/* Build executable statement trees.
+   Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* Executable statements are strung together into a singly linked list
+   of code structures.  These structures are later translated into GCC
+   GENERIC tree structures and from there to executable code for a
+   target.  */
+
+#include "config.h"
+#include "system.h"
+#include "gfortran.h"
+
+gfc_code new_st;
+
+
+/* Zeroes out the new_st structure.  */
+
+void
+gfc_clear_new_st (void)
+{
+  memset (&new_st, '\0', sizeof (new_st));
+  new_st.op = EXEC_NOP;
+}
+
+
+/* Get a gfc_code structure.  */
+
+gfc_code *
+gfc_get_code (void)
+{
+  gfc_code *c;
+
+  c = XCNEW (gfc_code);
+  c->loc = gfc_current_locus;
+  return c;
+}
+
+
+/* Given some part of a gfc_code structure, append a set of code to
+   its tail, returning a pointer to the new tail.  */
+
+gfc_code *
+gfc_append_code (gfc_code *tail, gfc_code *new_code)
+{
+  if (tail != NULL)
+    {
+      while (tail->next != NULL)
+	tail = tail->next;
+
+      tail->next = new_code;
+    }
+
+  while (new_code->next != NULL)
+    new_code = new_code->next;
+
+  return new_code;
+}
+
+
+/* Free a single code structure, but not the actual structure itself.  */
+
+void
+gfc_free_statement (gfc_code *p)
+{
+  if (p->expr1)
+    gfc_free_expr (p->expr1);
+  if (p->expr2)
+    gfc_free_expr (p->expr2);
+
+  switch (p->op)
+    {
+    case EXEC_NOP:
+    case EXEC_END_BLOCK:
+    case EXEC_ASSIGN:
+    case EXEC_INIT_ASSIGN:
+    case EXEC_GOTO:
+    case EXEC_CYCLE:
+    case EXEC_RETURN:
+    case EXEC_END_PROCEDURE:
+    case EXEC_IF:
+    case EXEC_PAUSE:
+    case EXEC_STOP:
+    case EXEC_ERROR_STOP:
+    case EXEC_EXIT:
+    case EXEC_WHERE:
+    case EXEC_IOLENGTH:
+    case EXEC_POINTER_ASSIGN:
+    case EXEC_DO_WHILE:
+    case EXEC_CONTINUE:
+    case EXEC_TRANSFER:
+    case EXEC_LABEL_ASSIGN:
+    case EXEC_ENTRY:
+    case EXEC_ARITHMETIC_IF:
+    case EXEC_CRITICAL:
+    case EXEC_SYNC_ALL:
+    case EXEC_SYNC_IMAGES:
+    case EXEC_SYNC_MEMORY:
+      break;
+
+    case EXEC_BLOCK:
+      gfc_free_namespace (p->ext.block.ns);
+      gfc_free_association_list (p->ext.block.assoc);
+      break;
+
+    case EXEC_COMPCALL:
+    case EXEC_CALL_PPC:
+    case EXEC_CALL:
+    case EXEC_ASSIGN_CALL:
+      gfc_free_actual_arglist (p->ext.actual);
+      break;
+
+    case EXEC_SELECT:
+    case EXEC_SELECT_TYPE:
+      if (p->ext.block.case_list)
+	gfc_free_case_list (p->ext.block.case_list);
+      break;
+
+    case EXEC_DO:
+      gfc_free_iterator (p->ext.iterator, 1);
+      break;
+
+    case EXEC_ALLOCATE:
+    case EXEC_DEALLOCATE:
+      gfc_free_alloc_list (p->ext.alloc.list);
+      break;
+
+    case EXEC_OPEN:
+      gfc_free_open (p->ext.open);
+      break;
+
+    case EXEC_CLOSE:
+      gfc_free_close (p->ext.close);
+      break;
+
+    case EXEC_BACKSPACE:
+    case EXEC_ENDFILE:
+    case EXEC_REWIND:
+    case EXEC_FLUSH:
+      gfc_free_filepos (p->ext.filepos);
+      break;
+
+    case EXEC_INQUIRE:
+      gfc_free_inquire (p->ext.inquire);
+      break;
+
+    case EXEC_WAIT:
+      gfc_free_wait (p->ext.wait);
+      break;
+
+    case EXEC_READ:
+    case EXEC_WRITE:
+      gfc_free_dt (p->ext.dt);
+      break;
+
+    case EXEC_DT_END:
+      /* The ext.dt member is a duplicate pointer and doesn't need to
+	 be freed.  */
+      break;
+
+    case EXEC_FORALL:
+      gfc_free_forall_iterator (p->ext.forall_iterator);
+      break;
+
+    case EXEC_OMP_DO:
+    case EXEC_OMP_END_SINGLE:
+    case EXEC_OMP_PARALLEL:
+    case EXEC_OMP_PARALLEL_DO:
+    case EXEC_OMP_PARALLEL_SECTIONS:
+    case EXEC_OMP_SECTIONS:
+    case EXEC_OMP_SINGLE:
+    case EXEC_OMP_TASK:
+    case EXEC_OMP_WORKSHARE:
+    case EXEC_OMP_PARALLEL_WORKSHARE:
+      gfc_free_omp_clauses (p->ext.omp_clauses);
+      break;
+
+    case EXEC_OMP_CRITICAL:
+      gfc_free (CONST_CAST (char *, p->ext.omp_name));
+      break;
+
+    case EXEC_OMP_FLUSH:
+      gfc_free_namelist (p->ext.omp_namelist);
+      break;
+
+    case EXEC_OMP_ATOMIC:
+    case EXEC_OMP_BARRIER:
+    case EXEC_OMP_MASTER:
+    case EXEC_OMP_ORDERED:
+    case EXEC_OMP_END_NOWAIT:
+    case EXEC_OMP_TASKWAIT:
+      break;
+
+    default:
+      gfc_internal_error ("gfc_free_statement(): Bad statement");
+    }
+}
+
+
+/* Free a code statement and all other code structures linked to it.  */
+
+void
+gfc_free_statements (gfc_code *p)
+{
+  gfc_code *q;
+
+  for (; p; p = q)
+    {
+      q = p->next;
+
+      if (p->block)
+	gfc_free_statements (p->block);
+      gfc_free_statement (p);
+      gfc_free (p);
+    }
+}
+
+
+/* Free an association list (of an ASSOCIATE statement).  */
+
+void
+gfc_free_association_list (gfc_association_list* assoc)
+{
+  if (!assoc)
+    return;
+
+  gfc_free_association_list (assoc->next);
+  gfc_free (assoc);
+}
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
new file mode 100644
index 000000000..5b73f6a71
--- /dev/null
+++ b/gcc/fortran/symbol.c
@@ -0,0 +1,4768 @@
+/* Maintain binary trees of symbols.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+   2009, 2010, 2011
+   Free Software Foundation, Inc.
+   Contributed by Andy Vaught
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "parse.h"
+#include "match.h"
+#include "constructor.h"
+
+
+/* Strings for all symbol attributes.  We use these for dumping the
+   parse tree, in error messages, and also when reading and writing
+   modules.  */
+
+const mstring flavors[] =
+{
+  minit ("UNKNOWN-FL", FL_UNKNOWN), minit ("PROGRAM", FL_PROGRAM),
+  minit ("BLOCK-DATA", FL_BLOCK_DATA), minit ("MODULE", FL_MODULE),
+  minit ("VARIABLE", FL_VARIABLE), minit ("PARAMETER", FL_PARAMETER),
+  minit ("LABEL", FL_LABEL), minit ("PROCEDURE", FL_PROCEDURE),
+  minit ("DERIVED", FL_DERIVED), minit ("NAMELIST", FL_NAMELIST),
+  minit (NULL, -1)
+};
+
+const mstring procedures[] =
+{
+    minit ("UNKNOWN-PROC", PROC_UNKNOWN),
+    minit ("MODULE-PROC", PROC_MODULE),
+    minit ("INTERNAL-PROC", PROC_INTERNAL),
+    minit ("DUMMY-PROC", PROC_DUMMY),
+    minit ("INTRINSIC-PROC", PROC_INTRINSIC),
+    minit ("EXTERNAL-PROC", PROC_EXTERNAL),
+    minit ("STATEMENT-PROC", PROC_ST_FUNCTION),
+    minit (NULL, -1)
+};
+
+const mstring intents[] =
+{
+    minit ("UNKNOWN-INTENT", INTENT_UNKNOWN),
+    minit ("IN", INTENT_IN),
+    minit ("OUT", INTENT_OUT),
+    minit ("INOUT", INTENT_INOUT),
+    minit (NULL, -1)
+};
+
+const mstring access_types[] =
+{
+    minit ("UNKNOWN-ACCESS", ACCESS_UNKNOWN),
+    minit ("PUBLIC", ACCESS_PUBLIC),
+    minit ("PRIVATE", ACCESS_PRIVATE),
+    minit (NULL, -1)
+};
+
+const mstring ifsrc_types[] =
+{
+    minit ("UNKNOWN", IFSRC_UNKNOWN),
+    minit ("DECL", IFSRC_DECL),
+    minit ("BODY", IFSRC_IFBODY)
+};
+
+const mstring save_status[] =
+{
+    minit ("UNKNOWN", SAVE_NONE),
+    minit ("EXPLICIT-SAVE", SAVE_EXPLICIT),
+    minit ("IMPLICIT-SAVE", SAVE_IMPLICIT),
+};
+
+/* This is to make sure the backend generates setup code in the correct
+   order.  */
+
+static int next_dummy_order = 1;
+
+
+gfc_namespace *gfc_current_ns;
+gfc_namespace *gfc_global_ns_list;
+
+gfc_gsymbol *gfc_gsym_root = NULL;
+
+static gfc_symbol *changed_syms = NULL;
+
+gfc_dt_list *gfc_derived_types;
+
+
+/* List of tentative typebound-procedures.  */
+
+typedef struct tentative_tbp
+{
+  gfc_typebound_proc *proc;
+  struct tentative_tbp *next;
+}
+tentative_tbp;
+
+static tentative_tbp *tentative_tbp_list = NULL;
+
+
+/*********** IMPLICIT NONE and IMPLICIT statement handlers ***********/
+
+/* The following static variable indicates whether a particular element has
+   been explicitly set or not.  */
+
+static int new_flag[GFC_LETTERS];
+
+
+/* Handle a correctly parsed IMPLICIT NONE.  */
+
+void
+gfc_set_implicit_none (void)
+{
+  int i;
+
+  if (gfc_current_ns->seen_implicit_none)
+    {
+      gfc_error ("Duplicate IMPLICIT NONE statement at %C");
+      return;
+    }
+
+  gfc_current_ns->seen_implicit_none = 1;
+
+  for (i = 0; i < GFC_LETTERS; i++)
+    {
+      gfc_clear_ts (&gfc_current_ns->default_type[i]);
+      gfc_current_ns->set_flag[i] = 1;
+    }
+}
+
+
+/* Reset the implicit range flags.  */
+
+void
+gfc_clear_new_implicit (void)
+{
+  int i;
+
+  for (i = 0; i < GFC_LETTERS; i++)
+    new_flag[i] = 0;
+}
+
+
+/* Prepare for a new implicit range.  Sets flags in new_flag[].  */
+
+gfc_try
+gfc_add_new_implicit_range (int c1, int c2)
+{
+  int i;
+
+  c1 -= 'a';
+  c2 -= 'a';
+
+  for (i = c1; i <= c2; i++)
+    {
+      if (new_flag[i])
+	{
+	  gfc_error ("Letter '%c' already set in IMPLICIT statement at %C",
+		     i + 'A');
+	  return FAILURE;
+	}
+
+      new_flag[i] = 1;
+    }
+
+  return SUCCESS;
+}
+
+
+/* Add a matched implicit range for gfc_set_implicit().  Check if merging
+   the new implicit types back into the existing types will work.  */
+
+gfc_try
+gfc_merge_new_implicit (gfc_typespec *ts)
+{
+  int i;
+
+  if (gfc_current_ns->seen_implicit_none)
+    {
+      gfc_error ("Cannot specify IMPLICIT at %C after IMPLICIT NONE");
+      return FAILURE;
+    }
+
+  for (i = 0; i < GFC_LETTERS; i++)
+    {
+      if (new_flag[i])
+	{
+	  if (gfc_current_ns->set_flag[i])
+	    {
+	      gfc_error ("Letter %c already has an IMPLICIT type at %C",
+			 i + 'A');
+	      return FAILURE;
+	    }
+
+	  gfc_current_ns->default_type[i] = *ts;
+	  gfc_current_ns->implicit_loc[i] = gfc_current_locus;
+	  gfc_current_ns->set_flag[i] = 1;
+	}
+    }
+  return SUCCESS;
+}
+
+
+/* Given a symbol, return a pointer to the typespec for its default type.  */
+
+gfc_typespec *
+gfc_get_default_type (const char *name, gfc_namespace *ns)
+{
+  char letter;
+
+  letter = name[0];
+
+  if (gfc_option.flag_allow_leading_underscore && letter == '_')
+    gfc_internal_error ("Option -fallow-leading-underscore is for use only by "
+			"gfortran developers, and should not be used for "
+			"implicitly typed variables");
+
+  if (letter < 'a' || letter > 'z')
+    gfc_internal_error ("gfc_get_default_type(): Bad symbol '%s'", name);
+
+  if (ns == NULL)
+    ns = gfc_current_ns;
+
+  return &ns->default_type[letter - 'a'];
+}
+
+
+/* Given a pointer to a symbol, set its type according to the first
+   letter of its name.  Fails if the letter in question has no default
+   type.  */
+
+gfc_try
+gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns)
+{
+  gfc_typespec *ts;
+
+  if (sym->ts.type != BT_UNKNOWN)
+    gfc_internal_error ("gfc_set_default_type(): symbol already has a type");
+
+  ts = gfc_get_default_type (sym->name, ns);
+
+  if (ts->type == BT_UNKNOWN)
+    {
+      if (error_flag && !sym->attr.untyped)
+	{
+	  gfc_error ("Symbol '%s' at %L has no IMPLICIT type",
+		     sym->name, &sym->declared_at);
+	  sym->attr.untyped = 1; /* Ensure we only give an error once.  */
+	}
+
+      return FAILURE;
+    }
+
+  sym->ts = *ts;
+  sym->attr.implicit_type = 1;
+
+  if (ts->type == BT_CHARACTER && ts->u.cl)
+    sym->ts.u.cl = gfc_new_charlen (sym->ns, ts->u.cl);
+
+  if (sym->attr.is_bind_c == 1)
+    {
+      /* BIND(C) variables should not be implicitly declared.  */
+      gfc_warning_now ("Implicitly declared BIND(C) variable '%s' at %L may "
+                       "not be C interoperable", sym->name, &sym->declared_at);
+      sym->ts.f90_type = sym->ts.type;
+    }
+
+  if (sym->attr.dummy != 0)
+    {
+      if (sym->ns->proc_name != NULL
+	  && (sym->ns->proc_name->attr.subroutine != 0
+	      || sym->ns->proc_name->attr.function != 0)
+	  && sym->ns->proc_name->attr.is_bind_c != 0)
+        {
+          /* Dummy args to a BIND(C) routine may not be interoperable if
+             they are implicitly typed.  */
+          gfc_warning_now ("Implicitly declared variable '%s' at %L may not "
+                           "be C interoperable but it is a dummy argument to "
+                           "the BIND(C) procedure '%s' at %L", sym->name,
+                           &(sym->declared_at), sym->ns->proc_name->name,
+                           &(sym->ns->proc_name->declared_at));
+          sym->ts.f90_type = sym->ts.type;
+        }
+    }
+  
+  return SUCCESS;
+}
+
+
+/* This function is called from parse.c(parse_progunit) to check the
+   type of the function is not implicitly typed in the host namespace
+   and to implicitly type the function result, if necessary.  */
+
+void
+gfc_check_function_type (gfc_namespace *ns)
+{
+  gfc_symbol *proc = ns->proc_name;
+
+  if (!proc->attr.contained || proc->result->attr.implicit_type)
+    return;
+
+  if (proc->result->ts.type == BT_UNKNOWN && proc->result->ts.interface == NULL)
+    {
+      if (gfc_set_default_type (proc->result, 0, gfc_current_ns)
+		== SUCCESS)
+	{
+	  if (proc->result != proc)
+	    {
+	      proc->ts = proc->result->ts;
+	      proc->as = gfc_copy_array_spec (proc->result->as);
+	      proc->attr.dimension = proc->result->attr.dimension;
+	      proc->attr.pointer = proc->result->attr.pointer;
+	      proc->attr.allocatable = proc->result->attr.allocatable;
+	    }
+	}
+      else if (!proc->result->attr.proc_pointer)
+	{
+	  gfc_error ("Function result '%s' at %L has no IMPLICIT type",
+		     proc->result->name, &proc->result->declared_at);
+	  proc->result->attr.untyped = 1;
+	}
+    }
+}
+
+
+/******************** Symbol attribute stuff *********************/
+
+/* This is a generic conflict-checker.  We do this to avoid having a
+   single conflict in two places.  */
+
+#define conf(a, b) if (attr->a && attr->b) { a1 = a; a2 = b; goto conflict; }
+#define conf2(a) if (attr->a) { a2 = a; goto conflict; }
+#define conf_std(a, b, std) if (attr->a && attr->b)\
+                              {\
+                                a1 = a;\
+                                a2 = b;\
+                                standard = std;\
+                                goto conflict_std;\
+                              }
+
+static gfc_try
+check_conflict (symbol_attribute *attr, const char *name, locus *where)
+{
+  static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
+    *target = "TARGET", *external = "EXTERNAL", *intent = "INTENT",
+    *intent_in = "INTENT(IN)", *intrinsic = "INTRINSIC",
+    *intent_out = "INTENT(OUT)", *intent_inout = "INTENT(INOUT)",
+    *allocatable = "ALLOCATABLE", *elemental = "ELEMENTAL",
+    *privat = "PRIVATE", *recursive = "RECURSIVE",
+    *in_common = "COMMON", *result = "RESULT", *in_namelist = "NAMELIST",
+    *publik = "PUBLIC", *optional = "OPTIONAL", *entry = "ENTRY",
+    *function = "FUNCTION", *subroutine = "SUBROUTINE",
+    *dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE",
+    *use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
+    *cray_pointee = "CRAY POINTEE", *data = "DATA", *value = "VALUE",
+    *volatile_ = "VOLATILE", *is_protected = "PROTECTED",
+    *is_bind_c = "BIND(C)", *procedure = "PROCEDURE",
+    *asynchronous = "ASYNCHRONOUS", *codimension = "CODIMENSION",
+    *contiguous = "CONTIGUOUS";
+  static const char *threadprivate = "THREADPRIVATE";
+
+  const char *a1, *a2;
+  int standard;
+
+  if (where == NULL)
+    where = &gfc_current_locus;
+
+  if (attr->pointer && attr->intent != INTENT_UNKNOWN)
+    {
+      a1 = pointer;
+      a2 = intent;
+      standard = GFC_STD_F2003;
+      goto conflict_std;
+    }
+
+  if (attr->in_namelist && (attr->allocatable || attr->pointer))
+    {
+      a1 = in_namelist;
+      a2 = attr->allocatable ? allocatable : pointer;
+      standard = GFC_STD_F2003;
+      goto conflict_std;
+    }
+
+  /* Check for attributes not allowed in a BLOCK DATA.  */
+  if (gfc_current_state () == COMP_BLOCK_DATA)
+    {
+      a1 = NULL;
+
+      if (attr->in_namelist)
+	a1 = in_namelist;
+      if (attr->allocatable)
+	a1 = allocatable;
+      if (attr->external)
+	a1 = external;
+      if (attr->optional)
+	a1 = optional;
+      if (attr->access == ACCESS_PRIVATE)
+	a1 = privat;
+      if (attr->access == ACCESS_PUBLIC)
+	a1 = publik;
+      if (attr->intent != INTENT_UNKNOWN)
+	a1 = intent;
+
+      if (a1 != NULL)
+	{
+	  gfc_error
+	    ("%s attribute not allowed in BLOCK DATA program unit at %L",
+	     a1, where);
+	  return FAILURE;
+	}
+    }
+
+  if (attr->save == SAVE_EXPLICIT)
+    {
+      conf (dummy, save);
+      conf (in_common, save);
+      conf (result, save);
+
+      switch (attr->flavor)
+	{
+	  case FL_PROGRAM:
+	  case FL_BLOCK_DATA:
+	  case FL_MODULE:
+	  case FL_LABEL:
+	  case FL_DERIVED:
+	  case FL_PARAMETER:
+            a1 = gfc_code2string (flavors, attr->flavor);
+            a2 = save;
+	    goto conflict;
+
+	  case FL_PROCEDURE:
+	    /* Conflicts between SAVE and PROCEDURE will be checked at
+	       resolution stage, see "resolve_fl_procedure".  */
+	  case FL_VARIABLE:
+	  case FL_NAMELIST:
+	  default:
+	    break;
+	}
+    }
+
+  conf (dummy, entry);
+  conf (dummy, intrinsic);
+  conf (dummy, threadprivate);
+  conf (pointer, target);
+  conf (pointer, intrinsic);
+  conf (pointer, elemental);
+  conf (allocatable, elemental);
+
+  conf (target, external);
+  conf (target, intrinsic);
+
+  if (!attr->if_source)
+    conf (external, dimension);   /* See Fortran 95's R504.  */
+
+  conf (external, intrinsic);
+  conf (entry, intrinsic);
+
+  if ((attr->if_source == IFSRC_DECL && !attr->procedure) || attr->contained)
+    conf (external, subroutine);
+
+  if (attr->proc_pointer && gfc_notify_std (GFC_STD_F2003,
+			    "Fortran 2003: Procedure pointer at %C") == FAILURE)
+    return FAILURE;
+
+  conf (allocatable, pointer);
+  conf_std (allocatable, dummy, GFC_STD_F2003);
+  conf_std (allocatable, function, GFC_STD_F2003);
+  conf_std (allocatable, result, GFC_STD_F2003);
+  conf (elemental, recursive);
+
+  conf (in_common, dummy);
+  conf (in_common, allocatable);
+  conf (in_common, codimension);
+  conf (in_common, result);
+
+  conf (dummy, result);
+
+  conf (in_equivalence, use_assoc);
+  conf (in_equivalence, codimension);
+  conf (in_equivalence, dummy);
+  conf (in_equivalence, target);
+  conf (in_equivalence, pointer);
+  conf (in_equivalence, function);
+  conf (in_equivalence, result);
+  conf (in_equivalence, entry);
+  conf (in_equivalence, allocatable);
+  conf (in_equivalence, threadprivate);
+
+  conf (entry, result);
+
+  conf (function, subroutine);
+
+  if (!function && !subroutine)
+    conf (is_bind_c, dummy);
+
+  conf (is_bind_c, cray_pointer);
+  conf (is_bind_c, cray_pointee);
+  conf (is_bind_c, codimension);
+  conf (is_bind_c, allocatable);
+  conf (is_bind_c, elemental);
+
+  /* Need to also get volatile attr, according to 5.1 of F2003 draft.
+     Parameter conflict caught below.  Also, value cannot be specified
+     for a dummy procedure.  */
+
+  /* Cray pointer/pointee conflicts.  */
+  conf (cray_pointer, cray_pointee);
+  conf (cray_pointer, dimension);
+  conf (cray_pointer, codimension);
+  conf (cray_pointer, contiguous);
+  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_pointer, contiguous);
+  conf (cray_pointer, codimension);
+  conf (cray_pointee, intent);
+  conf (cray_pointee, optional);
+  conf (cray_pointee, dummy);
+  conf (cray_pointee, target);
+  conf (cray_pointee, intrinsic);
+  conf (cray_pointee, pointer);
+  conf (cray_pointee, entry);
+  conf (cray_pointee, in_common);
+  conf (cray_pointee, in_equivalence);
+  conf (cray_pointee, threadprivate);
+
+  conf (data, dummy);
+  conf (data, function);
+  conf (data, result);
+  conf (data, allocatable);
+
+  conf (value, pointer)
+  conf (value, allocatable)
+  conf (value, subroutine)
+  conf (value, function)
+  conf (value, volatile_)
+  conf (value, dimension)
+  conf (value, codimension)
+  conf (value, external)
+
+  conf (codimension, result)
+
+  if (attr->value
+      && (attr->intent == INTENT_OUT || attr->intent == INTENT_INOUT))
+    {
+      a1 = value;
+      a2 = attr->intent == INTENT_OUT ? intent_out : intent_inout;
+      goto conflict;
+    }
+
+  conf (is_protected, intrinsic)
+  conf (is_protected, in_common)
+
+  conf (asynchronous, intrinsic)
+  conf (asynchronous, external)
+
+  conf (volatile_, intrinsic)
+  conf (volatile_, external)
+
+  if (attr->volatile_ && attr->intent == INTENT_IN)
+    {
+      a1 = volatile_;
+      a2 = intent_in;
+      goto conflict;
+    }
+
+  conf (procedure, allocatable)
+  conf (procedure, dimension)
+  conf (procedure, codimension)
+  conf (procedure, intrinsic)
+  conf (procedure, target)
+  conf (procedure, value)
+  conf (procedure, volatile_)
+  conf (procedure, asynchronous)
+  conf (procedure, entry)
+
+  a1 = gfc_code2string (flavors, attr->flavor);
+
+  if (attr->in_namelist
+      && attr->flavor != FL_VARIABLE
+      && attr->flavor != FL_PROCEDURE
+      && attr->flavor != FL_UNKNOWN)
+    {
+      a2 = in_namelist;
+      goto conflict;
+    }
+
+  switch (attr->flavor)
+    {
+    case FL_PROGRAM:
+    case FL_BLOCK_DATA:
+    case FL_MODULE:
+    case FL_LABEL:
+      conf2 (codimension);
+      conf2 (dimension);
+      conf2 (dummy);
+      conf2 (volatile_);
+      conf2 (asynchronous);
+      conf2 (contiguous);
+      conf2 (pointer);
+      conf2 (is_protected);
+      conf2 (target);
+      conf2 (external);
+      conf2 (intrinsic);
+      conf2 (allocatable);
+      conf2 (result);
+      conf2 (in_namelist);
+      conf2 (optional);
+      conf2 (function);
+      conf2 (subroutine);
+      conf2 (threadprivate);
+
+      if (attr->access == ACCESS_PUBLIC || attr->access == ACCESS_PRIVATE)
+	{
+	  a2 = attr->access == ACCESS_PUBLIC ? publik : privat;
+	  gfc_error ("%s attribute applied to %s %s at %L", a2, a1,
+	    name, where);
+	  return FAILURE;
+	}
+
+      if (attr->is_bind_c)
+	{
+	  gfc_error_now ("BIND(C) applied to %s %s at %L", a1, name, where);
+	  return FAILURE;
+	}
+
+      break;
+
+    case FL_VARIABLE:
+      break;
+
+    case FL_NAMELIST:
+      conf2 (result);
+      break;
+
+    case FL_PROCEDURE:
+      /* Conflicts with INTENT, SAVE and RESULT will be checked
+	 at resolution stage, see "resolve_fl_procedure".  */
+
+      if (attr->subroutine)
+	{
+	  a1 = subroutine;
+	  conf2 (target);
+	  conf2 (allocatable);
+	  conf2 (volatile_);
+	  conf2 (asynchronous);
+	  conf2 (in_namelist);
+	  conf2 (codimension);
+	  conf2 (dimension);
+	  conf2 (function);
+	  conf2 (threadprivate);
+	}
+
+      if (!attr->proc_pointer)
+	conf2 (in_common);
+
+      switch (attr->proc)
+	{
+	case PROC_ST_FUNCTION:
+	  conf2 (dummy);
+	  break;
+
+	case PROC_MODULE:
+	  conf2 (dummy);
+	  break;
+
+	case PROC_DUMMY:
+	  conf2 (result);
+	  conf2 (threadprivate);
+	  break;
+
+	default:
+	  break;
+	}
+
+      break;
+
+    case FL_DERIVED:
+      conf2 (dummy);
+      conf2 (pointer);
+      conf2 (target);
+      conf2 (external);
+      conf2 (intrinsic);
+      conf2 (allocatable);
+      conf2 (optional);
+      conf2 (entry);
+      conf2 (function);
+      conf2 (subroutine);
+      conf2 (threadprivate);
+      conf2 (result);
+
+      if (attr->intent != INTENT_UNKNOWN)
+	{
+	  a2 = intent;
+	  goto conflict;
+	}
+      break;
+
+    case FL_PARAMETER:
+      conf2 (external);
+      conf2 (intrinsic);
+      conf2 (optional);
+      conf2 (allocatable);
+      conf2 (function);
+      conf2 (subroutine);
+      conf2 (entry);
+      conf2 (contiguous);
+      conf2 (pointer);
+      conf2 (is_protected);
+      conf2 (target);
+      conf2 (dummy);
+      conf2 (in_common);
+      conf2 (value);
+      conf2 (volatile_);
+      conf2 (asynchronous);
+      conf2 (threadprivate);
+      conf2 (value);
+      conf2 (is_bind_c);
+      conf2 (codimension);
+      conf2 (result);
+      break;
+
+    default:
+      break;
+    }
+
+  return SUCCESS;
+
+conflict:
+  if (name == NULL)
+    gfc_error ("%s attribute conflicts with %s attribute at %L",
+	       a1, a2, where);
+  else
+    gfc_error ("%s attribute conflicts with %s attribute in '%s' at %L",
+	       a1, a2, name, where);
+
+  return FAILURE;
+
+conflict_std:
+  if (name == NULL)
+    {
+      return gfc_notify_std (standard, "Fortran 2003: %s attribute "
+                             "with %s attribute at %L", a1, a2,
+                             where);
+    }
+  else
+    {
+      return gfc_notify_std (standard, "Fortran 2003: %s attribute "
+			     "with %s attribute in '%s' at %L",
+                             a1, a2, name, where);
+    }
+}
+
+#undef conf
+#undef conf2
+#undef conf_std
+
+
+/* Mark a symbol as referenced.  */
+
+void
+gfc_set_sym_referenced (gfc_symbol *sym)
+{
+
+  if (sym->attr.referenced)
+    return;
+
+  sym->attr.referenced = 1;
+
+  /* Remember which order dummy variables are accessed in.  */
+  if (sym->attr.dummy)
+    sym->dummy_order = next_dummy_order++;
+}
+
+
+/* Common subroutine called by attribute changing subroutines in order
+   to prevent them from changing a symbol that has been
+   use-associated.  Returns zero if it is OK to change the symbol,
+   nonzero if not.  */
+
+static int
+check_used (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (attr->use_assoc == 0)
+    return 0;
+
+  if (where == NULL)
+    where = &gfc_current_locus;
+
+  if (name == NULL)
+    gfc_error ("Cannot change attributes of USE-associated symbol at %L",
+	       where);
+  else
+    gfc_error ("Cannot change attributes of USE-associated symbol %s at %L",
+	       name, where);
+
+  return 1;
+}
+
+
+/* Generate an error because of a duplicate attribute.  */
+
+static void
+duplicate_attr (const char *attr, locus *where)
+{
+
+  if (where == NULL)
+    where = &gfc_current_locus;
+
+  gfc_error ("Duplicate %s attribute specified at %L", attr, where);
+}
+
+
+gfc_try
+gfc_add_ext_attribute (symbol_attribute *attr, ext_attr_id_t ext_attr,
+		       locus *where ATTRIBUTE_UNUSED)
+{
+  attr->ext_attr |= 1 << ext_attr;
+  return SUCCESS;
+}
+
+
+/* Called from decl.c (attr_decl1) to check attributes, when declared
+   separately.  */
+
+gfc_try
+gfc_add_attribute (symbol_attribute *attr, locus *where)
+{
+  if (check_used (attr, NULL, where))
+    return FAILURE;
+
+  return check_conflict (attr, NULL, where);
+}
+
+
+gfc_try
+gfc_add_allocatable (symbol_attribute *attr, locus *where)
+{
+
+  if (check_used (attr, NULL, where))
+    return FAILURE;
+
+  if (attr->allocatable)
+    {
+      duplicate_attr ("ALLOCATABLE", where);
+      return FAILURE;
+    }
+
+  if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY
+      && gfc_find_state (COMP_INTERFACE) == FAILURE)
+    {
+      gfc_error ("ALLOCATABLE specified outside of INTERFACE body at %L",
+		 where);
+      return FAILURE;
+    }
+
+  attr->allocatable = 1;
+  return check_conflict (attr, NULL, where);
+}
+
+
+gfc_try
+gfc_add_codimension (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  if (attr->codimension)
+    {
+      duplicate_attr ("CODIMENSION", where);
+      return FAILURE;
+    }
+
+  if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY
+      && gfc_find_state (COMP_INTERFACE) == FAILURE)
+    {
+      gfc_error ("CODIMENSION specified for '%s' outside its INTERFACE body "
+		 "at %L", name, where);
+      return FAILURE;
+    }
+
+  attr->codimension = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  if (attr->dimension)
+    {
+      duplicate_attr ("DIMENSION", where);
+      return FAILURE;
+    }
+
+  if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY
+      && gfc_find_state (COMP_INTERFACE) == FAILURE)
+    {
+      gfc_error ("DIMENSION specified for '%s' outside its INTERFACE body "
+		 "at %L", name, where);
+      return FAILURE;
+    }
+
+  attr->dimension = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_contiguous (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  attr->contiguous = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_external (symbol_attribute *attr, locus *where)
+{
+
+  if (check_used (attr, NULL, where))
+    return FAILURE;
+
+  if (attr->external)
+    {
+      duplicate_attr ("EXTERNAL", where);
+      return FAILURE;
+    }
+
+  if (attr->pointer && attr->if_source != IFSRC_IFBODY)
+    {
+      attr->pointer = 0;
+      attr->proc_pointer = 1;
+    }
+
+  attr->external = 1;
+
+  return check_conflict (attr, NULL, where);
+}
+
+
+gfc_try
+gfc_add_intrinsic (symbol_attribute *attr, locus *where)
+{
+
+  if (check_used (attr, NULL, where))
+    return FAILURE;
+
+  if (attr->intrinsic)
+    {
+      duplicate_attr ("INTRINSIC", where);
+      return FAILURE;
+    }
+
+  attr->intrinsic = 1;
+
+  return check_conflict (attr, NULL, where);
+}
+
+
+gfc_try
+gfc_add_optional (symbol_attribute *attr, locus *where)
+{
+
+  if (check_used (attr, NULL, where))
+    return FAILURE;
+
+  if (attr->optional)
+    {
+      duplicate_attr ("OPTIONAL", where);
+      return FAILURE;
+    }
+
+  attr->optional = 1;
+  return check_conflict (attr, NULL, where);
+}
+
+
+gfc_try
+gfc_add_pointer (symbol_attribute *attr, locus *where)
+{
+
+  if (check_used (attr, NULL, where))
+    return FAILURE;
+
+  if (attr->pointer && !(attr->if_source == IFSRC_IFBODY
+      && gfc_find_state (COMP_INTERFACE) == FAILURE))
+    {
+      duplicate_attr ("POINTER", where);
+      return FAILURE;
+    }
+
+  if (attr->procedure || (attr->external && attr->if_source != IFSRC_IFBODY)
+      || (attr->if_source == IFSRC_IFBODY
+      && gfc_find_state (COMP_INTERFACE) == FAILURE))
+    attr->proc_pointer = 1;
+  else
+    attr->pointer = 1;
+
+  return check_conflict (attr, NULL, where);
+}
+
+
+gfc_try
+gfc_add_cray_pointer (symbol_attribute *attr, locus *where)
+{
+
+  if (check_used (attr, NULL, where))
+    return FAILURE;
+
+  attr->cray_pointer = 1;
+  return check_conflict (attr, NULL, where);
+}
+
+
+gfc_try
+gfc_add_cray_pointee (symbol_attribute *attr, locus *where)
+{
+
+  if (check_used (attr, NULL, 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);
+}
+
+
+gfc_try
+gfc_add_protected (symbol_attribute *attr, const char *name, locus *where)
+{
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  if (attr->is_protected)
+    {
+	if (gfc_notify_std (GFC_STD_LEGACY, 
+			    "Duplicate PROTECTED attribute specified at %L",
+			    where) 
+	    == FAILURE)
+	  return FAILURE;
+    }
+
+  attr->is_protected = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_result (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  attr->result = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_save (symbol_attribute *attr, save_state s, const char *name,
+	      locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  if (s == SAVE_EXPLICIT && gfc_pure (NULL))
+    {
+      gfc_error
+	("SAVE attribute at %L cannot be specified in a PURE procedure",
+	 where);
+      return FAILURE;
+    }
+
+  if (s == SAVE_EXPLICIT && gfc_implicit_pure (NULL))
+    gfc_current_ns->proc_name->attr.implicit_pure = 0;
+
+  if (s == SAVE_EXPLICIT && attr->save == SAVE_EXPLICIT)
+    {
+	if (gfc_notify_std (GFC_STD_LEGACY, 
+			    "Duplicate SAVE attribute specified at %L",
+			    where) 
+	    == FAILURE)
+	  return FAILURE;
+    }
+
+  attr->save = s;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_value (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  if (attr->value)
+    {
+	if (gfc_notify_std (GFC_STD_LEGACY, 
+			    "Duplicate VALUE attribute specified at %L",
+			    where) 
+	    == FAILURE)
+	  return FAILURE;
+    }
+
+  attr->value = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_volatile (symbol_attribute *attr, const char *name, locus *where)
+{
+  /* No check_used needed as 11.2.1 of the F2003 standard allows
+     that the local identifier made accessible by a use statement can be
+     given a VOLATILE attribute - unless it is a coarray (F2008, C560).  */
+
+  if (attr->volatile_ && attr->volatile_ns == gfc_current_ns)
+    if (gfc_notify_std (GFC_STD_LEGACY, 
+        		"Duplicate VOLATILE attribute specified at %L", where)
+        == FAILURE)
+      return FAILURE;
+
+  attr->volatile_ = 1;
+  attr->volatile_ns = gfc_current_ns;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_asynchronous (symbol_attribute *attr, const char *name, locus *where)
+{
+  /* No check_used needed as 11.2.1 of the F2003 standard allows
+     that the local identifier made accessible by a use statement can be
+     given a ASYNCHRONOUS attribute.  */
+
+  if (attr->asynchronous && attr->asynchronous_ns == gfc_current_ns)
+    if (gfc_notify_std (GFC_STD_LEGACY, 
+        		"Duplicate ASYNCHRONOUS attribute specified at %L",
+			where) == FAILURE)
+      return FAILURE;
+
+  attr->asynchronous = 1;
+  attr->asynchronous_ns = gfc_current_ns;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  if (attr->threadprivate)
+    {
+      duplicate_attr ("THREADPRIVATE", where);
+      return FAILURE;
+    }
+
+  attr->threadprivate = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_target (symbol_attribute *attr, locus *where)
+{
+
+  if (check_used (attr, NULL, where))
+    return FAILURE;
+
+  if (attr->target)
+    {
+      duplicate_attr ("TARGET", where);
+      return FAILURE;
+    }
+
+  attr->target = 1;
+  return check_conflict (attr, NULL, where);
+}
+
+
+gfc_try
+gfc_add_dummy (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  /* Duplicate dummy arguments are allowed due to ENTRY statements.  */
+  attr->dummy = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_in_common (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  /* Duplicate attribute already checked for.  */
+  attr->in_common = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_in_equivalence (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  /* Duplicate attribute already checked for.  */
+  attr->in_equivalence = 1;
+  if (check_conflict (attr, name, where) == FAILURE)
+    return FAILURE;
+
+  if (attr->flavor == FL_VARIABLE)
+    return SUCCESS;
+
+  return gfc_add_flavor (attr, FL_VARIABLE, name, where);
+}
+
+
+gfc_try
+gfc_add_data (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  attr->data = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_in_namelist (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  attr->in_namelist = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_sequence (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  attr->sequence = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_elemental (symbol_attribute *attr, locus *where)
+{
+
+  if (check_used (attr, NULL, where))
+    return FAILURE;
+
+  if (attr->elemental)
+    {
+      duplicate_attr ("ELEMENTAL", where);
+      return FAILURE;
+    }
+
+  attr->elemental = 1;
+  return check_conflict (attr, NULL, where);
+}
+
+
+gfc_try
+gfc_add_pure (symbol_attribute *attr, locus *where)
+{
+
+  if (check_used (attr, NULL, where))
+    return FAILURE;
+
+  if (attr->pure)
+    {
+      duplicate_attr ("PURE", where);
+      return FAILURE;
+    }
+
+  attr->pure = 1;
+  return check_conflict (attr, NULL, where);
+}
+
+
+gfc_try
+gfc_add_recursive (symbol_attribute *attr, locus *where)
+{
+
+  if (check_used (attr, NULL, where))
+    return FAILURE;
+
+  if (attr->recursive)
+    {
+      duplicate_attr ("RECURSIVE", where);
+      return FAILURE;
+    }
+
+  attr->recursive = 1;
+  return check_conflict (attr, NULL, where);
+}
+
+
+gfc_try
+gfc_add_entry (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  if (attr->entry)
+    {
+      duplicate_attr ("ENTRY", where);
+      return FAILURE;
+    }
+
+  attr->entry = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_function (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (attr->flavor != FL_PROCEDURE
+      && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE)
+    return FAILURE;
+
+  attr->function = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_subroutine (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (attr->flavor != FL_PROCEDURE
+      && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE)
+    return FAILURE;
+
+  attr->subroutine = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_generic (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (attr->flavor != FL_PROCEDURE
+      && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE)
+    return FAILURE;
+
+  attr->generic = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_proc (symbol_attribute *attr, const char *name, locus *where)
+{
+
+  if (check_used (attr, NULL, where))
+    return FAILURE;
+
+  if (attr->flavor != FL_PROCEDURE
+      && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE)
+    return FAILURE;
+
+  if (attr->procedure)
+    {
+      duplicate_attr ("PROCEDURE", where);
+      return FAILURE;
+    }
+
+  attr->procedure = 1;
+
+  return check_conflict (attr, NULL, where);
+}
+
+
+gfc_try
+gfc_add_abstract (symbol_attribute* attr, locus* where)
+{
+  if (attr->abstract)
+    {
+      duplicate_attr ("ABSTRACT", where);
+      return FAILURE;
+    }
+
+  attr->abstract = 1;
+  return SUCCESS;
+}
+
+
+/* Flavors are special because some flavors are not what Fortran
+   considers attributes and can be reaffirmed multiple times.  */
+
+gfc_try
+gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name,
+		locus *where)
+{
+
+  if ((f == FL_PROGRAM || f == FL_BLOCK_DATA || f == FL_MODULE
+       || f == FL_PARAMETER || f == FL_LABEL || f == FL_DERIVED
+       || f == FL_NAMELIST) && check_used (attr, name, where))
+    return FAILURE;
+
+  if (attr->flavor == f && f == FL_VARIABLE)
+    return SUCCESS;
+
+  if (attr->flavor != FL_UNKNOWN)
+    {
+      if (where == NULL)
+	where = &gfc_current_locus;
+
+      if (name)
+        gfc_error ("%s attribute of '%s' conflicts with %s attribute at %L",
+		   gfc_code2string (flavors, attr->flavor), name,
+		   gfc_code2string (flavors, f), where);
+      else
+        gfc_error ("%s attribute conflicts with %s attribute at %L",
+		   gfc_code2string (flavors, attr->flavor),
+		   gfc_code2string (flavors, f), where);
+
+      return FAILURE;
+    }
+
+  attr->flavor = f;
+
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_procedure (symbol_attribute *attr, procedure_type t,
+		   const char *name, locus *where)
+{
+
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  if (attr->flavor != FL_PROCEDURE
+      && gfc_add_flavor (attr, FL_PROCEDURE, name, where) == FAILURE)
+    return FAILURE;
+
+  if (where == NULL)
+    where = &gfc_current_locus;
+
+  if (attr->proc != PROC_UNKNOWN)
+    {
+      gfc_error ("%s procedure at %L is already declared as %s procedure",
+		 gfc_code2string (procedures, t), where,
+		 gfc_code2string (procedures, attr->proc));
+
+      return FAILURE;
+    }
+
+  attr->proc = t;
+
+  /* Statement functions are always scalar and functions.  */
+  if (t == PROC_ST_FUNCTION
+      && ((!attr->function && gfc_add_function (attr, name, where) == FAILURE)
+	  || attr->dimension))
+    return FAILURE;
+
+  return check_conflict (attr, name, where);
+}
+
+
+gfc_try
+gfc_add_intent (symbol_attribute *attr, sym_intent intent, locus *where)
+{
+
+  if (check_used (attr, NULL, where))
+    return FAILURE;
+
+  if (attr->intent == INTENT_UNKNOWN)
+    {
+      attr->intent = intent;
+      return check_conflict (attr, NULL, where);
+    }
+
+  if (where == NULL)
+    where = &gfc_current_locus;
+
+  gfc_error ("INTENT (%s) conflicts with INTENT(%s) at %L",
+	     gfc_intent_string (attr->intent),
+	     gfc_intent_string (intent), where);
+
+  return FAILURE;
+}
+
+
+/* No checks for use-association in public and private statements.  */
+
+gfc_try
+gfc_add_access (symbol_attribute *attr, gfc_access access,
+		const char *name, locus *where)
+{
+
+  if (attr->access == ACCESS_UNKNOWN
+	|| (attr->use_assoc && attr->access != ACCESS_PRIVATE))
+    {
+      attr->access = access;
+      return check_conflict (attr, name, where);
+    }
+
+  if (where == NULL)
+    where = &gfc_current_locus;
+  gfc_error ("ACCESS specification at %L was already specified", where);
+
+  return FAILURE;
+}
+
+
+/* Set the is_bind_c field for the given symbol_attribute.  */
+
+gfc_try
+gfc_add_is_bind_c (symbol_attribute *attr, const char *name, locus *where,
+                   int is_proc_lang_bind_spec)
+{
+
+  if (is_proc_lang_bind_spec == 0 && attr->flavor == FL_PROCEDURE)
+    gfc_error_now ("BIND(C) attribute at %L can only be used for "
+		   "variables or common blocks", where);
+  else if (attr->is_bind_c)
+    gfc_error_now ("Duplicate BIND attribute specified at %L", where);
+  else
+    attr->is_bind_c = 1;
+  
+  if (where == NULL)
+    where = &gfc_current_locus;
+   
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: BIND(C) at %L", where)
+      == FAILURE)
+    return FAILURE;
+
+  return check_conflict (attr, name, where);
+}
+
+
+/* Set the extension field for the given symbol_attribute.  */
+
+gfc_try
+gfc_add_extension (symbol_attribute *attr, locus *where)
+{
+  if (where == NULL)
+    where = &gfc_current_locus;
+
+  if (attr->extension)
+    gfc_error_now ("Duplicate EXTENDS attribute specified at %L", where);
+  else
+    attr->extension = 1;
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: EXTENDS at %L", where)
+	== FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+gfc_try
+gfc_add_explicit_interface (gfc_symbol *sym, ifsrc source,
+			    gfc_formal_arglist * formal, locus *where)
+{
+
+  if (check_used (&sym->attr, sym->name, where))
+    return FAILURE;
+
+  if (where == NULL)
+    where = &gfc_current_locus;
+
+  if (sym->attr.if_source != IFSRC_UNKNOWN
+      && sym->attr.if_source != IFSRC_DECL)
+    {
+      gfc_error ("Symbol '%s' at %L already has an explicit interface",
+		 sym->name, where);
+      return FAILURE;
+    }
+
+  if (source == IFSRC_IFBODY && (sym->attr.dimension || sym->attr.allocatable))
+    {
+      gfc_error ("'%s' at %L has attributes specified outside its INTERFACE "
+		 "body", sym->name, where);
+      return FAILURE;
+    }
+
+  sym->formal = formal;
+  sym->attr.if_source = source;
+
+  return SUCCESS;
+}
+
+
+/* Add a type to a symbol.  */
+
+gfc_try
+gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
+{
+  sym_flavor flavor;
+  bt type;
+
+  if (where == NULL)
+    where = &gfc_current_locus;
+
+  if (sym->result)
+    type = sym->result->ts.type;
+  else
+    type = sym->ts.type;
+
+  if (sym->attr.result && type == BT_UNKNOWN && sym->ns->proc_name)
+    type = sym->ns->proc_name->ts.type;
+
+  if (type != BT_UNKNOWN && !(sym->attr.function && sym->attr.implicit_type))
+    {
+      gfc_error ("Symbol '%s' at %L already has basic type of %s", sym->name,
+		 where, gfc_basic_typename (type));
+      return FAILURE;
+    }
+
+  if (sym->attr.procedure && sym->ts.interface)
+    {
+      gfc_error ("Procedure '%s' at %L may not have basic type of %s",
+		 sym->name, where, gfc_basic_typename (ts->type));
+      return FAILURE;
+    }
+
+  flavor = sym->attr.flavor;
+
+  if (flavor == FL_PROGRAM || flavor == FL_BLOCK_DATA || flavor == FL_MODULE
+      || flavor == FL_LABEL
+      || (flavor == FL_PROCEDURE && sym->attr.subroutine)
+      || flavor == FL_DERIVED || flavor == FL_NAMELIST)
+    {
+      gfc_error ("Symbol '%s' at %L cannot have a type", sym->name, where);
+      return FAILURE;
+    }
+
+  sym->ts = *ts;
+  return SUCCESS;
+}
+
+
+/* Clears all attributes.  */
+
+void
+gfc_clear_attr (symbol_attribute *attr)
+{
+  memset (attr, 0, sizeof (symbol_attribute));
+}
+
+
+/* Check for missing attributes in the new symbol.  Currently does
+   nothing, but it's not clear that it is unnecessary yet.  */
+
+gfc_try
+gfc_missing_attr (symbol_attribute *attr ATTRIBUTE_UNUSED,
+		  locus *where ATTRIBUTE_UNUSED)
+{
+
+  return SUCCESS;
+}
+
+
+/* Copy an attribute to a symbol attribute, bit by bit.  Some
+   attributes have a lot of side-effects but cannot be present given
+   where we are called from, so we ignore some bits.  */
+
+gfc_try
+gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where)
+{
+  int is_proc_lang_bind_spec;
+  
+  /* In line with the other attributes, we only add bits but do not remove
+     them; cf. also PR 41034.  */
+  dest->ext_attr |= src->ext_attr;
+
+  if (src->allocatable && gfc_add_allocatable (dest, where) == FAILURE)
+    goto fail;
+
+  if (src->dimension && gfc_add_dimension (dest, NULL, where) == FAILURE)
+    goto fail;
+  if (src->codimension && gfc_add_codimension (dest, NULL, where) == FAILURE)
+    goto fail;
+  if (src->contiguous && gfc_add_contiguous (dest, NULL, where) == FAILURE)
+    goto fail;
+  if (src->optional && gfc_add_optional (dest, where) == FAILURE)
+    goto fail;
+  if (src->pointer && gfc_add_pointer (dest, where) == FAILURE)
+    goto fail;
+  if (src->is_protected && gfc_add_protected (dest, NULL, where) == FAILURE)
+    goto fail;
+  if (src->save && gfc_add_save (dest, src->save, NULL, where) == FAILURE)
+    goto fail;
+  if (src->value && gfc_add_value (dest, NULL, where) == FAILURE)
+    goto fail;
+  if (src->volatile_ && gfc_add_volatile (dest, NULL, where) == FAILURE)
+    goto fail;
+  if (src->asynchronous && gfc_add_asynchronous (dest, NULL, where) == FAILURE)
+    goto fail;
+  if (src->threadprivate
+      && gfc_add_threadprivate (dest, NULL, where) == FAILURE)
+    goto fail;
+  if (src->target && gfc_add_target (dest, where) == FAILURE)
+    goto fail;
+  if (src->dummy && gfc_add_dummy (dest, NULL, where) == FAILURE)
+    goto fail;
+  if (src->result && gfc_add_result (dest, NULL, where) == FAILURE)
+    goto fail;
+  if (src->entry)
+    dest->entry = 1;
+
+  if (src->in_namelist && gfc_add_in_namelist (dest, NULL, where) == FAILURE)
+    goto fail;
+
+  if (src->in_common && gfc_add_in_common (dest, NULL, where) == FAILURE)
+    goto fail;
+
+  if (src->generic && gfc_add_generic (dest, NULL, where) == FAILURE)
+    goto fail;
+  if (src->function && gfc_add_function (dest, NULL, where) == FAILURE)
+    goto fail;
+  if (src->subroutine && gfc_add_subroutine (dest, NULL, where) == FAILURE)
+    goto fail;
+
+  if (src->sequence && gfc_add_sequence (dest, NULL, where) == FAILURE)
+    goto fail;
+  if (src->elemental && gfc_add_elemental (dest, where) == FAILURE)
+    goto fail;
+  if (src->pure && gfc_add_pure (dest, where) == FAILURE)
+    goto fail;
+  if (src->recursive && gfc_add_recursive (dest, where) == FAILURE)
+    goto fail;
+
+  if (src->flavor != FL_UNKNOWN
+      && gfc_add_flavor (dest, src->flavor, NULL, where) == FAILURE)
+    goto fail;
+
+  if (src->intent != INTENT_UNKNOWN
+      && gfc_add_intent (dest, src->intent, where) == FAILURE)
+    goto fail;
+
+  if (src->access != ACCESS_UNKNOWN
+      && gfc_add_access (dest, src->access, NULL, where) == FAILURE)
+    goto fail;
+
+  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;
+
+  is_proc_lang_bind_spec = (src->flavor == FL_PROCEDURE ? 1 : 0);
+  if (src->is_bind_c
+      && gfc_add_is_bind_c (dest, NULL, where, is_proc_lang_bind_spec)
+	 != SUCCESS)
+    return FAILURE;
+
+  if (src->is_c_interop)
+    dest->is_c_interop = 1;
+  if (src->is_iso_c)
+    dest->is_iso_c = 1;
+  
+  if (src->external && gfc_add_external (dest, where) == FAILURE)
+    goto fail;
+  if (src->intrinsic && gfc_add_intrinsic (dest, where) == FAILURE)
+    goto fail;
+  if (src->proc_pointer)
+    dest->proc_pointer = 1;
+
+  return SUCCESS;
+
+fail:
+  return FAILURE;
+}
+
+
+/************** Component name management ************/
+
+/* Component names of a derived type form their own little namespaces
+   that are separate from all other spaces.  The space is composed of
+   a singly linked list of gfc_component structures whose head is
+   located in the parent symbol.  */
+
+
+/* Add a component name to a symbol.  The call fails if the name is
+   already present.  On success, the component pointer is modified to
+   point to the additional component structure.  */
+
+gfc_try
+gfc_add_component (gfc_symbol *sym, const char *name,
+		   gfc_component **component)
+{
+  gfc_component *p, *tail;
+
+  tail = NULL;
+
+  for (p = sym->components; p; p = p->next)
+    {
+      if (strcmp (p->name, name) == 0)
+	{
+	  gfc_error ("Component '%s' at %C already declared at %L",
+		     name, &p->loc);
+	  return FAILURE;
+	}
+
+      tail = p;
+    }
+
+  if (sym->attr.extension
+	&& gfc_find_component (sym->components->ts.u.derived, name, true, true))
+    {
+      gfc_error ("Component '%s' at %C already in the parent type "
+		 "at %L", name, &sym->components->ts.u.derived->declared_at);
+      return FAILURE;
+    }
+
+  /* Allocate a new component.  */
+  p = gfc_get_component ();
+
+  if (tail == NULL)
+    sym->components = p;
+  else
+    tail->next = p;
+
+  p->name = gfc_get_string (name);
+  p->loc = gfc_current_locus;
+  p->ts.type = BT_UNKNOWN;
+
+  *component = p;
+  return SUCCESS;
+}
+
+
+/* Recursive function to switch derived types of all symbol in a
+   namespace.  */
+
+static void
+switch_types (gfc_symtree *st, gfc_symbol *from, gfc_symbol *to)
+{
+  gfc_symbol *sym;
+
+  if (st == NULL)
+    return;
+
+  sym = st->n.sym;
+  if (sym->ts.type == BT_DERIVED && sym->ts.u.derived == from)
+    sym->ts.u.derived = to;
+
+  switch_types (st->left, from, to);
+  switch_types (st->right, from, to);
+}
+
+
+/* This subroutine is called when a derived type is used in order to
+   make the final determination about which version to use.  The
+   standard requires that a type be defined before it is 'used', but
+   such types can appear in IMPLICIT statements before the actual
+   definition.  'Using' in this context means declaring a variable to
+   be that type or using the type constructor.
+
+   If a type is used and the components haven't been defined, then we
+   have to have a derived type in a parent unit.  We find the node in
+   the other namespace and point the symtree node in this namespace to
+   that node.  Further reference to this name point to the correct
+   node.  If we can't find the node in a parent namespace, then we have
+   an error.
+
+   This subroutine takes a pointer to a symbol node and returns a
+   pointer to the translated node or NULL for an error.  Usually there
+   is no translation and we return the node we were passed.  */
+
+gfc_symbol *
+gfc_use_derived (gfc_symbol *sym)
+{
+  gfc_symbol *s;
+  gfc_typespec *t;
+  gfc_symtree *st;
+  int i;
+
+  if (sym->components != NULL || sym->attr.zero_comp)
+    return sym;               /* Already defined.  */
+
+  if (sym->ns->parent == NULL)
+    goto bad;
+
+  if (gfc_find_symbol (sym->name, sym->ns->parent, 1, &s))
+    {
+      gfc_error ("Symbol '%s' at %C is ambiguous", sym->name);
+      return NULL;
+    }
+
+  if (s == NULL || s->attr.flavor != FL_DERIVED)
+    goto bad;
+
+  /* Get rid of symbol sym, translating all references to s.  */
+  for (i = 0; i < GFC_LETTERS; i++)
+    {
+      t = &sym->ns->default_type[i];
+      if (t->u.derived == sym)
+	t->u.derived = s;
+    }
+
+  st = gfc_find_symtree (sym->ns->sym_root, sym->name);
+  st->n.sym = s;
+
+  s->refs++;
+
+  /* Unlink from list of modified symbols.  */
+  gfc_commit_symbol (sym);
+
+  switch_types (sym->ns->sym_root, sym, s);
+
+  /* TODO: Also have to replace sym -> s in other lists like
+     namelists, common lists and interface lists.  */
+  gfc_free_symbol (sym);
+
+  return s;
+
+bad:
+  gfc_error ("Derived type '%s' at %C is being used before it is defined",
+	     sym->name);
+  return NULL;
+}
+
+
+/* Given a derived type node and a component name, try to locate the
+   component structure.  Returns the NULL pointer if the component is
+   not found or the components are private.  If noaccess is set, no access
+   checks are done.  */
+
+gfc_component *
+gfc_find_component (gfc_symbol *sym, const char *name,
+		    bool noaccess, bool silent)
+{
+  gfc_component *p;
+
+  if (name == NULL || sym == NULL)
+    return NULL;
+
+  sym = gfc_use_derived (sym);
+
+  if (sym == NULL)
+    return NULL;
+
+  for (p = sym->components; p; p = p->next)
+    if (strcmp (p->name, name) == 0)
+      break;
+
+  if (p == NULL
+	&& sym->attr.extension
+	&& sym->components->ts.type == BT_DERIVED)
+    {
+      p = gfc_find_component (sym->components->ts.u.derived, name,
+			      noaccess, silent);
+      /* Do not overwrite the error.  */
+      if (p == NULL)
+	return p;
+    }
+
+  if (p == NULL && !silent)
+    gfc_error ("'%s' at %C is not a member of the '%s' structure",
+	       name, sym->name);
+
+  else if (sym->attr.use_assoc && !noaccess)
+    {
+      bool is_parent_comp = sym->attr.extension && (p == sym->components);
+      if (p->attr.access == ACCESS_PRIVATE ||
+	  (p->attr.access != ACCESS_PUBLIC
+	   && sym->component_access == ACCESS_PRIVATE
+	   && !is_parent_comp))
+	{
+	  if (!silent)
+	    gfc_error ("Component '%s' at %C is a PRIVATE component of '%s'",
+		       name, sym->name);
+	  return NULL;
+	}
+    }
+
+  return p;
+}
+
+
+/* Given a symbol, free all of the component structures and everything
+   they point to.  */
+
+static void
+free_components (gfc_component *p)
+{
+  gfc_component *q;
+
+  for (; p; p = q)
+    {
+      q = p->next;
+
+      gfc_free_array_spec (p->as);
+      gfc_free_expr (p->initializer);
+
+      gfc_free_formal_arglist (p->formal);
+      gfc_free_namespace (p->formal_ns);
+
+      gfc_free (p);
+    }
+}
+
+
+/******************** Statement label management ********************/
+
+/* Comparison function for statement labels, used for managing the
+   binary tree.  */
+
+static int
+compare_st_labels (void *a1, void *b1)
+{
+  int a = ((gfc_st_label *) a1)->value;
+  int b = ((gfc_st_label *) b1)->value;
+
+  return (b - a);
+}
+
+
+/* Free a single gfc_st_label structure, making sure the tree is not
+   messed up.  This function is called only when some parse error
+   occurs.  */
+
+void
+gfc_free_st_label (gfc_st_label *label)
+{
+
+  if (label == NULL)
+    return;
+
+  gfc_delete_bbt (&gfc_current_ns->st_labels, label, compare_st_labels);
+
+  if (label->format != NULL)
+    gfc_free_expr (label->format);
+
+  gfc_free (label);
+}
+
+
+/* Free a whole tree of gfc_st_label structures.  */
+
+static void
+free_st_labels (gfc_st_label *label)
+{
+
+  if (label == NULL)
+    return;
+
+  free_st_labels (label->left);
+  free_st_labels (label->right);
+  
+  if (label->format != NULL)
+    gfc_free_expr (label->format);
+  gfc_free (label);
+}
+
+
+/* Given a label number, search for and return a pointer to the label
+   structure, creating it if it does not exist.  */
+
+gfc_st_label *
+gfc_get_st_label (int labelno)
+{
+  gfc_st_label *lp;
+  gfc_namespace *ns;
+
+  /* Find the namespace of the scoping unit:
+     If we're in a BLOCK construct, jump to the parent namespace.  */
+  ns = gfc_current_ns;
+  while (ns->proc_name && ns->proc_name->attr.flavor == FL_LABEL)
+    ns = ns->parent;
+
+  /* First see if the label is already in this namespace.  */
+  lp = ns->st_labels;
+  while (lp)
+    {
+      if (lp->value == labelno)
+	return lp;
+
+      if (lp->value < labelno)
+	lp = lp->left;
+      else
+	lp = lp->right;
+    }
+
+  lp = XCNEW (gfc_st_label);
+
+  lp->value = labelno;
+  lp->defined = ST_LABEL_UNKNOWN;
+  lp->referenced = ST_LABEL_UNKNOWN;
+
+  gfc_insert_bbt (&ns->st_labels, lp, compare_st_labels);
+
+  return lp;
+}
+
+
+/* Called when a statement with a statement label is about to be
+   accepted.  We add the label to the list of the current namespace,
+   making sure it hasn't been defined previously and referenced
+   correctly.  */
+
+void
+gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus)
+{
+  int labelno;
+
+  labelno = lp->value;
+
+  if (lp->defined != ST_LABEL_UNKNOWN)
+    gfc_error ("Duplicate statement label %d at %L and %L", labelno,
+	       &lp->where, label_locus);
+  else
+    {
+      lp->where = *label_locus;
+
+      switch (type)
+	{
+	case ST_LABEL_FORMAT:
+	  if (lp->referenced == ST_LABEL_TARGET)
+	    gfc_error ("Label %d at %C already referenced as branch target",
+		       labelno);
+	  else
+	    lp->defined = ST_LABEL_FORMAT;
+
+	  break;
+
+	case ST_LABEL_TARGET:
+	  if (lp->referenced == ST_LABEL_FORMAT)
+	    gfc_error ("Label %d at %C already referenced as a format label",
+		       labelno);
+	  else
+	    lp->defined = ST_LABEL_TARGET;
+
+	  break;
+
+	default:
+	  lp->defined = ST_LABEL_BAD_TARGET;
+	  lp->referenced = ST_LABEL_BAD_TARGET;
+	}
+    }
+}
+
+
+/* Reference a label.  Given a label and its type, see if that
+   reference is consistent with what is known about that label,
+   updating the unknown state.  Returns FAILURE if something goes
+   wrong.  */
+
+gfc_try
+gfc_reference_st_label (gfc_st_label *lp, gfc_sl_type type)
+{
+  gfc_sl_type label_type;
+  int labelno;
+  gfc_try rc;
+
+  if (lp == NULL)
+    return SUCCESS;
+
+  labelno = lp->value;
+
+  if (lp->defined != ST_LABEL_UNKNOWN)
+    label_type = lp->defined;
+  else
+    {
+      label_type = lp->referenced;
+      lp->where = gfc_current_locus;
+    }
+
+  if (label_type == ST_LABEL_FORMAT && type == ST_LABEL_TARGET)
+    {
+      gfc_error ("Label %d at %C previously used as a FORMAT label", labelno);
+      rc = FAILURE;
+      goto done;
+    }
+
+  if ((label_type == ST_LABEL_TARGET || label_type == ST_LABEL_BAD_TARGET)
+      && type == ST_LABEL_FORMAT)
+    {
+      gfc_error ("Label %d at %C previously used as branch target", labelno);
+      rc = FAILURE;
+      goto done;
+    }
+
+  lp->referenced = type;
+  rc = SUCCESS;
+
+done:
+  return rc;
+}
+
+
+/************** Symbol table management subroutines ****************/
+
+/* Basic details: Fortran 95 requires a potentially unlimited number
+   of distinct namespaces when compiling a program unit.  This case
+   occurs during a compilation of internal subprograms because all of
+   the internal subprograms must be read before we can start
+   generating code for the host.
+
+   Given the tricky nature of the Fortran grammar, we must be able to
+   undo changes made to a symbol table if the current interpretation
+   of a statement is found to be incorrect.  Whenever a symbol is
+   looked up, we make a copy of it and link to it.  All of these
+   symbols are kept in a singly linked list so that we can commit or
+   undo the changes at a later time.
+
+   A symtree may point to a symbol node outside of its namespace.  In
+   this case, that symbol has been used as a host associated variable
+   at some previous time.  */
+
+/* Allocate a new namespace structure.  Copies the implicit types from
+   PARENT if PARENT_TYPES is set.  */
+
+gfc_namespace *
+gfc_get_namespace (gfc_namespace *parent, int parent_types)
+{
+  gfc_namespace *ns;
+  gfc_typespec *ts;
+  int in;
+  int i;
+
+  ns = XCNEW (gfc_namespace);
+  ns->sym_root = NULL;
+  ns->uop_root = NULL;
+  ns->tb_sym_root = NULL;
+  ns->finalizers = NULL;
+  ns->default_access = ACCESS_UNKNOWN;
+  ns->parent = parent;
+
+  for (in = GFC_INTRINSIC_BEGIN; in != GFC_INTRINSIC_END; in++)
+    {
+      ns->operator_access[in] = ACCESS_UNKNOWN;
+      ns->tb_op[in] = NULL;
+    }
+
+  /* Initialize default implicit types.  */
+  for (i = 'a'; i <= 'z'; i++)
+    {
+      ns->set_flag[i - 'a'] = 0;
+      ts = &ns->default_type[i - 'a'];
+
+      if (parent_types && ns->parent != NULL)
+	{
+	  /* Copy parent settings.  */
+	  *ts = ns->parent->default_type[i - 'a'];
+	  continue;
+	}
+
+      if (gfc_option.flag_implicit_none != 0)
+	{
+	  gfc_clear_ts (ts);
+	  continue;
+	}
+
+      if ('i' <= i && i <= 'n')
+	{
+	  ts->type = BT_INTEGER;
+	  ts->kind = gfc_default_integer_kind;
+	}
+      else
+	{
+	  ts->type = BT_REAL;
+	  ts->kind = gfc_default_real_kind;
+	}
+    }
+
+  ns->refs = 1;
+
+  return ns;
+}
+
+
+/* Comparison function for symtree nodes.  */
+
+static int
+compare_symtree (void *_st1, void *_st2)
+{
+  gfc_symtree *st1, *st2;
+
+  st1 = (gfc_symtree *) _st1;
+  st2 = (gfc_symtree *) _st2;
+
+  return strcmp (st1->name, st2->name);
+}
+
+
+/* Allocate a new symtree node and associate it with the new symbol.  */
+
+gfc_symtree *
+gfc_new_symtree (gfc_symtree **root, const char *name)
+{
+  gfc_symtree *st;
+
+  st = XCNEW (gfc_symtree);
+  st->name = gfc_get_string (name);
+
+  gfc_insert_bbt (root, st, compare_symtree);
+  return st;
+}
+
+
+/* Delete a symbol from the tree.  Does not free the symbol itself!  */
+
+void
+gfc_delete_symtree (gfc_symtree **root, const char *name)
+{
+  gfc_symtree st, *st0;
+
+  st0 = gfc_find_symtree (*root, name);
+
+  st.name = gfc_get_string (name);
+  gfc_delete_bbt (root, &st, compare_symtree);
+
+  gfc_free (st0);
+}
+
+
+/* Given a root symtree node and a name, try to find the symbol within
+   the namespace.  Returns NULL if the symbol is not found.  */
+
+gfc_symtree *
+gfc_find_symtree (gfc_symtree *st, const char *name)
+{
+  int c;
+
+  while (st != NULL)
+    {
+      c = strcmp (name, st->name);
+      if (c == 0)
+	return st;
+
+      st = (c < 0) ? st->left : st->right;
+    }
+
+  return NULL;
+}
+
+
+/* Return a symtree node with a name that is guaranteed to be unique
+   within the namespace and corresponds to an illegal fortran name.  */
+
+gfc_symtree *
+gfc_get_unique_symtree (gfc_namespace *ns)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  static int serial = 0;
+
+  sprintf (name, "@%d", serial++);
+  return gfc_new_symtree (&ns->sym_root, name);
+}
+
+
+/* Given a name find a user operator node, creating it if it doesn't
+   exist.  These are much simpler than symbols because they can't be
+   ambiguous with one another.  */
+
+gfc_user_op *
+gfc_get_uop (const char *name)
+{
+  gfc_user_op *uop;
+  gfc_symtree *st;
+
+  st = gfc_find_symtree (gfc_current_ns->uop_root, name);
+  if (st != NULL)
+    return st->n.uop;
+
+  st = gfc_new_symtree (&gfc_current_ns->uop_root, name);
+
+  uop = st->n.uop = XCNEW (gfc_user_op);
+  uop->name = gfc_get_string (name);
+  uop->access = ACCESS_UNKNOWN;
+  uop->ns = gfc_current_ns;
+
+  return uop;
+}
+
+
+/* Given a name find the user operator node.  Returns NULL if it does
+   not exist.  */
+
+gfc_user_op *
+gfc_find_uop (const char *name, gfc_namespace *ns)
+{
+  gfc_symtree *st;
+
+  if (ns == NULL)
+    ns = gfc_current_ns;
+
+  st = gfc_find_symtree (ns->uop_root, name);
+  return (st == NULL) ? NULL : st->n.uop;
+}
+
+
+/* Remove a gfc_symbol structure and everything it points to.  */
+
+void
+gfc_free_symbol (gfc_symbol *sym)
+{
+
+  if (sym == NULL)
+    return;
+
+  gfc_free_array_spec (sym->as);
+
+  free_components (sym->components);
+
+  gfc_free_expr (sym->value);
+
+  gfc_free_namelist (sym->namelist);
+
+  gfc_free_namespace (sym->formal_ns);
+
+  if (!sym->attr.generic_copy)
+    gfc_free_interface (sym->generic);
+
+  gfc_free_formal_arglist (sym->formal);
+
+  gfc_free_namespace (sym->f2k_derived);
+
+  gfc_free (sym);
+}
+
+
+/* Decrease the reference counter and free memory when we reach zero.  */
+
+void
+gfc_release_symbol (gfc_symbol *sym)
+{
+  if (sym == NULL)
+    return;
+
+  if (sym->formal_ns != NULL && sym->refs == 2)
+    {
+      /* As formal_ns contains a reference to sym, delete formal_ns just
+	 before the deletion of sym.  */
+      gfc_namespace *ns = sym->formal_ns;
+      sym->formal_ns = NULL;
+      gfc_free_namespace (ns);
+    }
+
+  sym->refs--;
+  if (sym->refs > 0)
+    return;
+
+  gcc_assert (sym->refs == 0);
+  gfc_free_symbol (sym);
+}
+
+
+/* Allocate and initialize a new symbol node.  */
+
+gfc_symbol *
+gfc_new_symbol (const char *name, gfc_namespace *ns)
+{
+  gfc_symbol *p;
+
+  p = XCNEW (gfc_symbol);
+
+  gfc_clear_ts (&p->ts);
+  gfc_clear_attr (&p->attr);
+  p->ns = ns;
+
+  p->declared_at = gfc_current_locus;
+
+  if (strlen (name) > GFC_MAX_SYMBOL_LEN)
+    gfc_internal_error ("new_symbol(): Symbol name too long");
+
+  p->name = gfc_get_string (name);
+
+  /* Make sure flags for symbol being C bound are clear initially.  */
+  p->attr.is_bind_c = 0;
+  p->attr.is_iso_c = 0;
+  /* Make sure the binding label field has a Nul char to start.  */
+  p->binding_label[0] = '\0';
+
+  /* Clear the ptrs we may need.  */
+  p->common_block = NULL;
+  p->f2k_derived = NULL;
+  p->assoc = NULL;
+  
+  return p;
+}
+
+
+/* Generate an error if a symbol is ambiguous.  */
+
+static void
+ambiguous_symbol (const char *name, gfc_symtree *st)
+{
+
+  if (st->n.sym->module)
+    gfc_error ("Name '%s' at %C is an ambiguous reference to '%s' "
+	       "from module '%s'", name, st->n.sym->name, st->n.sym->module);
+  else
+    gfc_error ("Name '%s' at %C is an ambiguous reference to '%s' "
+	       "from current program unit", name, st->n.sym->name);
+}
+
+
+/* If we're in a SELECT TYPE block, check if the variable 'st' matches any
+   selector on the stack. If yes, replace it by the corresponding temporary.  */
+
+static void
+select_type_insert_tmp (gfc_symtree **st)
+{
+  gfc_select_type_stack *stack = select_type_stack;
+  for (; stack; stack = stack->prev)
+    if ((*st)->n.sym == stack->selector && stack->tmp)
+      *st = stack->tmp;
+}
+
+
+/* Look for a symtree in the current procedure -- that is, go up to
+   parent namespaces but only if inside a BLOCK.  Returns NULL if not found.  */
+
+gfc_symtree*
+gfc_find_symtree_in_proc (const char* name, gfc_namespace* ns)
+{
+  while (ns)
+    {
+      gfc_symtree* st = gfc_find_symtree (ns->sym_root, name);
+      if (st)
+	return st;
+
+      if (!ns->construct_entities)
+	break;
+      ns = ns->parent;
+    }
+
+  return NULL;
+}
+
+
+/* Search for a symtree starting in the current namespace, resorting to
+   any parent namespaces if requested by a nonzero parent_flag.
+   Returns nonzero if the name is ambiguous.  */
+
+int
+gfc_find_sym_tree (const char *name, gfc_namespace *ns, int parent_flag,
+		   gfc_symtree **result)
+{
+  gfc_symtree *st;
+
+  if (ns == NULL)
+    ns = gfc_current_ns;
+
+  do
+    {
+      st = gfc_find_symtree (ns->sym_root, name);
+      if (st != NULL)
+	{
+	  select_type_insert_tmp (&st);
+
+	  *result = st;
+	  /* Ambiguous generic interfaces are permitted, as long
+	     as the specific interfaces are different.  */
+	  if (st->ambiguous && !st->n.sym->attr.generic)
+	    {
+	      ambiguous_symbol (name, st);
+	      return 1;
+	    }
+
+	  return 0;
+	}
+
+      if (!parent_flag)
+	break;
+
+      ns = ns->parent;
+    }
+  while (ns != NULL);
+
+  *result = NULL;
+  return 0;
+}
+
+
+/* Same, but returns the symbol instead.  */
+
+int
+gfc_find_symbol (const char *name, gfc_namespace *ns, int parent_flag,
+		 gfc_symbol **result)
+{
+  gfc_symtree *st;
+  int i;
+
+  i = gfc_find_sym_tree (name, ns, parent_flag, &st);
+
+  if (st == NULL)
+    *result = NULL;
+  else
+    *result = st->n.sym;
+
+  return i;
+}
+
+
+/* Save symbol with the information necessary to back it out.  */
+
+static void
+save_symbol_data (gfc_symbol *sym)
+{
+
+  if (sym->gfc_new || sym->old_symbol != NULL)
+    return;
+
+  sym->old_symbol = XCNEW (gfc_symbol);
+  *(sym->old_symbol) = *sym;
+
+  sym->tlink = changed_syms;
+  changed_syms = sym;
+}
+
+
+/* Given a name, find a symbol, or create it if it does not exist yet
+   in the current namespace.  If the symbol is found we make sure that
+   it's OK.
+
+   The integer return code indicates
+     0   All OK
+     1   The symbol name was ambiguous
+     2   The name meant to be established was already host associated.
+
+   So if the return value is nonzero, then an error was issued.  */
+
+int
+gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result,
+		  bool allow_subroutine)
+{
+  gfc_symtree *st;
+  gfc_symbol *p;
+
+  /* This doesn't usually happen during resolution.  */
+  if (ns == NULL)
+    ns = gfc_current_ns;
+
+  /* Try to find the symbol in ns.  */
+  st = gfc_find_symtree (ns->sym_root, name);
+
+  if (st == NULL)
+    {
+      /* If not there, create a new symbol.  */
+      p = gfc_new_symbol (name, ns);
+
+      /* Add to the list of tentative symbols.  */
+      p->old_symbol = NULL;
+      p->tlink = changed_syms;
+      p->mark = 1;
+      p->gfc_new = 1;
+      changed_syms = p;
+
+      st = gfc_new_symtree (&ns->sym_root, name);
+      st->n.sym = p;
+      p->refs++;
+
+    }
+  else
+    {
+      /* Make sure the existing symbol is OK.  Ambiguous
+	 generic interfaces are permitted, as long as the
+	 specific interfaces are different.  */
+      if (st->ambiguous && !st->n.sym->attr.generic)
+	{
+	  ambiguous_symbol (name, st);
+	  return 1;
+	}
+
+      p = st->n.sym;
+      if (p->ns != ns && (!p->attr.function || ns->proc_name != p)
+	  && !(allow_subroutine && p->attr.subroutine)
+	  && !(ns->proc_name && ns->proc_name->attr.if_source == IFSRC_IFBODY
+	  && (ns->has_import_set || p->attr.imported)))
+	{
+	  /* Symbol is from another namespace.  */
+	  gfc_error ("Symbol '%s' at %C has already been host associated",
+		     name);
+	  return 2;
+	}
+
+      p->mark = 1;
+
+      /* Copy in case this symbol is changed.  */
+      save_symbol_data (p);
+    }
+
+  *result = st;
+  return 0;
+}
+
+
+int
+gfc_get_symbol (const char *name, gfc_namespace *ns, gfc_symbol **result)
+{
+  gfc_symtree *st;
+  int i;
+
+  i = gfc_get_sym_tree (name, ns, &st, false);
+  if (i != 0)
+    return i;
+
+  if (st)
+    *result = st->n.sym;
+  else
+    *result = NULL;
+  return i;
+}
+
+
+/* Subroutine that searches for a symbol, creating it if it doesn't
+   exist, but tries to host-associate the symbol if possible.  */
+
+int
+gfc_get_ha_sym_tree (const char *name, gfc_symtree **result)
+{
+  gfc_symtree *st;
+  int i;
+
+  i = gfc_find_sym_tree (name, gfc_current_ns, 0, &st);
+
+  if (st != NULL)
+    {
+      save_symbol_data (st->n.sym);
+      *result = st;
+      return i;
+    }
+
+  if (gfc_current_ns->parent != NULL)
+    {
+      i = gfc_find_sym_tree (name, gfc_current_ns->parent, 1, &st);
+      if (i)
+	return i;
+
+      if (st != NULL)
+	{
+	  *result = st;
+	  return 0;
+	}
+    }
+
+  return gfc_get_sym_tree (name, gfc_current_ns, result, false);
+}
+
+
+int
+gfc_get_ha_symbol (const char *name, gfc_symbol **result)
+{
+  int i;
+  gfc_symtree *st;
+
+  i = gfc_get_ha_sym_tree (name, &st);
+
+  if (st)
+    *result = st->n.sym;
+  else
+    *result = NULL;
+
+  return i;
+}
+
+/* Undoes all the changes made to symbols in the current statement.
+   This subroutine is made simpler due to the fact that attributes are
+   never removed once added.  */
+
+void
+gfc_undo_symbols (void)
+{
+  gfc_symbol *p, *q, *old;
+  tentative_tbp *tbp, *tbq;
+
+  for (p = changed_syms; p; p = q)
+    {
+      q = p->tlink;
+
+      if (p->gfc_new)
+	{
+	  /* Symbol was new.  */
+	  if (p->attr.in_common && p->common_block && p->common_block->head)
+	    {
+	      /* If the symbol was added to any common block, it
+		 needs to be removed to stop the resolver looking
+		 for a (possibly) dead symbol.  */
+
+	      if (p->common_block->head == p)
+	        p->common_block->head = p->common_next;
+	      else
+		{
+		  gfc_symbol *cparent, *csym;
+
+		  cparent = p->common_block->head;
+		  csym = cparent->common_next;
+
+		  while (csym != p)
+		    {
+		      cparent = csym;
+		      csym = csym->common_next;
+		    }
+
+		  gcc_assert(cparent->common_next == p);
+
+		  cparent->common_next = csym->common_next;
+		}
+	    }
+
+	  gfc_delete_symtree (&p->ns->sym_root, p->name);
+
+	  gfc_release_symbol (p);
+	  continue;
+	}
+
+      /* Restore previous state of symbol.  Just copy simple stuff.  */
+      p->mark = 0;
+      old = p->old_symbol;
+
+      p->ts.type = old->ts.type;
+      p->ts.kind = old->ts.kind;
+
+      p->attr = old->attr;
+
+      if (p->value != old->value)
+	{
+	  gfc_free_expr (old->value);
+	  p->value = NULL;
+	}
+
+      if (p->as != old->as)
+	{
+	  if (p->as)
+	    gfc_free_array_spec (p->as);
+	  p->as = old->as;
+	}
+
+      p->generic = old->generic;
+      p->component_access = old->component_access;
+
+      if (p->namelist != NULL && old->namelist == NULL)
+	{
+	  gfc_free_namelist (p->namelist);
+	  p->namelist = NULL;
+	}
+      else
+	{
+	  if (p->namelist_tail != old->namelist_tail)
+	    {
+	      gfc_free_namelist (old->namelist_tail);
+	      old->namelist_tail->next = NULL;
+	    }
+	}
+
+      p->namelist_tail = old->namelist_tail;
+
+      if (p->formal != old->formal)
+	{
+	  gfc_free_formal_arglist (p->formal);
+	  p->formal = old->formal;
+	}
+
+      gfc_free (p->old_symbol);
+      p->old_symbol = NULL;
+      p->tlink = NULL;
+    }
+
+  changed_syms = NULL;
+
+  for (tbp = tentative_tbp_list; tbp; tbp = tbq)
+    {
+      tbq = tbp->next;
+      /* Procedure is already marked `error' by default.  */
+      gfc_free (tbp);
+    }
+  tentative_tbp_list = NULL;
+}
+
+
+/* Free sym->old_symbol. sym->old_symbol is mostly a shallow copy of sym; the
+   components of old_symbol that might need deallocation are the "allocatables"
+   that are restored in gfc_undo_symbols(), with two exceptions: namelist and
+   namelist_tail.  In case these differ between old_symbol and sym, it's just
+   because sym->namelist has gotten a few more items.  */
+
+static void
+free_old_symbol (gfc_symbol *sym)
+{
+
+  if (sym->old_symbol == NULL)
+    return;
+
+  if (sym->old_symbol->as != sym->as) 
+    gfc_free_array_spec (sym->old_symbol->as);
+
+  if (sym->old_symbol->value != sym->value) 
+    gfc_free_expr (sym->old_symbol->value);
+
+  if (sym->old_symbol->formal != sym->formal)
+    gfc_free_formal_arglist (sym->old_symbol->formal);
+
+  gfc_free (sym->old_symbol);
+  sym->old_symbol = NULL;
+}
+
+
+/* Makes the changes made in the current statement permanent-- gets
+   rid of undo information.  */
+
+void
+gfc_commit_symbols (void)
+{
+  gfc_symbol *p, *q;
+  tentative_tbp *tbp, *tbq;
+
+  for (p = changed_syms; p; p = q)
+    {
+      q = p->tlink;
+      p->tlink = NULL;
+      p->mark = 0;
+      p->gfc_new = 0;
+      free_old_symbol (p);
+    }
+  changed_syms = NULL;
+
+  for (tbp = tentative_tbp_list; tbp; tbp = tbq)
+    {
+      tbq = tbp->next;
+      tbp->proc->error = 0;
+      gfc_free (tbp);
+    }
+  tentative_tbp_list = NULL;
+}
+
+
+/* Makes the changes made in one symbol permanent -- gets rid of undo
+   information.  */
+
+void
+gfc_commit_symbol (gfc_symbol *sym)
+{
+  gfc_symbol *p;
+
+  if (changed_syms == sym)
+    changed_syms = sym->tlink;
+  else
+    {
+      for (p = changed_syms; p; p = p->tlink)
+        if (p->tlink == sym)
+          {
+            p->tlink = sym->tlink;
+            break;
+          }
+    }
+
+  sym->tlink = NULL;
+  sym->mark = 0;
+  sym->gfc_new = 0;
+
+  free_old_symbol (sym);
+}
+
+
+/* Recursively free trees containing type-bound procedures.  */
+
+static void
+free_tb_tree (gfc_symtree *t)
+{
+  if (t == NULL)
+    return;
+
+  free_tb_tree (t->left);
+  free_tb_tree (t->right);
+
+  /* TODO: Free type-bound procedure structs themselves; probably needs some
+     sort of ref-counting mechanism.  */
+
+  gfc_free (t);
+}
+
+
+/* Recursive function that deletes an entire tree and all the common
+   head structures it points to.  */
+
+static void
+free_common_tree (gfc_symtree * common_tree)
+{
+  if (common_tree == NULL)
+    return;
+
+  free_common_tree (common_tree->left);
+  free_common_tree (common_tree->right);
+
+  gfc_free (common_tree);
+}  
+
+
+/* Recursive function that deletes an entire tree and all the user
+   operator nodes that it contains.  */
+
+static void
+free_uop_tree (gfc_symtree *uop_tree)
+{
+  if (uop_tree == NULL)
+    return;
+
+  free_uop_tree (uop_tree->left);
+  free_uop_tree (uop_tree->right);
+
+  gfc_free_interface (uop_tree->n.uop->op);
+  gfc_free (uop_tree->n.uop);
+  gfc_free (uop_tree);
+}
+
+
+/* Recursive function that deletes an entire tree and all the symbols
+   that it contains.  */
+
+static void
+free_sym_tree (gfc_symtree *sym_tree)
+{
+  if (sym_tree == NULL)
+    return;
+
+  free_sym_tree (sym_tree->left);
+  free_sym_tree (sym_tree->right);
+
+  gfc_release_symbol (sym_tree->n.sym);
+  gfc_free (sym_tree);
+}
+
+
+/* Free the derived type list.  */
+
+void
+gfc_free_dt_list (void)
+{
+  gfc_dt_list *dt, *n;
+
+  for (dt = gfc_derived_types; dt; dt = n)
+    {
+      n = dt->next;
+      gfc_free (dt);
+    }
+
+  gfc_derived_types = NULL;
+}
+
+
+/* Free the gfc_equiv_info's.  */
+
+static void
+gfc_free_equiv_infos (gfc_equiv_info *s)
+{
+  if (s == NULL)
+    return;
+  gfc_free_equiv_infos (s->next);
+  gfc_free (s);
+}
+
+
+/* Free the gfc_equiv_lists.  */
+
+static void
+gfc_free_equiv_lists (gfc_equiv_list *l)
+{
+  if (l == NULL)
+    return;
+  gfc_free_equiv_lists (l->next);
+  gfc_free_equiv_infos (l->equiv);
+  gfc_free (l);
+}
+
+
+/* Free a finalizer procedure list.  */
+
+void
+gfc_free_finalizer (gfc_finalizer* el)
+{
+  if (el)
+    {
+      gfc_release_symbol (el->proc_sym);
+      gfc_free (el);
+    }
+}
+
+static void
+gfc_free_finalizer_list (gfc_finalizer* list)
+{
+  while (list)
+    {
+      gfc_finalizer* current = list;
+      list = list->next;
+      gfc_free_finalizer (current);
+    }
+}
+
+
+/* Create a new gfc_charlen structure and add it to a namespace.
+   If 'old_cl' is given, the newly created charlen will be a copy of it.  */
+
+gfc_charlen*
+gfc_new_charlen (gfc_namespace *ns, gfc_charlen *old_cl)
+{
+  gfc_charlen *cl;
+  cl = gfc_get_charlen ();
+
+  /* Copy old_cl.  */
+  if (old_cl)
+    {
+      /* Put into namespace, but don't allow reject_statement
+	 to free it if old_cl is given.  */
+      gfc_charlen **prev = &ns->cl_list;
+      cl->next = ns->old_cl_list;
+      while (*prev != ns->old_cl_list)
+	prev = &(*prev)->next;
+      *prev = cl;
+      ns->old_cl_list = cl;
+      cl->length = gfc_copy_expr (old_cl->length);
+      cl->length_from_typespec = old_cl->length_from_typespec;
+      cl->backend_decl = old_cl->backend_decl;
+      cl->passed_length = old_cl->passed_length;
+      cl->resolved = old_cl->resolved;
+    }
+  else
+    {
+      /* Put into namespace.  */
+      cl->next = ns->cl_list;
+      ns->cl_list = cl;
+    }
+
+  return cl;
+}
+
+
+/* Free the charlen list from cl to end (end is not freed). 
+   Free the whole list if end is NULL.  */
+
+void gfc_free_charlen (gfc_charlen *cl, gfc_charlen *end)
+{
+  gfc_charlen *cl2;
+
+  for (; cl != end; cl = cl2)
+    {
+      gcc_assert (cl);
+
+      cl2 = cl->next;
+      gfc_free_expr (cl->length);
+      gfc_free (cl);
+    }
+}
+
+
+/* Free entry list structs.  */
+
+static void
+free_entry_list (gfc_entry_list *el)
+{
+  gfc_entry_list *next;
+
+  if (el == NULL)
+    return;
+
+  next = el->next;
+  gfc_free (el);
+  free_entry_list (next);
+}
+
+
+/* Free a namespace structure and everything below it.  Interface
+   lists associated with intrinsic operators are not freed.  These are
+   taken care of when a specific name is freed.  */
+
+void
+gfc_free_namespace (gfc_namespace *ns)
+{
+  gfc_namespace *p, *q;
+  int i;
+
+  if (ns == NULL)
+    return;
+
+  ns->refs--;
+  if (ns->refs > 0)
+    return;
+  gcc_assert (ns->refs == 0);
+
+  gfc_free_statements (ns->code);
+
+  free_sym_tree (ns->sym_root);
+  free_uop_tree (ns->uop_root);
+  free_common_tree (ns->common_root);
+  free_tb_tree (ns->tb_sym_root);
+  free_tb_tree (ns->tb_uop_root);
+  gfc_free_finalizer_list (ns->finalizers);
+  gfc_free_charlen (ns->cl_list, NULL);
+  free_st_labels (ns->st_labels);
+
+  free_entry_list (ns->entries);
+  gfc_free_equiv (ns->equiv);
+  gfc_free_equiv_lists (ns->equiv_lists);
+  gfc_free_use_stmts (ns->use_stmts);
+
+  for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++)
+    gfc_free_interface (ns->op[i]);
+
+  gfc_free_data (ns->data);
+  p = ns->contained;
+  gfc_free (ns);
+
+  /* Recursively free any contained namespaces.  */
+  while (p != NULL)
+    {
+      q = p;
+      p = p->sibling;
+      gfc_free_namespace (q);
+    }
+}
+
+
+void
+gfc_symbol_init_2 (void)
+{
+
+  gfc_current_ns = gfc_get_namespace (NULL, 0);
+}
+
+
+void
+gfc_symbol_done_2 (void)
+{
+
+  gfc_free_namespace (gfc_current_ns);
+  gfc_current_ns = NULL;
+  gfc_free_dt_list ();
+}
+
+
+/* Clear mark bits from symbol nodes associated with a symtree node.  */
+
+static void
+clear_sym_mark (gfc_symtree *st)
+{
+
+  st->n.sym->mark = 0;
+}
+
+
+/* Recursively traverse the symtree nodes.  */
+
+void
+gfc_traverse_symtree (gfc_symtree *st, void (*func) (gfc_symtree *))
+{
+  if (!st)
+    return;
+
+  gfc_traverse_symtree (st->left, func);
+  (*func) (st);
+  gfc_traverse_symtree (st->right, func);
+}
+
+
+/* Recursive namespace traversal function.  */
+
+static void
+traverse_ns (gfc_symtree *st, void (*func) (gfc_symbol *))
+{
+
+  if (st == NULL)
+    return;
+
+  traverse_ns (st->left, func);
+
+  if (st->n.sym->mark == 0)
+    (*func) (st->n.sym);
+  st->n.sym->mark = 1;
+
+  traverse_ns (st->right, func);
+}
+
+
+/* Call a given function for all symbols in the namespace.  We take
+   care that each gfc_symbol node is called exactly once.  */
+
+void
+gfc_traverse_ns (gfc_namespace *ns, void (*func) (gfc_symbol *))
+{
+
+  gfc_traverse_symtree (ns->sym_root, clear_sym_mark);
+
+  traverse_ns (ns->sym_root, func);
+}
+
+
+/* Return TRUE when name is the name of an intrinsic type.  */
+
+bool
+gfc_is_intrinsic_typename (const char *name)
+{
+  if (strcmp (name, "integer") == 0
+      || strcmp (name, "real") == 0
+      || strcmp (name, "character") == 0
+      || strcmp (name, "logical") == 0
+      || strcmp (name, "complex") == 0
+      || strcmp (name, "doubleprecision") == 0
+      || strcmp (name, "doublecomplex") == 0)
+    return true;
+  else
+    return false;
+}
+
+
+/* Return TRUE if the symbol is an automatic variable.  */
+
+static bool
+gfc_is_var_automatic (gfc_symbol *sym)
+{
+  /* Pointer and allocatable variables are never automatic.  */
+  if (sym->attr.pointer || sym->attr.allocatable)
+    return false;
+  /* Check for arrays with non-constant size.  */
+  if (sym->attr.dimension && sym->as
+      && !gfc_is_compile_time_shape (sym->as))
+    return true;
+  /* Check for non-constant length character variables.  */
+  if (sym->ts.type == BT_CHARACTER
+      && sym->ts.u.cl
+      && !gfc_is_constant_expr (sym->ts.u.cl->length))
+    return true;
+  return false;
+}
+
+/* Given a symbol, mark it as SAVEd if it is allowed.  */
+
+static void
+save_symbol (gfc_symbol *sym)
+{
+
+  if (sym->attr.use_assoc)
+    return;
+
+  if (sym->attr.in_common
+      || sym->attr.dummy
+      || sym->attr.result
+      || sym->attr.flavor != FL_VARIABLE)
+    return;
+  /* Automatic objects are not saved.  */
+  if (gfc_is_var_automatic (sym))
+    return;
+  gfc_add_save (&sym->attr, SAVE_EXPLICIT, sym->name, &sym->declared_at);
+}
+
+
+/* Mark those symbols which can be SAVEd as such.  */
+
+void
+gfc_save_all (gfc_namespace *ns)
+{
+  gfc_traverse_ns (ns, save_symbol);
+}
+
+
+/* Make sure that no changes to symbols are pending.  */
+
+void
+gfc_enforce_clean_symbol_state(void)
+{
+  gcc_assert (changed_syms == NULL);
+}
+
+
+/************** Global symbol handling ************/
+
+
+/* Search a tree for the global symbol.  */
+
+gfc_gsymbol *
+gfc_find_gsymbol (gfc_gsymbol *symbol, const char *name)
+{
+  int c;
+
+  if (symbol == NULL)
+    return NULL;
+
+  while (symbol)
+    {
+      c = strcmp (name, symbol->name);
+      if (!c)
+	return symbol;
+
+      symbol = (c < 0) ? symbol->left : symbol->right;
+    }
+
+  return NULL;
+}
+
+
+/* Compare two global symbols. Used for managing the BB tree.  */
+
+static int
+gsym_compare (void *_s1, void *_s2)
+{
+  gfc_gsymbol *s1, *s2;
+
+  s1 = (gfc_gsymbol *) _s1;
+  s2 = (gfc_gsymbol *) _s2;
+  return strcmp (s1->name, s2->name);
+}
+
+
+/* Get a global symbol, creating it if it doesn't exist.  */
+
+gfc_gsymbol *
+gfc_get_gsymbol (const char *name)
+{
+  gfc_gsymbol *s;
+
+  s = gfc_find_gsymbol (gfc_gsym_root, name);
+  if (s != NULL)
+    return s;
+
+  s = XCNEW (gfc_gsymbol);
+  s->type = GSYM_UNKNOWN;
+  s->name = gfc_get_string (name);
+
+  gfc_insert_bbt (&gfc_gsym_root, s, gsym_compare);
+
+  return s;
+}
+
+
+static gfc_symbol *
+get_iso_c_binding_dt (int sym_id)
+{
+  gfc_dt_list *dt_list;
+
+  dt_list = gfc_derived_types;
+
+  /* Loop through the derived types in the name list, searching for
+     the desired symbol from iso_c_binding.  Search the parent namespaces
+     if necessary and requested to (parent_flag).  */
+  while (dt_list != NULL)
+    {
+      if (dt_list->derived->from_intmod != INTMOD_NONE
+	  && dt_list->derived->intmod_sym_id == sym_id)
+        return dt_list->derived;
+
+      dt_list = dt_list->next;
+    }
+
+  return NULL;
+}
+
+
+/* Verifies that the given derived type symbol, derived_sym, is interoperable
+   with C.  This is necessary for any derived type that is BIND(C) and for
+   derived types that are parameters to functions that are BIND(C).  All
+   fields of the derived type are required to be interoperable, and are tested
+   for such.  If an error occurs, the errors are reported here, allowing for
+   multiple errors to be handled for a single derived type.  */
+
+gfc_try
+verify_bind_c_derived_type (gfc_symbol *derived_sym)
+{
+  gfc_component *curr_comp = NULL;
+  gfc_try is_c_interop = FAILURE;
+  gfc_try retval = SUCCESS;
+   
+  if (derived_sym == NULL)
+    gfc_internal_error ("verify_bind_c_derived_type(): Given symbol is "
+                        "unexpectedly NULL");
+
+  /* If we've already looked at this derived symbol, do not look at it again
+     so we don't repeat warnings/errors.  */
+  if (derived_sym->ts.is_c_interop)
+    return SUCCESS;
+  
+  /* The derived type must have the BIND attribute to be interoperable
+     J3/04-007, Section 15.2.3.  */
+  if (derived_sym->attr.is_bind_c != 1)
+    {
+      derived_sym->ts.is_c_interop = 0;
+      gfc_error_now ("Derived type '%s' declared at %L must have the BIND "
+                     "attribute to be C interoperable", derived_sym->name,
+                     &(derived_sym->declared_at));
+      retval = FAILURE;
+    }
+  
+  curr_comp = derived_sym->components;
+
+  /* Fortran 2003 allows an empty derived type.  C99 appears to disallow an
+     empty struct.  Section 15.2 in Fortran 2003 states:  "The following
+     subclauses define the conditions under which a Fortran entity is
+     interoperable.  If a Fortran entity is interoperable, an equivalent
+     entity may be defined by means of C and the Fortran entity is said
+     to be interoperable with the C entity.  There does not have to be such
+     an interoperating C entity."
+  */
+  if (curr_comp == NULL)
+    {
+      gfc_warning ("Derived type '%s' with BIND(C) attribute at %L is empty, "
+		   "and may be inaccessible by the C companion processor",
+		   derived_sym->name, &(derived_sym->declared_at));
+      derived_sym->ts.is_c_interop = 1;
+      derived_sym->attr.is_bind_c = 1;
+      return SUCCESS;
+    }
+
+
+  /* Initialize the derived type as being C interoperable.
+     If we find an error in the components, this will be set false.  */
+  derived_sym->ts.is_c_interop = 1;
+  
+  /* Loop through the list of components to verify that the kind of
+     each is a C interoperable type.  */
+  do
+    {
+      /* The components cannot be pointers (fortran sense).  
+         J3/04-007, Section 15.2.3, C1505.	*/
+      if (curr_comp->attr.pointer != 0)
+        {
+          gfc_error ("Component '%s' at %L cannot have the "
+                     "POINTER attribute because it is a member "
+                     "of the BIND(C) derived type '%s' at %L",
+                     curr_comp->name, &(curr_comp->loc),
+                     derived_sym->name, &(derived_sym->declared_at));
+          retval = FAILURE;
+        }
+
+      if (curr_comp->attr.proc_pointer != 0)
+	{
+	  gfc_error ("Procedure pointer component '%s' at %L cannot be a member"
+		     " of the BIND(C) derived type '%s' at %L", curr_comp->name,
+		     &curr_comp->loc, derived_sym->name,
+		     &derived_sym->declared_at);
+          retval = FAILURE;
+        }
+
+      /* The components cannot be allocatable.
+         J3/04-007, Section 15.2.3, C1505.	*/
+      if (curr_comp->attr.allocatable != 0)
+        {
+          gfc_error ("Component '%s' at %L cannot have the "
+                     "ALLOCATABLE attribute because it is a member "
+                     "of the BIND(C) derived type '%s' at %L",
+                     curr_comp->name, &(curr_comp->loc),
+                     derived_sym->name, &(derived_sym->declared_at));
+          retval = FAILURE;
+        }
+      
+      /* BIND(C) derived types must have interoperable components.  */
+      if (curr_comp->ts.type == BT_DERIVED
+	  && curr_comp->ts.u.derived->ts.is_iso_c != 1 
+          && curr_comp->ts.u.derived != derived_sym)
+        {
+          /* This should be allowed; the draft says a derived-type can not
+             have type parameters if it is has the BIND attribute.  Type
+             parameters seem to be for making parameterized derived types.
+             There's no need to verify the type if it is c_ptr/c_funptr.  */
+          retval = verify_bind_c_derived_type (curr_comp->ts.u.derived);
+	}
+      else
+	{
+	  /* Grab the typespec for the given component and test the kind.  */ 
+	  is_c_interop = verify_c_interop (&(curr_comp->ts));
+	  
+	  if (is_c_interop != SUCCESS)
+	    {
+	      /* Report warning and continue since not fatal.  The
+		 draft does specify a constraint that requires all fields
+		 to interoperate, but if the user says real(4), etc., it
+		 may interoperate with *something* in C, but the compiler
+		 most likely won't know exactly what.  Further, it may not
+		 interoperate with the same data type(s) in C if the user
+		 recompiles with different flags (e.g., -m32 and -m64 on
+		 x86_64 and using integer(4) to claim interop with a
+		 C_LONG).  */
+	      if (derived_sym->attr.is_bind_c == 1)
+		/* If the derived type is bind(c), all fields must be
+		   interop.  */
+		gfc_warning ("Component '%s' in derived type '%s' at %L "
+                             "may not be C interoperable, even though "
+                             "derived type '%s' is BIND(C)",
+                             curr_comp->name, derived_sym->name,
+                             &(curr_comp->loc), derived_sym->name);
+	      else
+		/* If derived type is param to bind(c) routine, or to one
+		   of the iso_c_binding procs, it must be interoperable, so
+		   all fields must interop too.	 */
+		gfc_warning ("Component '%s' in derived type '%s' at %L "
+                             "may not be C interoperable",
+                             curr_comp->name, derived_sym->name,
+                             &(curr_comp->loc));
+	    }
+	}
+      
+      curr_comp = curr_comp->next;
+    } while (curr_comp != NULL); 
+
+
+  /* Make sure we don't have conflicts with the attributes.  */
+  if (derived_sym->attr.access == ACCESS_PRIVATE)
+    {
+      gfc_error ("Derived type '%s' at %L cannot be declared with both "
+                 "PRIVATE and BIND(C) attributes", derived_sym->name,
+                 &(derived_sym->declared_at));
+      retval = FAILURE;
+    }
+
+  if (derived_sym->attr.sequence != 0)
+    {
+      gfc_error ("Derived type '%s' at %L cannot have the SEQUENCE "
+                 "attribute because it is BIND(C)", derived_sym->name,
+                 &(derived_sym->declared_at));
+      retval = FAILURE;
+    }
+
+  /* Mark the derived type as not being C interoperable if we found an
+     error.  If there were only warnings, proceed with the assumption
+     it's interoperable.  */
+  if (retval == FAILURE)
+    derived_sym->ts.is_c_interop = 0;
+  
+  return retval;
+}
+
+
+/* Generate symbols for the named constants c_null_ptr and c_null_funptr.  */
+
+static gfc_try
+gen_special_c_interop_ptr (int ptr_id, const char *ptr_name,
+                           const char *module_name)
+{
+  gfc_symtree *tmp_symtree;
+  gfc_symbol *tmp_sym;
+  gfc_constructor *c;
+
+  tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, ptr_name);
+	 
+  if (tmp_symtree != NULL)
+    tmp_sym = tmp_symtree->n.sym;
+  else
+    {
+      tmp_sym = NULL;
+      gfc_internal_error ("gen_special_c_interop_ptr(): Unable to "
+                          "create symbol for %s", ptr_name);
+    }
+
+  /* Set up the symbol's important fields.  Save attr required so we can
+     initialize the ptr to NULL.  */
+  tmp_sym->attr.save = SAVE_EXPLICIT;
+  tmp_sym->ts.is_c_interop = 1;
+  tmp_sym->attr.is_c_interop = 1;
+  tmp_sym->ts.is_iso_c = 1;
+  tmp_sym->ts.type = BT_DERIVED;
+
+  /* The c_ptr and c_funptr derived types will provide the
+     definition for c_null_ptr and c_null_funptr, respectively.  */
+  if (ptr_id == ISOCBINDING_NULL_PTR)
+    tmp_sym->ts.u.derived = get_iso_c_binding_dt (ISOCBINDING_PTR);
+  else
+    tmp_sym->ts.u.derived = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+  if (tmp_sym->ts.u.derived == NULL)
+    {
+      /* This can occur if the user forgot to declare c_ptr or
+         c_funptr and they're trying to use one of the procedures
+         that has arg(s) of the missing type.  In this case, a
+         regular version of the thing should have been put in the
+         current ns.  */
+      generate_isocbinding_symbol (module_name, ptr_id == ISOCBINDING_NULL_PTR 
+                                   ? ISOCBINDING_PTR : ISOCBINDING_FUNPTR,
+                                   (const char *) (ptr_id == ISOCBINDING_NULL_PTR 
+				   ? "_gfortran_iso_c_binding_c_ptr"
+				   : "_gfortran_iso_c_binding_c_funptr"));
+
+      tmp_sym->ts.u.derived =
+        get_iso_c_binding_dt (ptr_id == ISOCBINDING_NULL_PTR
+                              ? ISOCBINDING_PTR : ISOCBINDING_FUNPTR);
+    }
+
+  /* Module name is some mangled version of iso_c_binding.  */
+  tmp_sym->module = gfc_get_string (module_name);
+  
+  /* Say it's from the iso_c_binding module.  */
+  tmp_sym->attr.is_iso_c = 1;
+  
+  tmp_sym->attr.use_assoc = 1;
+  tmp_sym->attr.is_bind_c = 1;
+  /* Set the binding_label.  */
+  sprintf (tmp_sym->binding_label, "%s_%s", module_name, tmp_sym->name);
+  
+  /* Set the c_address field of c_null_ptr and c_null_funptr to
+     the value of NULL.	 */
+  tmp_sym->value = gfc_get_expr ();
+  tmp_sym->value->expr_type = EXPR_STRUCTURE;
+  tmp_sym->value->ts.type = BT_DERIVED;
+  tmp_sym->value->ts.u.derived = tmp_sym->ts.u.derived;
+  gfc_constructor_append_expr (&tmp_sym->value->value.constructor, NULL, NULL);
+  c = gfc_constructor_first (tmp_sym->value->value.constructor);
+  c->expr = gfc_get_expr ();
+  c->expr->expr_type = EXPR_NULL;
+  c->expr->ts.is_iso_c = 1;
+  /* Must declare c_null_ptr and c_null_funptr as having the
+     PARAMETER attribute so they can be used in init expressions.  */
+  tmp_sym->attr.flavor = FL_PARAMETER;
+
+  return SUCCESS;
+}
+
+
+/* Add a formal argument, gfc_formal_arglist, to the
+   end of the given list of arguments.	Set the reference to the
+   provided symbol, param_sym, in the argument.  */
+
+static void
+add_formal_arg (gfc_formal_arglist **head,
+                gfc_formal_arglist **tail,
+                gfc_formal_arglist *formal_arg,
+                gfc_symbol *param_sym)
+{
+  /* Put in list, either as first arg or at the tail (curr arg).  */
+  if (*head == NULL)
+    *head = *tail = formal_arg;
+  else
+    {
+      (*tail)->next = formal_arg;
+      (*tail) = formal_arg;
+    }
+   
+  (*tail)->sym = param_sym;
+  (*tail)->next = NULL;
+   
+  return;
+}
+
+
+/* Generates a symbol representing the CPTR argument to an
+   iso_c_binding procedure.  Also, create a gfc_formal_arglist for the
+   CPTR and add it to the provided argument list.  */
+
+static void
+gen_cptr_param (gfc_formal_arglist **head,
+                gfc_formal_arglist **tail,
+                const char *module_name,
+                gfc_namespace *ns, const char *c_ptr_name,
+                int iso_c_sym_id)
+{
+  gfc_symbol *param_sym = NULL;
+  gfc_symbol *c_ptr_sym = NULL;
+  gfc_symtree *param_symtree = NULL;
+  gfc_formal_arglist *formal_arg = NULL;
+  const char *c_ptr_in;
+  const char *c_ptr_type = NULL;
+
+  if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
+    c_ptr_type = "_gfortran_iso_c_binding_c_funptr";
+  else
+    c_ptr_type = "_gfortran_iso_c_binding_c_ptr";
+
+  if(c_ptr_name == NULL)
+    c_ptr_in = "gfc_cptr__";
+  else
+    c_ptr_in = c_ptr_name;
+  gfc_get_sym_tree (c_ptr_in, ns, &param_symtree, false);
+  if (param_symtree != NULL)
+    param_sym = param_symtree->n.sym;
+  else
+    gfc_internal_error ("gen_cptr_param(): Unable to "
+			"create symbol for %s", c_ptr_in);
+
+  /* Set up the appropriate fields for the new c_ptr param sym.  */
+  param_sym->refs++;
+  param_sym->attr.flavor = FL_DERIVED;
+  param_sym->ts.type = BT_DERIVED;
+  param_sym->attr.intent = INTENT_IN;
+  param_sym->attr.dummy = 1;
+
+  /* This will pass the ptr to the iso_c routines as a (void *).  */
+  param_sym->attr.value = 1;
+  param_sym->attr.use_assoc = 1;
+
+  /* Get the symbol for c_ptr or c_funptr, no matter what it's name is 
+     (user renamed).  */
+  if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
+    c_ptr_sym = get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+  else
+    c_ptr_sym = get_iso_c_binding_dt (ISOCBINDING_PTR);
+  if (c_ptr_sym == NULL)
+    {
+      /* This can happen if the user did not define c_ptr but they are
+         trying to use one of the iso_c_binding functions that need it.  */
+      if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
+	generate_isocbinding_symbol (module_name, ISOCBINDING_FUNPTR,
+				     (const char *)c_ptr_type);
+      else
+	generate_isocbinding_symbol (module_name, ISOCBINDING_PTR,
+				     (const char *)c_ptr_type);
+
+      gfc_get_ha_symbol (c_ptr_type, &(c_ptr_sym));
+    }
+
+  param_sym->ts.u.derived = c_ptr_sym;
+  param_sym->module = gfc_get_string (module_name);
+
+  /* Make new formal arg.  */
+  formal_arg = gfc_get_formal_arglist ();
+  /* Add arg to list of formal args (the CPTR arg).  */
+  add_formal_arg (head, tail, formal_arg, param_sym);
+
+  /* Validate changes.  */
+  gfc_commit_symbol (param_sym);
+}
+
+
+/* Generates a symbol representing the FPTR argument to an
+   iso_c_binding procedure.  Also, create a gfc_formal_arglist for the
+   FPTR and add it to the provided argument list.  */
+
+static void
+gen_fptr_param (gfc_formal_arglist **head,
+                gfc_formal_arglist **tail,
+                const char *module_name,
+                gfc_namespace *ns, const char *f_ptr_name, int proc)
+{
+  gfc_symbol *param_sym = NULL;
+  gfc_symtree *param_symtree = NULL;
+  gfc_formal_arglist *formal_arg = NULL;
+  const char *f_ptr_out = "gfc_fptr__";
+
+  if (f_ptr_name != NULL)
+    f_ptr_out = f_ptr_name;
+
+  gfc_get_sym_tree (f_ptr_out, ns, &param_symtree, false);
+  if (param_symtree != NULL)
+    param_sym = param_symtree->n.sym;
+  else
+    gfc_internal_error ("generateFPtrParam(): Unable to "
+			"create symbol for %s", f_ptr_out);
+
+  /* Set up the necessary fields for the fptr output param sym.  */
+  param_sym->refs++;
+  if (proc)
+    param_sym->attr.proc_pointer = 1;
+  else
+    param_sym->attr.pointer = 1;
+  param_sym->attr.dummy = 1;
+  param_sym->attr.use_assoc = 1;
+
+  /* ISO C Binding type to allow any pointer type as actual param.  */
+  param_sym->ts.type = BT_VOID;
+  param_sym->module = gfc_get_string (module_name);
+   
+  /* Make the arg.  */
+  formal_arg = gfc_get_formal_arglist ();
+  /* Add arg to list of formal args.  */
+  add_formal_arg (head, tail, formal_arg, param_sym);
+
+  /* Validate changes.  */
+  gfc_commit_symbol (param_sym);
+}
+
+
+/* Generates a symbol representing the optional SHAPE argument for the
+   iso_c_binding c_f_pointer() procedure.  Also, create a
+   gfc_formal_arglist for the SHAPE and add it to the provided
+   argument list.  */
+
+static void
+gen_shape_param (gfc_formal_arglist **head,
+                 gfc_formal_arglist **tail,
+                 const char *module_name,
+                 gfc_namespace *ns, const char *shape_param_name)
+{
+  gfc_symbol *param_sym = NULL;
+  gfc_symtree *param_symtree = NULL;
+  gfc_formal_arglist *formal_arg = NULL;
+  const char *shape_param = "gfc_shape_array__";
+
+  if (shape_param_name != NULL)
+    shape_param = shape_param_name;
+
+  gfc_get_sym_tree (shape_param, ns, &param_symtree, false);
+  if (param_symtree != NULL)
+    param_sym = param_symtree->n.sym;
+  else
+    gfc_internal_error ("generateShapeParam(): Unable to "
+			"create symbol for %s", shape_param);
+   
+  /* Set up the necessary fields for the shape input param sym.  */
+  param_sym->refs++;
+  param_sym->attr.dummy = 1;
+  param_sym->attr.use_assoc = 1;
+
+  /* Integer array, rank 1, describing the shape of the object.  Make it's
+     type BT_VOID initially so we can accept any type/kind combination of
+     integer.  During gfc_iso_c_sub_interface (resolve.c), we'll make it
+     of BT_INTEGER type.  */
+  param_sym->ts.type = BT_VOID;
+
+  /* Initialize the kind to default integer.  However, it will be overridden
+     during resolution to match the kind of the SHAPE parameter given as
+     the actual argument (to allow for any valid integer kind).  */
+  param_sym->ts.kind = gfc_default_integer_kind;
+  param_sym->as = gfc_get_array_spec ();
+
+  param_sym->as->rank = 1;
+  param_sym->as->lower[0] = gfc_get_int_expr (gfc_default_integer_kind,
+					      NULL, 1);
+
+  /* The extent is unknown until we get it.  The length give us
+     the rank the incoming pointer.  */
+  param_sym->as->type = AS_ASSUMED_SHAPE;
+
+  /* The arg is also optional; it is required iff the second arg
+     (fptr) is to an array, otherwise, it's ignored.  */
+  param_sym->attr.optional = 1;
+  param_sym->attr.intent = INTENT_IN;
+  param_sym->attr.dimension = 1;
+  param_sym->module = gfc_get_string (module_name);
+   
+  /* Make the arg.  */
+  formal_arg = gfc_get_formal_arglist ();
+  /* Add arg to list of formal args.  */
+  add_formal_arg (head, tail, formal_arg, param_sym);
+
+  /* Validate changes.  */
+  gfc_commit_symbol (param_sym);
+}
+
+
+/* Add a procedure interface to the given symbol (i.e., store a
+   reference to the list of formal arguments).  */
+
+static void
+add_proc_interface (gfc_symbol *sym, ifsrc source,
+                    gfc_formal_arglist *formal)
+{
+
+  sym->formal = formal;
+  sym->attr.if_source = source;
+}
+
+
+/* Copy the formal args from an existing symbol, src, into a new
+   symbol, dest.  New formal args are created, and the description of
+   each arg is set according to the existing ones.  This function is
+   used when creating procedure declaration variables from a procedure
+   declaration statement (see match_proc_decl()) to create the formal
+   args based on the args of a given named interface.  */
+
+void
+gfc_copy_formal_args (gfc_symbol *dest, gfc_symbol *src)
+{
+  gfc_formal_arglist *head = NULL;
+  gfc_formal_arglist *tail = NULL;
+  gfc_formal_arglist *formal_arg = NULL;
+  gfc_formal_arglist *curr_arg = NULL;
+  gfc_formal_arglist *formal_prev = NULL;
+  /* Save current namespace so we can change it for formal args.  */
+  gfc_namespace *parent_ns = gfc_current_ns;
+
+  /* Create a new namespace, which will be the formal ns (namespace
+     of the formal args).  */
+  gfc_current_ns = gfc_get_namespace (parent_ns, 0);
+  gfc_current_ns->proc_name = dest;
+
+  for (curr_arg = src->formal; curr_arg; curr_arg = curr_arg->next)
+    {
+      formal_arg = gfc_get_formal_arglist ();
+      gfc_get_symbol (curr_arg->sym->name, gfc_current_ns, &(formal_arg->sym));
+
+      /* May need to copy more info for the symbol.  */
+      formal_arg->sym->attr = curr_arg->sym->attr;
+      formal_arg->sym->ts = curr_arg->sym->ts;
+      formal_arg->sym->as = gfc_copy_array_spec (curr_arg->sym->as);
+      gfc_copy_formal_args (formal_arg->sym, curr_arg->sym);
+
+      /* If this isn't the first arg, set up the next ptr.  For the
+        last arg built, the formal_arg->next will never get set to
+        anything other than NULL.  */
+      if (formal_prev != NULL)
+	formal_prev->next = formal_arg;
+      else
+	formal_arg->next = NULL;
+
+      formal_prev = formal_arg;
+
+      /* Add arg to list of formal args.  */
+      add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
+
+      /* Validate changes.  */
+      gfc_commit_symbol (formal_arg->sym);
+    }
+
+  /* Add the interface to the symbol.  */
+  add_proc_interface (dest, IFSRC_DECL, head);
+
+  /* Store the formal namespace information.  */
+  if (dest->formal != NULL)
+    /* The current ns should be that for the dest proc.  */
+    dest->formal_ns = gfc_current_ns;
+  /* Restore the current namespace to what it was on entry.  */
+  gfc_current_ns = parent_ns;
+}
+
+
+void
+gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src)
+{
+  gfc_formal_arglist *head = NULL;
+  gfc_formal_arglist *tail = NULL;
+  gfc_formal_arglist *formal_arg = NULL;
+  gfc_intrinsic_arg *curr_arg = NULL;
+  gfc_formal_arglist *formal_prev = NULL;
+  /* Save current namespace so we can change it for formal args.  */
+  gfc_namespace *parent_ns = gfc_current_ns;
+
+  /* Create a new namespace, which will be the formal ns (namespace
+     of the formal args).  */
+  gfc_current_ns = gfc_get_namespace (parent_ns, 0);
+  gfc_current_ns->proc_name = dest;
+
+  for (curr_arg = src->formal; curr_arg; curr_arg = curr_arg->next)
+    {
+      formal_arg = gfc_get_formal_arglist ();
+      gfc_get_symbol (curr_arg->name, gfc_current_ns, &(formal_arg->sym));
+
+      /* May need to copy more info for the symbol.  */
+      formal_arg->sym->ts = curr_arg->ts;
+      formal_arg->sym->attr.optional = curr_arg->optional;
+      formal_arg->sym->attr.value = curr_arg->value;
+      formal_arg->sym->attr.intent = curr_arg->intent;
+      formal_arg->sym->attr.flavor = FL_VARIABLE;
+      formal_arg->sym->attr.dummy = 1;
+
+      if (formal_arg->sym->ts.type == BT_CHARACTER)
+	formal_arg->sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+
+      /* If this isn't the first arg, set up the next ptr.  For the
+        last arg built, the formal_arg->next will never get set to
+        anything other than NULL.  */
+      if (formal_prev != NULL)
+	formal_prev->next = formal_arg;
+      else
+	formal_arg->next = NULL;
+
+      formal_prev = formal_arg;
+
+      /* Add arg to list of formal args.  */
+      add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
+
+      /* Validate changes.  */
+      gfc_commit_symbol (formal_arg->sym);
+    }
+
+  /* Add the interface to the symbol.  */
+  add_proc_interface (dest, IFSRC_DECL, head);
+
+  /* Store the formal namespace information.  */
+  if (dest->formal != NULL)
+    /* The current ns should be that for the dest proc.  */
+    dest->formal_ns = gfc_current_ns;
+  /* Restore the current namespace to what it was on entry.  */
+  gfc_current_ns = parent_ns;
+}
+
+
+void
+gfc_copy_formal_args_ppc (gfc_component *dest, gfc_symbol *src)
+{
+  gfc_formal_arglist *head = NULL;
+  gfc_formal_arglist *tail = NULL;
+  gfc_formal_arglist *formal_arg = NULL;
+  gfc_formal_arglist *curr_arg = NULL;
+  gfc_formal_arglist *formal_prev = NULL;
+  /* Save current namespace so we can change it for formal args.  */
+  gfc_namespace *parent_ns = gfc_current_ns;
+
+  /* Create a new namespace, which will be the formal ns (namespace
+     of the formal args).  */
+  gfc_current_ns = gfc_get_namespace (parent_ns, 0);
+  /* TODO: gfc_current_ns->proc_name = dest;*/
+
+  for (curr_arg = src->formal; curr_arg; curr_arg = curr_arg->next)
+    {
+      formal_arg = gfc_get_formal_arglist ();
+      gfc_get_symbol (curr_arg->sym->name, gfc_current_ns, &(formal_arg->sym));
+
+      /* May need to copy more info for the symbol.  */
+      formal_arg->sym->attr = curr_arg->sym->attr;
+      formal_arg->sym->ts = curr_arg->sym->ts;
+      formal_arg->sym->as = gfc_copy_array_spec (curr_arg->sym->as);
+      gfc_copy_formal_args (formal_arg->sym, curr_arg->sym);
+
+      /* If this isn't the first arg, set up the next ptr.  For the
+        last arg built, the formal_arg->next will never get set to
+        anything other than NULL.  */
+      if (formal_prev != NULL)
+	formal_prev->next = formal_arg;
+      else
+	formal_arg->next = NULL;
+
+      formal_prev = formal_arg;
+
+      /* Add arg to list of formal args.  */
+      add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
+
+      /* Validate changes.  */
+      gfc_commit_symbol (formal_arg->sym);
+    }
+
+  /* Add the interface to the symbol.  */
+  gfc_free_formal_arglist (dest->formal);
+  dest->formal = head;
+  dest->attr.if_source = IFSRC_DECL;
+
+  /* Store the formal namespace information.  */
+  if (dest->formal != NULL)
+    /* The current ns should be that for the dest proc.  */
+    dest->formal_ns = gfc_current_ns;
+  /* Restore the current namespace to what it was on entry.  */
+  gfc_current_ns = parent_ns;
+}
+
+
+/* Builds the parameter list for the iso_c_binding procedure
+   c_f_pointer or c_f_procpointer.  The old_sym typically refers to a
+   generic version of either the c_f_pointer or c_f_procpointer
+   functions.  The new_proc_sym represents a "resolved" version of the
+   symbol.  The functions are resolved to match the types of their
+   parameters; for example, c_f_pointer(cptr, fptr) would resolve to
+   something similar to c_f_pointer_i4 if the type of data object fptr
+   pointed to was a default integer.  The actual name of the resolved
+   procedure symbol is further mangled with the module name, etc., but
+   the idea holds true.  */
+
+static void
+build_formal_args (gfc_symbol *new_proc_sym,
+                   gfc_symbol *old_sym, int add_optional_arg)
+{
+  gfc_formal_arglist *head = NULL, *tail = NULL;
+  gfc_namespace *parent_ns = NULL;
+
+  parent_ns = gfc_current_ns;
+  /* Create a new namespace, which will be the formal ns (namespace
+     of the formal args).  */
+  gfc_current_ns = gfc_get_namespace(parent_ns, 0);
+  gfc_current_ns->proc_name = new_proc_sym;
+
+  /* Generate the params.  */
+  if (old_sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER)
+    {
+      gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
+		      gfc_current_ns, "cptr", old_sym->intmod_sym_id);
+      gen_fptr_param (&head, &tail, (const char *) new_proc_sym->module,
+		      gfc_current_ns, "fptr", 1);
+    }
+  else if (old_sym->intmod_sym_id == ISOCBINDING_F_POINTER)
+    {
+      gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
+		      gfc_current_ns, "cptr", old_sym->intmod_sym_id);
+      gen_fptr_param (&head, &tail, (const char *) new_proc_sym->module,
+		      gfc_current_ns, "fptr", 0);
+      /* If we're dealing with c_f_pointer, it has an optional third arg.  */
+      gen_shape_param (&head, &tail,(const char *) new_proc_sym->module,
+		       gfc_current_ns, "shape");
+
+    }
+  else if (old_sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
+    {
+      /* c_associated has one required arg and one optional; both
+	 are c_ptrs.  */
+      gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
+		      gfc_current_ns, "c_ptr_1", ISOCBINDING_ASSOCIATED);
+      if (add_optional_arg)
+	{
+	  gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
+			  gfc_current_ns, "c_ptr_2", ISOCBINDING_ASSOCIATED);
+	  /* The last param is optional so mark it as such.  */
+	  tail->sym->attr.optional = 1;
+	}
+    }
+
+  /* Add the interface (store formal args to new_proc_sym).  */
+  add_proc_interface (new_proc_sym, IFSRC_DECL, head);
+
+  /* Set up the formal_ns pointer to the one created for the
+     new procedure so it'll get cleaned up during gfc_free_symbol().  */
+  new_proc_sym->formal_ns = gfc_current_ns;
+
+  gfc_current_ns = parent_ns;
+}
+
+static int
+std_for_isocbinding_symbol (int id)
+{
+  switch (id)
+    {
+#define NAMED_INTCST(a,b,c,d) \
+      case a:\
+        return d;
+#include "iso-c-binding.def"
+#undef NAMED_INTCST
+
+#define NAMED_FUNCTION(a,b,c,d) \
+      case a:\
+        return d;
+#include "iso-c-binding.def"
+#undef NAMED_FUNCTION
+
+       default:
+         return GFC_STD_F2003;
+    }
+}
+
+/* Generate the given set of C interoperable kind objects, or all
+   interoperable kinds.  This function will only be given kind objects
+   for valid iso_c_binding defined types because this is verified when
+   the 'use' statement is parsed.  If the user gives an 'only' clause,
+   the specific kinds are looked up; if they don't exist, an error is
+   reported.  If the user does not give an 'only' clause, all
+   iso_c_binding symbols are generated.  If a list of specific kinds
+   is given, it must have a NULL in the first empty spot to mark the
+   end of the list.  */
+
+
+void
+generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
+			     const char *local_name)
+{
+  const char *const name = (local_name && local_name[0]) ? local_name
+					     : c_interop_kinds_table[s].name;
+  gfc_symtree *tmp_symtree = NULL;
+  gfc_symbol *tmp_sym = NULL;
+  gfc_dt_list **dt_list_ptr = NULL;
+  gfc_component *tmp_comp = NULL;
+  char comp_name[(GFC_MAX_SYMBOL_LEN * 2) + 1];
+  int index;
+
+  if (gfc_notification_std (std_for_isocbinding_symbol (s)) == ERROR)
+    return;
+  tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
+
+  /* Already exists in this scope so don't re-add it.
+     TODO: we should probably check that it's really the same symbol.  */
+  if (tmp_symtree != NULL)
+    return;
+
+  /* Create the sym tree in the current ns.  */
+  gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
+  if (tmp_symtree)
+    tmp_sym = tmp_symtree->n.sym;
+  else
+    gfc_internal_error ("generate_isocbinding_symbol(): Unable to "
+			"create symbol");
+
+  /* Say what module this symbol belongs to.  */
+  tmp_sym->module = gfc_get_string (mod_name);
+  tmp_sym->from_intmod = INTMOD_ISO_C_BINDING;
+  tmp_sym->intmod_sym_id = s;
+
+  switch (s)
+    {
+
+#define NAMED_INTCST(a,b,c,d) case a : 
+#define NAMED_REALCST(a,b,c) case a :
+#define NAMED_CMPXCST(a,b,c) case a :
+#define NAMED_LOGCST(a,b,c) case a :
+#define NAMED_CHARKNDCST(a,b,c) case a :
+#include "iso-c-binding.def"
+
+	tmp_sym->value = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+				 	   c_interop_kinds_table[s].value);
+
+	/* Initialize an integer constant expression node.  */
+	tmp_sym->attr.flavor = FL_PARAMETER;
+	tmp_sym->ts.type = BT_INTEGER;
+	tmp_sym->ts.kind = gfc_default_integer_kind;
+
+	/* Mark this type as a C interoperable one.  */
+	tmp_sym->ts.is_c_interop = 1;
+	tmp_sym->ts.is_iso_c = 1;
+	tmp_sym->value->ts.is_c_interop = 1;
+	tmp_sym->value->ts.is_iso_c = 1;
+	tmp_sym->attr.is_c_interop = 1;
+
+	/* Tell what f90 type this c interop kind is valid.  */
+	tmp_sym->ts.f90_type = c_interop_kinds_table[s].f90_type;
+
+	/* Say it's from the iso_c_binding module.  */
+	tmp_sym->attr.is_iso_c = 1;
+
+	/* Make it use associated.  */
+	tmp_sym->attr.use_assoc = 1;
+	break;
+
+
+#define NAMED_CHARCST(a,b,c) case a :
+#include "iso-c-binding.def"
+
+	/* Initialize an integer constant expression node for the
+	   length of the character.  */
+	tmp_sym->value = gfc_get_character_expr (gfc_default_character_kind,
+						 &gfc_current_locus, NULL, 1);
+	tmp_sym->value->ts.is_c_interop = 1;
+	tmp_sym->value->ts.is_iso_c = 1;
+	tmp_sym->value->value.character.length = 1;
+	tmp_sym->value->value.character.string[0]
+	  = (gfc_char_t) c_interop_kinds_table[s].value;
+	tmp_sym->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+	tmp_sym->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+						     NULL, 1);
+
+	/* May not need this in both attr and ts, but do need in
+	   attr for writing module file.  */
+	tmp_sym->attr.is_c_interop = 1;
+
+	tmp_sym->attr.flavor = FL_PARAMETER;
+	tmp_sym->ts.type = BT_CHARACTER;
+
+	/* Need to set it to the C_CHAR kind.  */
+	tmp_sym->ts.kind = gfc_default_character_kind;
+
+	/* Mark this type as a C interoperable one.  */
+	tmp_sym->ts.is_c_interop = 1;
+	tmp_sym->ts.is_iso_c = 1;
+
+	/* Tell what f90 type this c interop kind is valid.  */
+	tmp_sym->ts.f90_type = BT_CHARACTER;
+
+	/* Say it's from the iso_c_binding module.  */
+	tmp_sym->attr.is_iso_c = 1;
+
+	/* Make it use associated.  */
+	tmp_sym->attr.use_assoc = 1;
+	break;
+
+      case ISOCBINDING_PTR:
+      case ISOCBINDING_FUNPTR:
+
+	/* Initialize an integer constant expression node.  */
+	tmp_sym->attr.flavor = FL_DERIVED;
+	tmp_sym->ts.is_c_interop = 1;
+	tmp_sym->attr.is_c_interop = 1;
+	tmp_sym->attr.is_iso_c = 1;
+	tmp_sym->ts.is_iso_c = 1;
+	tmp_sym->ts.type = BT_DERIVED;
+
+	/* A derived type must have the bind attribute to be
+	   interoperable (J3/04-007, Section 15.2.3), even though
+	   the binding label is not used.  */
+	tmp_sym->attr.is_bind_c = 1;
+
+	tmp_sym->attr.referenced = 1;
+
+	tmp_sym->ts.u.derived = tmp_sym;
+
+        /* Add the symbol created for the derived type to the current ns.  */
+        dt_list_ptr = &(gfc_derived_types);
+        while (*dt_list_ptr != NULL && (*dt_list_ptr)->next != NULL)
+          dt_list_ptr = &((*dt_list_ptr)->next);
+
+        /* There is already at least one derived type in the list, so append
+           the one we're currently building for c_ptr or c_funptr.  */
+        if (*dt_list_ptr != NULL)
+          dt_list_ptr = &((*dt_list_ptr)->next);
+        (*dt_list_ptr) = gfc_get_dt_list ();
+        (*dt_list_ptr)->derived = tmp_sym;
+        (*dt_list_ptr)->next = NULL;
+
+        /* Set up the component of the derived type, which will be
+           an integer with kind equal to c_ptr_size.  Mangle the name of
+           the field for the c_address to prevent the curious user from
+           trying to access it from Fortran.  */
+        sprintf (comp_name, "__%s_%s", tmp_sym->name, "c_address");
+        gfc_add_component (tmp_sym, comp_name, &tmp_comp);
+        if (tmp_comp == NULL)
+          gfc_internal_error ("generate_isocbinding_symbol(): Unable to "
+			      "create component for c_address");
+
+        tmp_comp->ts.type = BT_INTEGER;
+
+        /* Set this because the module will need to read/write this field.  */
+        tmp_comp->ts.f90_type = BT_INTEGER;
+
+        /* The kinds for c_ptr and c_funptr are the same.  */
+        index = get_c_kind ("c_ptr", c_interop_kinds_table);
+        tmp_comp->ts.kind = c_interop_kinds_table[index].value;
+
+        tmp_comp->attr.pointer = 0;
+        tmp_comp->attr.dimension = 0;
+
+        /* Mark the component as C interoperable.  */
+        tmp_comp->ts.is_c_interop = 1;
+
+        /* Make it use associated (iso_c_binding module).  */
+        tmp_sym->attr.use_assoc = 1;
+	break;
+
+      case ISOCBINDING_NULL_PTR:
+      case ISOCBINDING_NULL_FUNPTR:
+        gen_special_c_interop_ptr (s, name, mod_name);
+        break;
+
+      case ISOCBINDING_F_POINTER:
+      case ISOCBINDING_ASSOCIATED:
+      case ISOCBINDING_LOC:
+      case ISOCBINDING_FUNLOC:
+      case ISOCBINDING_F_PROCPOINTER:
+
+	tmp_sym->attr.proc = PROC_MODULE;
+
+        /* Use the procedure's name as it is in the iso_c_binding module for
+           setting the binding label in case the user renamed the symbol.  */
+	sprintf (tmp_sym->binding_label, "%s_%s", mod_name,
+                 c_interop_kinds_table[s].name);
+	tmp_sym->attr.is_iso_c = 1;
+	if (s == ISOCBINDING_F_POINTER || s == ISOCBINDING_F_PROCPOINTER)
+	  tmp_sym->attr.subroutine = 1;
+	else
+	  {
+            /* TODO!  This needs to be finished more for the expr of the
+               function or something!
+               This may not need to be here, because trying to do c_loc
+               as an external.  */
+	    if (s == ISOCBINDING_ASSOCIATED)
+	      {
+		tmp_sym->attr.function = 1;
+		tmp_sym->ts.type = BT_LOGICAL;
+		tmp_sym->ts.kind = gfc_default_logical_kind;
+		tmp_sym->result = tmp_sym;
+	      }
+	    else
+	      {
+               /* Here, we're taking the simple approach.  We're defining
+                  c_loc as an external identifier so the compiler will put
+                  what we expect on the stack for the address we want the
+                  C address of.  */
+		tmp_sym->ts.type = BT_DERIVED;
+                if (s == ISOCBINDING_LOC)
+                  tmp_sym->ts.u.derived =
+                    get_iso_c_binding_dt (ISOCBINDING_PTR);
+                else
+                  tmp_sym->ts.u.derived =
+                    get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
+
+                if (tmp_sym->ts.u.derived == NULL)
+                  {
+                    /* Create the necessary derived type so we can continue
+                       processing the file.  */
+                    generate_isocbinding_symbol
+		      (mod_name, s == ISOCBINDING_FUNLOC
+				 ? ISOCBINDING_FUNPTR : ISOCBINDING_PTR,
+		       (const char *)(s == ISOCBINDING_FUNLOC
+                                ? "_gfortran_iso_c_binding_c_funptr"
+				: "_gfortran_iso_c_binding_c_ptr"));
+                    tmp_sym->ts.u.derived =
+                      get_iso_c_binding_dt (s == ISOCBINDING_FUNLOC
+                                            ? ISOCBINDING_FUNPTR
+                                            : ISOCBINDING_PTR);
+                  }
+
+		/* The function result is itself (no result clause).  */
+		tmp_sym->result = tmp_sym;
+		tmp_sym->attr.external = 1;
+		tmp_sym->attr.use_assoc = 0;
+		tmp_sym->attr.pure = 1;
+		tmp_sym->attr.if_source = IFSRC_UNKNOWN;
+		tmp_sym->attr.proc = PROC_UNKNOWN;
+	      }
+	  }
+
+	tmp_sym->attr.flavor = FL_PROCEDURE;
+	tmp_sym->attr.contained = 0;
+	
+       /* Try using this builder routine, with the new and old symbols
+          both being the generic iso_c proc sym being created.  This
+          will create the formal args (and the new namespace for them).
+          Don't build an arg list for c_loc because we're going to treat
+          c_loc as an external procedure.  */
+	if (s != ISOCBINDING_LOC && s != ISOCBINDING_FUNLOC)
+          /* The 1 says to add any optional args, if applicable.  */
+	  build_formal_args (tmp_sym, tmp_sym, 1);
+
+        /* Set this after setting up the symbol, to prevent error messages.  */
+	tmp_sym->attr.use_assoc = 1;
+
+        /* This symbol will not be referenced directly.  It will be
+           resolved to the implementation for the given f90 kind.  */
+	tmp_sym->attr.referenced = 0;
+
+	break;
+
+      default:
+	gcc_unreachable ();
+    }
+  gfc_commit_symbol (tmp_sym);
+}
+
+
+/* Creates a new symbol based off of an old iso_c symbol, with a new
+   binding label.  This function can be used to create a new,
+   resolved, version of a procedure symbol for c_f_pointer or
+   c_f_procpointer that is based on the generic symbols.  A new
+   parameter list is created for the new symbol using
+   build_formal_args().  The add_optional_flag specifies whether the
+   to add the optional SHAPE argument.  The new symbol is
+   returned.  */
+
+gfc_symbol *
+get_iso_c_sym (gfc_symbol *old_sym, char *new_name,
+               char *new_binding_label, int add_optional_arg)
+{
+  gfc_symtree *new_symtree = NULL;
+
+  /* See if we have a symbol by that name already available, looking
+     through any parent namespaces.  */
+  gfc_find_sym_tree (new_name, gfc_current_ns, 1, &new_symtree);
+  if (new_symtree != NULL)
+    /* Return the existing symbol.  */
+    return new_symtree->n.sym;
+
+  /* Create the symtree/symbol, with attempted host association.  */
+  gfc_get_ha_sym_tree (new_name, &new_symtree);
+  if (new_symtree == NULL)
+    gfc_internal_error ("get_iso_c_sym(): Unable to create "
+			"symtree for '%s'", new_name);
+
+  /* Now fill in the fields of the resolved symbol with the old sym.  */
+  strcpy (new_symtree->n.sym->binding_label, new_binding_label);
+  new_symtree->n.sym->attr = old_sym->attr;
+  new_symtree->n.sym->ts = old_sym->ts;
+  new_symtree->n.sym->module = gfc_get_string (old_sym->module);
+  new_symtree->n.sym->from_intmod = old_sym->from_intmod;
+  new_symtree->n.sym->intmod_sym_id = old_sym->intmod_sym_id;
+  if (old_sym->attr.function)
+    new_symtree->n.sym->result = new_symtree->n.sym;
+  /* Build the formal arg list.  */
+  build_formal_args (new_symtree->n.sym, old_sym, add_optional_arg);
+
+  gfc_commit_symbol (new_symtree->n.sym);
+
+  return new_symtree->n.sym;
+}
+
+
+/* Check that a symbol is already typed.  If strict is not set, an untyped
+   symbol is acceptable for non-standard-conforming mode.  */
+
+gfc_try
+gfc_check_symbol_typed (gfc_symbol* sym, gfc_namespace* ns,
+			bool strict, locus where)
+{
+  gcc_assert (sym);
+
+  if (gfc_matching_prefix)
+    return SUCCESS;
+
+  /* Check for the type and try to give it an implicit one.  */
+  if (sym->ts.type == BT_UNKNOWN
+      && gfc_set_default_type (sym, 0, ns) == FAILURE)
+    {
+      if (strict)
+	{
+	  gfc_error ("Symbol '%s' is used before it is typed at %L",
+		     sym->name, &where);
+	  return FAILURE;
+	}
+
+      if (gfc_notify_std (GFC_STD_GNU,
+			  "Extension: Symbol '%s' is used before"
+			  " it is typed at %L", sym->name, &where) == FAILURE)
+	return FAILURE;
+    }
+
+  /* Everything is ok.  */
+  return SUCCESS;
+}
+
+
+/* Construct a typebound-procedure structure.  Those are stored in a tentative
+   list and marked `error' until symbols are committed.  */
+
+gfc_typebound_proc*
+gfc_get_typebound_proc (gfc_typebound_proc *tb0)
+{
+  gfc_typebound_proc *result;
+  tentative_tbp *list_node;
+
+  result = XCNEW (gfc_typebound_proc);
+  if (tb0)
+    *result = *tb0;
+  result->error = 1;
+
+  list_node = XCNEW (tentative_tbp);
+  list_node->next = tentative_tbp_list;
+  list_node->proc = result;
+  tentative_tbp_list = list_node;
+
+  return result;
+}
+
+
+/* Get the super-type of a given derived type.  */
+
+gfc_symbol*
+gfc_get_derived_super_type (gfc_symbol* derived)
+{
+  if (!derived->attr.extension)
+    return NULL;
+
+  gcc_assert (derived->components);
+  gcc_assert (derived->components->ts.type == BT_DERIVED);
+  gcc_assert (derived->components->ts.u.derived);
+
+  return derived->components->ts.u.derived;
+}
+
+
+/* Get the ultimate super-type of a given derived type.  */
+
+gfc_symbol*
+gfc_get_ultimate_derived_super_type (gfc_symbol* derived)
+{
+  if (!derived->attr.extension)
+    return NULL;
+
+  derived = gfc_get_derived_super_type (derived);
+
+  if (derived->attr.extension)
+    return gfc_get_ultimate_derived_super_type (derived);
+  else
+    return derived;
+}
+
+
+/* Check if a derived type t2 is an extension of (or equal to) a type t1.  */
+
+bool
+gfc_type_is_extension_of (gfc_symbol *t1, gfc_symbol *t2)
+{
+  while (!gfc_compare_derived_types (t1, t2) && t2->attr.extension)
+    t2 = gfc_get_derived_super_type (t2);
+  return gfc_compare_derived_types (t1, t2);
+}
+
+
+/* Check if two typespecs are type compatible (F03:5.1.1.2):
+   If ts1 is nonpolymorphic, ts2 must be the same type.
+   If ts1 is polymorphic (CLASS), ts2 must be an extension of ts1.  */
+
+bool
+gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2)
+{
+  bool is_class1 = (ts1->type == BT_CLASS);
+  bool is_class2 = (ts2->type == BT_CLASS);
+  bool is_derived1 = (ts1->type == BT_DERIVED);
+  bool is_derived2 = (ts2->type == BT_DERIVED);
+
+  if (!is_derived1 && !is_derived2 && !is_class1 && !is_class2)
+    return (ts1->type == ts2->type);
+
+  if (is_derived1 && is_derived2)
+    return gfc_compare_derived_types (ts1->u.derived, ts2->u.derived);
+
+  if (is_class1 && is_derived2)
+    return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived,
+				     ts2->u.derived);
+  else if (is_class1 && is_class2)
+    return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived,
+				     ts2->u.derived->components->ts.u.derived);
+  else
+    return 0;
+}
+
+
+/* Find the parent-namespace of the current function.  If we're inside
+   BLOCK constructs, it may not be the current one.  */
+
+gfc_namespace*
+gfc_find_proc_namespace (gfc_namespace* ns)
+{
+  while (ns->construct_entities)
+    {
+      ns = ns->parent;
+      gcc_assert (ns);
+    }
+
+  return ns;
+}
+
+
+/* Check if an associate-variable should be translated as an `implicit' pointer
+   internally (if it is associated to a variable and not an array with
+   descriptor).  */
+
+bool
+gfc_is_associate_pointer (gfc_symbol* sym)
+{
+  if (!sym->assoc)
+    return false;
+
+  if (!sym->assoc->variable)
+    return false;
+
+  if (sym->attr.dimension && sym->as->type != AS_EXPLICIT)
+    return false;
+
+  return true;
+}
diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
new file mode 100644
index 000000000..0a09f5a5e
--- /dev/null
+++ b/gcc/fortran/target-memory.c
@@ -0,0 +1,752 @@
+/* Simulate storage of variables into target memory.
+   Copyright (C) 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Thomas and Brooks Moses
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "machmode.h"
+#include "tree.h"
+#include "gfortran.h"
+#include "arith.h"
+#include "constructor.h"
+#include "trans.h"
+#include "trans-const.h"
+#include "trans-types.h"
+#include "target-memory.h"
+
+/* --------------------------------------------------------------- */ 
+/* Calculate the size of an expression.  */
+
+static size_t
+size_array (gfc_expr *e)
+{
+  mpz_t array_size;
+  gfc_constructor *c = gfc_constructor_first (e->value.constructor);
+  size_t elt_size = gfc_target_expr_size (c->expr);
+
+  gfc_array_size (e, &array_size);
+  return (size_t)mpz_get_ui (array_size) * elt_size;
+}
+
+static size_t
+size_integer (int kind)
+{
+  return GET_MODE_SIZE (TYPE_MODE (gfc_get_int_type (kind)));;
+}
+
+
+static size_t
+size_float (int kind)
+{
+  return GET_MODE_SIZE (TYPE_MODE (gfc_get_real_type (kind)));;
+}
+
+
+static size_t
+size_complex (int kind)
+{
+  return 2 * size_float (kind);
+}
+
+
+static size_t
+size_logical (int kind)
+{
+  return GET_MODE_SIZE (TYPE_MODE (gfc_get_logical_type (kind)));;
+}
+
+
+static size_t
+size_character (int length, int kind)
+{
+  int i = gfc_validate_kind (BT_CHARACTER, kind, false);
+  return length * gfc_character_kinds[i].bit_size / 8;
+}
+
+
+size_t
+gfc_target_expr_size (gfc_expr *e)
+{
+  tree type;
+
+  gcc_assert (e != NULL);
+
+  if (e->expr_type == EXPR_ARRAY)
+    return size_array (e);
+
+  switch (e->ts.type)
+    {
+    case BT_INTEGER:
+      return size_integer (e->ts.kind);
+    case BT_REAL:
+      return size_float (e->ts.kind);
+    case BT_COMPLEX:
+      return size_complex (e->ts.kind);
+    case BT_LOGICAL:
+      return size_logical (e->ts.kind);
+    case BT_CHARACTER:
+      if (e->expr_type == EXPR_SUBSTRING && e->ref)
+        {
+          int start, end;
+
+          gfc_extract_int (e->ref->u.ss.start, &start);
+          gfc_extract_int (e->ref->u.ss.end, &end);
+          return size_character (MAX(end - start + 1, 0), e->ts.kind);
+        }
+      else
+        return size_character (e->value.character.length, e->ts.kind);
+    case BT_HOLLERITH:
+      return e->representation.length;
+    case BT_DERIVED:
+      type = gfc_typenode_for_spec (&e->ts);
+      return int_size_in_bytes (type);
+    default:
+      gfc_internal_error ("Invalid expression in gfc_target_expr_size.");
+      return 0;
+    }
+}
+
+
+/* The encode_* functions export a value into a buffer, and 
+   return the number of bytes of the buffer that have been
+   used.  */
+
+static int
+encode_array (gfc_expr *expr, unsigned char *buffer, size_t buffer_size)
+{
+  mpz_t array_size;
+  int i;
+  int ptr = 0;
+
+  gfc_constructor_base ctor = expr->value.constructor;
+
+  gfc_array_size (expr, &array_size);
+  for (i = 0; i < (int)mpz_get_ui (array_size); i++)
+    {
+      ptr += gfc_target_encode_expr (gfc_constructor_lookup_expr (ctor, i),
+				     &buffer[ptr], buffer_size - ptr);
+    }
+
+  mpz_clear (array_size);
+  return ptr;
+}
+
+
+static int
+encode_integer (int kind, mpz_t integer, unsigned char *buffer,
+		size_t buffer_size)
+{
+  return native_encode_expr (gfc_conv_mpz_to_tree (integer, kind),
+			     buffer, buffer_size);
+}
+
+
+static int
+encode_float (int kind, mpfr_t real, unsigned char *buffer, size_t buffer_size)
+{
+  return native_encode_expr (gfc_conv_mpfr_to_tree (real, kind, 0), buffer,
+			     buffer_size);
+}
+
+
+static int
+encode_complex (int kind, mpc_t cmplx,
+		unsigned char *buffer, size_t buffer_size)
+{
+  int size;
+  size = encode_float (kind, mpc_realref (cmplx), &buffer[0], buffer_size);
+  size += encode_float (kind, mpc_imagref (cmplx),
+			&buffer[size], buffer_size - size);
+  return size;
+}
+
+
+static int
+encode_logical (int kind, int logical, unsigned char *buffer, size_t buffer_size)
+{
+  return native_encode_expr (build_int_cst (gfc_get_logical_type (kind),
+					    logical),
+			     buffer, buffer_size);
+}
+
+
+int
+gfc_encode_character (int kind, int length, const gfc_char_t *string,
+		      unsigned char *buffer, size_t buffer_size)
+{
+  size_t elsize = size_character (1, kind);
+  tree type = gfc_get_char_type (kind);
+  int i;
+
+  gcc_assert (buffer_size >= size_character (length, kind));
+
+  for (i = 0; i < length; i++)
+    native_encode_expr (build_int_cst (type, string[i]), &buffer[i*elsize],
+			elsize);
+
+  return length;
+}
+
+
+static int
+encode_derived (gfc_expr *source, unsigned char *buffer, size_t buffer_size)
+{
+  gfc_constructor *c;
+  gfc_component *cmp;
+  int ptr;
+  tree type;
+
+  type = gfc_typenode_for_spec (&source->ts);
+
+  for (c = gfc_constructor_first (source->value.constructor),
+       cmp = source->ts.u.derived->components;
+       c;
+       c = gfc_constructor_next (c), cmp = cmp->next)
+    {
+      gcc_assert (cmp);
+      if (!c->expr)
+	continue;
+      ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))
+	    + TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))/8;
+
+      if (c->expr->expr_type == EXPR_NULL)
+ 	memset (&buffer[ptr], 0,
+		int_size_in_bytes (TREE_TYPE (cmp->backend_decl)));
+      else
+	gfc_target_encode_expr (c->expr, &buffer[ptr],
+				buffer_size - ptr);
+    }
+
+  return int_size_in_bytes (type);
+}
+
+
+/* Write a constant expression in binary form to a buffer.  */
+int
+gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer,
+			size_t buffer_size)
+{
+  if (source == NULL)
+    return 0;
+
+  if (source->expr_type == EXPR_ARRAY)
+    return encode_array (source, buffer, buffer_size);
+
+  gcc_assert (source->expr_type == EXPR_CONSTANT
+	      || source->expr_type == EXPR_STRUCTURE
+	      || source->expr_type == EXPR_SUBSTRING);
+
+  /* If we already have a target-memory representation, we use that rather 
+     than recreating one.  */
+  if (source->representation.string)
+    {
+      memcpy (buffer, source->representation.string,
+	      source->representation.length);
+      return source->representation.length;
+    }
+
+  switch (source->ts.type)
+    {
+    case BT_INTEGER:
+      return encode_integer (source->ts.kind, source->value.integer, buffer,
+			     buffer_size);
+    case BT_REAL:
+      return encode_float (source->ts.kind, source->value.real, buffer,
+			   buffer_size);
+    case BT_COMPLEX:
+      return encode_complex (source->ts.kind, source->value.complex,
+			     buffer, buffer_size);
+    case BT_LOGICAL:
+      return encode_logical (source->ts.kind, source->value.logical, buffer,
+			     buffer_size);
+    case BT_CHARACTER:
+      if (source->expr_type == EXPR_CONSTANT || source->ref == NULL)
+	return gfc_encode_character (source->ts.kind,
+				     source->value.character.length,
+				     source->value.character.string,
+				     buffer, buffer_size);
+      else
+	{
+	  int start, end;
+
+	  gcc_assert (source->expr_type == EXPR_SUBSTRING);
+	  gfc_extract_int (source->ref->u.ss.start, &start);
+	  gfc_extract_int (source->ref->u.ss.end, &end);
+	  return gfc_encode_character (source->ts.kind, MAX(end - start + 1, 0),
+				       &source->value.character.string[start-1],
+				       buffer, buffer_size);
+	}
+
+    case BT_DERIVED:
+      return encode_derived (source, buffer, buffer_size);
+    default:
+      gfc_internal_error ("Invalid expression in gfc_target_encode_expr.");
+      return 0;
+    }
+}
+
+
+static int
+interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
+{
+  gfc_constructor_base base = NULL;
+  int array_size = 1;
+  int i;
+  int ptr = 0;
+
+  /* Calculate array size from its shape and rank.  */
+  gcc_assert (result->rank > 0 && result->shape);
+
+  for (i = 0; i < result->rank; i++)
+    array_size *= (int)mpz_get_ui (result->shape[i]);
+
+  /* Iterate over array elements, producing constructors.  */
+  for (i = 0; i < array_size; i++)
+    {
+      gfc_expr *e = gfc_get_constant_expr (result->ts.type, result->ts.kind,
+					   &result->where);
+      e->ts = result->ts;
+
+      if (e->ts.type == BT_CHARACTER)
+	e->value.character.length = result->value.character.length;
+
+      gfc_constructor_append_expr (&base, e, &result->where);
+
+      ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e);
+    }
+
+  result->value.constructor = base;
+  return ptr;
+}
+
+
+int
+gfc_interpret_integer (int kind, unsigned char *buffer, size_t buffer_size,
+		   mpz_t integer)
+{
+  mpz_init (integer);
+  gfc_conv_tree_to_mpz (integer,
+			native_interpret_expr (gfc_get_int_type (kind),
+					       buffer, buffer_size));
+  return size_integer (kind);
+}
+
+
+int
+gfc_interpret_float (int kind, unsigned char *buffer, size_t buffer_size,
+		     mpfr_t real)
+{
+  gfc_set_model_kind (kind);
+  mpfr_init (real);
+  gfc_conv_tree_to_mpfr (real,
+			 native_interpret_expr (gfc_get_real_type (kind),
+						buffer, buffer_size));
+
+  return size_float (kind);
+}
+
+
+int
+gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
+		       mpc_t complex)
+{
+  int size;
+  size = gfc_interpret_float (kind, &buffer[0], buffer_size,
+			      mpc_realref (complex));
+  size += gfc_interpret_float (kind, &buffer[size], buffer_size - size,
+			       mpc_imagref (complex));
+  return size;
+}
+
+
+int
+gfc_interpret_logical (int kind, unsigned char *buffer, size_t buffer_size,
+		   int *logical)
+{
+  tree t = native_interpret_expr (gfc_get_logical_type (kind), buffer,
+				  buffer_size);
+  *logical = double_int_zero_p (tree_to_double_int (t))
+	     ? 0 : 1;
+  return size_logical (kind);
+}
+
+
+int
+gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
+			 gfc_expr *result)
+{
+  int i;
+
+  if (result->ts.u.cl && result->ts.u.cl->length)
+    result->value.character.length =
+      (int) mpz_get_ui (result->ts.u.cl->length->value.integer);
+
+  gcc_assert (buffer_size >= size_character (result->value.character.length,
+					     result->ts.kind));
+  result->value.character.string =
+    gfc_get_wide_string (result->value.character.length + 1);
+
+  if (result->ts.kind == gfc_default_character_kind)
+    for (i = 0; i < result->value.character.length; i++)
+      result->value.character.string[i] = (gfc_char_t) buffer[i];
+  else
+    {
+      mpz_t integer;
+      unsigned bytes = size_character (1, result->ts.kind);
+      mpz_init (integer);
+      gcc_assert (bytes <= sizeof (unsigned long));
+
+      for (i = 0; i < result->value.character.length; i++)
+	{
+	  gfc_conv_tree_to_mpz (integer,
+	    native_interpret_expr (gfc_get_char_type (result->ts.kind),
+				   &buffer[bytes*i], buffer_size-bytes*i));
+	  result->value.character.string[i]
+	    = (gfc_char_t) mpz_get_ui (integer);
+	}
+
+      mpz_clear (integer);
+    }
+
+  result->value.character.string[result->value.character.length] = '\0';
+
+  return result->value.character.length;
+}
+
+
+int
+gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
+{
+  gfc_component *cmp;
+  int ptr;
+  tree type;
+
+  /* The attributes of the derived type need to be bolted to the floor.  */
+  result->expr_type = EXPR_STRUCTURE;
+
+  cmp = result->ts.u.derived->components;
+
+  if (result->ts.u.derived->from_intmod == INTMOD_ISO_C_BINDING
+      && (result->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR
+	  || result->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR))
+    {
+      gfc_constructor *c;
+      gfc_expr *e;
+      /* Needed as gfc_typenode_for_spec as gfc_typenode_for_spec
+	 sets this to BT_INTEGER.  */
+      result->ts.type = BT_DERIVED;
+      e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind, &result->where); 
+      c = gfc_constructor_append_expr (&result->value.constructor, e, NULL);
+      c->n.component = cmp;
+      gfc_target_interpret_expr (buffer, buffer_size, e);
+      e->ts.is_iso_c = 1;
+      return int_size_in_bytes (ptr_type_node);
+    }
+
+  type = gfc_typenode_for_spec (&result->ts);
+
+  /* Run through the derived type components.  */
+  for (;cmp; cmp = cmp->next)
+    {
+      gfc_constructor *c;
+      gfc_expr *e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind,
+					   &result->where); 
+      e->ts = cmp->ts;
+
+      /* Copy shape, if needed.  */
+      if (cmp->as && cmp->as->rank)
+	{
+	  int n;
+
+	  e->expr_type = EXPR_ARRAY;
+	  e->rank = cmp->as->rank;
+
+	  e->shape = gfc_get_shape (e->rank);
+	  for (n = 0; n < e->rank; n++)
+	     {
+	       mpz_init_set_ui (e->shape[n], 1);
+	       mpz_add (e->shape[n], e->shape[n],
+			cmp->as->upper[n]->value.integer);
+	       mpz_sub (e->shape[n], e->shape[n],
+			cmp->as->lower[n]->value.integer);
+	     }
+	}
+
+      c = gfc_constructor_append_expr (&result->value.constructor, e, NULL);
+
+      /* The constructor points to the component.  */
+      c->n.component = cmp;
+
+      /* Calculate the offset, which consists of the the FIELD_OFFSET in
+	 bytes, which appears in multiples of DECL_OFFSET_ALIGN-bit-sized,
+	 and additional bits of FIELD_BIT_OFFSET. The code assumes that all
+	 sizes of the components are multiples of BITS_PER_UNIT,
+	 i.e. there are, e.g., no bit fields.  */
+
+      gcc_assert (cmp->backend_decl);
+      ptr = TREE_INT_CST_LOW (DECL_FIELD_BIT_OFFSET (cmp->backend_decl));
+      gcc_assert (ptr % 8 == 0);
+      ptr = ptr/8 + TREE_INT_CST_LOW (DECL_FIELD_OFFSET (cmp->backend_decl));
+
+      gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e);
+    }
+    
+  return int_size_in_bytes (type);
+}
+
+
+/* Read a binary buffer to a constant expression.  */
+int
+gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
+			   gfc_expr *result)
+{
+  if (result->expr_type == EXPR_ARRAY)
+    return interpret_array (buffer, buffer_size, result);
+
+  switch (result->ts.type)
+    {
+    case BT_INTEGER:
+      result->representation.length = 
+        gfc_interpret_integer (result->ts.kind, buffer, buffer_size,
+			       result->value.integer);
+      break;
+
+    case BT_REAL:
+      result->representation.length = 
+        gfc_interpret_float (result->ts.kind, buffer, buffer_size,
+    			     result->value.real);
+      break;
+
+    case BT_COMPLEX:
+      result->representation.length = 
+        gfc_interpret_complex (result->ts.kind, buffer, buffer_size,
+			       result->value.complex);
+      break;
+
+    case BT_LOGICAL:
+      result->representation.length = 
+        gfc_interpret_logical (result->ts.kind, buffer, buffer_size,
+			       &result->value.logical);
+      break;
+
+    case BT_CHARACTER:
+      result->representation.length = 
+        gfc_interpret_character (buffer, buffer_size, result);
+      break;
+
+    case BT_DERIVED:
+      result->representation.length = 
+        gfc_interpret_derived (buffer, buffer_size, result);
+      break;
+
+    default:
+      gfc_internal_error ("Invalid expression in gfc_target_interpret_expr.");
+      break;
+    }
+
+  if (result->ts.type == BT_CHARACTER)
+    result->representation.string
+      = gfc_widechar_to_char (result->value.character.string,
+			      result->value.character.length);
+  else
+    {
+      result->representation.string =
+        (char *) gfc_getmem (result->representation.length + 1);
+      memcpy (result->representation.string, buffer,
+	      result->representation.length);
+      result->representation.string[result->representation.length] = '\0';
+    }
+
+  return result->representation.length;
+}
+
+
+/* --------------------------------------------------------------- */ 
+/* Two functions used by trans-common.c to write overlapping
+   equivalence initializers to a buffer.  This is added to the union
+   and the original initializers freed.  */
+
+
+/* Writes the values of a constant expression to a char buffer. If another
+   unequal initializer has already been written to the buffer, this is an
+   error.  */
+
+static size_t
+expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len)
+{
+  int i;
+  int ptr;
+  gfc_constructor *c;
+  gfc_component *cmp;
+  unsigned char *buffer;
+
+  if (e == NULL)
+    return 0;
+
+  /* Take a derived type, one component at a time, using the offsets from the backend
+     declaration.  */
+  if (e->ts.type == BT_DERIVED)
+    {
+      for (c = gfc_constructor_first (e->value.constructor),
+	   cmp = e->ts.u.derived->components;
+	   c; c = gfc_constructor_next (c), cmp = cmp->next)
+	{
+	  gcc_assert (cmp && cmp->backend_decl);
+	  if (!c->expr)
+	    continue;
+	    ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))
+			+ TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))/8;
+	  expr_to_char (c->expr, &data[ptr], &chk[ptr], len);
+	}
+      return len;
+    }
+
+  /* Otherwise, use the target-memory machinery to write a bitwise image, appropriate
+     to the target, in a buffer and check off the initialized part of the buffer.  */
+  len = gfc_target_expr_size (e);
+  buffer = (unsigned char*)alloca (len);
+  len = gfc_target_encode_expr (e, buffer, len);
+
+    for (i = 0; i < (int)len; i++)
+    {
+      if (chk[i] && (buffer[i] != data[i]))
+	{
+	  gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
+		     "at %L", &e->where);
+	  return 0;
+	}
+      chk[i] = 0xFF;
+    }
+
+  memcpy (data, buffer, len);
+  return len;
+}
+
+
+/* Writes the values from the equivalence initializers to a char* array
+   that will be written to the constructor to make the initializer for
+   the union declaration.  */
+
+size_t
+gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
+			unsigned char *chk, size_t length)
+{
+  size_t len = 0;
+  gfc_constructor * c;
+
+  switch (e->expr_type)
+    {
+    case EXPR_CONSTANT:
+    case EXPR_STRUCTURE:
+      len = expr_to_char (e, &data[0], &chk[0], length);
+
+      break;
+
+    case EXPR_ARRAY:
+      for (c = gfc_constructor_first (e->value.constructor);
+	   c; c = gfc_constructor_next (c))
+	{
+	  size_t elt_size = gfc_target_expr_size (c->expr);
+
+	  if (c->offset)
+	    len = elt_size * (size_t)mpz_get_si (c->offset);
+
+	  len = len + gfc_merge_initializers (ts, c->expr, &data[len],
+					      &chk[len], length - len);
+	}
+      break;
+
+    default:
+      return 0;
+    }
+
+  return len;
+}
+
+
+/* Transfer the bitpattern of a (integer) BOZ to real or complex variables.
+   When successful, no BOZ or nothing to do, true is returned.  */
+
+bool
+gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
+{
+  size_t buffer_size, boz_bit_size, ts_bit_size;
+  int index;
+  unsigned char *buffer;
+
+  if (!expr->is_boz)
+    return true;
+
+  gcc_assert (expr->expr_type == EXPR_CONSTANT
+	      && expr->ts.type == BT_INTEGER);
+
+  /* Don't convert BOZ to logical, character, derived etc.  */
+  if (ts->type == BT_REAL)
+    {
+      buffer_size = size_float (ts->kind);
+      ts_bit_size = buffer_size * 8;
+    }
+  else if (ts->type == BT_COMPLEX)
+    {
+      buffer_size = size_complex (ts->kind);
+      ts_bit_size = buffer_size * 8 / 2;
+    }
+  else
+    return true;
+
+  /* Convert BOZ to the smallest possible integer kind.  */
+  boz_bit_size = mpz_sizeinbase (expr->value.integer, 2);
+
+  if (boz_bit_size > ts_bit_size)
+    {
+      gfc_error_now ("BOZ constant at %L is too large (%ld vs %ld bits)",
+		     &expr->where, (long) boz_bit_size, (long) ts_bit_size);
+      return false;
+    }
+
+  for (index = 0; gfc_integer_kinds[index].kind != 0; ++index)
+    if ((unsigned) gfc_integer_kinds[index].bit_size >= ts_bit_size)
+      break;
+
+  expr->ts.kind = gfc_integer_kinds[index].kind;
+  buffer_size = MAX (buffer_size, size_integer (expr->ts.kind));
+
+  buffer = (unsigned char*)alloca (buffer_size);
+  encode_integer (expr->ts.kind, expr->value.integer, buffer, buffer_size);
+  mpz_clear (expr->value.integer);
+
+  if (ts->type == BT_REAL)
+    {
+      mpfr_init (expr->value.real);
+      gfc_interpret_float (ts->kind, buffer, buffer_size, expr->value.real);
+    }
+  else
+    {
+      mpc_init2 (expr->value.complex, mpfr_get_default_prec());
+      gfc_interpret_complex (ts->kind, buffer, buffer_size,
+			     expr->value.complex);
+    }
+  expr->is_boz = 0;  
+  expr->ts.type = ts->type;
+  expr->ts.kind = ts->kind;
+
+  return true;
+}
diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h
new file mode 100644
index 000000000..2a82a88c0
--- /dev/null
+++ b/gcc/fortran/target-memory.h
@@ -0,0 +1,51 @@
+/* Simulate storage of variables into target memory, header.
+   Copyright (C) 2007, 2008, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Thomas and Brooks Moses
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#ifndef GFC_TARGET_MEMORY_H
+#define GFC_TARGET_MEMORY_H
+
+/* Convert a BOZ to REAL or COMPLEX.  */
+bool gfc_convert_boz (gfc_expr *, gfc_typespec *);
+
+/* Return the size of an expression in its target representation.  */
+size_t gfc_target_expr_size (gfc_expr *);
+
+/* Write a constant expression in binary form to a target buffer.  */
+int gfc_encode_character (int, int, const gfc_char_t *, unsigned char *,
+			  size_t);
+int gfc_target_encode_expr (gfc_expr *, unsigned char *, size_t);
+
+/* Read a target buffer into a constant expression.  */
+
+int gfc_interpret_integer (int, unsigned char *, size_t, mpz_t);
+int gfc_interpret_float (int, unsigned char *, size_t, mpfr_t);
+int gfc_interpret_complex (int, unsigned char *, size_t, mpc_t);
+int gfc_interpret_logical (int, unsigned char *, size_t, int *);
+int gfc_interpret_character (unsigned char *, size_t, gfc_expr *);
+int gfc_interpret_derived (unsigned char *, size_t, gfc_expr *);
+int gfc_target_interpret_expr (unsigned char *, size_t, gfc_expr *);
+
+/* Merge overlapping equivalence initializers for trans-common.c. */
+size_t gfc_merge_initializers (gfc_typespec, gfc_expr *,
+			       unsigned char *, unsigned char *,
+			       size_t);
+
+#endif /* GFC_TARGET_MEMORY_H  */
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
new file mode 100644
index 000000000..c76cd115c
--- /dev/null
+++ b/gcc/fortran/trans-array.c
@@ -0,0 +1,7717 @@
+/* Array translation routines
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+   2011
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+   and Steven Bosscher <s.bosscher@student.tudelft.nl>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* trans-array.c-- Various array related code, including scalarization,
+                   allocation, initialization and other support routines.  */
+
+/* How the scalarizer works.
+   In gfortran, array expressions use the same core routines as scalar
+   expressions.
+   First, a Scalarization State (SS) chain is built.  This is done by walking
+   the expression tree, and building a linear list of the terms in the
+   expression.  As the tree is walked, scalar subexpressions are translated.
+
+   The scalarization parameters are stored in a gfc_loopinfo structure.
+   First the start and stride of each term is calculated by
+   gfc_conv_ss_startstride.  During this process the expressions for the array
+   descriptors and data pointers are also translated.
+
+   If the expression is an assignment, we must then resolve any dependencies.
+   In fortran all the rhs values of an assignment must be evaluated before
+   any assignments take place.  This can require a temporary array to store the
+   values.  We also require a temporary when we are passing array expressions
+   or vector subscripts as procedure parameters.
+
+   Array sections are passed without copying to a temporary.  These use the
+   scalarizer to determine the shape of the section.  The flag
+   loop->array_parameter tells the scalarizer that the actual values and loop
+   variables will not be required.
+
+   The function gfc_conv_loop_setup generates the scalarization setup code.
+   It determines the range of the scalarizing loop variables.  If a temporary
+   is required, this is created and initialized.  Code for scalar expressions
+   taken outside the loop is also generated at this time.  Next the offset and
+   scaling required to translate from loop variables to array indices for each
+   term is calculated.
+
+   A call to gfc_start_scalarized_body marks the start of the scalarized
+   expression.  This creates a scope and declares the loop variables.  Before
+   calling this gfc_make_ss_chain_used must be used to indicate which terms
+   will be used inside this loop.
+
+   The scalar gfc_conv_* functions are then used to build the main body of the
+   scalarization loop.  Scalarization loop variables and precalculated scalar
+   values are automatically substituted.  Note that gfc_advance_se_ss_chain
+   must be used, rather than changing the se->ss directly.
+
+   For assignment expressions requiring a temporary two sub loops are
+   generated.  The first stores the result of the expression in the temporary,
+   the second copies it to the result.  A call to
+   gfc_trans_scalarized_loop_boundary marks the end of the main loop code and
+   the start of the copying loop.  The temporary may be less than full rank.
+
+   Finally gfc_trans_scalarizing_loops is called to generate the implicit do
+   loops.  The loops are added to the pre chain of the loopinfo.  The post
+   chain may still contain cleanup code.
+
+   After the loop code has been added into its parent scope gfc_cleanup_loop
+   is called to free all the SS allocated by the scalarizer.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "diagnostic-core.h"	/* For internal_error/fatal_error.  */
+#include "flags.h"
+#include "gfortran.h"
+#include "constructor.h"
+#include "trans.h"
+#include "trans-stmt.h"
+#include "trans-types.h"
+#include "trans-array.h"
+#include "trans-const.h"
+#include "dependency.h"
+
+static bool gfc_get_array_constructor_size (mpz_t *, gfc_constructor_base);
+
+/* The contents of this structure aren't actually used, just the address.  */
+static gfc_ss gfc_ss_terminator_var;
+gfc_ss * const gfc_ss_terminator = &gfc_ss_terminator_var;
+
+
+static tree
+gfc_array_dataptr_type (tree desc)
+{
+  return (GFC_TYPE_ARRAY_DATAPTR_TYPE (TREE_TYPE (desc)));
+}
+
+
+/* Build expressions to access the members of an array descriptor.
+   It's surprisingly easy to mess up here, so never access
+   an array descriptor by "brute force", always use these
+   functions.  This also avoids problems if we change the format
+   of an array descriptor.
+
+   To understand these magic numbers, look at the comments
+   before gfc_build_array_type() in trans-types.c.
+
+   The code within these defines should be the only code which knows the format
+   of an array descriptor.
+
+   Any code just needing to read obtain the bounds of an array should use
+   gfc_conv_array_* rather than the following functions as these will return
+   know constant values, and work with arrays which do not have descriptors.
+
+   Don't forget to #undef these!  */
+
+#define DATA_FIELD 0
+#define OFFSET_FIELD 1
+#define DTYPE_FIELD 2
+#define DIMENSION_FIELD 3
+
+#define STRIDE_SUBFIELD 0
+#define LBOUND_SUBFIELD 1
+#define UBOUND_SUBFIELD 2
+
+/* This provides READ-ONLY access to the data field.  The field itself
+   doesn't have the proper type.  */
+
+tree
+gfc_conv_descriptor_data_get (tree desc)
+{
+  tree field, type, t;
+
+  type = TREE_TYPE (desc);
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+  field = TYPE_FIELDS (type);
+  gcc_assert (DATA_FIELD == 0);
+
+  t = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), desc,
+		       field, NULL_TREE);
+  t = fold_convert (GFC_TYPE_ARRAY_DATAPTR_TYPE (type), t);
+
+  return t;
+}
+
+/* This provides WRITE access to the data field.
+
+   TUPLES_P is true if we are generating tuples.
+   
+   This function gets called through the following macros:
+     gfc_conv_descriptor_data_set
+     gfc_conv_descriptor_data_set.  */
+
+void
+gfc_conv_descriptor_data_set (stmtblock_t *block, tree desc, tree value)
+{
+  tree field, type, t;
+
+  type = TREE_TYPE (desc);
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+  field = TYPE_FIELDS (type);
+  gcc_assert (DATA_FIELD == 0);
+
+  t = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), desc,
+		       field, NULL_TREE);
+  gfc_add_modify (block, t, fold_convert (TREE_TYPE (field), value));
+}
+
+
+/* This provides address access to the data field.  This should only be
+   used by array allocation, passing this on to the runtime.  */
+
+tree
+gfc_conv_descriptor_data_addr (tree desc)
+{
+  tree field, type, t;
+
+  type = TREE_TYPE (desc);
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+  field = TYPE_FIELDS (type);
+  gcc_assert (DATA_FIELD == 0);
+
+  t = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), desc,
+		       field, NULL_TREE);
+  return gfc_build_addr_expr (NULL_TREE, t);
+}
+
+static tree
+gfc_conv_descriptor_offset (tree desc)
+{
+  tree type;
+  tree field;
+
+  type = TREE_TYPE (desc);
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+  field = gfc_advance_chain (TYPE_FIELDS (type), OFFSET_FIELD);
+  gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type);
+
+  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			  desc, field, NULL_TREE);
+}
+
+tree
+gfc_conv_descriptor_offset_get (tree desc)
+{
+  return gfc_conv_descriptor_offset (desc);
+}
+
+void
+gfc_conv_descriptor_offset_set (stmtblock_t *block, tree desc,
+				tree value)
+{
+  tree t = gfc_conv_descriptor_offset (desc);
+  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+}
+
+
+tree
+gfc_conv_descriptor_dtype (tree desc)
+{
+  tree field;
+  tree type;
+
+  type = TREE_TYPE (desc);
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+  field = gfc_advance_chain (TYPE_FIELDS (type), DTYPE_FIELD);
+  gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type);
+
+  return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			  desc, field, NULL_TREE);
+}
+
+static tree
+gfc_conv_descriptor_dimension (tree desc, tree dim)
+{
+  tree field;
+  tree type;
+  tree tmp;
+
+  type = TREE_TYPE (desc);
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+
+  field = gfc_advance_chain (TYPE_FIELDS (type), DIMENSION_FIELD);
+  gcc_assert (field != NULL_TREE
+	  && TREE_CODE (TREE_TYPE (field)) == ARRAY_TYPE
+	  && TREE_CODE (TREE_TYPE (TREE_TYPE (field))) == RECORD_TYPE);
+
+  tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			 desc, field, NULL_TREE);
+  tmp = gfc_build_array_ref (tmp, dim, NULL);
+  return tmp;
+}
+
+static tree
+gfc_conv_descriptor_stride (tree desc, tree dim)
+{
+  tree tmp;
+  tree field;
+
+  tmp = gfc_conv_descriptor_dimension (desc, dim);
+  field = TYPE_FIELDS (TREE_TYPE (tmp));
+  field = gfc_advance_chain (field, STRIDE_SUBFIELD);
+  gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type);
+
+  tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			 tmp, field, NULL_TREE);
+  return tmp;
+}
+
+tree
+gfc_conv_descriptor_stride_get (tree desc, tree dim)
+{
+  tree type = TREE_TYPE (desc);
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+  if (integer_zerop (dim)
+      && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE
+	  ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT
+	  ||GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
+    return gfc_index_one_node;
+
+  return gfc_conv_descriptor_stride (desc, dim);
+}
+
+void
+gfc_conv_descriptor_stride_set (stmtblock_t *block, tree desc,
+				tree dim, tree value)
+{
+  tree t = gfc_conv_descriptor_stride (desc, dim);
+  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+}
+
+static tree
+gfc_conv_descriptor_lbound (tree desc, tree dim)
+{
+  tree tmp;
+  tree field;
+
+  tmp = gfc_conv_descriptor_dimension (desc, dim);
+  field = TYPE_FIELDS (TREE_TYPE (tmp));
+  field = gfc_advance_chain (field, LBOUND_SUBFIELD);
+  gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type);
+
+  tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			 tmp, field, NULL_TREE);
+  return tmp;
+}
+
+tree
+gfc_conv_descriptor_lbound_get (tree desc, tree dim)
+{
+  return gfc_conv_descriptor_lbound (desc, dim);
+}
+
+void
+gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc,
+				tree dim, tree value)
+{
+  tree t = gfc_conv_descriptor_lbound (desc, dim);
+  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+}
+
+static tree
+gfc_conv_descriptor_ubound (tree desc, tree dim)
+{
+  tree tmp;
+  tree field;
+
+  tmp = gfc_conv_descriptor_dimension (desc, dim);
+  field = TYPE_FIELDS (TREE_TYPE (tmp));
+  field = gfc_advance_chain (field, UBOUND_SUBFIELD);
+  gcc_assert (field != NULL_TREE && TREE_TYPE (field) == gfc_array_index_type);
+
+  tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			 tmp, field, NULL_TREE);
+  return tmp;
+}
+
+tree
+gfc_conv_descriptor_ubound_get (tree desc, tree dim)
+{
+  return gfc_conv_descriptor_ubound (desc, dim);
+}
+
+void
+gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc,
+				tree dim, tree value)
+{
+  tree t = gfc_conv_descriptor_ubound (desc, dim);
+  gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
+}
+
+/* Build a null array descriptor constructor.  */
+
+tree
+gfc_build_null_descriptor (tree type)
+{
+  tree field;
+  tree tmp;
+
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+  gcc_assert (DATA_FIELD == 0);
+  field = TYPE_FIELDS (type);
+
+  /* Set a NULL data pointer.  */
+  tmp = build_constructor_single (type, field, null_pointer_node);
+  TREE_CONSTANT (tmp) = 1;
+  /* All other fields are ignored.  */
+
+  return tmp;
+}
+
+
+/* Modify a descriptor such that the lbound of a given dimension is the value
+   specified.  This also updates ubound and offset accordingly.  */
+
+void
+gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc,
+				  int dim, tree new_lbound)
+{
+  tree offs, ubound, lbound, stride;
+  tree diff, offs_diff;
+
+  new_lbound = fold_convert (gfc_array_index_type, new_lbound);
+
+  offs = gfc_conv_descriptor_offset_get (desc);
+  lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
+  ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
+  stride = gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]);
+
+  /* Get difference (new - old) by which to shift stuff.  */
+  diff = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			  new_lbound, lbound);
+
+  /* Shift ubound and offset accordingly.  This has to be done before
+     updating the lbound, as they depend on the lbound expression!  */
+  ubound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			    ubound, diff);
+  gfc_conv_descriptor_ubound_set (block, desc, gfc_rank_cst[dim], ubound);
+  offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			       diff, stride);
+  offs = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			  offs, offs_diff);
+  gfc_conv_descriptor_offset_set (block, desc, offs);
+
+  /* Finally set lbound to value we want.  */
+  gfc_conv_descriptor_lbound_set (block, desc, gfc_rank_cst[dim], new_lbound);
+}
+
+
+/* Cleanup those #defines.  */
+
+#undef DATA_FIELD
+#undef OFFSET_FIELD
+#undef DTYPE_FIELD
+#undef DIMENSION_FIELD
+#undef STRIDE_SUBFIELD
+#undef LBOUND_SUBFIELD
+#undef UBOUND_SUBFIELD
+
+
+/* Mark a SS chain as used.  Flags specifies in which loops the SS is used.
+   flags & 1 = Main loop body.
+   flags & 2 = temp copy loop.  */
+
+void
+gfc_mark_ss_chain_used (gfc_ss * ss, unsigned flags)
+{
+  for (; ss != gfc_ss_terminator; ss = ss->next)
+    ss->useflags = flags;
+}
+
+static void gfc_free_ss (gfc_ss *);
+
+
+/* Free a gfc_ss chain.  */
+
+void
+gfc_free_ss_chain (gfc_ss * ss)
+{
+  gfc_ss *next;
+
+  while (ss != gfc_ss_terminator)
+    {
+      gcc_assert (ss != NULL);
+      next = ss->next;
+      gfc_free_ss (ss);
+      ss = next;
+    }
+}
+
+
+/* Free a SS.  */
+
+static void
+gfc_free_ss (gfc_ss * ss)
+{
+  int n;
+
+  switch (ss->type)
+    {
+    case GFC_SS_SECTION:
+      for (n = 0; n < ss->data.info.dimen; n++)
+	{
+	  if (ss->data.info.subscript[ss->data.info.dim[n]])
+	    gfc_free_ss_chain (ss->data.info.subscript[ss->data.info.dim[n]]);
+	}
+      break;
+
+    default:
+      break;
+    }
+
+  gfc_free (ss);
+}
+
+
+/* Free all the SS associated with a loop.  */
+
+void
+gfc_cleanup_loop (gfc_loopinfo * loop)
+{
+  gfc_ss *ss;
+  gfc_ss *next;
+
+  ss = loop->ss;
+  while (ss != gfc_ss_terminator)
+    {
+      gcc_assert (ss != NULL);
+      next = ss->loop_chain;
+      gfc_free_ss (ss);
+      ss = next;
+    }
+}
+
+
+/* Associate a SS chain with a loop.  */
+
+void
+gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head)
+{
+  gfc_ss *ss;
+
+  if (head == gfc_ss_terminator)
+    return;
+
+  ss = head;
+  for (; ss && ss != gfc_ss_terminator; ss = ss->next)
+    {
+      if (ss->next == gfc_ss_terminator)
+	ss->loop_chain = loop->ss;
+      else
+	ss->loop_chain = ss->next;
+    }
+  gcc_assert (ss == gfc_ss_terminator);
+  loop->ss = head;
+}
+
+
+/* Generate an initializer for a static pointer or allocatable array.  */
+
+void
+gfc_trans_static_array_pointer (gfc_symbol * sym)
+{
+  tree type;
+
+  gcc_assert (TREE_STATIC (sym->backend_decl));
+  /* Just zero the data member.  */
+  type = TREE_TYPE (sym->backend_decl);
+  DECL_INITIAL (sym->backend_decl) = gfc_build_null_descriptor (type);
+}
+
+
+/* If the bounds of SE's loop have not yet been set, see if they can be
+   determined from array spec AS, which is the array spec of a called
+   function.  MAPPING maps the callee's dummy arguments to the values
+   that the caller is passing.  Add any initialization and finalization
+   code to SE.  */
+
+void
+gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping,
+				     gfc_se * se, gfc_array_spec * as)
+{
+  int n, dim;
+  gfc_se tmpse;
+  tree lower;
+  tree upper;
+  tree tmp;
+
+  if (as && as->type == AS_EXPLICIT)
+    for (n = 0; n < se->loop->dimen; n++)
+      {
+	dim = se->ss->data.info.dim[n];
+	gcc_assert (dim < as->rank);
+	gcc_assert (se->loop->dimen == as->rank);
+	if (se->loop->to[n] == NULL_TREE)
+	  {
+	    /* Evaluate the lower bound.  */
+	    gfc_init_se (&tmpse, NULL);
+	    gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]);
+	    gfc_add_block_to_block (&se->pre, &tmpse.pre);
+	    gfc_add_block_to_block (&se->post, &tmpse.post);
+	    lower = fold_convert (gfc_array_index_type, tmpse.expr);
+
+	    /* ...and the upper bound.  */
+	    gfc_init_se (&tmpse, NULL);
+	    gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]);
+	    gfc_add_block_to_block (&se->pre, &tmpse.pre);
+	    gfc_add_block_to_block (&se->post, &tmpse.post);
+	    upper = fold_convert (gfc_array_index_type, tmpse.expr);
+
+	    /* Set the upper bound of the loop to UPPER - LOWER.  */
+	    tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				   gfc_array_index_type, upper, lower);
+	    tmp = gfc_evaluate_now (tmp, &se->pre);
+	    se->loop->to[n] = tmp;
+	  }
+      }
+}
+
+
+/* Generate code to allocate an array temporary, or create a variable to
+   hold the data.  If size is NULL, zero the descriptor so that the
+   callee will allocate the array.  If DEALLOC is true, also generate code to
+   free the array afterwards.
+
+   If INITIAL is not NULL, it is packed using internal_pack and the result used
+   as data instead of allocating a fresh, unitialized area of memory.
+
+   Initialization code is added to PRE and finalization code to POST.
+   DYNAMIC is true if the caller may want to extend the array later
+   using realloc.  This prevents us from putting the array on the stack.  */
+
+static void
+gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post,
+				  gfc_ss_info * info, tree size, tree nelem,
+				  tree initial, bool dynamic, bool dealloc)
+{
+  tree tmp;
+  tree desc;
+  bool onstack;
+
+  desc = info->descriptor;
+  info->offset = gfc_index_zero_node;
+  if (size == NULL_TREE || integer_zerop (size))
+    {
+      /* A callee allocated array.  */
+      gfc_conv_descriptor_data_set (pre, desc, null_pointer_node);
+      onstack = FALSE;
+    }
+  else
+    {
+      /* Allocate the temporary.  */
+      onstack = !dynamic && initial == NULL_TREE
+			 && gfc_can_put_var_on_stack (size);
+
+      if (onstack)
+	{
+	  /* Make a temporary variable to hold the data.  */
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (nelem),
+				 nelem, gfc_index_one_node);
+	  tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node,
+				  tmp);
+	  tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)),
+				  tmp);
+	  tmp = gfc_create_var (tmp, "A");
+	  tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+	  gfc_conv_descriptor_data_set (pre, desc, tmp);
+	}
+      else
+	{
+	  /* Allocate memory to hold the data or call internal_pack.  */
+	  if (initial == NULL_TREE)
+	    {
+	      tmp = gfc_call_malloc (pre, NULL, size);
+	      tmp = gfc_evaluate_now (tmp, pre);
+	    }
+	  else
+	    {
+	      tree packed;
+	      tree source_data;
+	      tree was_packed;
+	      stmtblock_t do_copying;
+
+	      tmp = TREE_TYPE (initial); /* Pointer to descriptor.  */
+	      gcc_assert (TREE_CODE (tmp) == POINTER_TYPE);
+	      tmp = TREE_TYPE (tmp); /* The descriptor itself.  */
+	      tmp = gfc_get_element_type (tmp);
+	      gcc_assert (tmp == gfc_get_element_type (TREE_TYPE (desc)));
+	      packed = gfc_create_var (build_pointer_type (tmp), "data");
+
+	      tmp = build_call_expr_loc (input_location,
+				     gfor_fndecl_in_pack, 1, initial);
+	      tmp = fold_convert (TREE_TYPE (packed), tmp);
+	      gfc_add_modify (pre, packed, tmp);
+
+	      tmp = build_fold_indirect_ref_loc (input_location,
+					     initial);
+	      source_data = gfc_conv_descriptor_data_get (tmp);
+
+	      /* internal_pack may return source->data without any allocation
+		 or copying if it is already packed.  If that's the case, we
+		 need to allocate and copy manually.  */
+
+	      gfc_start_block (&do_copying);
+	      tmp = gfc_call_malloc (&do_copying, NULL, size);
+	      tmp = fold_convert (TREE_TYPE (packed), tmp);
+	      gfc_add_modify (&do_copying, packed, tmp);
+	      tmp = gfc_build_memcpy_call (packed, source_data, size);
+	      gfc_add_expr_to_block (&do_copying, tmp);
+
+	      was_packed = fold_build2_loc (input_location, EQ_EXPR,
+					    boolean_type_node, packed,
+					    source_data);
+	      tmp = gfc_finish_block (&do_copying);
+	      tmp = build3_v (COND_EXPR, was_packed, tmp,
+			      build_empty_stmt (input_location));
+	      gfc_add_expr_to_block (pre, tmp);
+
+	      tmp = fold_convert (pvoid_type_node, packed);
+	    }
+
+	  gfc_conv_descriptor_data_set (pre, desc, tmp);
+	}
+    }
+  info->data = gfc_conv_descriptor_data_get (desc);
+
+  /* The offset is zero because we create temporaries with a zero
+     lower bound.  */
+  gfc_conv_descriptor_offset_set (pre, desc, gfc_index_zero_node);
+
+  if (dealloc && !onstack)
+    {
+      /* Free the temporary.  */
+      tmp = gfc_conv_descriptor_data_get (desc);
+      tmp = gfc_call_free (fold_convert (pvoid_type_node, tmp));
+      gfc_add_expr_to_block (post, tmp);
+    }
+}
+
+
+/* Get the array reference dimension corresponding to the given loop dimension.
+   It is different from the true array dimension given by the dim array in
+   the case of a partial array reference
+   It is different from the loop dimension in the case of a transposed array.
+   */
+
+static int
+get_array_ref_dim (gfc_ss_info *info, int loop_dim)
+{
+  int n, array_dim, array_ref_dim;
+
+  array_ref_dim = 0;
+  array_dim = info->dim[loop_dim];
+
+  for (n = 0; n < info->dimen; n++)
+    if (n != loop_dim && info->dim[n] < array_dim)
+      array_ref_dim++;
+
+  return array_ref_dim;
+}
+
+
+/* Generate code to create and initialize the descriptor for a temporary
+   array.  This is used for both temporaries needed by the scalarizer, and
+   functions returning arrays.  Adjusts the loop variables to be
+   zero-based, and calculates the loop bounds for callee allocated arrays.
+   Allocate the array unless it's callee allocated (we have a callee
+   allocated array if 'callee_alloc' is true, or if loop->to[n] is
+   NULL_TREE for any n).  Also fills in the descriptor, data and offset
+   fields of info if known.  Returns the size of the array, or NULL for a
+   callee allocated array.
+
+   PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for
+   gfc_trans_allocate_array_storage.
+ */
+
+tree
+gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
+			     gfc_loopinfo * loop, gfc_ss_info * info,
+			     tree eltype, tree initial, bool dynamic,
+			     bool dealloc, bool callee_alloc, locus * where)
+{
+  tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS];
+  tree type;
+  tree desc;
+  tree tmp;
+  tree size;
+  tree nelem;
+  tree cond;
+  tree or_expr;
+  int n, dim, tmp_dim;
+
+  memset (from, 0, sizeof (from));
+  memset (to, 0, sizeof (to));
+
+  gcc_assert (info->dimen > 0);
+  gcc_assert (loop->dimen == info->dimen);
+
+  if (gfc_option.warn_array_temp && where)
+    gfc_warning ("Creating array temporary at %L", where);
+
+  /* Set the lower bound to zero.  */
+  for (n = 0; n < loop->dimen; n++)
+    {
+      dim = info->dim[n];
+
+      /* Callee allocated arrays may not have a known bound yet.  */
+      if (loop->to[n])
+	loop->to[n] = gfc_evaluate_now (
+			fold_build2_loc (input_location, MINUS_EXPR,
+					 gfc_array_index_type,
+					 loop->to[n], loop->from[n]),
+			pre);
+      loop->from[n] = gfc_index_zero_node;
+
+      /* We are constructing the temporary's descriptor based on the loop
+	 dimensions. As the dimensions may be accessed in arbitrary order
+	 (think of transpose) the size taken from the n'th loop may not map
+	 to the n'th dimension of the array. We need to reconstruct loop infos
+	 in the right order before using it to set the descriptor
+	 bounds.  */
+      tmp_dim = get_array_ref_dim (info, n);
+      from[tmp_dim] = loop->from[n];
+      to[tmp_dim] = loop->to[n];
+
+      info->delta[dim] = gfc_index_zero_node;
+      info->start[dim] = gfc_index_zero_node;
+      info->end[dim] = gfc_index_zero_node;
+      info->stride[dim] = gfc_index_one_node;
+    }
+
+  /* Initialize the descriptor.  */
+  type =
+    gfc_get_array_type_bounds (eltype, info->dimen, 0, from, to, 1,
+			       GFC_ARRAY_UNKNOWN, true);
+  desc = gfc_create_var (type, "atmp");
+  GFC_DECL_PACKED_ARRAY (desc) = 1;
+
+  info->descriptor = desc;
+  size = gfc_index_one_node;
+
+  /* Fill in the array dtype.  */
+  tmp = gfc_conv_descriptor_dtype (desc);
+  gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+
+  /*
+     Fill in the bounds and stride.  This is a packed array, so:
+
+     size = 1;
+     for (n = 0; n < rank; n++)
+       {
+	 stride[n] = size
+	 delta = ubound[n] + 1 - lbound[n];
+	 size = size * delta;
+       }
+     size = size * sizeof(element);
+  */
+
+  or_expr = NULL_TREE;
+
+  /* If there is at least one null loop->to[n], it is a callee allocated
+     array.  */
+  for (n = 0; n < loop->dimen; n++)
+    if (loop->to[n] == NULL_TREE)
+      {
+	size = NULL_TREE;
+	break;
+      }
+
+  for (n = 0; n < loop->dimen; n++)
+    {
+      dim = info->dim[n];
+
+      if (size == NULL_TREE)
+	{
+	  /* For a callee allocated array express the loop bounds in terms
+	     of the descriptor fields.  */
+	  tmp = fold_build2_loc (input_location,
+		MINUS_EXPR, gfc_array_index_type,
+		gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]),
+		gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]));
+	  loop->to[n] = tmp;
+	  continue;
+	}
+	
+      /* Store the stride and bound components in the descriptor.  */
+      gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size);
+
+      gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n],
+				      gfc_index_zero_node);
+
+      gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n],
+				      to[n]);
+
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     to[n], gfc_index_one_node);
+
+      /* Check whether the size for this dimension is negative.  */
+      cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, tmp,
+			      gfc_index_zero_node);
+      cond = gfc_evaluate_now (cond, pre);
+
+      if (n == 0)
+	or_expr = cond;
+      else
+	or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+				   boolean_type_node, or_expr, cond);
+
+      size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			      size, tmp);
+      size = gfc_evaluate_now (size, pre);
+    }
+
+  /* Get the size of the array.  */
+
+  if (size && !callee_alloc)
+    {
+      /* If or_expr is true, then the extent in at least one
+	 dimension is zero and the size is set to zero.  */
+      size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
+			      or_expr, gfc_index_zero_node, size);
+
+      nelem = size;
+      size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+		size,
+		fold_convert (gfc_array_index_type,
+			      TYPE_SIZE_UNIT (gfc_get_element_type (type))));
+    }
+  else
+    {
+      nelem = size;
+      size = NULL_TREE;
+    }
+
+  gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial,
+				    dynamic, dealloc);
+
+  if (info->dimen > loop->temp_dim)
+    loop->temp_dim = info->dimen;
+
+  return size;
+}
+
+
+/* Return the number of iterations in a loop that starts at START,
+   ends at END, and has step STEP.  */
+
+static tree
+gfc_get_iteration_count (tree start, tree end, tree step)
+{
+  tree tmp;
+  tree type;
+
+  type = TREE_TYPE (step);
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, type, end, start);
+  tmp = fold_build2_loc (input_location, FLOOR_DIV_EXPR, type, tmp, step);
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, type, tmp,
+			 build_int_cst (type, 1));
+  tmp = fold_build2_loc (input_location, MAX_EXPR, type, tmp,
+			 build_int_cst (type, 0));
+  return fold_convert (gfc_array_index_type, tmp);
+}
+
+
+/* Extend the data in array DESC by EXTRA elements.  */
+
+static void
+gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
+{
+  tree arg0, arg1;
+  tree tmp;
+  tree size;
+  tree ubound;
+
+  if (integer_zerop (extra))
+    return;
+
+  ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[0]);
+
+  /* Add EXTRA to the upper bound.  */
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			 ubound, extra);
+  gfc_conv_descriptor_ubound_set (pblock, desc, gfc_rank_cst[0], tmp);
+
+  /* Get the value of the current data pointer.  */
+  arg0 = gfc_conv_descriptor_data_get (desc);
+
+  /* Calculate the new array size.  */
+  size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			 ubound, gfc_index_one_node);
+  arg1 = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+			  fold_convert (size_type_node, tmp),
+			  fold_convert (size_type_node, size));
+
+  /* Call the realloc() function.  */
+  tmp = gfc_call_realloc (pblock, arg0, arg1);
+  gfc_conv_descriptor_data_set (pblock, desc, tmp);
+}
+
+
+/* Return true if the bounds of iterator I can only be determined
+   at run time.  */
+
+static inline bool
+gfc_iterator_has_dynamic_bounds (gfc_iterator * i)
+{
+  return (i->start->expr_type != EXPR_CONSTANT
+	  || i->end->expr_type != EXPR_CONSTANT
+	  || i->step->expr_type != EXPR_CONSTANT);
+}
+
+
+/* Split the size of constructor element EXPR into the sum of two terms,
+   one of which can be determined at compile time and one of which must
+   be calculated at run time.  Set *SIZE to the former and return true
+   if the latter might be nonzero.  */
+
+static bool
+gfc_get_array_constructor_element_size (mpz_t * size, gfc_expr * expr)
+{
+  if (expr->expr_type == EXPR_ARRAY)
+    return gfc_get_array_constructor_size (size, expr->value.constructor);
+  else if (expr->rank > 0)
+    {
+      /* Calculate everything at run time.  */
+      mpz_set_ui (*size, 0);
+      return true;
+    }
+  else
+    {
+      /* A single element.  */
+      mpz_set_ui (*size, 1);
+      return false;
+    }
+}
+
+
+/* Like gfc_get_array_constructor_element_size, but applied to the whole
+   of array constructor C.  */
+
+static bool
+gfc_get_array_constructor_size (mpz_t * size, gfc_constructor_base base)
+{
+  gfc_constructor *c;
+  gfc_iterator *i;
+  mpz_t val;
+  mpz_t len;
+  bool dynamic;
+
+  mpz_set_ui (*size, 0);
+  mpz_init (len);
+  mpz_init (val);
+
+  dynamic = false;
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+    {
+      i = c->iterator;
+      if (i && gfc_iterator_has_dynamic_bounds (i))
+	dynamic = true;
+      else
+	{
+	  dynamic |= gfc_get_array_constructor_element_size (&len, c->expr);
+	  if (i)
+	    {
+	      /* Multiply the static part of the element size by the
+		 number of iterations.  */
+	      mpz_sub (val, i->end->value.integer, i->start->value.integer);
+	      mpz_fdiv_q (val, val, i->step->value.integer);
+	      mpz_add_ui (val, val, 1);
+	      if (mpz_sgn (val) > 0)
+		mpz_mul (len, len, val);
+	      else
+		mpz_set_ui (len, 0);
+	    }
+	  mpz_add (*size, *size, len);
+	}
+    }
+  mpz_clear (len);
+  mpz_clear (val);
+  return dynamic;
+}
+
+
+/* Make sure offset is a variable.  */
+
+static void
+gfc_put_offset_into_var (stmtblock_t * pblock, tree * poffset,
+			 tree * offsetvar)
+{
+  /* We should have already created the offset variable.  We cannot
+     create it here because we may be in an inner scope.  */
+  gcc_assert (*offsetvar != NULL_TREE);
+  gfc_add_modify (pblock, *offsetvar, *poffset);
+  *poffset = *offsetvar;
+  TREE_USED (*offsetvar) = 1;
+}
+
+
+/* Variables needed for bounds-checking.  */
+static bool first_len;
+static tree first_len_val; 
+static bool typespec_chararray_ctor;
+
+static void
+gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
+			      tree offset, gfc_se * se, gfc_expr * expr)
+{
+  tree tmp;
+
+  gfc_conv_expr (se, expr);
+
+  /* Store the value.  */
+  tmp = build_fold_indirect_ref_loc (input_location,
+				 gfc_conv_descriptor_data_get (desc));
+  tmp = gfc_build_array_ref (tmp, offset, NULL);
+
+  if (expr->ts.type == BT_CHARACTER)
+    {
+      int i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false);
+      tree esize;
+
+      esize = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc)));
+      esize = fold_convert (gfc_charlen_type_node, esize);
+      esize = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			   gfc_charlen_type_node, esize,
+			   build_int_cst (gfc_charlen_type_node,
+					  gfc_character_kinds[i].bit_size / 8));
+
+      gfc_conv_string_parameter (se);
+      if (POINTER_TYPE_P (TREE_TYPE (tmp)))
+	{
+	  /* The temporary is an array of pointers.  */
+	  se->expr = fold_convert (TREE_TYPE (tmp), se->expr);
+	  gfc_add_modify (&se->pre, tmp, se->expr);
+	}
+      else
+	{
+	  /* The temporary is an array of string values.  */
+	  tmp = gfc_build_addr_expr (gfc_get_pchar_type (expr->ts.kind), tmp);
+	  /* We know the temporary and the value will be the same length,
+	     so can use memcpy.  */
+	  gfc_trans_string_copy (&se->pre, esize, tmp, expr->ts.kind,
+				 se->string_length, se->expr, expr->ts.kind);
+	}
+      if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && !typespec_chararray_ctor)
+	{
+	  if (first_len)
+	    {
+	      gfc_add_modify (&se->pre, first_len_val,
+				   se->string_length);
+	      first_len = false;
+	    }
+	  else
+	    {
+	      /* Verify that all constructor elements are of the same
+		 length.  */
+	      tree cond = fold_build2_loc (input_location, NE_EXPR,
+					   boolean_type_node, first_len_val,
+					   se->string_length);
+	      gfc_trans_runtime_check
+		(true, false, cond, &se->pre, &expr->where,
+		 "Different CHARACTER lengths (%ld/%ld) in array constructor",
+		 fold_convert (long_integer_type_node, first_len_val),
+		 fold_convert (long_integer_type_node, se->string_length));
+	    }
+	}
+    }
+  else
+    {
+      /* TODO: Should the frontend already have done this conversion?  */
+      se->expr = fold_convert (TREE_TYPE (tmp), se->expr);
+      gfc_add_modify (&se->pre, tmp, se->expr);
+    }
+
+  gfc_add_block_to_block (pblock, &se->pre);
+  gfc_add_block_to_block (pblock, &se->post);
+}
+
+
+/* Add the contents of an array to the constructor.  DYNAMIC is as for
+   gfc_trans_array_constructor_value.  */
+
+static void
+gfc_trans_array_constructor_subarray (stmtblock_t * pblock,
+				      tree type ATTRIBUTE_UNUSED,
+				      tree desc, gfc_expr * expr,
+				      tree * poffset, tree * offsetvar,
+				      bool dynamic)
+{
+  gfc_se se;
+  gfc_ss *ss;
+  gfc_loopinfo loop;
+  stmtblock_t body;
+  tree tmp;
+  tree size;
+  int n;
+
+  /* We need this to be a variable so we can increment it.  */
+  gfc_put_offset_into_var (pblock, poffset, offsetvar);
+
+  gfc_init_se (&se, NULL);
+
+  /* Walk the array expression.  */
+  ss = gfc_walk_expr (expr);
+  gcc_assert (ss != gfc_ss_terminator);
+
+  /* Initialize the scalarizer.  */
+  gfc_init_loopinfo (&loop);
+  gfc_add_ss_to_loop (&loop, ss);
+
+  /* Initialize the loop.  */
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop, &expr->where);
+
+  /* Make sure the constructed array has room for the new data.  */
+  if (dynamic)
+    {
+      /* Set SIZE to the total number of elements in the subarray.  */
+      size = gfc_index_one_node;
+      for (n = 0; n < loop.dimen; n++)
+	{
+	  tmp = gfc_get_iteration_count (loop.from[n], loop.to[n],
+					 gfc_index_one_node);
+	  size = fold_build2_loc (input_location, MULT_EXPR,
+				  gfc_array_index_type, size, tmp);
+	}
+
+      /* Grow the constructed array by SIZE elements.  */
+      gfc_grow_array (&loop.pre, desc, size);
+    }
+
+  /* Make the loop body.  */
+  gfc_mark_ss_chain_used (ss, 1);
+  gfc_start_scalarized_body (&loop, &body);
+  gfc_copy_loopinfo_to_se (&se, &loop);
+  se.ss = ss;
+
+  gfc_trans_array_ctor_element (&body, desc, *poffset, &se, expr);
+  gcc_assert (se.ss == gfc_ss_terminator);
+
+  /* Increment the offset.  */
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			 *poffset, gfc_index_one_node);
+  gfc_add_modify (&body, *poffset, tmp);
+
+  /* Finish the loop.  */
+  gfc_trans_scalarizing_loops (&loop, &body);
+  gfc_add_block_to_block (&loop.pre, &loop.post);
+  tmp = gfc_finish_block (&loop.pre);
+  gfc_add_expr_to_block (pblock, tmp);
+
+  gfc_cleanup_loop (&loop);
+}
+
+
+/* Assign the values to the elements of an array constructor.  DYNAMIC
+   is true if descriptor DESC only contains enough data for the static
+   size calculated by gfc_get_array_constructor_size.  When true, memory
+   for the dynamic parts must be allocated using realloc.  */
+
+static void
+gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
+				   tree desc, gfc_constructor_base base,
+				   tree * poffset, tree * offsetvar,
+				   bool dynamic)
+{
+  tree tmp;
+  stmtblock_t body;
+  gfc_se se;
+  mpz_t size;
+  gfc_constructor *c;
+
+  tree shadow_loopvar = NULL_TREE;
+  gfc_saved_var saved_loopvar;
+
+  mpz_init (size);
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+    {
+      /* If this is an iterator or an array, the offset must be a variable.  */
+      if ((c->iterator || c->expr->rank > 0) && INTEGER_CST_P (*poffset))
+	gfc_put_offset_into_var (pblock, poffset, offsetvar);
+
+      /* Shadowing the iterator avoids changing its value and saves us from
+	 keeping track of it. Further, it makes sure that there's always a
+	 backend-decl for the symbol, even if there wasn't one before,
+	 e.g. in the case of an iterator that appears in a specification
+	 expression in an interface mapping.  */
+      if (c->iterator)
+	{
+	  gfc_symbol *sym = c->iterator->var->symtree->n.sym;
+	  tree type = gfc_typenode_for_spec (&sym->ts);
+
+	  shadow_loopvar = gfc_create_var (type, "shadow_loopvar");
+	  gfc_shadow_sym (sym, shadow_loopvar, &saved_loopvar);
+	}
+
+      gfc_start_block (&body);
+
+      if (c->expr->expr_type == EXPR_ARRAY)
+	{
+	  /* Array constructors can be nested.  */
+	  gfc_trans_array_constructor_value (&body, type, desc,
+					     c->expr->value.constructor,
+					     poffset, offsetvar, dynamic);
+	}
+      else if (c->expr->rank > 0)
+	{
+	  gfc_trans_array_constructor_subarray (&body, type, desc, c->expr,
+						poffset, offsetvar, dynamic);
+	}
+      else
+	{
+	  /* This code really upsets the gimplifier so don't bother for now.  */
+	  gfc_constructor *p;
+	  HOST_WIDE_INT n;
+	  HOST_WIDE_INT size;
+
+	  p = c;
+	  n = 0;
+	  while (p && !(p->iterator || p->expr->expr_type != EXPR_CONSTANT))
+	    {
+	      p = gfc_constructor_next (p);
+	      n++;
+	    }
+	  if (n < 4)
+	    {
+	      /* Scalar values.  */
+	      gfc_init_se (&se, NULL);
+	      gfc_trans_array_ctor_element (&body, desc, *poffset,
+					    &se, c->expr);
+
+	      *poffset = fold_build2_loc (input_location, PLUS_EXPR,
+					  gfc_array_index_type,
+					  *poffset, gfc_index_one_node);
+	    }
+	  else
+	    {
+	      /* Collect multiple scalar constants into a constructor.  */
+	      VEC(constructor_elt,gc) *v = NULL;
+	      tree init;
+	      tree bound;
+	      tree tmptype;
+	      HOST_WIDE_INT idx = 0;
+
+	      p = c;
+              /* Count the number of consecutive scalar constants.  */
+	      while (p && !(p->iterator
+			    || p->expr->expr_type != EXPR_CONSTANT))
+		{
+		  gfc_init_se (&se, NULL);
+		  gfc_conv_constant (&se, p->expr);
+
+		  if (c->expr->ts.type != BT_CHARACTER)
+		    se.expr = fold_convert (type, se.expr);
+		  /* For constant character array constructors we build
+		     an array of pointers.  */
+		  else if (POINTER_TYPE_P (type))
+		    se.expr = gfc_build_addr_expr
+				(gfc_get_pchar_type (p->expr->ts.kind),
+				 se.expr);
+
+                  CONSTRUCTOR_APPEND_ELT (v,
+                                          build_int_cst (gfc_array_index_type,
+                                                         idx++),
+                                          se.expr);
+		  c = p;
+		  p = gfc_constructor_next (p);
+		}
+
+	      bound = build_int_cst (NULL_TREE, n - 1);
+              /* Create an array type to hold them.  */
+	      tmptype = build_range_type (gfc_array_index_type,
+					  gfc_index_zero_node, bound);
+	      tmptype = build_array_type (type, tmptype);
+
+	      init = build_constructor (tmptype, v);
+	      TREE_CONSTANT (init) = 1;
+	      TREE_STATIC (init) = 1;
+	      /* Create a static variable to hold the data.  */
+	      tmp = gfc_create_var (tmptype, "data");
+	      TREE_STATIC (tmp) = 1;
+	      TREE_CONSTANT (tmp) = 1;
+	      TREE_READONLY (tmp) = 1;
+	      DECL_INITIAL (tmp) = init;
+	      init = tmp;
+
+	      /* Use BUILTIN_MEMCPY to assign the values.  */
+	      tmp = gfc_conv_descriptor_data_get (desc);
+	      tmp = build_fold_indirect_ref_loc (input_location,
+					     tmp);
+	      tmp = gfc_build_array_ref (tmp, *poffset, NULL);
+	      tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+	      init = gfc_build_addr_expr (NULL_TREE, init);
+
+	      size = TREE_INT_CST_LOW (TYPE_SIZE_UNIT (type));
+	      bound = build_int_cst (NULL_TREE, n * size);
+	      tmp = build_call_expr_loc (input_location,
+				     built_in_decls[BUILT_IN_MEMCPY], 3,
+				     tmp, init, bound);
+	      gfc_add_expr_to_block (&body, tmp);
+
+	      *poffset = fold_build2_loc (input_location, PLUS_EXPR,
+				      gfc_array_index_type, *poffset,
+				      build_int_cst (gfc_array_index_type, n));
+	    }
+	  if (!INTEGER_CST_P (*poffset))
+            {
+              gfc_add_modify (&body, *offsetvar, *poffset);
+              *poffset = *offsetvar;
+            }
+	}
+
+      /* The frontend should already have done any expansions
+	 at compile-time.  */
+      if (!c->iterator)
+	{
+	  /* Pass the code as is.  */
+	  tmp = gfc_finish_block (&body);
+	  gfc_add_expr_to_block (pblock, tmp);
+	}
+      else
+	{
+	  /* Build the implied do-loop.  */
+	  stmtblock_t implied_do_block;
+	  tree cond;
+	  tree end;
+	  tree step;
+	  tree exit_label;
+	  tree loopbody;
+	  tree tmp2;
+
+	  loopbody = gfc_finish_block (&body);
+
+	  /* Create a new block that holds the implied-do loop. A temporary
+	     loop-variable is used.  */
+	  gfc_start_block(&implied_do_block);
+
+	  /* Initialize the loop.  */
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr_val (&se, c->iterator->start);
+	  gfc_add_block_to_block (&implied_do_block, &se.pre);
+	  gfc_add_modify (&implied_do_block, shadow_loopvar, se.expr);
+
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr_val (&se, c->iterator->end);
+	  gfc_add_block_to_block (&implied_do_block, &se.pre);
+	  end = gfc_evaluate_now (se.expr, &implied_do_block);
+
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr_val (&se, c->iterator->step);
+	  gfc_add_block_to_block (&implied_do_block, &se.pre);
+	  step = gfc_evaluate_now (se.expr, &implied_do_block);
+
+	  /* If this array expands dynamically, and the number of iterations
+	     is not constant, we won't have allocated space for the static
+	     part of C->EXPR's size.  Do that now.  */
+	  if (dynamic && gfc_iterator_has_dynamic_bounds (c->iterator))
+	    {
+	      /* Get the number of iterations.  */
+	      tmp = gfc_get_iteration_count (shadow_loopvar, end, step);
+
+	      /* Get the static part of C->EXPR's size.  */
+	      gfc_get_array_constructor_element_size (&size, c->expr);
+	      tmp2 = gfc_conv_mpz_to_tree (size, gfc_index_integer_kind);
+
+	      /* Grow the array by TMP * TMP2 elements.  */
+	      tmp = fold_build2_loc (input_location, MULT_EXPR,
+				     gfc_array_index_type, tmp, tmp2);
+	      gfc_grow_array (&implied_do_block, desc, tmp);
+	    }
+
+	  /* Generate the loop body.  */
+	  exit_label = gfc_build_label_decl (NULL_TREE);
+	  gfc_start_block (&body);
+
+	  /* Generate the exit condition.  Depending on the sign of
+	     the step variable we have to generate the correct
+	     comparison.  */
+	  tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+				 step, build_int_cst (TREE_TYPE (step), 0));
+	  cond = fold_build3_loc (input_location, COND_EXPR,
+		      boolean_type_node, tmp,
+		      fold_build2_loc (input_location, GT_EXPR,
+				       boolean_type_node, shadow_loopvar, end),
+		      fold_build2_loc (input_location, LT_EXPR,
+				       boolean_type_node, shadow_loopvar, end));
+	  tmp = build1_v (GOTO_EXPR, exit_label);
+	  TREE_USED (exit_label) = 1;
+	  tmp = build3_v (COND_EXPR, cond, tmp,
+			  build_empty_stmt (input_location));
+	  gfc_add_expr_to_block (&body, tmp);
+
+	  /* The main loop body.  */
+	  gfc_add_expr_to_block (&body, loopbody);
+
+	  /* Increase loop variable by step.  */
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 TREE_TYPE (shadow_loopvar), shadow_loopvar,
+				 step);
+	  gfc_add_modify (&body, shadow_loopvar, tmp);
+
+	  /* Finish the loop.  */
+	  tmp = gfc_finish_block (&body);
+	  tmp = build1_v (LOOP_EXPR, tmp);
+	  gfc_add_expr_to_block (&implied_do_block, tmp);
+
+	  /* Add the exit label.  */
+	  tmp = build1_v (LABEL_EXPR, exit_label);
+	  gfc_add_expr_to_block (&implied_do_block, tmp);
+
+	  /* Finishe the implied-do loop.  */
+	  tmp = gfc_finish_block(&implied_do_block);
+	  gfc_add_expr_to_block(pblock, tmp);
+
+	  gfc_restore_sym (c->iterator->var->symtree->n.sym, &saved_loopvar);
+	}
+    }
+  mpz_clear (size);
+}
+
+
+/* A catch-all to obtain the string length for anything that is not a
+   a substring of non-constant length, a constant, array or variable.  */
+
+static void
+get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
+{
+  gfc_se se;
+  gfc_ss *ss;
+
+  /* Don't bother if we already know the length is a constant.  */
+  if (*len && INTEGER_CST_P (*len))
+    return;
+
+  if (!e->ref && e->ts.u.cl && e->ts.u.cl->length
+	&& e->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+    {
+      /* This is easy.  */
+      gfc_conv_const_charlen (e->ts.u.cl);
+      *len = e->ts.u.cl->backend_decl;
+    }
+  else
+    {
+      /* Otherwise, be brutal even if inefficient.  */
+      ss = gfc_walk_expr (e);
+      gfc_init_se (&se, NULL);
+
+      /* No function call, in case of side effects.  */
+      se.no_function_call = 1;
+      if (ss == gfc_ss_terminator)
+	gfc_conv_expr (&se, e);
+      else
+	gfc_conv_expr_descriptor (&se, e, ss);
+
+      /* Fix the value.  */
+      *len = gfc_evaluate_now (se.string_length, &se.pre);
+
+      gfc_add_block_to_block (block, &se.pre);
+      gfc_add_block_to_block (block, &se.post);
+
+      e->ts.u.cl->backend_decl = *len;
+    }
+}
+
+
+/* Figure out the string length of a variable reference expression.
+   Used by get_array_ctor_strlen.  */
+
+static void
+get_array_ctor_var_strlen (stmtblock_t *block, gfc_expr * expr, tree * len)
+{
+  gfc_ref *ref;
+  gfc_typespec *ts;
+  mpz_t char_len;
+
+  /* Don't bother if we already know the length is a constant.  */
+  if (*len && INTEGER_CST_P (*len))
+    return;
+
+  ts = &expr->symtree->n.sym->ts;
+  for (ref = expr->ref; ref; ref = ref->next)
+    {
+      switch (ref->type)
+	{
+	case REF_ARRAY:
+	  /* Array references don't change the string length.  */
+	  break;
+
+	case REF_COMPONENT:
+	  /* Use the length of the component.  */
+	  ts = &ref->u.c.component->ts;
+	  break;
+
+	case REF_SUBSTRING:
+	  if (ref->u.ss.start->expr_type != EXPR_CONSTANT
+	      || ref->u.ss.end->expr_type != EXPR_CONSTANT)
+	    {
+	      /* Note that this might evaluate expr.  */
+	      get_array_ctor_all_strlen (block, expr, len);
+	      return;
+	    }
+	  mpz_init_set_ui (char_len, 1);
+	  mpz_add (char_len, char_len, ref->u.ss.end->value.integer);
+	  mpz_sub (char_len, char_len, ref->u.ss.start->value.integer);
+	  *len = gfc_conv_mpz_to_tree (char_len, gfc_default_integer_kind);
+	  *len = convert (gfc_charlen_type_node, *len);
+	  mpz_clear (char_len);
+	  return;
+
+	default:
+	 gcc_unreachable ();
+	}
+    }
+
+  *len = ts->u.cl->backend_decl;
+}
+
+
+/* Figure out the string length of a character array constructor.
+   If len is NULL, don't calculate the length; this happens for recursive calls
+   when a sub-array-constructor is an element but not at the first position,
+   so when we're not interested in the length.
+   Returns TRUE if all elements are character constants.  */
+
+bool
+get_array_ctor_strlen (stmtblock_t *block, gfc_constructor_base base, tree * len)
+{
+  gfc_constructor *c;
+  bool is_const;
+
+  is_const = TRUE;
+
+  if (gfc_constructor_first (base) == NULL)
+    {
+      if (len)
+	*len = build_int_cstu (gfc_charlen_type_node, 0);
+      return is_const;
+    }
+
+  /* Loop over all constructor elements to find out is_const, but in len we
+     want to store the length of the first, not the last, element.  We can
+     of course exit the loop as soon as is_const is found to be false.  */
+  for (c = gfc_constructor_first (base);
+       c && is_const; c = gfc_constructor_next (c))
+    {
+      switch (c->expr->expr_type)
+	{
+	case EXPR_CONSTANT:
+	  if (len && !(*len && INTEGER_CST_P (*len)))
+	    *len = build_int_cstu (gfc_charlen_type_node,
+				   c->expr->value.character.length);
+	  break;
+
+	case EXPR_ARRAY:
+	  if (!get_array_ctor_strlen (block, c->expr->value.constructor, len))
+	    is_const = false;
+	  break;
+
+	case EXPR_VARIABLE:
+	  is_const = false;
+	  if (len)
+	    get_array_ctor_var_strlen (block, c->expr, len);
+	  break;
+
+	default:
+	  is_const = false;
+	  if (len)
+	    get_array_ctor_all_strlen (block, c->expr, len);
+	  break;
+	}
+
+      /* After the first iteration, we don't want the length modified.  */
+      len = NULL;
+    }
+
+  return is_const;
+}
+
+/* Check whether the array constructor C consists entirely of constant
+   elements, and if so returns the number of those elements, otherwise
+   return zero.  Note, an empty or NULL array constructor returns zero.  */
+
+unsigned HOST_WIDE_INT
+gfc_constant_array_constructor_p (gfc_constructor_base base)
+{
+  unsigned HOST_WIDE_INT nelem = 0;
+
+  gfc_constructor *c = gfc_constructor_first (base);
+  while (c)
+    {
+      if (c->iterator
+	  || c->expr->rank > 0
+	  || c->expr->expr_type != EXPR_CONSTANT)
+	return 0;
+      c = gfc_constructor_next (c);
+      nelem++;
+    }
+  return nelem;
+}
+
+
+/* Given EXPR, the constant array constructor specified by an EXPR_ARRAY,
+   and the tree type of it's elements, TYPE, return a static constant
+   variable that is compile-time initialized.  */
+
+tree
+gfc_build_constant_array_constructor (gfc_expr * expr, tree type)
+{
+  tree tmptype, init, tmp;
+  HOST_WIDE_INT nelem;
+  gfc_constructor *c;
+  gfc_array_spec as;
+  gfc_se se;
+  int i;
+  VEC(constructor_elt,gc) *v = NULL;
+
+  /* First traverse the constructor list, converting the constants
+     to tree to build an initializer.  */
+  nelem = 0;
+  c = gfc_constructor_first (expr->value.constructor);
+  while (c)
+    {
+      gfc_init_se (&se, NULL);
+      gfc_conv_constant (&se, c->expr);
+      if (c->expr->ts.type != BT_CHARACTER)
+	se.expr = fold_convert (type, se.expr);
+      else if (POINTER_TYPE_P (type))
+	se.expr = gfc_build_addr_expr (gfc_get_pchar_type (c->expr->ts.kind),
+				       se.expr);
+      CONSTRUCTOR_APPEND_ELT (v, build_int_cst (gfc_array_index_type, nelem),
+                              se.expr);
+      c = gfc_constructor_next (c);
+      nelem++;
+    }
+
+  /* Next determine the tree type for the array.  We use the gfortran
+     front-end's gfc_get_nodesc_array_type in order to create a suitable
+     GFC_ARRAY_TYPE_P that may be used by the scalarizer.  */
+
+  memset (&as, 0, sizeof (gfc_array_spec));
+
+  as.rank = expr->rank;
+  as.type = AS_EXPLICIT;
+  if (!expr->shape)
+    {
+      as.lower[0] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0);
+      as.upper[0] = gfc_get_int_expr (gfc_default_integer_kind,
+				      NULL, nelem - 1);
+    }
+  else
+    for (i = 0; i < expr->rank; i++)
+      {
+	int tmp = (int) mpz_get_si (expr->shape[i]);
+        as.lower[i] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0);
+        as.upper[i] = gfc_get_int_expr (gfc_default_integer_kind,
+					NULL, tmp - 1);
+      }
+
+  tmptype = gfc_get_nodesc_array_type (type, &as, PACKED_STATIC, true);
+
+  /* as is not needed anymore.  */
+  for (i = 0; i < as.rank + as.corank; i++)
+    {
+      gfc_free_expr (as.lower[i]);
+      gfc_free_expr (as.upper[i]);
+    }
+
+  init = build_constructor (tmptype, v);
+
+  TREE_CONSTANT (init) = 1;
+  TREE_STATIC (init) = 1;
+
+  tmp = gfc_create_var (tmptype, "A");
+  TREE_STATIC (tmp) = 1;
+  TREE_CONSTANT (tmp) = 1;
+  TREE_READONLY (tmp) = 1;
+  DECL_INITIAL (tmp) = init;
+
+  return tmp;
+}
+
+
+/* Translate a constant EXPR_ARRAY array constructor for the scalarizer.
+   This mostly initializes the scalarizer state info structure with the
+   appropriate values to directly use the array created by the function
+   gfc_build_constant_array_constructor.  */
+
+static void
+gfc_trans_constant_array_constructor (gfc_loopinfo * loop,
+				      gfc_ss * ss, tree type)
+{
+  gfc_ss_info *info;
+  tree tmp;
+  int i;
+
+  tmp = gfc_build_constant_array_constructor (ss->expr, type);
+
+  info = &ss->data.info;
+
+  info->descriptor = tmp;
+  info->data = gfc_build_addr_expr (NULL_TREE, tmp);
+  info->offset = gfc_index_zero_node;
+
+  for (i = 0; i < info->dimen; i++)
+    {
+      info->delta[i] = gfc_index_zero_node;
+      info->start[i] = gfc_index_zero_node;
+      info->end[i] = gfc_index_zero_node;
+      info->stride[i] = gfc_index_one_node;
+      info->dim[i] = i;
+    }
+
+  if (info->dimen > loop->temp_dim)
+    loop->temp_dim = info->dimen;
+}
+
+/* Helper routine of gfc_trans_array_constructor to determine if the
+   bounds of the loop specified by LOOP are constant and simple enough
+   to use with gfc_trans_constant_array_constructor.  Returns the
+   iteration count of the loop if suitable, and NULL_TREE otherwise.  */
+
+static tree
+constant_array_constructor_loop_size (gfc_loopinfo * loop)
+{
+  tree size = gfc_index_one_node;
+  tree tmp;
+  int i;
+
+  for (i = 0; i < loop->dimen; i++)
+    {
+      /* If the bounds aren't constant, return NULL_TREE.  */
+      if (!INTEGER_CST_P (loop->from[i]) || !INTEGER_CST_P (loop->to[i]))
+	return NULL_TREE;
+      if (!integer_zerop (loop->from[i]))
+	{
+	  /* Only allow nonzero "from" in one-dimensional arrays.  */
+	  if (loop->dimen != 1)
+	    return NULL_TREE;
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type,
+				 loop->to[i], loop->from[i]);
+	}
+      else
+	tmp = loop->to[i];
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     tmp, gfc_index_one_node);
+      size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			      size, tmp);
+    }
+
+  return size;
+}
+
+
+/* Array constructors are handled by constructing a temporary, then using that
+   within the scalarization loop.  This is not optimal, but seems by far the
+   simplest method.  */
+
+static void
+gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
+{
+  gfc_constructor_base c;
+  tree offset;
+  tree offsetvar;
+  tree desc;
+  tree type;
+  tree tmp;
+  bool dynamic;
+  bool old_first_len, old_typespec_chararray_ctor;
+  tree old_first_len_val;
+
+  /* Save the old values for nested checking.  */
+  old_first_len = first_len;
+  old_first_len_val = first_len_val;
+  old_typespec_chararray_ctor = typespec_chararray_ctor;
+
+  /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no
+     typespec was given for the array constructor.  */
+  typespec_chararray_ctor = (ss->expr->ts.u.cl
+			     && ss->expr->ts.u.cl->length_from_typespec);
+
+  if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+      && ss->expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor)
+    {  
+      first_len_val = gfc_create_var (gfc_charlen_type_node, "len");
+      first_len = true;
+    }
+
+  ss->data.info.dimen = loop->dimen;
+
+  c = ss->expr->value.constructor;
+  if (ss->expr->ts.type == BT_CHARACTER)
+    {
+      bool const_string;
+      
+      /* get_array_ctor_strlen walks the elements of the constructor, if a
+	 typespec was given, we already know the string length and want the one
+	 specified there.  */
+      if (typespec_chararray_ctor && ss->expr->ts.u.cl->length
+	  && ss->expr->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+	{
+	  gfc_se length_se;
+
+	  const_string = false;
+	  gfc_init_se (&length_se, NULL);
+	  gfc_conv_expr_type (&length_se, ss->expr->ts.u.cl->length,
+			      gfc_charlen_type_node);
+	  ss->string_length = length_se.expr;
+	  gfc_add_block_to_block (&loop->pre, &length_se.pre);
+	  gfc_add_block_to_block (&loop->post, &length_se.post);
+	}
+      else
+	const_string = get_array_ctor_strlen (&loop->pre, c,
+					      &ss->string_length);
+
+      /* Complex character array constructors should have been taken care of
+	 and not end up here.  */
+      gcc_assert (ss->string_length);
+
+      ss->expr->ts.u.cl->backend_decl = ss->string_length;
+
+      type = gfc_get_character_type_len (ss->expr->ts.kind, ss->string_length);
+      if (const_string)
+	type = build_pointer_type (type);
+    }
+  else
+    type = gfc_typenode_for_spec (&ss->expr->ts);
+
+  /* See if the constructor determines the loop bounds.  */
+  dynamic = false;
+
+  if (ss->expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE)
+    {
+      /* We have a multidimensional parameter.  */
+      int n;
+      for (n = 0; n < ss->expr->rank; n++)
+      {
+	loop->from[n] = gfc_index_zero_node;
+	loop->to[n] = gfc_conv_mpz_to_tree (ss->expr->shape [n],
+					    gfc_index_integer_kind);
+	loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR,
+			  	       gfc_array_index_type,
+				       loop->to[n], gfc_index_one_node);
+      }
+    }
+
+  if (loop->to[0] == NULL_TREE)
+    {
+      mpz_t size;
+
+      /* We should have a 1-dimensional, zero-based loop.  */
+      gcc_assert (loop->dimen == 1);
+      gcc_assert (integer_zerop (loop->from[0]));
+
+      /* Split the constructor size into a static part and a dynamic part.
+	 Allocate the static size up-front and record whether the dynamic
+	 size might be nonzero.  */
+      mpz_init (size);
+      dynamic = gfc_get_array_constructor_size (&size, c);
+      mpz_sub_ui (size, size, 1);
+      loop->to[0] = gfc_conv_mpz_to_tree (size, gfc_index_integer_kind);
+      mpz_clear (size);
+    }
+
+  /* Special case constant array constructors.  */
+  if (!dynamic)
+    {
+      unsigned HOST_WIDE_INT nelem = gfc_constant_array_constructor_p (c);
+      if (nelem > 0)
+	{
+	  tree size = constant_array_constructor_loop_size (loop);
+	  if (size && compare_tree_int (size, nelem) == 0)
+	    {
+	      gfc_trans_constant_array_constructor (loop, ss, type);
+	      goto finish;
+	    }
+	}
+    }
+
+  if (TREE_CODE (loop->to[0]) == VAR_DECL)
+    dynamic = true;
+
+  gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info,
+			       type, NULL_TREE, dynamic, true, false, where);
+
+  desc = ss->data.info.descriptor;
+  offset = gfc_index_zero_node;
+  offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
+  TREE_NO_WARNING (offsetvar) = 1;
+  TREE_USED (offsetvar) = 0;
+  gfc_trans_array_constructor_value (&loop->pre, type, desc, c,
+				     &offset, &offsetvar, dynamic);
+
+  /* If the array grows dynamically, the upper bound of the loop variable
+     is determined by the array's final upper bound.  */
+  if (dynamic)
+    {
+      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+			     gfc_array_index_type,
+			     offsetvar, gfc_index_one_node);
+      tmp = gfc_evaluate_now (tmp, &loop->pre);
+      gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp);
+      if (loop->to[0] && TREE_CODE (loop->to[0]) == VAR_DECL)
+	gfc_add_modify (&loop->pre, loop->to[0], tmp);
+      else
+	loop->to[0] = tmp;
+    }
+
+  if (TREE_USED (offsetvar))
+    pushdecl (offsetvar);
+  else
+    gcc_assert (INTEGER_CST_P (offset));
+
+#if 0
+  /* Disable bound checking for now because it's probably broken.  */
+  if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+    {
+      gcc_unreachable ();
+    }
+#endif
+
+finish:
+  /* Restore old values of globals.  */
+  first_len = old_first_len;
+  first_len_val = old_first_len_val;
+  typespec_chararray_ctor = old_typespec_chararray_ctor;
+}
+
+
+/* INFO describes a GFC_SS_SECTION in loop LOOP, and this function is
+   called after evaluating all of INFO's vector dimensions.  Go through
+   each such vector dimension and see if we can now fill in any missing
+   loop bounds.  */
+
+static void
+gfc_set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss_info * info)
+{
+  gfc_se se;
+  tree tmp;
+  tree desc;
+  tree zero;
+  int n;
+  int dim;
+
+  for (n = 0; n < loop->dimen; n++)
+    {
+      dim = info->dim[n];
+      if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR
+	  && loop->to[n] == NULL)
+	{
+	  /* Loop variable N indexes vector dimension DIM, and we don't
+	     yet know the upper bound of loop variable N.  Set it to the
+	     difference between the vector's upper and lower bounds.  */
+	  gcc_assert (loop->from[n] == gfc_index_zero_node);
+	  gcc_assert (info->subscript[dim]
+		      && info->subscript[dim]->type == GFC_SS_VECTOR);
+
+	  gfc_init_se (&se, NULL);
+	  desc = info->subscript[dim]->data.info.descriptor;
+	  zero = gfc_rank_cst[0];
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+			     gfc_array_index_type,
+			     gfc_conv_descriptor_ubound_get (desc, zero),
+			     gfc_conv_descriptor_lbound_get (desc, zero));
+	  tmp = gfc_evaluate_now (tmp, &loop->pre);
+	  loop->to[n] = tmp;
+	}
+    }
+}
+
+
+/* Add the pre and post chains for all the scalar expressions in a SS chain
+   to loop.  This is called after the loop parameters have been calculated,
+   but before the actual scalarizing loops.  */
+
+static void
+gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
+		      locus * where)
+{
+  gfc_se se;
+  int n;
+
+  /* Don't evaluate the arguments for realloc_lhs_loop_for_fcn_call; otherwise,
+     arguments could get evaluated multiple times.  */
+  if (ss->is_alloc_lhs)
+    return;
+
+  /* TODO: This can generate bad code if there are ordering dependencies,
+     e.g., a callee allocated function and an unknown size constructor.  */
+  gcc_assert (ss != NULL);
+
+  for (; ss != gfc_ss_terminator; ss = ss->loop_chain)
+    {
+      gcc_assert (ss);
+
+      switch (ss->type)
+	{
+	case GFC_SS_SCALAR:
+	  /* Scalar expression.  Evaluate this now.  This includes elemental
+	     dimension indices, but not array section bounds.  */
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr (&se, ss->expr);
+	  gfc_add_block_to_block (&loop->pre, &se.pre);
+
+	  if (ss->expr->ts.type != BT_CHARACTER)
+	    {
+	      /* Move the evaluation of scalar expressions outside the
+		 scalarization loop, except for WHERE assignments.  */
+	      if (subscript)
+		se.expr = convert(gfc_array_index_type, se.expr);
+	      if (!ss->where)
+		se.expr = gfc_evaluate_now (se.expr, &loop->pre);
+	      gfc_add_block_to_block (&loop->pre, &se.post);
+	    }
+	  else
+	    gfc_add_block_to_block (&loop->post, &se.post);
+
+	  ss->data.scalar.expr = se.expr;
+	  ss->string_length = se.string_length;
+	  break;
+
+	case GFC_SS_REFERENCE:
+	  /* Scalar argument to elemental procedure.  Evaluate this
+	     now.  */
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr (&se, ss->expr);
+	  gfc_add_block_to_block (&loop->pre, &se.pre);
+	  gfc_add_block_to_block (&loop->post, &se.post);
+
+	  ss->data.scalar.expr = gfc_evaluate_now (se.expr, &loop->pre);
+	  ss->string_length = se.string_length;
+	  break;
+
+	case GFC_SS_SECTION:
+	  /* Add the expressions for scalar and vector subscripts.  */
+	  for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
+	    if (ss->data.info.subscript[n])
+	      gfc_add_loop_ss_code (loop, ss->data.info.subscript[n], true,
+				    where);
+
+	  gfc_set_vector_loop_bounds (loop, &ss->data.info);
+	  break;
+
+	case GFC_SS_VECTOR:
+	  /* Get the vector's descriptor and store it in SS.  */
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr_descriptor (&se, ss->expr, gfc_walk_expr (ss->expr));
+	  gfc_add_block_to_block (&loop->pre, &se.pre);
+	  gfc_add_block_to_block (&loop->post, &se.post);
+	  ss->data.info.descriptor = se.expr;
+	  break;
+
+	case GFC_SS_INTRINSIC:
+	  gfc_add_intrinsic_ss_code (loop, ss);
+	  break;
+
+	case GFC_SS_FUNCTION:
+	  /* Array function return value.  We call the function and save its
+	     result in a temporary for use inside the loop.  */
+	  gfc_init_se (&se, NULL);
+	  se.loop = loop;
+	  se.ss = ss;
+	  gfc_conv_expr (&se, ss->expr);
+	  gfc_add_block_to_block (&loop->pre, &se.pre);
+	  gfc_add_block_to_block (&loop->post, &se.post);
+	  ss->string_length = se.string_length;
+	  break;
+
+	case GFC_SS_CONSTRUCTOR:
+	  if (ss->expr->ts.type == BT_CHARACTER
+		&& ss->string_length == NULL
+		&& ss->expr->ts.u.cl
+		&& ss->expr->ts.u.cl->length)
+	    {
+	      gfc_init_se (&se, NULL);
+	      gfc_conv_expr_type (&se, ss->expr->ts.u.cl->length,
+				  gfc_charlen_type_node);
+	      ss->string_length = se.expr;
+	      gfc_add_block_to_block (&loop->pre, &se.pre);
+	      gfc_add_block_to_block (&loop->post, &se.post);
+	    }
+	  gfc_trans_array_constructor (loop, ss, where);
+	  break;
+
+        case GFC_SS_TEMP:
+	case GFC_SS_COMPONENT:
+          /* Do nothing.  These are handled elsewhere.  */
+          break;
+
+	default:
+	  gcc_unreachable ();
+	}
+    }
+}
+
+
+/* Translate expressions for the descriptor and data pointer of a SS.  */
+/*GCC ARRAYS*/
+
+static void
+gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
+{
+  gfc_se se;
+  tree tmp;
+
+  /* Get the descriptor for the array to be scalarized.  */
+  gcc_assert (ss->expr->expr_type == EXPR_VARIABLE);
+  gfc_init_se (&se, NULL);
+  se.descriptor_only = 1;
+  gfc_conv_expr_lhs (&se, ss->expr);
+  gfc_add_block_to_block (block, &se.pre);
+  ss->data.info.descriptor = se.expr;
+  ss->string_length = se.string_length;
+
+  if (base)
+    {
+      /* Also the data pointer.  */
+      tmp = gfc_conv_array_data (se.expr);
+      /* If this is a variable or address of a variable we use it directly.
+         Otherwise we must evaluate it now to avoid breaking dependency
+	 analysis by pulling the expressions for elemental array indices
+	 inside the loop.  */
+      if (!(DECL_P (tmp)
+	    || (TREE_CODE (tmp) == ADDR_EXPR
+		&& DECL_P (TREE_OPERAND (tmp, 0)))))
+	tmp = gfc_evaluate_now (tmp, block);
+      ss->data.info.data = tmp;
+
+      tmp = gfc_conv_array_offset (se.expr);
+      ss->data.info.offset = gfc_evaluate_now (tmp, block);
+
+      /* Make absolutely sure that the saved_offset is indeed saved
+	 so that the variable is still accessible after the loops
+	 are translated.  */
+      ss->data.info.saved_offset = ss->data.info.offset;
+    }
+}
+
+
+/* Initialize a gfc_loopinfo structure.  */
+
+void
+gfc_init_loopinfo (gfc_loopinfo * loop)
+{
+  int n;
+
+  memset (loop, 0, sizeof (gfc_loopinfo));
+  gfc_init_block (&loop->pre);
+  gfc_init_block (&loop->post);
+
+  /* Initially scalarize in order and default to no loop reversal.  */
+  for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
+    {
+      loop->order[n] = n;
+      loop->reverse[n] = GFC_INHIBIT_REVERSE;
+    }
+
+  loop->ss = gfc_ss_terminator;
+}
+
+
+/* Copies the loop variable info to a gfc_se structure. Does not copy the SS
+   chain.  */
+
+void
+gfc_copy_loopinfo_to_se (gfc_se * se, gfc_loopinfo * loop)
+{
+  se->loop = loop;
+}
+
+
+/* Return an expression for the data pointer of an array.  */
+
+tree
+gfc_conv_array_data (tree descriptor)
+{
+  tree type;
+
+  type = TREE_TYPE (descriptor);
+  if (GFC_ARRAY_TYPE_P (type))
+    {
+      if (TREE_CODE (type) == POINTER_TYPE)
+        return descriptor;
+      else
+        {
+          /* Descriptorless arrays.  */
+	  return gfc_build_addr_expr (NULL_TREE, descriptor);
+        }
+    }
+  else
+    return gfc_conv_descriptor_data_get (descriptor);
+}
+
+
+/* Return an expression for the base offset of an array.  */
+
+tree
+gfc_conv_array_offset (tree descriptor)
+{
+  tree type;
+
+  type = TREE_TYPE (descriptor);
+  if (GFC_ARRAY_TYPE_P (type))
+    return GFC_TYPE_ARRAY_OFFSET (type);
+  else
+    return gfc_conv_descriptor_offset_get (descriptor);
+}
+
+
+/* Get an expression for the array stride.  */
+
+tree
+gfc_conv_array_stride (tree descriptor, int dim)
+{
+  tree tmp;
+  tree type;
+
+  type = TREE_TYPE (descriptor);
+
+  /* For descriptorless arrays use the array size.  */
+  tmp = GFC_TYPE_ARRAY_STRIDE (type, dim);
+  if (tmp != NULL_TREE)
+    return tmp;
+
+  tmp = gfc_conv_descriptor_stride_get (descriptor, gfc_rank_cst[dim]);
+  return tmp;
+}
+
+
+/* Like gfc_conv_array_stride, but for the lower bound.  */
+
+tree
+gfc_conv_array_lbound (tree descriptor, int dim)
+{
+  tree tmp;
+  tree type;
+
+  type = TREE_TYPE (descriptor);
+
+  tmp = GFC_TYPE_ARRAY_LBOUND (type, dim);
+  if (tmp != NULL_TREE)
+    return tmp;
+
+  tmp = gfc_conv_descriptor_lbound_get (descriptor, gfc_rank_cst[dim]);
+  return tmp;
+}
+
+
+/* Like gfc_conv_array_stride, but for the upper bound.  */
+
+tree
+gfc_conv_array_ubound (tree descriptor, int dim)
+{
+  tree tmp;
+  tree type;
+
+  type = TREE_TYPE (descriptor);
+
+  tmp = GFC_TYPE_ARRAY_UBOUND (type, dim);
+  if (tmp != NULL_TREE)
+    return tmp;
+
+  /* This should only ever happen when passing an assumed shape array
+     as an actual parameter.  The value will never be used.  */
+  if (GFC_ARRAY_TYPE_P (TREE_TYPE (descriptor)))
+    return gfc_index_zero_node;
+
+  tmp = gfc_conv_descriptor_ubound_get (descriptor, gfc_rank_cst[dim]);
+  return tmp;
+}
+
+
+/* Generate code to perform an array index bound check.  */
+
+static tree
+gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
+			     locus * where, bool check_upper)
+{
+  tree fault;
+  tree tmp_lo, tmp_up;
+  char *msg;
+  const char * name = NULL;
+
+  if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS))
+    return index;
+
+  index = gfc_evaluate_now (index, &se->pre);
+
+  /* We find a name for the error message.  */
+  if (se->ss)
+    name = se->ss->expr->symtree->name;
+
+  if (!name && se->loop && se->loop->ss && se->loop->ss->expr
+      && se->loop->ss->expr->symtree)
+    name = se->loop->ss->expr->symtree->name;
+
+  if (!name && se->loop && se->loop->ss && se->loop->ss->loop_chain
+      && se->loop->ss->loop_chain->expr
+      && se->loop->ss->loop_chain->expr->symtree)
+    name = se->loop->ss->loop_chain->expr->symtree->name;
+
+  if (!name && se->loop && se->loop->ss && se->loop->ss->expr)
+    {
+      if (se->loop->ss->expr->expr_type == EXPR_FUNCTION
+	  && se->loop->ss->expr->value.function.name)
+	name = se->loop->ss->expr->value.function.name;
+      else
+	if (se->loop->ss->type == GFC_SS_CONSTRUCTOR
+	    || se->loop->ss->type == GFC_SS_SCALAR)
+	  name = "unnamed constant";
+    }
+
+  if (TREE_CODE (descriptor) == VAR_DECL)
+    name = IDENTIFIER_POINTER (DECL_NAME (descriptor));
+
+  /* If upper bound is present, include both bounds in the error message.  */
+  if (check_upper)
+    {
+      tmp_lo = gfc_conv_array_lbound (descriptor, n);
+      tmp_up = gfc_conv_array_ubound (descriptor, n);
+
+      if (name)
+	asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
+		  "outside of expected range (%%ld:%%ld)", n+1, name);
+      else
+	asprintf (&msg, "Index '%%ld' of dimension %d "
+		  "outside of expected range (%%ld:%%ld)", n+1);
+
+      fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+			       index, tmp_lo);
+      gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
+			       fold_convert (long_integer_type_node, index),
+			       fold_convert (long_integer_type_node, tmp_lo),
+			       fold_convert (long_integer_type_node, tmp_up));
+      fault = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+			       index, tmp_up);
+      gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
+			       fold_convert (long_integer_type_node, index),
+			       fold_convert (long_integer_type_node, tmp_lo),
+			       fold_convert (long_integer_type_node, tmp_up));
+      gfc_free (msg);
+    }
+  else
+    {
+      tmp_lo = gfc_conv_array_lbound (descriptor, n);
+
+      if (name)
+	asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
+		  "below lower bound of %%ld", n+1, name);
+      else
+	asprintf (&msg, "Index '%%ld' of dimension %d "
+		  "below lower bound of %%ld", n+1);
+
+      fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+			       index, tmp_lo);
+      gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
+			       fold_convert (long_integer_type_node, index),
+			       fold_convert (long_integer_type_node, tmp_lo));
+      gfc_free (msg);
+    }
+
+  return index;
+}
+
+
+/* Return the offset for an index.  Performs bound checking for elemental
+   dimensions.  Single element references are processed separately.
+   DIM is the array dimension, I is the loop dimension.  */
+
+static tree
+gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
+			     gfc_array_ref * ar, tree stride)
+{
+  tree index;
+  tree desc;
+  tree data;
+
+  /* Get the index into the array for this dimension.  */
+  if (ar)
+    {
+      gcc_assert (ar->type != AR_ELEMENT);
+      switch (ar->dimen_type[dim])
+	{
+	case DIMEN_ELEMENT:
+	  /* Elemental dimension.  */
+	  gcc_assert (info->subscript[dim]
+		      && info->subscript[dim]->type == GFC_SS_SCALAR);
+	  /* We've already translated this value outside the loop.  */
+	  index = info->subscript[dim]->data.scalar.expr;
+
+	  index = gfc_trans_array_bound_check (se, info->descriptor,
+			index, dim, &ar->where,
+			ar->as->type != AS_ASSUMED_SIZE
+			|| dim < ar->dimen - 1);
+	  break;
+
+	case DIMEN_VECTOR:
+	  gcc_assert (info && se->loop);
+	  gcc_assert (info->subscript[dim]
+		      && info->subscript[dim]->type == GFC_SS_VECTOR);
+	  desc = info->subscript[dim]->data.info.descriptor;
+
+	  /* Get a zero-based index into the vector.  */
+	  index = fold_build2_loc (input_location, MINUS_EXPR,
+				   gfc_array_index_type,
+				   se->loop->loopvar[i], se->loop->from[i]);
+
+	  /* Multiply the index by the stride.  */
+	  index = fold_build2_loc (input_location, MULT_EXPR,
+				   gfc_array_index_type,
+				   index, gfc_conv_array_stride (desc, 0));
+
+	  /* Read the vector to get an index into info->descriptor.  */
+	  data = build_fold_indirect_ref_loc (input_location,
+					  gfc_conv_array_data (desc));
+	  index = gfc_build_array_ref (data, index, NULL);
+	  index = gfc_evaluate_now (index, &se->pre);
+	  index = fold_convert (gfc_array_index_type, index);
+
+	  /* Do any bounds checking on the final info->descriptor index.  */
+	  index = gfc_trans_array_bound_check (se, info->descriptor,
+			index, dim, &ar->where,
+			ar->as->type != AS_ASSUMED_SIZE
+			|| dim < ar->dimen - 1);
+	  break;
+
+	case DIMEN_RANGE:
+	  /* Scalarized dimension.  */
+	  gcc_assert (info && se->loop);
+
+	  /* Multiply the loop variable by the stride and delta.  */
+	  index = se->loop->loopvar[i];
+	  if (!integer_onep (info->stride[dim]))
+	    index = fold_build2_loc (input_location, MULT_EXPR,
+				     gfc_array_index_type, index,
+				     info->stride[dim]);
+	  if (!integer_zerop (info->delta[dim]))
+	    index = fold_build2_loc (input_location, PLUS_EXPR,
+				     gfc_array_index_type, index,
+				     info->delta[dim]);
+	  break;
+
+	default:
+	  gcc_unreachable ();
+	}
+    }
+  else
+    {
+      /* Temporary array or derived type component.  */
+      gcc_assert (se->loop);
+      index = se->loop->loopvar[se->loop->order[i]];
+      if (!integer_zerop (info->delta[dim]))
+	index = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, index, info->delta[dim]);
+    }
+
+  /* Multiply by the stride.  */
+  if (!integer_onep (stride))
+    index = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     index, stride);
+
+  return index;
+}
+
+
+/* Build a scalarized reference to an array.  */
+
+static void
+gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar)
+{
+  gfc_ss_info *info;
+  tree decl = NULL_TREE;
+  tree index;
+  tree tmp;
+  int n;
+
+  info = &se->ss->data.info;
+  if (ar)
+    n = se->loop->order[0];
+  else
+    n = 0;
+
+  index = gfc_conv_array_index_offset (se, info, info->dim[n], n, ar,
+				       info->stride0);
+  /* Add the offset for this dimension to the stored offset for all other
+     dimensions.  */
+  if (!integer_zerop (info->offset))
+    index = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     index, info->offset);
+
+  if (se->ss->expr && is_subref_array (se->ss->expr))
+    decl = se->ss->expr->symtree->n.sym->backend_decl;
+
+  tmp = build_fold_indirect_ref_loc (input_location,
+				 info->data);
+  se->expr = gfc_build_array_ref (tmp, index, decl);
+}
+
+
+/* Translate access of temporary array.  */
+
+void
+gfc_conv_tmp_array_ref (gfc_se * se)
+{
+  se->string_length = se->ss->string_length;
+  gfc_conv_scalarized_array_ref (se, NULL);
+  gfc_advance_se_ss_chain (se);
+}
+
+
+/* Build an array reference.  se->expr already holds the array descriptor.
+   This should be either a variable, indirect variable reference or component
+   reference.  For arrays which do not have a descriptor, se->expr will be
+   the data pointer.
+   a(i, j, k) = base[offset + i * stride[0] + j * stride[1] + k * stride[2]]*/
+
+void
+gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
+		    locus * where)
+{
+  int n;
+  tree index;
+  tree tmp;
+  tree stride;
+  gfc_se indexse;
+  gfc_se tmpse;
+
+  if (ar->dimen == 0)
+    return;
+
+  /* Handle scalarized references separately.  */
+  if (ar->type != AR_ELEMENT)
+    {
+      gfc_conv_scalarized_array_ref (se, ar);
+      gfc_advance_se_ss_chain (se);
+      return;
+    }
+
+  index = gfc_index_zero_node;
+
+  /* Calculate the offsets from all the dimensions.  */
+  for (n = 0; n < ar->dimen; n++)
+    {
+      /* Calculate the index for this dimension.  */
+      gfc_init_se (&indexse, se);
+      gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type);
+      gfc_add_block_to_block (&se->pre, &indexse.pre);
+
+      if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+	{
+	  /* Check array bounds.  */
+	  tree cond;
+	  char *msg;
+
+	  /* Evaluate the indexse.expr only once.  */
+	  indexse.expr = save_expr (indexse.expr);
+
+	  /* Lower bound.  */
+	  tmp = gfc_conv_array_lbound (se->expr, n);
+	  if (sym->attr.temporary)
+	    {
+	      gfc_init_se (&tmpse, se);
+	      gfc_conv_expr_type (&tmpse, ar->as->lower[n],
+				  gfc_array_index_type);
+	      gfc_add_block_to_block (&se->pre, &tmpse.pre);
+	      tmp = tmpse.expr;
+	    }
+
+	  cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, 
+				  indexse.expr, tmp);
+	  asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
+		    "below lower bound of %%ld", n+1, sym->name);
+	  gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg,
+				   fold_convert (long_integer_type_node,
+						 indexse.expr),
+				   fold_convert (long_integer_type_node, tmp));
+	  gfc_free (msg);
+
+	  /* Upper bound, but not for the last dimension of assumed-size
+	     arrays.  */
+	  if (n < ar->dimen - 1 || ar->as->type != AS_ASSUMED_SIZE)
+	    {
+	      tmp = gfc_conv_array_ubound (se->expr, n);
+	      if (sym->attr.temporary)
+		{
+		  gfc_init_se (&tmpse, se);
+		  gfc_conv_expr_type (&tmpse, ar->as->upper[n],
+				      gfc_array_index_type);
+		  gfc_add_block_to_block (&se->pre, &tmpse.pre);
+		  tmp = tmpse.expr;
+		}
+
+	      cond = fold_build2_loc (input_location, GT_EXPR,
+				      boolean_type_node, indexse.expr, tmp);
+	      asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
+			"above upper bound of %%ld", n+1, sym->name);
+	      gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg,
+				   fold_convert (long_integer_type_node,
+						 indexse.expr),
+				   fold_convert (long_integer_type_node, tmp));
+	      gfc_free (msg);
+	    }
+	}
+
+      /* Multiply the index by the stride.  */
+      stride = gfc_conv_array_stride (se->expr, n);
+      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     indexse.expr, stride);
+
+      /* And add it to the total.  */
+      index = fold_build2_loc (input_location, PLUS_EXPR,
+			       gfc_array_index_type, index, tmp);
+    }
+
+  tmp = gfc_conv_array_offset (se->expr);
+  if (!integer_zerop (tmp))
+    index = fold_build2_loc (input_location, PLUS_EXPR,
+			     gfc_array_index_type, index, tmp);
+
+  /* Access the calculated element.  */
+  tmp = gfc_conv_array_data (se->expr);
+  tmp = build_fold_indirect_ref (tmp);
+  se->expr = gfc_build_array_ref (tmp, index, sym->backend_decl);
+}
+
+
+/* Generate the code to be executed immediately before entering a
+   scalarization loop.  */
+
+static void
+gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag,
+			 stmtblock_t * pblock)
+{
+  tree index;
+  tree stride;
+  gfc_ss_info *info;
+  gfc_ss *ss;
+  gfc_se se;
+  int i;
+
+  /* This code will be executed before entering the scalarization loop
+     for this dimension.  */
+  for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
+    {
+      if ((ss->useflags & flag) == 0)
+	continue;
+
+      if (ss->type != GFC_SS_SECTION
+	  && ss->type != GFC_SS_FUNCTION && ss->type != GFC_SS_CONSTRUCTOR
+	  && ss->type != GFC_SS_COMPONENT)
+	continue;
+
+      info = &ss->data.info;
+
+      if (dim >= info->dimen)
+	continue;
+
+      if (dim == info->dimen - 1)
+	{
+	  /* For the outermost loop calculate the offset due to any
+	     elemental dimensions.  It will have been initialized with the
+	     base offset of the array.  */
+	  if (info->ref)
+	    {
+	      for (i = 0; i < info->ref->u.ar.dimen; i++)
+		{
+		  if (info->ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
+		    continue;
+
+		  gfc_init_se (&se, NULL);
+		  se.loop = loop;
+		  se.expr = info->descriptor;
+		  stride = gfc_conv_array_stride (info->descriptor, i);
+		  index = gfc_conv_array_index_offset (&se, info, i, -1,
+						       &info->ref->u.ar,
+						       stride);
+		  gfc_add_block_to_block (pblock, &se.pre);
+
+		  info->offset = fold_build2_loc (input_location, PLUS_EXPR,
+						  gfc_array_index_type,
+						  info->offset, index);
+		  info->offset = gfc_evaluate_now (info->offset, pblock);
+		}
+	    }
+
+	  i = loop->order[0];
+	  /* For the time being, the innermost loop is unconditionally on
+	     the first dimension of the scalarization loop.  */
+	  gcc_assert (i == 0);
+	  stride = gfc_conv_array_stride (info->descriptor, info->dim[i]);
+
+	  /* Calculate the stride of the innermost loop.  Hopefully this will
+	     allow the backend optimizers to do their stuff more effectively.
+	   */
+	  info->stride0 = gfc_evaluate_now (stride, pblock);
+	}
+      else
+	{
+	  /* Add the offset for the previous loop dimension.  */
+	  gfc_array_ref *ar;
+
+	  if (info->ref)
+	    {
+	      ar = &info->ref->u.ar;
+	      i = loop->order[dim + 1];
+	    }
+	  else
+	    {
+	      ar = NULL;
+	      i = dim + 1;
+	    }
+
+	  gfc_init_se (&se, NULL);
+	  se.loop = loop;
+	  se.expr = info->descriptor;
+	  stride = gfc_conv_array_stride (info->descriptor, info->dim[i]);
+	  index = gfc_conv_array_index_offset (&se, info, info->dim[i], i,
+					       ar, stride);
+	  gfc_add_block_to_block (pblock, &se.pre);
+	  info->offset = fold_build2_loc (input_location, PLUS_EXPR,
+					  gfc_array_index_type, info->offset,
+					  index);
+	  info->offset = gfc_evaluate_now (info->offset, pblock);
+	}
+
+      /* Remember this offset for the second loop.  */
+      if (dim == loop->temp_dim - 1)
+        info->saved_offset = info->offset;
+    }
+}
+
+
+/* Start a scalarized expression.  Creates a scope and declares loop
+   variables.  */
+
+void
+gfc_start_scalarized_body (gfc_loopinfo * loop, stmtblock_t * pbody)
+{
+  int dim;
+  int n;
+  int flags;
+
+  gcc_assert (!loop->array_parameter);
+
+  for (dim = loop->dimen - 1; dim >= 0; dim--)
+    {
+      n = loop->order[dim];
+
+      gfc_start_block (&loop->code[n]);
+
+      /* Create the loop variable.  */
+      loop->loopvar[n] = gfc_create_var (gfc_array_index_type, "S");
+
+      if (dim < loop->temp_dim)
+	flags = 3;
+      else
+	flags = 1;
+      /* Calculate values that will be constant within this loop.  */
+      gfc_trans_preloop_setup (loop, dim, flags, &loop->code[n]);
+    }
+  gfc_start_block (pbody);
+}
+
+
+/* Generates the actual loop code for a scalarization loop.  */
+
+void
+gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n,
+			       stmtblock_t * pbody)
+{
+  stmtblock_t block;
+  tree cond;
+  tree tmp;
+  tree loopbody;
+  tree exit_label;
+  tree stmt;
+  tree init;
+  tree incr;
+
+  if ((ompws_flags & (OMPWS_WORKSHARE_FLAG | OMPWS_SCALARIZER_WS))
+      == (OMPWS_WORKSHARE_FLAG | OMPWS_SCALARIZER_WS)
+      && n == loop->dimen - 1)
+    {
+      /* We create an OMP_FOR construct for the outermost scalarized loop.  */
+      init = make_tree_vec (1);
+      cond = make_tree_vec (1);
+      incr = make_tree_vec (1);
+
+      /* Cycle statement is implemented with a goto.  Exit statement must not
+	 be present for this loop.  */
+      exit_label = gfc_build_label_decl (NULL_TREE);
+      TREE_USED (exit_label) = 1;
+
+      /* Label for cycle statements (if needed).  */
+      tmp = build1_v (LABEL_EXPR, exit_label);
+      gfc_add_expr_to_block (pbody, tmp);
+
+      stmt = make_node (OMP_FOR);
+
+      TREE_TYPE (stmt) = void_type_node;
+      OMP_FOR_BODY (stmt) = loopbody = gfc_finish_block (pbody);
+
+      OMP_FOR_CLAUSES (stmt) = build_omp_clause (input_location,
+						 OMP_CLAUSE_SCHEDULE);
+      OMP_CLAUSE_SCHEDULE_KIND (OMP_FOR_CLAUSES (stmt))
+	= OMP_CLAUSE_SCHEDULE_STATIC;
+      if (ompws_flags & OMPWS_NOWAIT)
+	OMP_CLAUSE_CHAIN (OMP_FOR_CLAUSES (stmt))
+	  = build_omp_clause (input_location, OMP_CLAUSE_NOWAIT);
+
+      /* Initialize the loopvar.  */
+      TREE_VEC_ELT (init, 0) = build2_v (MODIFY_EXPR, loop->loopvar[n],
+					 loop->from[n]);
+      OMP_FOR_INIT (stmt) = init;
+      /* The exit condition.  */
+      TREE_VEC_ELT (cond, 0) = build2_loc (input_location, LE_EXPR,
+					   boolean_type_node,
+					   loop->loopvar[n], loop->to[n]);
+      SET_EXPR_LOCATION (TREE_VEC_ELT (cond, 0), input_location);
+      OMP_FOR_COND (stmt) = cond;
+      /* Increment the loopvar.  */
+      tmp = build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			loop->loopvar[n], gfc_index_one_node);
+      TREE_VEC_ELT (incr, 0) = fold_build2_loc (input_location, MODIFY_EXPR,
+	  void_type_node, loop->loopvar[n], tmp);
+      OMP_FOR_INCR (stmt) = incr;
+
+      ompws_flags &= ~OMPWS_CURR_SINGLEUNIT;
+      gfc_add_expr_to_block (&loop->code[n], stmt);
+    }
+  else
+    {
+      bool reverse_loop = (loop->reverse[n] == GFC_REVERSE_SET)
+			     && (loop->temp_ss == NULL);
+
+      loopbody = gfc_finish_block (pbody);
+
+      if (reverse_loop)
+	{
+	  tmp = loop->from[n];
+	  loop->from[n] = loop->to[n];
+	  loop->to[n] = tmp;
+	}
+
+      /* Initialize the loopvar.  */
+      if (loop->loopvar[n] != loop->from[n])
+	gfc_add_modify (&loop->code[n], loop->loopvar[n], loop->from[n]);
+
+      exit_label = gfc_build_label_decl (NULL_TREE);
+
+      /* Generate the loop body.  */
+      gfc_init_block (&block);
+
+      /* The exit condition.  */
+      cond = fold_build2_loc (input_location, reverse_loop ? LT_EXPR : GT_EXPR,
+			  boolean_type_node, loop->loopvar[n], loop->to[n]);
+      tmp = build1_v (GOTO_EXPR, exit_label);
+      TREE_USED (exit_label) = 1;
+      tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block, tmp);
+
+      /* The main body.  */
+      gfc_add_expr_to_block (&block, loopbody);
+
+      /* Increment the loopvar.  */
+      tmp = fold_build2_loc (input_location,
+			     reverse_loop ? MINUS_EXPR : PLUS_EXPR,
+			     gfc_array_index_type, loop->loopvar[n],
+			     gfc_index_one_node);
+
+      gfc_add_modify (&block, loop->loopvar[n], tmp);
+
+      /* Build the loop.  */
+      tmp = gfc_finish_block (&block);
+      tmp = build1_v (LOOP_EXPR, tmp);
+      gfc_add_expr_to_block (&loop->code[n], tmp);
+
+      /* Add the exit label.  */
+      tmp = build1_v (LABEL_EXPR, exit_label);
+      gfc_add_expr_to_block (&loop->code[n], tmp);
+    }
+
+}
+
+
+/* Finishes and generates the loops for a scalarized expression.  */
+
+void
+gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body)
+{
+  int dim;
+  int n;
+  gfc_ss *ss;
+  stmtblock_t *pblock;
+  tree tmp;
+
+  pblock = body;
+  /* Generate the loops.  */
+  for (dim = 0; dim < loop->dimen; dim++)
+    {
+      n = loop->order[dim];
+      gfc_trans_scalarized_loop_end (loop, n, pblock);
+      loop->loopvar[n] = NULL_TREE;
+      pblock = &loop->code[n];
+    }
+
+  tmp = gfc_finish_block (pblock);
+  gfc_add_expr_to_block (&loop->pre, tmp);
+
+  /* Clear all the used flags.  */
+  for (ss = loop->ss; ss; ss = ss->loop_chain)
+    ss->useflags = 0;
+}
+
+
+/* Finish the main body of a scalarized expression, and start the secondary
+   copying body.  */
+
+void
+gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body)
+{
+  int dim;
+  int n;
+  stmtblock_t *pblock;
+  gfc_ss *ss;
+
+  pblock = body;
+  /* We finish as many loops as are used by the temporary.  */
+  for (dim = 0; dim < loop->temp_dim - 1; dim++)
+    {
+      n = loop->order[dim];
+      gfc_trans_scalarized_loop_end (loop, n, pblock);
+      loop->loopvar[n] = NULL_TREE;
+      pblock = &loop->code[n];
+    }
+
+  /* We don't want to finish the outermost loop entirely.  */
+  n = loop->order[loop->temp_dim - 1];
+  gfc_trans_scalarized_loop_end (loop, n, pblock);
+
+  /* Restore the initial offsets.  */
+  for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
+    {
+      if ((ss->useflags & 2) == 0)
+	continue;
+
+      if (ss->type != GFC_SS_SECTION
+	  && ss->type != GFC_SS_FUNCTION && ss->type != GFC_SS_CONSTRUCTOR
+	  && ss->type != GFC_SS_COMPONENT)
+	continue;
+
+      ss->data.info.offset = ss->data.info.saved_offset;
+    }
+
+  /* Restart all the inner loops we just finished.  */
+  for (dim = loop->temp_dim - 2; dim >= 0; dim--)
+    {
+      n = loop->order[dim];
+
+      gfc_start_block (&loop->code[n]);
+
+      loop->loopvar[n] = gfc_create_var (gfc_array_index_type, "Q");
+
+      gfc_trans_preloop_setup (loop, dim, 2, &loop->code[n]);
+    }
+
+  /* Start a block for the secondary copying code.  */
+  gfc_start_block (body);
+}
+
+
+/* Calculate the lower bound of an array section.  */
+
+static void
+gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim)
+{
+  gfc_expr *start;
+  gfc_expr *end;
+  gfc_expr *stride;
+  tree desc;
+  gfc_se se;
+  gfc_ss_info *info;
+
+  gcc_assert (ss->type == GFC_SS_SECTION);
+
+  info = &ss->data.info;
+
+  if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
+    {
+      /* We use a zero-based index to access the vector.  */
+      info->start[dim] = gfc_index_zero_node;
+      info->stride[dim] = gfc_index_one_node;
+      info->end[dim] = NULL;
+      return;
+    }
+
+  gcc_assert (info->ref->u.ar.dimen_type[dim] == DIMEN_RANGE);
+  desc = info->descriptor;
+  start = info->ref->u.ar.start[dim];
+  end = info->ref->u.ar.end[dim];
+  stride = info->ref->u.ar.stride[dim];
+
+  /* Calculate the start of the range.  For vector subscripts this will
+     be the range of the vector.  */
+  if (start)
+    {
+      /* Specified section start.  */
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_type (&se, start, gfc_array_index_type);
+      gfc_add_block_to_block (&loop->pre, &se.pre);
+      info->start[dim] = se.expr;
+    }
+  else
+    {
+      /* No lower bound specified so use the bound of the array.  */
+      info->start[dim] = gfc_conv_array_lbound (desc, dim);
+    }
+  info->start[dim] = gfc_evaluate_now (info->start[dim], &loop->pre);
+
+  /* Similarly calculate the end.  Although this is not used in the
+     scalarizer, it is needed when checking bounds and where the end
+     is an expression with side-effects.  */
+  if (end)
+    {
+      /* Specified section start.  */
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_type (&se, end, gfc_array_index_type);
+      gfc_add_block_to_block (&loop->pre, &se.pre);
+      info->end[dim] = se.expr;
+    }
+  else
+    {
+      /* No upper bound specified so use the bound of the array.  */
+      info->end[dim] = gfc_conv_array_ubound (desc, dim);
+    }
+  info->end[dim] = gfc_evaluate_now (info->end[dim], &loop->pre);
+
+  /* Calculate the stride.  */
+  if (stride == NULL)
+    info->stride[dim] = gfc_index_one_node;
+  else
+    {
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_type (&se, stride, gfc_array_index_type);
+      gfc_add_block_to_block (&loop->pre, &se.pre);
+      info->stride[dim] = gfc_evaluate_now (se.expr, &loop->pre);
+    }
+}
+
+
+/* Calculates the range start and stride for a SS chain.  Also gets the
+   descriptor and data pointer.  The range of vector subscripts is the size
+   of the vector.  Array bounds are also checked.  */
+
+void
+gfc_conv_ss_startstride (gfc_loopinfo * loop)
+{
+  int n;
+  tree tmp;
+  gfc_ss *ss;
+  tree desc;
+
+  loop->dimen = 0;
+  /* Determine the rank of the loop.  */
+  for (ss = loop->ss;
+       ss != gfc_ss_terminator && loop->dimen == 0; ss = ss->loop_chain)
+    {
+      switch (ss->type)
+	{
+	case GFC_SS_SECTION:
+	case GFC_SS_CONSTRUCTOR:
+	case GFC_SS_FUNCTION:
+	case GFC_SS_COMPONENT:
+	  loop->dimen = ss->data.info.dimen;
+	  break;
+
+	/* As usual, lbound and ubound are exceptions!.  */
+	case GFC_SS_INTRINSIC:
+	  switch (ss->expr->value.function.isym->id)
+	    {
+	    case GFC_ISYM_LBOUND:
+	    case GFC_ISYM_UBOUND:
+	      loop->dimen = ss->data.info.dimen;
+
+	    default:
+	      break;
+	    }
+
+	default:
+	  break;
+	}
+    }
+
+  /* We should have determined the rank of the expression by now.  If
+     not, that's bad news.  */
+  gcc_assert (loop->dimen != 0);
+
+  /* Loop over all the SS in the chain.  */
+  for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
+    {
+      if (ss->expr && ss->expr->shape && !ss->shape)
+	ss->shape = ss->expr->shape;
+
+      switch (ss->type)
+	{
+	case GFC_SS_SECTION:
+	  /* Get the descriptor for the array.  */
+	  gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter);
+
+	  for (n = 0; n < ss->data.info.dimen; n++)
+	    gfc_conv_section_startstride (loop, ss, ss->data.info.dim[n]);
+	  break;
+
+	case GFC_SS_INTRINSIC:
+	  switch (ss->expr->value.function.isym->id)
+	    {
+	    /* Fall through to supply start and stride.  */
+	    case GFC_ISYM_LBOUND:
+	    case GFC_ISYM_UBOUND:
+	      break;
+	    default:
+	      continue;
+	    }
+
+	case GFC_SS_CONSTRUCTOR:
+	case GFC_SS_FUNCTION:
+	  for (n = 0; n < ss->data.info.dimen; n++)
+	    {
+	      ss->data.info.start[n] = gfc_index_zero_node;
+	      ss->data.info.end[n] = gfc_index_zero_node;
+	      ss->data.info.stride[n] = gfc_index_one_node;
+	    }
+	  break;
+
+	default:
+	  break;
+	}
+    }
+
+  /* The rest is just runtime bound checking.  */
+  if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+    {
+      stmtblock_t block;
+      tree lbound, ubound;
+      tree end;
+      tree size[GFC_MAX_DIMENSIONS];
+      tree stride_pos, stride_neg, non_zerosized, tmp2, tmp3;
+      gfc_ss_info *info;
+      char *msg;
+      int dim;
+
+      gfc_start_block (&block);
+
+      for (n = 0; n < loop->dimen; n++)
+	size[n] = NULL_TREE;
+
+      for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
+	{
+	  stmtblock_t inner;
+
+	  if (ss->type != GFC_SS_SECTION)
+	    continue;
+
+	  /* Catch allocatable lhs in f2003.  */
+	  if (gfc_option.flag_realloc_lhs && ss->is_alloc_lhs)
+	    continue;
+
+	  gfc_start_block (&inner);
+
+	  /* TODO: range checking for mapped dimensions.  */
+	  info = &ss->data.info;
+
+	  /* This code only checks ranges.  Elemental and vector
+	     dimensions are checked later.  */
+	  for (n = 0; n < loop->dimen; n++)
+	    {
+	      bool check_upper;
+
+	      dim = info->dim[n];
+	      if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
+		continue;
+
+	      if (dim == info->ref->u.ar.dimen - 1
+		  && info->ref->u.ar.as->type == AS_ASSUMED_SIZE)
+		check_upper = false;
+	      else
+		check_upper = true;
+
+	      /* Zero stride is not allowed.  */
+	      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				     info->stride[dim], gfc_index_zero_node);
+	      asprintf (&msg, "Zero stride is not allowed, for dimension %d "
+			"of array '%s'", dim + 1, ss->expr->symtree->name);
+	      gfc_trans_runtime_check (true, false, tmp, &inner,
+				       &ss->expr->where, msg);
+	      gfc_free (msg);
+
+	      desc = ss->data.info.descriptor;
+
+	      /* This is the run-time equivalent of resolve.c's
+		 check_dimension().  The logical is more readable there
+		 than it is here, with all the trees.  */
+	      lbound = gfc_conv_array_lbound (desc, dim);
+	      end = info->end[dim];
+	      if (check_upper)
+		ubound = gfc_conv_array_ubound (desc, dim);
+	      else
+		ubound = NULL;
+
+	      /* non_zerosized is true when the selected range is not
+		 empty.  */
+	      stride_pos = fold_build2_loc (input_location, GT_EXPR,
+					boolean_type_node, info->stride[dim],
+					gfc_index_zero_node);
+	      tmp = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
+				     info->start[dim], end);
+	      stride_pos = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+					    boolean_type_node, stride_pos, tmp);
+
+	      stride_neg = fold_build2_loc (input_location, LT_EXPR,
+				     boolean_type_node,
+				     info->stride[dim], gfc_index_zero_node);
+	      tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
+				     info->start[dim], end);
+	      stride_neg = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+					    boolean_type_node,
+					    stride_neg, tmp);
+	      non_zerosized = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+					       boolean_type_node,
+					       stride_pos, stride_neg);
+
+	      /* Check the start of the range against the lower and upper
+		 bounds of the array, if the range is not empty. 
+	         If upper bound is present, include both bounds in the 
+		 error message.  */
+	      if (check_upper)
+		{
+		  tmp = fold_build2_loc (input_location, LT_EXPR,
+					 boolean_type_node,
+					 info->start[dim], lbound);
+		  tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+					 boolean_type_node,
+					 non_zerosized, tmp);
+		  tmp2 = fold_build2_loc (input_location, GT_EXPR,
+					  boolean_type_node,
+					  info->start[dim], ubound);
+		  tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+					  boolean_type_node,
+					  non_zerosized, tmp2);
+		  asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
+			    "outside of expected range (%%ld:%%ld)",
+			    dim + 1, ss->expr->symtree->name);
+		  gfc_trans_runtime_check (true, false, tmp, &inner,
+					   &ss->expr->where, msg,
+		     fold_convert (long_integer_type_node, info->start[dim]),
+		     fold_convert (long_integer_type_node, lbound),
+		     fold_convert (long_integer_type_node, ubound));
+		  gfc_trans_runtime_check (true, false, tmp2, &inner,
+					   &ss->expr->where, msg,
+		     fold_convert (long_integer_type_node, info->start[dim]),
+		     fold_convert (long_integer_type_node, lbound),
+		     fold_convert (long_integer_type_node, ubound));
+		  gfc_free (msg);
+		}
+	      else
+		{
+		  tmp = fold_build2_loc (input_location, LT_EXPR,
+					 boolean_type_node,
+					 info->start[dim], lbound);
+		  tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+					 boolean_type_node, non_zerosized, tmp);
+		  asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
+			    "below lower bound of %%ld",
+			    dim + 1, ss->expr->symtree->name);
+		  gfc_trans_runtime_check (true, false, tmp, &inner,
+					   &ss->expr->where, msg,
+		     fold_convert (long_integer_type_node, info->start[dim]),
+		     fold_convert (long_integer_type_node, lbound));
+		  gfc_free (msg);
+		}
+	      
+	      /* Compute the last element of the range, which is not
+		 necessarily "end" (think 0:5:3, which doesn't contain 5)
+		 and check it against both lower and upper bounds.  */
+
+	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				     gfc_array_index_type, end,
+				     info->start[dim]);
+	      tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
+				     gfc_array_index_type, tmp,
+				     info->stride[dim]);
+	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				     gfc_array_index_type, end, tmp);
+	      tmp2 = fold_build2_loc (input_location, LT_EXPR,
+				      boolean_type_node, tmp, lbound);
+	      tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+				      boolean_type_node, non_zerosized, tmp2);
+	      if (check_upper)
+		{
+		  tmp3 = fold_build2_loc (input_location, GT_EXPR,
+					  boolean_type_node, tmp, ubound);
+		  tmp3 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+					  boolean_type_node, non_zerosized, tmp3);
+		  asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
+			    "outside of expected range (%%ld:%%ld)",
+			    dim + 1, ss->expr->symtree->name);
+		  gfc_trans_runtime_check (true, false, tmp2, &inner,
+					   &ss->expr->where, msg,
+		     fold_convert (long_integer_type_node, tmp),
+		     fold_convert (long_integer_type_node, ubound), 
+		     fold_convert (long_integer_type_node, lbound));
+		  gfc_trans_runtime_check (true, false, tmp3, &inner,
+					   &ss->expr->where, msg,
+		     fold_convert (long_integer_type_node, tmp),
+		     fold_convert (long_integer_type_node, ubound), 
+		     fold_convert (long_integer_type_node, lbound));
+		  gfc_free (msg);
+		}
+	      else
+		{
+		  asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
+			    "below lower bound of %%ld",
+			    dim + 1, ss->expr->symtree->name);
+		  gfc_trans_runtime_check (true, false, tmp2, &inner,
+					   &ss->expr->where, msg,
+		     fold_convert (long_integer_type_node, tmp),
+		     fold_convert (long_integer_type_node, lbound));
+		  gfc_free (msg);
+		}
+
+	      /* Check the section sizes match.  */
+	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				     gfc_array_index_type, end,
+				     info->start[dim]);
+	      tmp = fold_build2_loc (input_location, FLOOR_DIV_EXPR,
+				     gfc_array_index_type, tmp,
+				     info->stride[dim]);
+	      tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				     gfc_array_index_type,
+				     gfc_index_one_node, tmp);
+	      tmp = fold_build2_loc (input_location, MAX_EXPR,
+				     gfc_array_index_type, tmp,
+				     build_int_cst (gfc_array_index_type, 0));
+	      /* We remember the size of the first section, and check all the
+		 others against this.  */
+	      if (size[n])
+		{
+		  tmp3 = fold_build2_loc (input_location, NE_EXPR,
+					  boolean_type_node, tmp, size[n]);
+		  asprintf (&msg, "Array bound mismatch for dimension %d "
+			    "of array '%s' (%%ld/%%ld)",
+			    dim + 1, ss->expr->symtree->name);
+
+		  gfc_trans_runtime_check (true, false, tmp3, &inner,
+					   &ss->expr->where, msg,
+			fold_convert (long_integer_type_node, tmp),
+			fold_convert (long_integer_type_node, size[n]));
+
+		  gfc_free (msg);
+		}
+	      else
+		size[n] = gfc_evaluate_now (tmp, &inner);
+	    }
+
+	  tmp = gfc_finish_block (&inner);
+
+	  /* For optional arguments, only check bounds if the argument is
+	     present.  */
+	  if (ss->expr->symtree->n.sym->attr.optional
+	      || ss->expr->symtree->n.sym->attr.not_always_present)
+	    tmp = build3_v (COND_EXPR,
+			    gfc_conv_expr_present (ss->expr->symtree->n.sym),
+			    tmp, build_empty_stmt (input_location));
+
+	  gfc_add_expr_to_block (&block, tmp);
+
+	}
+
+      tmp = gfc_finish_block (&block);
+      gfc_add_expr_to_block (&loop->pre, tmp);
+    }
+}
+
+/* Return true if both symbols could refer to the same data object.  Does
+   not take account of aliasing due to equivalence statements.  */
+
+static int
+symbols_could_alias (gfc_symbol *lsym, gfc_symbol *rsym, bool lsym_pointer,
+		     bool lsym_target, bool rsym_pointer, bool rsym_target)
+{
+  /* Aliasing isn't possible if the symbols have different base types.  */
+  if (gfc_compare_types (&lsym->ts, &rsym->ts) == 0)
+    return 0;
+
+  /* Pointers can point to other pointers and target objects.  */
+
+  if ((lsym_pointer && (rsym_pointer || rsym_target))
+      || (rsym_pointer && (lsym_pointer || lsym_target)))
+    return 1;
+
+  /* Special case: Argument association, cf. F90 12.4.1.6, F2003 12.4.1.7
+     and F2008 12.5.2.13 items 3b and 4b. The pointer case (a) is already
+     checked above.  */
+  if (lsym_target && rsym_target
+      && ((lsym->attr.dummy && !lsym->attr.contiguous
+	   && (!lsym->attr.dimension || lsym->as->type == AS_ASSUMED_SHAPE))
+	  || (rsym->attr.dummy && !rsym->attr.contiguous
+	      && (!rsym->attr.dimension
+		  || rsym->as->type == AS_ASSUMED_SHAPE))))
+    return 1;
+
+  return 0;
+}
+
+
+/* Return true if the two SS could be aliased, i.e. both point to the same data
+   object.  */
+/* TODO: resolve aliases based on frontend expressions.  */
+
+static int
+gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss)
+{
+  gfc_ref *lref;
+  gfc_ref *rref;
+  gfc_symbol *lsym;
+  gfc_symbol *rsym;
+  bool lsym_pointer, lsym_target, rsym_pointer, rsym_target;
+
+  lsym = lss->expr->symtree->n.sym;
+  rsym = rss->expr->symtree->n.sym;
+
+  lsym_pointer = lsym->attr.pointer;
+  lsym_target = lsym->attr.target;
+  rsym_pointer = rsym->attr.pointer;
+  rsym_target = rsym->attr.target;
+
+  if (symbols_could_alias (lsym, rsym, lsym_pointer, lsym_target,
+			   rsym_pointer, rsym_target))
+    return 1;
+
+  if (rsym->ts.type != BT_DERIVED && rsym->ts.type != BT_CLASS
+      && lsym->ts.type != BT_DERIVED && lsym->ts.type != BT_CLASS)
+    return 0;
+
+  /* For derived types we must check all the component types.  We can ignore
+     array references as these will have the same base type as the previous
+     component ref.  */
+  for (lref = lss->expr->ref; lref != lss->data.info.ref; lref = lref->next)
+    {
+      if (lref->type != REF_COMPONENT)
+	continue;
+
+      lsym_pointer = lsym_pointer || lref->u.c.sym->attr.pointer;
+      lsym_target  = lsym_target  || lref->u.c.sym->attr.target;
+
+      if (symbols_could_alias (lref->u.c.sym, rsym, lsym_pointer, lsym_target,
+			       rsym_pointer, rsym_target))
+	return 1;
+
+      if ((lsym_pointer && (rsym_pointer || rsym_target))
+	  || (rsym_pointer && (lsym_pointer || lsym_target)))
+	{
+	  if (gfc_compare_types (&lref->u.c.component->ts,
+				 &rsym->ts))
+	    return 1;
+	}
+
+      for (rref = rss->expr->ref; rref != rss->data.info.ref;
+	   rref = rref->next)
+	{
+	  if (rref->type != REF_COMPONENT)
+	    continue;
+
+	  rsym_pointer = rsym_pointer || rref->u.c.sym->attr.pointer;
+	  rsym_target  = lsym_target  || rref->u.c.sym->attr.target;
+
+	  if (symbols_could_alias (lref->u.c.sym, rref->u.c.sym,
+				   lsym_pointer, lsym_target,
+				   rsym_pointer, rsym_target))
+	    return 1;
+
+	  if ((lsym_pointer && (rsym_pointer || rsym_target))
+	      || (rsym_pointer && (lsym_pointer || lsym_target)))
+	    {
+	      if (gfc_compare_types (&lref->u.c.component->ts,
+				     &rref->u.c.sym->ts))
+		return 1;
+	      if (gfc_compare_types (&lref->u.c.sym->ts,
+				     &rref->u.c.component->ts))
+		return 1;
+	      if (gfc_compare_types (&lref->u.c.component->ts,
+				     &rref->u.c.component->ts))
+		return 1;
+	    }
+	}
+    }
+
+  lsym_pointer = lsym->attr.pointer;
+  lsym_target = lsym->attr.target;
+  lsym_pointer = lsym->attr.pointer;
+  lsym_target = lsym->attr.target;
+
+  for (rref = rss->expr->ref; rref != rss->data.info.ref; rref = rref->next)
+    {
+      if (rref->type != REF_COMPONENT)
+	break;
+
+      rsym_pointer = rsym_pointer || rref->u.c.sym->attr.pointer;
+      rsym_target  = lsym_target  || rref->u.c.sym->attr.target;
+
+      if (symbols_could_alias (rref->u.c.sym, lsym,
+			       lsym_pointer, lsym_target,
+			       rsym_pointer, rsym_target))
+	return 1;
+
+      if ((lsym_pointer && (rsym_pointer || rsym_target))
+	  || (rsym_pointer && (lsym_pointer || lsym_target)))
+	{
+	  if (gfc_compare_types (&lsym->ts, &rref->u.c.component->ts))
+	    return 1;
+	}
+    }
+
+  return 0;
+}
+
+
+/* Resolve array data dependencies.  Creates a temporary if required.  */
+/* TODO: Calc dependencies with gfc_expr rather than gfc_ss, and move to
+   dependency.c.  */
+
+void
+gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
+			       gfc_ss * rss)
+{
+  gfc_ss *ss;
+  gfc_ref *lref;
+  gfc_ref *rref;
+  int nDepend = 0;
+  int i, j;
+
+  loop->temp_ss = NULL;
+
+  for (ss = rss; ss != gfc_ss_terminator; ss = ss->next)
+    {
+      if (ss->type != GFC_SS_SECTION)
+	continue;
+
+      if (dest->expr->symtree->n.sym != ss->expr->symtree->n.sym)
+	{
+	  if (gfc_could_be_alias (dest, ss)
+		|| gfc_are_equivalenced_arrays (dest->expr, ss->expr))
+	    {
+	      nDepend = 1;
+	      break;
+	    }
+	}
+      else
+	{
+	  lref = dest->expr->ref;
+	  rref = ss->expr->ref;
+
+	  nDepend = gfc_dep_resolver (lref, rref, &loop->reverse[0]);
+
+	  if (nDepend == 1)
+	    break;
+
+	  for (i = 0; i < dest->data.info.dimen; i++)
+	    for (j = 0; j < ss->data.info.dimen; j++)
+	      if (i != j
+		  && dest->data.info.dim[i] == ss->data.info.dim[j])
+		{
+		  /* If we don't access array elements in the same order,
+		     there is a dependency.  */
+		  nDepend = 1;
+		  goto temporary;
+		}
+#if 0
+	  /* TODO : loop shifting.  */
+	  if (nDepend == 1)
+	    {
+	      /* Mark the dimensions for LOOP SHIFTING */
+	      for (n = 0; n < loop->dimen; n++)
+	        {
+	          int dim = dest->data.info.dim[n];
+
+		  if (lref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
+		    depends[n] = 2;
+		  else if (! gfc_is_same_range (&lref->u.ar,
+						&rref->u.ar, dim, 0))
+		    depends[n] = 1;
+	         }
+
+	      /* Put all the dimensions with dependencies in the
+		 innermost loops.  */
+	      dim = 0;
+	      for (n = 0; n < loop->dimen; n++)
+		{
+		  gcc_assert (loop->order[n] == n);
+		  if (depends[n])
+		  loop->order[dim++] = n;
+		}
+	      for (n = 0; n < loop->dimen; n++)
+	        {
+		  if (! depends[n])
+		  loop->order[dim++] = n;
+		}
+
+	      gcc_assert (dim == loop->dimen);
+	      break;
+	    }
+#endif
+	}
+    }
+
+temporary:
+
+  if (nDepend == 1)
+    {
+      tree base_type = gfc_typenode_for_spec (&dest->expr->ts);
+      if (GFC_ARRAY_TYPE_P (base_type)
+	  || GFC_DESCRIPTOR_TYPE_P (base_type))
+	base_type = gfc_get_element_type (base_type);
+      loop->temp_ss = gfc_get_ss ();
+      loop->temp_ss->type = GFC_SS_TEMP;
+      loop->temp_ss->data.temp.type = base_type;
+      loop->temp_ss->string_length = dest->string_length;
+      loop->temp_ss->data.temp.dimen = loop->dimen;
+      loop->temp_ss->next = gfc_ss_terminator;
+      gfc_add_ss_to_loop (loop, loop->temp_ss);
+    }
+  else
+    loop->temp_ss = NULL;
+}
+
+
+/* Initialize the scalarization loop.  Creates the loop variables.  Determines
+   the range of the loop variables.  Creates a temporary if required.
+   Calculates how to transform from loop variables to array indices for each
+   expression.  Also generates code for scalar expressions which have been
+   moved outside the loop.  */
+
+void
+gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
+{
+  int n, dim, spec_dim;
+  gfc_ss_info *info;
+  gfc_ss_info *specinfo;
+  gfc_ss *ss;
+  tree tmp;
+  gfc_ss *loopspec[GFC_MAX_DIMENSIONS];
+  bool dynamic[GFC_MAX_DIMENSIONS];
+  mpz_t *cshape;
+  mpz_t i;
+
+  mpz_init (i);
+  for (n = 0; n < loop->dimen; n++)
+    {
+      loopspec[n] = NULL;
+      dynamic[n] = false;
+      /* We use one SS term, and use that to determine the bounds of the
+	 loop for this dimension.  We try to pick the simplest term.  */
+      for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
+	{
+	  if (ss->type == GFC_SS_SCALAR || ss->type == GFC_SS_REFERENCE)
+	    continue;
+
+	  info = &ss->data.info;
+	  dim = info->dim[n];
+
+	  if (loopspec[n] != NULL)
+	    {
+	      specinfo = &loopspec[n]->data.info;
+	      spec_dim = specinfo->dim[n];
+	    }
+	  else
+	    {
+	      /* Silence unitialized warnings.  */
+	      specinfo = NULL;
+	      spec_dim = 0;
+	    }
+
+	  if (ss->shape)
+	    {
+	      gcc_assert (ss->shape[dim]);
+	      /* The frontend has worked out the size for us.  */
+	      if (!loopspec[n]
+		  || !loopspec[n]->shape
+		  || !integer_zerop (specinfo->start[spec_dim]))
+		/* Prefer zero-based descriptors if possible.  */
+		loopspec[n] = ss;
+	      continue;
+	    }
+
+	  if (ss->type == GFC_SS_CONSTRUCTOR)
+	    {
+	      gfc_constructor_base base;
+	      /* An unknown size constructor will always be rank one.
+		 Higher rank constructors will either have known shape,
+		 or still be wrapped in a call to reshape.  */
+	      gcc_assert (loop->dimen == 1);
+
+	      /* Always prefer to use the constructor bounds if the size
+		 can be determined at compile time.  Prefer not to otherwise,
+		 since the general case involves realloc, and it's better to
+		 avoid that overhead if possible.  */
+	      base = ss->expr->value.constructor;
+	      dynamic[n] = gfc_get_array_constructor_size (&i, base);
+	      if (!dynamic[n] || !loopspec[n])
+		loopspec[n] = ss;
+	      continue;
+	    }
+
+	  /* TODO: Pick the best bound if we have a choice between a
+	     function and something else.  */
+	  if (ss->type == GFC_SS_FUNCTION)
+	    {
+	      loopspec[n] = ss;
+	      continue;
+	    }
+
+	  /* Avoid using an allocatable lhs in an assignment, since
+	     there might be a reallocation coming.  */
+	  if (loopspec[n] && ss->is_alloc_lhs)
+	    continue;
+
+	  if (ss->type != GFC_SS_SECTION)
+	    continue;
+
+	  if (!loopspec[n])
+	    loopspec[n] = ss;
+	  /* Criteria for choosing a loop specifier (most important first):
+	     doesn't need realloc
+	     stride of one
+	     known stride
+	     known lower bound
+	     known upper bound
+	   */
+	  else if (loopspec[n]->type == GFC_SS_CONSTRUCTOR && dynamic[n])
+	    loopspec[n] = ss;
+	  else if (integer_onep (info->stride[dim])
+		   && !integer_onep (specinfo->stride[spec_dim]))
+	    loopspec[n] = ss;
+	  else if (INTEGER_CST_P (info->stride[dim])
+		   && !INTEGER_CST_P (specinfo->stride[spec_dim]))
+	    loopspec[n] = ss;
+	  else if (INTEGER_CST_P (info->start[dim])
+		   && !INTEGER_CST_P (specinfo->start[spec_dim]))
+	    loopspec[n] = ss;
+	  /* We don't work out the upper bound.
+	     else if (INTEGER_CST_P (info->finish[n])
+	     && ! INTEGER_CST_P (specinfo->finish[n]))
+	     loopspec[n] = ss; */
+	}
+
+      /* We should have found the scalarization loop specifier.  If not,
+	 that's bad news.  */
+      gcc_assert (loopspec[n]);
+
+      info = &loopspec[n]->data.info;
+      dim = info->dim[n];
+
+      /* Set the extents of this range.  */
+      cshape = loopspec[n]->shape;
+      if (cshape && INTEGER_CST_P (info->start[dim])
+	  && INTEGER_CST_P (info->stride[dim]))
+	{
+	  loop->from[n] = info->start[dim];
+	  mpz_set (i, cshape[get_array_ref_dim (info, n)]);
+	  mpz_sub_ui (i, i, 1);
+	  /* To = from + (size - 1) * stride.  */
+	  tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind);
+	  if (!integer_onep (info->stride[dim]))
+	    tmp = fold_build2_loc (input_location, MULT_EXPR,
+				   gfc_array_index_type, tmp,
+				   info->stride[dim]);
+	  loop->to[n] = fold_build2_loc (input_location, PLUS_EXPR,
+					 gfc_array_index_type,
+					 loop->from[n], tmp);
+	}
+      else
+	{
+	  loop->from[n] = info->start[dim];
+	  switch (loopspec[n]->type)
+	    {
+	    case GFC_SS_CONSTRUCTOR:
+	      /* The upper bound is calculated when we expand the
+		 constructor.  */
+	      gcc_assert (loop->to[n] == NULL_TREE);
+	      break;
+
+	    case GFC_SS_SECTION:
+	      /* Use the end expression if it exists and is not constant,
+		 so that it is only evaluated once.  */
+	      loop->to[n] = info->end[dim];
+	      break;
+
+	    case GFC_SS_FUNCTION:
+	      /* The loop bound will be set when we generate the call.  */
+	      gcc_assert (loop->to[n] == NULL_TREE);
+	      break;
+
+	    default:
+	      gcc_unreachable ();
+	    }
+	}
+
+      /* Transform everything so we have a simple incrementing variable.  */
+      if (integer_onep (info->stride[dim]))
+	info->delta[dim] = gfc_index_zero_node;
+      else
+	{
+	  /* Set the delta for this section.  */
+	  info->delta[dim] = gfc_evaluate_now (loop->from[n], &loop->pre);
+	  /* Number of iterations is (end - start + step) / step.
+	     with start = 0, this simplifies to
+	     last = end / step;
+	     for (i = 0; i<=last; i++){...};  */
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type, loop->to[n],
+				 loop->from[n]);
+	  tmp = fold_build2_loc (input_location, FLOOR_DIV_EXPR,
+				 gfc_array_index_type, tmp, info->stride[dim]);
+	  tmp = fold_build2_loc (input_location, MAX_EXPR, gfc_array_index_type,
+				 tmp, build_int_cst (gfc_array_index_type, -1));
+	  loop->to[n] = gfc_evaluate_now (tmp, &loop->pre);
+	  /* Make the loop variable start at 0.  */
+	  loop->from[n] = gfc_index_zero_node;
+	}
+    }
+
+  /* Add all the scalar code that can be taken out of the loops.
+     This may include calculating the loop bounds, so do it before
+     allocating the temporary.  */
+  gfc_add_loop_ss_code (loop, loop->ss, false, where);
+
+  /* If we want a temporary then create it.  */
+  if (loop->temp_ss != NULL)
+    {
+      gcc_assert (loop->temp_ss->type == GFC_SS_TEMP);
+
+      /* Make absolutely sure that this is a complete type.  */
+      if (loop->temp_ss->string_length)
+	loop->temp_ss->data.temp.type
+		= gfc_get_character_type_len_for_eltype
+			(TREE_TYPE (loop->temp_ss->data.temp.type),
+			 loop->temp_ss->string_length);
+
+      tmp = loop->temp_ss->data.temp.type;
+      n = loop->temp_ss->data.temp.dimen;
+      memset (&loop->temp_ss->data.info, 0, sizeof (gfc_ss_info));
+      loop->temp_ss->type = GFC_SS_SECTION;
+      loop->temp_ss->data.info.dimen = n;
+
+      gcc_assert (loop->temp_ss->data.info.dimen != 0);
+      for (n = 0; n < loop->temp_ss->data.info.dimen; n++)
+	loop->temp_ss->data.info.dim[n] = n;
+
+      gfc_trans_create_temp_array (&loop->pre, &loop->post, loop,
+				   &loop->temp_ss->data.info, tmp, NULL_TREE,
+				   false, true, false, where);
+    }
+
+  for (n = 0; n < loop->temp_dim; n++)
+    loopspec[loop->order[n]] = NULL;
+
+  mpz_clear (i);
+
+  /* For array parameters we don't have loop variables, so don't calculate the
+     translations.  */
+  if (loop->array_parameter)
+    return;
+
+  /* Calculate the translation from loop variables to array indices.  */
+  for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
+    {
+      if (ss->type != GFC_SS_SECTION && ss->type != GFC_SS_COMPONENT
+	    && ss->type != GFC_SS_CONSTRUCTOR)
+
+	continue;
+
+      info = &ss->data.info;
+
+      for (n = 0; n < info->dimen; n++)
+	{
+	  /* If we are specifying the range the delta is already set.  */
+	  if (loopspec[n] != ss)
+	    {
+	      dim = ss->data.info.dim[n];
+
+	      /* Calculate the offset relative to the loop variable.
+		 First multiply by the stride.  */
+	      tmp = loop->from[n];
+	      if (!integer_onep (info->stride[dim]))
+		tmp = fold_build2_loc (input_location, MULT_EXPR,
+				       gfc_array_index_type,
+				       tmp, info->stride[dim]);
+
+	      /* Then subtract this from our starting value.  */
+	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				     gfc_array_index_type,
+				     info->start[dim], tmp);
+
+	      info->delta[dim] = gfc_evaluate_now (tmp, &loop->pre);
+	    }
+	}
+    }
+}
+
+
+/* Calculate the size of a given array dimension from the bounds.  This
+   is simply (ubound - lbound + 1) if this expression is positive
+   or 0 if it is negative (pick either one if it is zero).  Optionally
+   (if or_expr is present) OR the (expression != 0) condition to it.  */
+
+tree
+gfc_conv_array_extent_dim (tree lbound, tree ubound, tree* or_expr)
+{
+  tree res;
+  tree cond;
+
+  /* Calculate (ubound - lbound + 1).  */
+  res = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			 ubound, lbound);
+  res = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, res,
+			 gfc_index_one_node);
+
+  /* Check whether the size for this dimension is negative.  */
+  cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, res,
+			  gfc_index_zero_node);
+  res = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type, cond,
+			 gfc_index_zero_node, res);
+
+  /* Build OR expression.  */
+  if (or_expr)
+    *or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+				boolean_type_node, *or_expr, cond);
+
+  return res;
+}
+
+
+/* For an array descriptor, get the total number of elements.  This is just
+   the product of the extents along all dimensions.  */
+
+tree
+gfc_conv_descriptor_size (tree desc, int rank)
+{
+  tree res;
+  int dim;
+
+  res = gfc_index_one_node;
+
+  for (dim = 0; dim < rank; ++dim)
+    {
+      tree lbound;
+      tree ubound;
+      tree extent;
+
+      lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]);
+      ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]);
+
+      extent = gfc_conv_array_extent_dim (lbound, ubound, NULL);
+      res = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     res, extent);
+    }
+
+  return res;
+}
+
+
+/* Helper function for marking a boolean expression tree as unlikely.  */
+
+static tree
+gfc_unlikely (tree cond)
+{
+  tree tmp;
+
+  cond = fold_convert (long_integer_type_node, cond);
+  tmp = build_zero_cst (long_integer_type_node);
+  cond = build_call_expr_loc (input_location,
+			      built_in_decls[BUILT_IN_EXPECT], 2, cond, tmp);
+  cond = fold_convert (boolean_type_node, cond);
+  return cond;
+}
+
+/* Fills in an array descriptor, and returns the size of the array.
+   The size will be a simple_val, ie a variable or a constant.  Also
+   calculates the offset of the base.  The pointer argument overflow,
+   which should be of integer type, will increase in value if overflow
+   occurs during the size calculation.  Returns the size of the array.
+   {
+    stride = 1;
+    offset = 0;
+    for (n = 0; n < rank; n++)
+      {
+	a.lbound[n] = specified_lower_bound;
+	offset = offset + a.lbond[n] * stride;
+	size = 1 - lbound;
+	a.ubound[n] = specified_upper_bound;
+	a.stride[n] = stride;
+	size = siz >= 0 ? ubound + size : 0; //size = ubound + 1 - lbound
+	overflow += size == 0 ? 0: (MAX/size < stride ? 1: 0);
+	stride = stride * size;
+      }
+    element_size = sizeof (array element);
+    stride = (size_t) stride;
+    overflow += element_size == 0 ? 0: (MAX/element_size < stride ? 1: 0);
+    stride = stride * element_size;
+    return (stride);
+   }  */
+/*GCC ARRAYS*/
+
+static tree
+gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset,
+		     gfc_expr ** lower, gfc_expr ** upper,
+		     stmtblock_t * pblock, tree * overflow)
+{
+  tree type;
+  tree tmp;
+  tree size;
+  tree offset;
+  tree stride;
+  tree element_size;
+  tree or_expr;
+  tree thencase;
+  tree elsecase;
+  tree cond;
+  tree var;
+  stmtblock_t thenblock;
+  stmtblock_t elseblock;
+  gfc_expr *ubound;
+  gfc_se se;
+  int n;
+
+  type = TREE_TYPE (descriptor);
+
+  stride = gfc_index_one_node;
+  offset = gfc_index_zero_node;
+
+  /* Set the dtype.  */
+  tmp = gfc_conv_descriptor_dtype (descriptor);
+  gfc_add_modify (pblock, tmp, gfc_get_dtype (TREE_TYPE (descriptor)));
+
+  or_expr = boolean_false_node;
+
+  for (n = 0; n < rank; n++)
+    {
+      tree conv_lbound;
+      tree conv_ubound;
+
+      /* We have 3 possibilities for determining the size of the array:
+	 lower == NULL    => lbound = 1, ubound = upper[n]
+	 upper[n] = NULL  => lbound = 1, ubound = lower[n]
+	 upper[n] != NULL => lbound = lower[n], ubound = upper[n]  */
+      ubound = upper[n];
+
+      /* Set lower bound.  */
+      gfc_init_se (&se, NULL);
+      if (lower == NULL)
+	se.expr = gfc_index_one_node;
+      else
+	{
+	  gcc_assert (lower[n]);
+	  if (ubound)
+	    {
+	      gfc_conv_expr_type (&se, lower[n], gfc_array_index_type);
+	      gfc_add_block_to_block (pblock, &se.pre);
+	    }
+	  else
+	    {
+	      se.expr = gfc_index_one_node;
+	      ubound = lower[n];
+	    }
+	}
+      gfc_conv_descriptor_lbound_set (pblock, descriptor, gfc_rank_cst[n],
+				      se.expr);
+      conv_lbound = se.expr;
+
+      /* Work out the offset for this component.  */
+      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     se.expr, stride);
+      offset = fold_build2_loc (input_location, MINUS_EXPR,
+				gfc_array_index_type, offset, tmp);
+
+      /* Set upper bound.  */
+      gfc_init_se (&se, NULL);
+      gcc_assert (ubound);
+      gfc_conv_expr_type (&se, ubound, gfc_array_index_type);
+      gfc_add_block_to_block (pblock, &se.pre);
+
+      gfc_conv_descriptor_ubound_set (pblock, descriptor,
+				      gfc_rank_cst[n], se.expr);
+      conv_ubound = se.expr;
+
+      /* Store the stride.  */
+      gfc_conv_descriptor_stride_set (pblock, descriptor,
+				      gfc_rank_cst[n], stride);
+
+      /* Calculate size and check whether extent is negative.  */
+      size = gfc_conv_array_extent_dim (conv_lbound, conv_ubound, &or_expr);
+      size = gfc_evaluate_now (size, pblock);
+
+      /* Check whether multiplying the stride by the number of
+	 elements in this dimension would overflow. We must also check
+	 whether the current dimension has zero size in order to avoid
+	 division by zero. 
+      */
+      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, 
+			     gfc_array_index_type, 
+			     fold_convert (gfc_array_index_type, 
+					   TYPE_MAX_VALUE (gfc_array_index_type)),
+					   size);
+      cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
+					    boolean_type_node, tmp, stride));
+      tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
+			     integer_one_node, integer_zero_node);
+      cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
+					    boolean_type_node, size,
+					    gfc_index_zero_node));
+      tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
+			     integer_zero_node, tmp);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
+			     *overflow, tmp);
+      *overflow = gfc_evaluate_now (tmp, pblock);
+      
+      /* Multiply the stride by the number of elements in this dimension.  */
+      stride = fold_build2_loc (input_location, MULT_EXPR,
+				gfc_array_index_type, stride, size);
+      stride = gfc_evaluate_now (stride, pblock);
+    }
+
+  for (n = rank; n < rank + corank; n++)
+    {
+      ubound = upper[n];
+
+      /* Set lower bound.  */
+      gfc_init_se (&se, NULL);
+      if (lower == NULL || lower[n] == NULL)
+	{
+	  gcc_assert (n == rank + corank - 1);
+	  se.expr = gfc_index_one_node;
+	}
+      else
+	{
+	  if (ubound || n == rank + corank - 1)
+	    {
+	      gfc_conv_expr_type (&se, lower[n], gfc_array_index_type);
+	      gfc_add_block_to_block (pblock, &se.pre);
+	    }
+	  else
+	    {
+	      se.expr = gfc_index_one_node;
+	      ubound = lower[n];
+	    }
+	}
+      gfc_conv_descriptor_lbound_set (pblock, descriptor, gfc_rank_cst[n],
+				      se.expr);
+
+      if (n < rank + corank - 1)
+	{
+	  gfc_init_se (&se, NULL);
+	  gcc_assert (ubound);
+	  gfc_conv_expr_type (&se, ubound, gfc_array_index_type);
+	  gfc_add_block_to_block (pblock, &se.pre);
+	  gfc_conv_descriptor_ubound_set (pblock, descriptor,
+					  gfc_rank_cst[n], se.expr);
+	}
+    }
+
+  /* The stride 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));
+  /* Convert to size_t.  */
+  element_size = fold_convert (size_type_node, tmp);
+  stride = fold_convert (size_type_node, stride);
+
+  /* First check for overflow. Since an array of type character can
+     have zero element_size, we must check for that before
+     dividing.  */
+  tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, 
+			 size_type_node,
+			 TYPE_MAX_VALUE (size_type_node), element_size);
+  cond = gfc_unlikely (fold_build2_loc (input_location, LT_EXPR,
+					boolean_type_node, tmp, stride));
+  tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
+			 integer_one_node, integer_zero_node);
+  cond = gfc_unlikely (fold_build2_loc (input_location, EQ_EXPR,
+					boolean_type_node, element_size,
+					build_int_cst (size_type_node, 0)));
+  tmp = fold_build3_loc (input_location, COND_EXPR, integer_type_node, cond,
+			 integer_zero_node, tmp);
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
+			 *overflow, tmp);
+  *overflow = gfc_evaluate_now (tmp, pblock);
+
+  size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+			  stride, element_size);
+
+  if (poffset != NULL)
+    {
+      offset = gfc_evaluate_now (offset, pblock);
+      *poffset = offset;
+    }
+
+  if (integer_zerop (or_expr))
+    return size;
+  if (integer_onep (or_expr))
+    return build_int_cst (size_type_node, 0);
+
+  var = gfc_create_var (TREE_TYPE (size), "size");
+  gfc_start_block (&thenblock);
+  gfc_add_modify (&thenblock, var, build_int_cst (size_type_node, 0));
+  thencase = gfc_finish_block (&thenblock);
+
+  gfc_start_block (&elseblock);
+  gfc_add_modify (&elseblock, var, size);
+  elsecase = gfc_finish_block (&elseblock);
+
+  tmp = gfc_evaluate_now (or_expr, pblock);
+  tmp = build3_v (COND_EXPR, tmp, thencase, elsecase);
+  gfc_add_expr_to_block (pblock, tmp);
+
+  return var;
+}
+
+
+/* Initializes the descriptor and generates a call to _gfor_allocate.  Does
+   the work for an ALLOCATE statement.  */
+/*GCC ARRAYS*/
+
+bool
+gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree pstat)
+{
+  tree tmp;
+  tree pointer;
+  tree offset;
+  tree size;
+  tree msg;
+  tree error;
+  tree overflow; /* Boolean storing whether size calculation overflows.  */
+  tree var_overflow;
+  tree cond;
+  stmtblock_t elseblock;
+  gfc_expr **lower;
+  gfc_expr **upper;
+  gfc_ref *ref, *prev_ref = NULL;
+  bool allocatable_array, coarray;
+
+  ref = expr->ref;
+
+  /* Find the last reference in the chain.  */
+  while (ref && ref->next != NULL)
+    {
+      gcc_assert (ref->type != REF_ARRAY || ref->u.ar.type == AR_ELEMENT
+		  || (ref->u.ar.dimen == 0 && ref->u.ar.codimen > 0));
+      prev_ref = ref;
+      ref = ref->next;
+    }
+
+  if (ref == NULL || ref->type != REF_ARRAY)
+    return false;
+
+  if (!prev_ref)
+    {
+      allocatable_array = expr->symtree->n.sym->attr.allocatable;
+      coarray = expr->symtree->n.sym->attr.codimension;
+    }
+  else
+    {
+      allocatable_array = prev_ref->u.c.component->attr.allocatable;
+      coarray = prev_ref->u.c.component->attr.codimension;
+    }
+
+  /* Return if this is a scalar coarray.  */
+  if ((!prev_ref && !expr->symtree->n.sym->attr.dimension)
+      || (prev_ref && !prev_ref->u.c.component->attr.dimension))
+    {
+      gcc_assert (coarray);
+      return false;
+    }
+
+  /* Figure out the size of the array.  */
+  switch (ref->u.ar.type)
+    {
+    case AR_ELEMENT:
+      if (!coarray)
+	{
+	  lower = NULL;
+	  upper = ref->u.ar.start;
+	  break;
+	}
+      /* Fall through.  */
+
+    case AR_SECTION:
+      lower = ref->u.ar.start;
+      upper = ref->u.ar.end;
+      break;
+
+    case AR_FULL:
+      gcc_assert (ref->u.ar.as->type == AS_EXPLICIT);
+
+      lower = ref->u.ar.as->lower;
+      upper = ref->u.ar.as->upper;
+      break;
+
+    default:
+      gcc_unreachable ();
+      break;
+    }
+
+  overflow = integer_zero_node;
+  size = gfc_array_init_size (se->expr, ref->u.ar.as->rank,
+			      ref->u.ar.as->corank, &offset, lower, upper,
+			      &se->pre, &overflow);
+
+  var_overflow = gfc_create_var (integer_type_node, "overflow");
+  gfc_add_modify (&se->pre, var_overflow, overflow);
+
+  /* Generate the block of code handling overflow.  */
+  msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
+  			("Integer overflow when calculating the amount of "
+  			 "memory to allocate"));
+  error = build_call_expr_loc (input_location,
+  			   gfor_fndecl_runtime_error, 1, msg);
+
+  if (pstat != NULL_TREE && !integer_zerop (pstat))
+    {
+      /* Set the status variable if it's present.  */
+      stmtblock_t set_status_block;
+      tree status_type = pstat ? TREE_TYPE (TREE_TYPE (pstat)) : NULL_TREE;
+
+      gfc_start_block (&set_status_block);
+      gfc_add_modify (&set_status_block,
+  		      fold_build1_loc (input_location, INDIRECT_REF,
+  				       status_type, pstat),
+  			   build_int_cst (status_type, LIBERROR_ALLOCATION));
+
+      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+  			     pstat, build_int_cst (TREE_TYPE (pstat), 0));
+      error = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp,
+  			       error, gfc_finish_block (&set_status_block));
+    }
+
+  gfc_start_block (&elseblock);
+  
+  /* Allocate memory to store the data.  */
+  pointer = gfc_conv_descriptor_data_get (se->expr);
+  STRIP_NOPS (pointer);
+
+  /* The allocate_array variants take the old pointer as first argument.  */
+  if (allocatable_array)
+    tmp = gfc_allocate_array_with_status (&elseblock, pointer, size, pstat, expr);
+  else
+    tmp = gfc_allocate_with_status (&elseblock, size, pstat);
+  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node, pointer,
+			 tmp);
+
+  gfc_add_expr_to_block (&elseblock, tmp);
+
+  cond = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+					var_overflow, integer_zero_node));
+  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, 
+			 error, gfc_finish_block (&elseblock));
+
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  gfc_conv_descriptor_offset_set (&se->pre, se->expr, offset);
+
+  if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
+	&& expr->ts.u.derived->attr.alloc_comp)
+    {
+      tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, se->expr,
+				    ref->u.ar.as->rank);
+      gfc_add_expr_to_block (&se->pre, tmp);
+    }
+
+  return true;
+}
+
+
+/* Deallocate an array variable.  Also used when an allocated variable goes
+   out of scope.  */
+/*GCC ARRAYS*/
+
+tree
+gfc_array_deallocate (tree descriptor, tree pstat, gfc_expr* expr)
+{
+  tree var;
+  tree tmp;
+  stmtblock_t block;
+
+  gfc_start_block (&block);
+  /* Get a pointer to the data.  */
+  var = gfc_conv_descriptor_data_get (descriptor);
+  STRIP_NOPS (var);
+
+  /* Parameter is the address of the data component.  */
+  tmp = gfc_deallocate_with_status (var, pstat, false, expr);
+  gfc_add_expr_to_block (&block, tmp);
+
+  /* Zero the data pointer.  */
+  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+			 var, build_int_cst (TREE_TYPE (var), 0));
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Create an array constructor from an initialization expression.
+   We assume the frontend already did any expansions and conversions.  */
+
+tree
+gfc_conv_array_initializer (tree type, gfc_expr * expr)
+{
+  gfc_constructor *c;
+  tree tmp;
+  gfc_se se;
+  HOST_WIDE_INT hi;
+  unsigned HOST_WIDE_INT lo;
+  tree index, range;
+  VEC(constructor_elt,gc) *v = NULL;
+
+  switch (expr->expr_type)
+    {
+    case EXPR_CONSTANT:
+    case EXPR_STRUCTURE:
+      /* A single scalar or derived type value.  Create an array with all
+         elements equal to that value.  */
+      gfc_init_se (&se, NULL);
+      
+      if (expr->expr_type == EXPR_CONSTANT)
+	gfc_conv_constant (&se, expr);
+      else
+	gfc_conv_structure (&se, expr, 1);
+
+      tmp = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
+      gcc_assert (tmp && INTEGER_CST_P (tmp));
+      hi = TREE_INT_CST_HIGH (tmp);
+      lo = TREE_INT_CST_LOW (tmp);
+      lo++;
+      if (lo == 0)
+	hi++;
+      /* This will probably eat buckets of memory for large arrays.  */
+      while (hi != 0 || lo != 0)
+        {
+	  CONSTRUCTOR_APPEND_ELT (v, NULL_TREE, se.expr);
+          if (lo == 0)
+            hi--;
+          lo--;
+        }
+      break;
+
+    case EXPR_ARRAY:
+      /* Create a vector of all the elements.  */
+      for (c = gfc_constructor_first (expr->value.constructor);
+	   c; c = gfc_constructor_next (c))
+        {
+          if (c->iterator)
+            {
+              /* Problems occur when we get something like
+                 integer :: a(lots) = (/(i, i=1, lots)/)  */
+              gfc_fatal_error ("The number of elements in the array constructor "
+			       "at %L requires an increase of the allowed %d "
+			       "upper limit.   See -fmax-array-constructor "
+			       "option", &expr->where,
+			       gfc_option.flag_max_array_constructor);
+	      return NULL_TREE;
+	    }
+          if (mpz_cmp_si (c->offset, 0) != 0)
+            index = gfc_conv_mpz_to_tree (c->offset, gfc_index_integer_kind);
+          else
+            index = NULL_TREE;
+
+	  if (mpz_cmp_si (c->repeat, 1) > 0)
+	    {
+	      tree tmp1, tmp2;
+	      mpz_t maxval;
+
+	      mpz_init (maxval);
+	      mpz_add (maxval, c->offset, c->repeat);
+	      mpz_sub_ui (maxval, maxval, 1);
+	      tmp2 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
+	      if (mpz_cmp_si (c->offset, 0) != 0)
+		{
+		  mpz_add_ui (maxval, c->offset, 1);
+		  tmp1 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
+		}
+	      else
+		tmp1 = gfc_conv_mpz_to_tree (c->offset, gfc_index_integer_kind);
+
+	      range = fold_build2 (RANGE_EXPR, gfc_array_index_type, tmp1, tmp2);
+	      mpz_clear (maxval);
+	    }
+	  else
+	    range = NULL;
+
+          gfc_init_se (&se, NULL);
+	  switch (c->expr->expr_type)
+	    {
+	    case EXPR_CONSTANT:
+	      gfc_conv_constant (&se, c->expr);
+	      break;
+
+	    case EXPR_STRUCTURE:
+              gfc_conv_structure (&se, c->expr, 1);
+	      break;
+
+	    default:
+	      /* Catch those occasional beasts that do not simplify
+		 for one reason or another, assuming that if they are
+		 standard defying the frontend will catch them.  */
+	      gfc_conv_expr (&se, c->expr);
+	      break;
+	    }
+
+	  if (range == NULL_TREE)
+	    CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+	  else
+	    {
+	      if (index != NULL_TREE)
+		CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+	      CONSTRUCTOR_APPEND_ELT (v, range, se.expr);
+	    }
+        }
+      break;
+
+    case EXPR_NULL:
+      return gfc_build_null_descriptor (type);
+
+    default:
+      gcc_unreachable ();
+    }
+
+  /* Create a constructor from the list of elements.  */
+  tmp = build_constructor (type, v);
+  TREE_CONSTANT (tmp) = 1;
+  return tmp;
+}
+
+
+/* Generate code to evaluate non-constant array bounds.  Sets *poffset and
+   returns the size (in elements) of the array.  */
+
+static tree
+gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
+                        stmtblock_t * pblock)
+{
+  gfc_array_spec *as;
+  tree size;
+  tree stride;
+  tree offset;
+  tree ubound;
+  tree lbound;
+  tree tmp;
+  gfc_se se;
+
+  int dim;
+
+  as = sym->as;
+
+  size = gfc_index_one_node;
+  offset = gfc_index_zero_node;
+  for (dim = 0; dim < as->rank; dim++)
+    {
+      /* Evaluate non-constant array bound expressions.  */
+      lbound = GFC_TYPE_ARRAY_LBOUND (type, dim);
+      if (as->lower[dim] && !INTEGER_CST_P (lbound))
+        {
+          gfc_init_se (&se, NULL);
+          gfc_conv_expr_type (&se, as->lower[dim], gfc_array_index_type);
+          gfc_add_block_to_block (pblock, &se.pre);
+          gfc_add_modify (pblock, lbound, se.expr);
+        }
+      ubound = GFC_TYPE_ARRAY_UBOUND (type, dim);
+      if (as->upper[dim] && !INTEGER_CST_P (ubound))
+        {
+          gfc_init_se (&se, NULL);
+          gfc_conv_expr_type (&se, as->upper[dim], gfc_array_index_type);
+          gfc_add_block_to_block (pblock, &se.pre);
+          gfc_add_modify (pblock, ubound, se.expr);
+        }
+      /* The offset of this dimension.  offset = offset - lbound * stride.  */
+      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     lbound, size);
+      offset = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+				offset, tmp);
+
+      /* The size of this dimension, and the stride of the next.  */
+      if (dim + 1 < as->rank)
+        stride = GFC_TYPE_ARRAY_STRIDE (type, dim + 1);
+      else
+	stride = GFC_TYPE_ARRAY_SIZE (type);
+
+      if (ubound != NULL_TREE && !(stride && INTEGER_CST_P (stride)))
+        {
+          /* Calculate stride = size * (ubound + 1 - lbound).  */
+          tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type,
+				 gfc_index_one_node, lbound);
+          tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, ubound, tmp);
+          tmp = fold_build2_loc (input_location, MULT_EXPR,
+				 gfc_array_index_type, size, tmp);
+          if (stride)
+            gfc_add_modify (pblock, stride, tmp);
+          else
+            stride = gfc_evaluate_now (tmp, pblock);
+
+	  /* Make sure that negative size arrays are translated
+	     to being zero size.  */
+	  tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
+				 stride, gfc_index_zero_node);
+	  tmp = fold_build3_loc (input_location, COND_EXPR,
+				 gfc_array_index_type, tmp,
+				 stride, gfc_index_zero_node);
+	  gfc_add_modify (pblock, stride, tmp);
+        }
+
+      size = stride;
+    }
+
+  gfc_trans_vla_type_sizes (sym, pblock);
+
+  *poffset = offset;
+  return size;
+}
+
+
+/* Generate code to initialize/allocate an array variable.  */
+
+void
+gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym,
+				 gfc_wrapped_block * block)
+{
+  stmtblock_t init;
+  tree type;
+  tree tmp;
+  tree size;
+  tree offset;
+  bool onstack;
+
+  gcc_assert (!(sym->attr.pointer || sym->attr.allocatable));
+
+  /* Do nothing for USEd variables.  */
+  if (sym->attr.use_assoc)
+    return;
+
+  type = TREE_TYPE (decl);
+  gcc_assert (GFC_ARRAY_TYPE_P (type));
+  onstack = TREE_CODE (type) != POINTER_TYPE;
+
+  gfc_init_block (&init);
+
+  /* Evaluate character string length.  */
+  if (sym->ts.type == BT_CHARACTER
+      && onstack && !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
+    {
+      gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
+
+      gfc_trans_vla_type_sizes (sym, &init);
+
+      /* Emit a DECL_EXPR for this variable, which will cause the
+	 gimplifier to allocate storage, and all that good stuff.  */
+      tmp = fold_build1_loc (input_location, DECL_EXPR, TREE_TYPE (decl), decl);
+      gfc_add_expr_to_block (&init, tmp);
+    }
+
+  if (onstack)
+    {
+      gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+      return;
+    }
+
+  type = TREE_TYPE (type);
+
+  gcc_assert (!sym->attr.use_assoc);
+  gcc_assert (!TREE_STATIC (decl));
+  gcc_assert (!sym->module);
+
+  if (sym->ts.type == BT_CHARACTER
+      && !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
+    gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
+
+  size = gfc_trans_array_bounds (type, sym, &offset, &init);
+
+  /* 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 (&init, GFC_TYPE_ARRAY_OFFSET (type), offset);
+
+      gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+      return;
+    }
+
+  /* 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));
+  size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			  size, fold_convert (gfc_array_index_type, tmp));
+
+  /* Allocate memory to hold the data.  */
+  tmp = gfc_call_malloc (&init, TREE_TYPE (decl), size);
+  gfc_add_modify (&init, decl, tmp);
+
+  /* Set offset of the array.  */
+  if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL)
+    gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset);
+
+  /* Automatic arrays should not have initializers.  */
+  gcc_assert (!sym->value);
+
+  /* Free the temporary.  */
+  tmp = gfc_call_free (convert (pvoid_type_node, decl));
+
+  gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
+}
+
+
+/* Generate entry and exit code for g77 calling convention arrays.  */
+
+void
+gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block)
+{
+  tree parm;
+  tree type;
+  locus loc;
+  tree offset;
+  tree tmp;
+  tree stmt;
+  stmtblock_t init;
+
+  gfc_save_backend_locus (&loc);
+  gfc_set_backend_locus (&sym->declared_at);
+
+  /* Descriptor type.  */
+  parm = sym->backend_decl;
+  type = TREE_TYPE (parm);
+  gcc_assert (GFC_ARRAY_TYPE_P (type));
+
+  gfc_start_block (&init);
+
+  if (sym->ts.type == BT_CHARACTER
+      && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL)
+    gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
+
+  /* Evaluate the bounds of the array.  */
+  gfc_trans_array_bounds (type, sym, &offset, &init);
+
+  /* Set the offset.  */
+  if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL)
+    gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset);
+
+  /* Set the pointer itself if we aren't using the parameter directly.  */
+  if (TREE_CODE (parm) != PARM_DECL)
+    {
+      tmp = convert (TREE_TYPE (parm), GFC_DECL_SAVED_DESCRIPTOR (parm));
+      gfc_add_modify (&init, parm, tmp);
+    }
+  stmt = gfc_finish_block (&init);
+
+  gfc_restore_backend_locus (&loc);
+
+  /* Add the initialization code to the start of the function.  */
+
+  if (sym->attr.optional || sym->attr.not_always_present)
+    {
+      tmp = gfc_conv_expr_present (sym);
+      stmt = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt (input_location));
+    }
+  
+  gfc_add_init_cleanup (block, stmt, NULL_TREE);
+}
+
+
+/* Modify the descriptor of an array parameter so that it has the
+   correct lower bound.  Also move the upper bound accordingly.
+   If the array is not packed, it will be copied into a temporary.
+   For each dimension we set the new lower and upper bounds.  Then we copy the
+   stride and calculate the offset for this dimension.  We also work out
+   what the stride of a packed array would be, and see it the two match.
+   If the array need repacking, we set the stride to the values we just
+   calculated, recalculate the offset and copy the array data.
+   Code is also added to copy the data back at the end of the function.
+   */
+
+void
+gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
+			    gfc_wrapped_block * block)
+{
+  tree size;
+  tree type;
+  tree offset;
+  locus loc;
+  stmtblock_t init;
+  tree stmtInit, stmtCleanup;
+  tree lbound;
+  tree ubound;
+  tree dubound;
+  tree dlbound;
+  tree dumdesc;
+  tree tmp;
+  tree stride, stride2;
+  tree stmt_packed;
+  tree stmt_unpacked;
+  tree partial;
+  gfc_se se;
+  int n;
+  int checkparm;
+  int no_repack;
+  bool optional_arg;
+
+  /* Do nothing for pointer and allocatable arrays.  */
+  if (sym->attr.pointer || sym->attr.allocatable)
+    return;
+
+  if (sym->attr.dummy && gfc_is_nodesc_array (sym))
+    {
+      gfc_trans_g77_array (sym, block);
+      return;
+    }
+
+  gfc_save_backend_locus (&loc);
+  gfc_set_backend_locus (&sym->declared_at);
+
+  /* Descriptor type.  */
+  type = TREE_TYPE (tmpdesc);
+  gcc_assert (GFC_ARRAY_TYPE_P (type));
+  dumdesc = GFC_DECL_SAVED_DESCRIPTOR (tmpdesc);
+  dumdesc = build_fold_indirect_ref_loc (input_location, dumdesc);
+  gfc_start_block (&init);
+
+  if (sym->ts.type == BT_CHARACTER
+      && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL)
+    gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
+
+  checkparm = (sym->as->type == AS_EXPLICIT
+	       && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS));
+
+  no_repack = !(GFC_DECL_PACKED_ARRAY (tmpdesc)
+		|| GFC_DECL_PARTIAL_PACKED_ARRAY (tmpdesc));
+
+  if (GFC_DECL_PARTIAL_PACKED_ARRAY (tmpdesc))
+    {
+      /* For non-constant shape arrays we only check if the first dimension
+	 is contiguous.  Repacking higher dimensions wouldn't gain us
+	 anything as we still don't know the array stride.  */
+      partial = gfc_create_var (boolean_type_node, "partial");
+      TREE_USED (partial) = 1;
+      tmp = gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[0]);
+      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, tmp,
+			     gfc_index_one_node);
+      gfc_add_modify (&init, partial, tmp);
+    }
+  else
+    partial = NULL_TREE;
+
+  /* The naming of stmt_unpacked and stmt_packed may be counter-intuitive
+     here, however I think it does the right thing.  */
+  if (no_repack)
+    {
+      /* Set the first stride.  */
+      stride = gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[0]);
+      stride = gfc_evaluate_now (stride, &init);
+
+      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			     stride, gfc_index_zero_node);
+      tmp = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
+			     tmp, gfc_index_one_node, stride);
+      stride = GFC_TYPE_ARRAY_STRIDE (type, 0);
+      gfc_add_modify (&init, stride, tmp);
+
+      /* Allow the user to disable array repacking.  */
+      stmt_unpacked = NULL_TREE;
+    }
+  else
+    {
+      gcc_assert (integer_onep (GFC_TYPE_ARRAY_STRIDE (type, 0)));
+      /* A library call to repack the array if necessary.  */
+      tmp = GFC_DECL_SAVED_DESCRIPTOR (tmpdesc);
+      stmt_unpacked = build_call_expr_loc (input_location,
+				       gfor_fndecl_in_pack, 1, tmp);
+
+      stride = gfc_index_one_node;
+
+      if (gfc_option.warn_array_temp)
+	gfc_warning ("Creating array temporary at %L", &loc);
+    }
+
+  /* This is for the case where the array data is used directly without
+     calling the repack function.  */
+  if (no_repack || partial != NULL_TREE)
+    stmt_packed = gfc_conv_descriptor_data_get (dumdesc);
+  else
+    stmt_packed = NULL_TREE;
+
+  /* Assign the data pointer.  */
+  if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE)
+    {
+      /* Don't repack unknown shape arrays when the first stride is 1.  */
+      tmp = fold_build3_loc (input_location, COND_EXPR, TREE_TYPE (stmt_packed),
+			     partial, stmt_packed, stmt_unpacked);
+    }
+  else
+    tmp = stmt_packed != NULL_TREE ? stmt_packed : stmt_unpacked;
+  gfc_add_modify (&init, tmpdesc, fold_convert (type, tmp));
+
+  offset = gfc_index_zero_node;
+  size = gfc_index_one_node;
+
+  /* Evaluate the bounds of the array.  */
+  for (n = 0; n < sym->as->rank; n++)
+    {
+      if (checkparm || !sym->as->upper[n])
+	{
+	  /* Get the bounds of the actual parameter.  */
+	  dubound = gfc_conv_descriptor_ubound_get (dumdesc, gfc_rank_cst[n]);
+	  dlbound = gfc_conv_descriptor_lbound_get (dumdesc, gfc_rank_cst[n]);
+	}
+      else
+	{
+	  dubound = NULL_TREE;
+	  dlbound = NULL_TREE;
+	}
+
+      lbound = GFC_TYPE_ARRAY_LBOUND (type, n);
+      if (!INTEGER_CST_P (lbound))
+	{
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr_type (&se, sym->as->lower[n],
+			      gfc_array_index_type);
+	  gfc_add_block_to_block (&init, &se.pre);
+	  gfc_add_modify (&init, lbound, se.expr);
+	}
+
+      ubound = GFC_TYPE_ARRAY_UBOUND (type, n);
+      /* Set the desired upper bound.  */
+      if (sym->as->upper[n])
+	{
+	  /* We know what we want the upper bound to be.  */
+	  if (!INTEGER_CST_P (ubound))
+	    {
+	      gfc_init_se (&se, NULL);
+	      gfc_conv_expr_type (&se, sym->as->upper[n],
+				  gfc_array_index_type);
+	      gfc_add_block_to_block (&init, &se.pre);
+	      gfc_add_modify (&init, ubound, se.expr);
+	    }
+
+	  /* Check the sizes match.  */
+	  if (checkparm)
+	    {
+	      /* Check (ubound(a) - lbound(a) == ubound(b) - lbound(b)).  */
+	      char * msg;
+	      tree temp;
+
+	      temp = fold_build2_loc (input_location, MINUS_EXPR,
+				      gfc_array_index_type, ubound, lbound);
+	      temp = fold_build2_loc (input_location, PLUS_EXPR,
+				      gfc_array_index_type,
+				      gfc_index_one_node, temp);
+	      stride2 = fold_build2_loc (input_location, MINUS_EXPR,
+					 gfc_array_index_type, dubound,
+					 dlbound);
+	      stride2 = fold_build2_loc (input_location, PLUS_EXPR,
+					 gfc_array_index_type,
+					 gfc_index_one_node, stride2);
+	      tmp = fold_build2_loc (input_location, NE_EXPR,
+				     gfc_array_index_type, temp, stride2);
+	      asprintf (&msg, "Dimension %d of array '%s' has extent "
+			"%%ld instead of %%ld", n+1, sym->name);
+
+	      gfc_trans_runtime_check (true, false, tmp, &init, &loc, msg, 
+			fold_convert (long_integer_type_node, temp),
+			fold_convert (long_integer_type_node, stride2));
+
+	      gfc_free (msg);
+	    }
+	}
+      else
+	{
+	  /* For assumed shape arrays move the upper bound by the same amount
+	     as the lower bound.  */
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type, dubound, dlbound);
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, tmp, lbound);
+	  gfc_add_modify (&init, ubound, tmp);
+	}
+      /* The offset of this dimension.  offset = offset - lbound * stride.  */
+      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     lbound, stride);
+      offset = fold_build2_loc (input_location, MINUS_EXPR,
+				gfc_array_index_type, offset, tmp);
+
+      /* The size of this dimension, and the stride of the next.  */
+      if (n + 1 < sym->as->rank)
+	{
+	  stride = GFC_TYPE_ARRAY_STRIDE (type, n + 1);
+
+	  if (no_repack || partial != NULL_TREE)
+	    stmt_unpacked =
+	      gfc_conv_descriptor_stride_get (dumdesc, gfc_rank_cst[n+1]);
+
+	  /* Figure out the stride if not a known constant.  */
+	  if (!INTEGER_CST_P (stride))
+	    {
+	      if (no_repack)
+		stmt_packed = NULL_TREE;
+	      else
+		{
+		  /* Calculate stride = size * (ubound + 1 - lbound).  */
+		  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+					 gfc_array_index_type,
+					 gfc_index_one_node, lbound);
+		  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+					 gfc_array_index_type, ubound, tmp);
+		  size = fold_build2_loc (input_location, MULT_EXPR,
+					  gfc_array_index_type, size, tmp);
+		  stmt_packed = size;
+		}
+
+	      /* Assign the stride.  */
+	      if (stmt_packed != NULL_TREE && stmt_unpacked != NULL_TREE)
+		tmp = fold_build3_loc (input_location, COND_EXPR,
+				       gfc_array_index_type, partial,
+				       stmt_unpacked, stmt_packed);
+	      else
+		tmp = (stmt_packed != NULL_TREE) ? stmt_packed : stmt_unpacked;
+	      gfc_add_modify (&init, stride, tmp);
+	    }
+	}
+      else
+	{
+	  stride = GFC_TYPE_ARRAY_SIZE (type);
+
+	  if (stride && !INTEGER_CST_P (stride))
+	    {
+	      /* Calculate size = stride * (ubound + 1 - lbound).  */
+	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				     gfc_array_index_type,
+				     gfc_index_one_node, lbound);
+	      tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				     gfc_array_index_type,
+				     ubound, tmp);
+	      tmp = fold_build2_loc (input_location, MULT_EXPR,
+				     gfc_array_index_type,
+				     GFC_TYPE_ARRAY_STRIDE (type, n), tmp);
+	      gfc_add_modify (&init, stride, tmp);
+	    }
+	}
+    }
+
+  /* Set the offset.  */
+  if (TREE_CODE (GFC_TYPE_ARRAY_OFFSET (type)) == VAR_DECL)
+    gfc_add_modify (&init, GFC_TYPE_ARRAY_OFFSET (type), offset);
+
+  gfc_trans_vla_type_sizes (sym, &init);
+
+  stmtInit = gfc_finish_block (&init);
+
+  /* Only do the entry/initialization code if the arg is present.  */
+  dumdesc = GFC_DECL_SAVED_DESCRIPTOR (tmpdesc);
+  optional_arg = (sym->attr.optional
+		  || (sym->ns->proc_name->attr.entry_master
+		      && sym->attr.dummy));
+  if (optional_arg)
+    {
+      tmp = gfc_conv_expr_present (sym);
+      stmtInit = build3_v (COND_EXPR, tmp, stmtInit,
+			   build_empty_stmt (input_location));
+    }
+
+  /* Cleanup code.  */
+  if (no_repack)
+    stmtCleanup = NULL_TREE;
+  else
+    {
+      stmtblock_t cleanup;
+      gfc_start_block (&cleanup);
+
+      if (sym->attr.intent != INTENT_IN)
+	{
+	  /* Copy the data back.  */
+	  tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_in_unpack, 2, dumdesc, tmpdesc);
+	  gfc_add_expr_to_block (&cleanup, tmp);
+	}
+
+      /* Free the temporary.  */
+      tmp = gfc_call_free (tmpdesc);
+      gfc_add_expr_to_block (&cleanup, tmp);
+
+      stmtCleanup = gfc_finish_block (&cleanup);
+	
+      /* Only do the cleanup if the array was repacked.  */
+      tmp = build_fold_indirect_ref_loc (input_location, dumdesc);
+      tmp = gfc_conv_descriptor_data_get (tmp);
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			     tmp, tmpdesc);
+      stmtCleanup = build3_v (COND_EXPR, tmp, stmtCleanup,
+			      build_empty_stmt (input_location));
+
+      if (optional_arg)
+	{
+	  tmp = gfc_conv_expr_present (sym);
+	  stmtCleanup = build3_v (COND_EXPR, tmp, stmtCleanup,
+				  build_empty_stmt (input_location));
+	}
+    }
+
+  /* We don't need to free any memory allocated by internal_pack as it will
+     be freed at the end of the function by pop_context.  */
+  gfc_add_init_cleanup (block, stmtInit, stmtCleanup);
+
+  gfc_restore_backend_locus (&loc);
+}
+
+
+/* Calculate the overall offset, including subreferences.  */
+static void
+gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
+			bool subref, gfc_expr *expr)
+{
+  tree tmp;
+  tree field;
+  tree stride;
+  tree index;
+  gfc_ref *ref;
+  gfc_se start;
+  int n;
+
+  /* If offset is NULL and this is not a subreferenced array, there is
+     nothing to do.  */
+  if (offset == NULL_TREE)
+    {
+      if (subref)
+	offset = gfc_index_zero_node;
+      else
+	return;
+    }
+
+  tmp = gfc_conv_array_data (desc);
+  tmp = build_fold_indirect_ref_loc (input_location,
+				 tmp);
+  tmp = gfc_build_array_ref (tmp, offset, NULL);
+
+  /* Offset the data pointer for pointer assignments from arrays with
+     subreferences; e.g. my_integer => my_type(:)%integer_component.  */
+  if (subref)
+    {
+      /* Go past the array reference.  */
+      for (ref = expr->ref; ref; ref = ref->next)
+	if (ref->type == REF_ARRAY &&
+	      ref->u.ar.type != AR_ELEMENT)
+	  {
+	    ref = ref->next;
+	    break;
+	  }
+
+      /* Calculate the offset for each subsequent subreference.  */
+      for (; ref; ref = ref->next)
+	{
+	  switch (ref->type)
+	    {
+	    case REF_COMPONENT:
+	      field = ref->u.c.component->backend_decl;
+	      gcc_assert (field && TREE_CODE (field) == FIELD_DECL);
+	      tmp = fold_build3_loc (input_location, COMPONENT_REF,
+				     TREE_TYPE (field),
+				     tmp, field, NULL_TREE);
+	      break;
+
+	    case REF_SUBSTRING:
+	      gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE);
+	      gfc_init_se (&start, NULL);
+	      gfc_conv_expr_type (&start, ref->u.ss.start, gfc_charlen_type_node);
+	      gfc_add_block_to_block (block, &start.pre);
+	      tmp = gfc_build_array_ref (tmp, start.expr, NULL);
+	      break;
+
+	    case REF_ARRAY:
+	      gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE
+			    && ref->u.ar.type == AR_ELEMENT);
+
+	      /* TODO - Add bounds checking.  */
+	      stride = gfc_index_one_node;
+	      index = gfc_index_zero_node;
+	      for (n = 0; n < ref->u.ar.dimen; n++)
+		{
+		  tree itmp;
+		  tree jtmp;
+
+		  /* Update the index.  */
+		  gfc_init_se (&start, NULL);
+		  gfc_conv_expr_type (&start, ref->u.ar.start[n], gfc_array_index_type);
+		  itmp = gfc_evaluate_now (start.expr, block);
+		  gfc_init_se (&start, NULL);
+		  gfc_conv_expr_type (&start, ref->u.ar.as->lower[n], gfc_array_index_type);
+		  jtmp = gfc_evaluate_now (start.expr, block);
+		  itmp = fold_build2_loc (input_location, MINUS_EXPR,
+					  gfc_array_index_type, itmp, jtmp);
+		  itmp = fold_build2_loc (input_location, MULT_EXPR,
+					  gfc_array_index_type, itmp, stride);
+		  index = fold_build2_loc (input_location, PLUS_EXPR,
+					  gfc_array_index_type, itmp, index);
+		  index = gfc_evaluate_now (index, block);
+
+		  /* Update the stride.  */
+		  gfc_init_se (&start, NULL);
+		  gfc_conv_expr_type (&start, ref->u.ar.as->upper[n], gfc_array_index_type);
+		  itmp =  fold_build2_loc (input_location, MINUS_EXPR,
+					   gfc_array_index_type, start.expr,
+					   jtmp);
+		  itmp =  fold_build2_loc (input_location, PLUS_EXPR,
+					   gfc_array_index_type,
+					   gfc_index_one_node, itmp);
+		  stride =  fold_build2_loc (input_location, MULT_EXPR,
+					     gfc_array_index_type, stride, itmp);
+		  stride = gfc_evaluate_now (stride, block);
+		}
+
+	      /* Apply the index to obtain the array element.  */
+	      tmp = gfc_build_array_ref (tmp, index, NULL);
+	      break;
+
+	    default:
+	      gcc_unreachable ();
+	      break;
+	    }
+	}
+    }
+
+  /* Set the target data pointer.  */
+  offset = gfc_build_addr_expr (gfc_array_dataptr_type (desc), tmp);
+  gfc_conv_descriptor_data_set (block, parm, offset);
+}
+
+
+/* gfc_conv_expr_descriptor needs the string length an expression
+   so that the size of the temporary can be obtained.  This is done
+   by adding up the string lengths of all the elements in the
+   expression.  Function with non-constant expressions have their
+   string lengths mapped onto the actual arguments using the
+   interface mapping machinery in trans-expr.c.  */
+static void
+get_array_charlen (gfc_expr *expr, gfc_se *se)
+{
+  gfc_interface_mapping mapping;
+  gfc_formal_arglist *formal;
+  gfc_actual_arglist *arg;
+  gfc_se tse;
+
+  if (expr->ts.u.cl->length
+	&& gfc_is_constant_expr (expr->ts.u.cl->length))
+    {
+      if (!expr->ts.u.cl->backend_decl)
+	gfc_conv_string_length (expr->ts.u.cl, expr, &se->pre);
+      return;
+    }
+
+  switch (expr->expr_type)
+    {
+    case EXPR_OP:
+      get_array_charlen (expr->value.op.op1, se);
+
+      /* For parentheses the expression ts.u.cl is identical.  */
+      if (expr->value.op.op == INTRINSIC_PARENTHESES)
+	return;
+
+     expr->ts.u.cl->backend_decl =
+		gfc_create_var (gfc_charlen_type_node, "sln");
+
+      if (expr->value.op.op2)
+	{
+	  get_array_charlen (expr->value.op.op2, se);
+
+	  gcc_assert (expr->value.op.op == INTRINSIC_CONCAT);
+
+	  /* Add the string lengths and assign them to the expression
+	     string length backend declaration.  */
+	  gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl,
+			  fold_build2_loc (input_location, PLUS_EXPR,
+				gfc_charlen_type_node,
+				expr->value.op.op1->ts.u.cl->backend_decl,
+				expr->value.op.op2->ts.u.cl->backend_decl));
+	}
+      else
+	gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl,
+			expr->value.op.op1->ts.u.cl->backend_decl);
+      break;
+
+    case EXPR_FUNCTION:
+      if (expr->value.function.esym == NULL
+	    || expr->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+	{
+	  gfc_conv_string_length (expr->ts.u.cl, expr, &se->pre);
+	  break;
+	}
+
+      /* Map expressions involving the dummy arguments onto the actual
+	 argument expressions.  */
+      gfc_init_interface_mapping (&mapping);
+      formal = expr->symtree->n.sym->formal;
+      arg = expr->value.function.actual;
+
+      /* Set se = NULL in the calls to the interface mapping, to suppress any
+	 backend stuff.  */
+      for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
+	{
+	  if (!arg->expr)
+	    continue;
+	  if (formal->sym)
+	  gfc_add_interface_mapping (&mapping, formal->sym, NULL, arg->expr);
+	}
+
+      gfc_init_se (&tse, NULL);
+
+      /* Build the expression for the character length and convert it.  */
+      gfc_apply_interface_mapping (&mapping, &tse, expr->ts.u.cl->length);
+
+      gfc_add_block_to_block (&se->pre, &tse.pre);
+      gfc_add_block_to_block (&se->post, &tse.post);
+      tse.expr = fold_convert (gfc_charlen_type_node, tse.expr);
+      tse.expr = fold_build2_loc (input_location, MAX_EXPR,
+				  gfc_charlen_type_node, tse.expr,
+				  build_int_cst (gfc_charlen_type_node, 0));
+      expr->ts.u.cl->backend_decl = tse.expr;
+      gfc_free_interface_mapping (&mapping);
+      break;
+
+    default:
+      gfc_conv_string_length (expr->ts.u.cl, expr, &se->pre);
+      break;
+    }
+}
+
+/* Helper function to check dimensions.  */
+static bool
+dim_ok (gfc_ss_info *info)
+{
+  int n;
+  for (n = 0; n < info->dimen; n++)
+    if (info->dim[n] != n)
+      return false;
+  return true;
+}
+
+/* Convert an array for passing as an actual argument.  Expressions and
+   vector subscripts are evaluated and stored in a temporary, which is then
+   passed.  For whole arrays the descriptor is passed.  For array sections
+   a modified copy of the descriptor is passed, but using the original data.
+
+   This function is also used for array pointer assignments, and there
+   are three cases:
+
+     - se->want_pointer && !se->direct_byref
+	 EXPR is an actual argument.  On exit, se->expr contains a
+	 pointer to the array descriptor.
+
+     - !se->want_pointer && !se->direct_byref
+	 EXPR is an actual argument to an intrinsic function or the
+	 left-hand side of a pointer assignment.  On exit, se->expr
+	 contains the descriptor for EXPR.
+
+     - !se->want_pointer && se->direct_byref
+	 EXPR is the right-hand side of a pointer assignment and
+	 se->expr is the descriptor for the previously-evaluated
+	 left-hand side.  The function creates an assignment from
+	 EXPR to se->expr.  
+
+
+   The se->force_tmp flag disables the non-copying descriptor optimization
+   that is used for transpose. It may be used in cases where there is an
+   alias between the transpose argument and another argument in the same
+   function call.  */
+
+void
+gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
+{
+  gfc_loopinfo loop;
+  gfc_ss_info *info;
+  int need_tmp;
+  int n;
+  tree tmp;
+  tree desc;
+  stmtblock_t block;
+  tree start;
+  tree offset;
+  int full;
+  bool subref_array_target = false;
+  gfc_expr *arg;
+
+  gcc_assert (ss != NULL);
+  gcc_assert (ss != gfc_ss_terminator);
+
+  /* Special case things we know we can pass easily.  */
+  switch (expr->expr_type)
+    {
+    case EXPR_VARIABLE:
+      /* If we have a linear array section, we can pass it directly.
+	 Otherwise we need to copy it into a temporary.  */
+
+      gcc_assert (ss->type == GFC_SS_SECTION);
+      gcc_assert (ss->expr == expr);
+      info = &ss->data.info;
+
+      /* Get the descriptor for the array.  */
+      gfc_conv_ss_descriptor (&se->pre, ss, 0);
+      desc = info->descriptor;
+
+      subref_array_target = se->direct_byref && is_subref_array (expr);
+      need_tmp = gfc_ref_needs_temporary_p (expr->ref)
+			&& !subref_array_target;
+
+      if (se->force_tmp)
+	need_tmp = 1;
+
+      if (need_tmp)
+	full = 0;
+      else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
+	{
+	  /* Create a new descriptor if the array doesn't have one.  */
+	  full = 0;
+	}
+      else if (info->ref->u.ar.type == AR_FULL)
+	full = 1;
+      else if (se->direct_byref)
+	full = 0;
+      else
+	full = gfc_full_array_ref_p (info->ref, NULL);
+
+      if (full && dim_ok (info))
+	{
+	  if (se->direct_byref && !se->byref_noassign)
+	    {
+	      /* Copy the descriptor for pointer assignments.  */
+	      gfc_add_modify (&se->pre, se->expr, desc);
+
+	      /* Add any offsets from subreferences.  */
+	      gfc_get_dataptr_offset (&se->pre, se->expr, desc, NULL_TREE,
+				      subref_array_target, expr);
+	    }
+	  else if (se->want_pointer)
+	    {
+	      /* We pass full arrays directly.  This means that pointers and
+		 allocatable arrays should also work.  */
+	      se->expr = gfc_build_addr_expr (NULL_TREE, desc);
+	    }
+	  else
+	    {
+	      se->expr = desc;
+	    }
+
+	  if (expr->ts.type == BT_CHARACTER)
+	    se->string_length = gfc_get_expr_charlen (expr);
+
+	  return;
+	}
+      break;
+      
+    case EXPR_FUNCTION:
+
+      /* We don't need to copy data in some cases.  */
+      arg = gfc_get_noncopying_intrinsic_argument (expr);
+      if (arg)
+	{
+	  /* This is a call to transpose...  */
+	  gcc_assert (expr->value.function.isym->id == GFC_ISYM_TRANSPOSE);
+	  /* ... which has already been handled by the scalarizer, so
+	     that we just need to get its argument's descriptor.  */
+	  gfc_conv_expr_descriptor (se, expr->value.function.actual->expr, ss);
+	  return;
+	}
+
+      /* A transformational function return value will be a temporary
+	 array descriptor.  We still need to go through the scalarizer
+	 to create the descriptor.  Elemental functions ar handled as
+	 arbitrary expressions, i.e. copy to a temporary.  */
+
+      if (se->direct_byref)
+	{
+	  gcc_assert (ss->type == GFC_SS_FUNCTION && ss->expr == expr);
+
+	  /* For pointer assignments pass the descriptor directly.  */
+	  if (se->ss == NULL)
+	    se->ss = ss;
+	  else
+	    gcc_assert (se->ss == ss);
+	  se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
+	  gfc_conv_expr (se, expr);
+	  return;
+	}
+
+      if (ss->expr != expr || ss->type != GFC_SS_FUNCTION)
+	{
+	  if (ss->expr != expr)
+	    /* Elemental function.  */
+	    gcc_assert ((expr->value.function.esym != NULL
+			 && expr->value.function.esym->attr.elemental)
+			|| (expr->value.function.isym != NULL
+			    && expr->value.function.isym->elemental));
+	  else
+	    gcc_assert (ss->type == GFC_SS_INTRINSIC);
+
+	  need_tmp = 1;
+	  if (expr->ts.type == BT_CHARACTER
+		&& expr->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+	    get_array_charlen (expr, se);
+
+	  info = NULL;
+	}
+      else
+	{
+	  /* Transformational function.  */
+	  info = &ss->data.info;
+	  need_tmp = 0;
+	}
+      break;
+
+    case EXPR_ARRAY:
+      /* Constant array constructors don't need a temporary.  */
+      if (ss->type == GFC_SS_CONSTRUCTOR
+	  && expr->ts.type != BT_CHARACTER
+	  && gfc_constant_array_constructor_p (expr->value.constructor))
+	{
+	  need_tmp = 0;
+	  info = &ss->data.info;
+	}
+      else
+	{
+	  need_tmp = 1;
+	  info = NULL;
+	}
+      break;
+
+    default:
+      /* Something complicated.  Copy it into a temporary.  */
+      need_tmp = 1;
+      info = NULL;
+      break;
+    }
+
+  /* If we are creating a temporary, we don't need to bother about aliases
+     anymore.  */
+  if (need_tmp)
+    se->force_tmp = 0;
+
+  gfc_init_loopinfo (&loop);
+
+  /* Associate the SS with the loop.  */
+  gfc_add_ss_to_loop (&loop, ss);
+
+  /* Tell the scalarizer not to bother creating loop variables, etc.  */
+  if (!need_tmp)
+    loop.array_parameter = 1;
+  else
+    /* The right-hand side of a pointer assignment mustn't use a temporary.  */
+    gcc_assert (!se->direct_byref);
+
+  /* Setup the scalarizing loops and bounds.  */
+  gfc_conv_ss_startstride (&loop);
+
+  if (need_tmp)
+    {
+      /* Tell the scalarizer to make a temporary.  */
+      loop.temp_ss = gfc_get_ss ();
+      loop.temp_ss->type = GFC_SS_TEMP;
+      loop.temp_ss->next = gfc_ss_terminator;
+
+      if (expr->ts.type == BT_CHARACTER
+	    && !expr->ts.u.cl->backend_decl)
+	get_array_charlen (expr, se);
+
+      loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
+
+      if (expr->ts.type == BT_CHARACTER)
+	loop.temp_ss->string_length = expr->ts.u.cl->backend_decl;
+      else
+	loop.temp_ss->string_length = NULL;
+
+      se->string_length = loop.temp_ss->string_length;
+      loop.temp_ss->data.temp.dimen = loop.dimen;
+      gfc_add_ss_to_loop (&loop, loop.temp_ss);
+    }
+
+  gfc_conv_loop_setup (&loop, & expr->where);
+
+  if (need_tmp)
+    {
+      /* Copy into a temporary and pass that.  We don't need to copy the data
+         back because expressions and vector subscripts must be INTENT_IN.  */
+      /* TODO: Optimize passing function return values.  */
+      gfc_se lse;
+      gfc_se rse;
+
+      /* Start the copying loops.  */
+      gfc_mark_ss_chain_used (loop.temp_ss, 1);
+      gfc_mark_ss_chain_used (ss, 1);
+      gfc_start_scalarized_body (&loop, &block);
+
+      /* Copy each data element.  */
+      gfc_init_se (&lse, NULL);
+      gfc_copy_loopinfo_to_se (&lse, &loop);
+      gfc_init_se (&rse, NULL);
+      gfc_copy_loopinfo_to_se (&rse, &loop);
+
+      lse.ss = loop.temp_ss;
+      rse.ss = ss;
+
+      gfc_conv_scalarized_array_ref (&lse, NULL);
+      if (expr->ts.type == BT_CHARACTER)
+	{
+	  gfc_conv_expr (&rse, expr);
+	  if (POINTER_TYPE_P (TREE_TYPE (rse.expr)))
+	    rse.expr = build_fold_indirect_ref_loc (input_location,
+						rse.expr);
+	}
+      else
+        gfc_conv_expr_val (&rse, expr);
+
+      gfc_add_block_to_block (&block, &rse.pre);
+      gfc_add_block_to_block (&block, &lse.pre);
+
+      lse.string_length = rse.string_length;
+      tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, true,
+				     expr->expr_type == EXPR_VARIABLE
+				     || expr->expr_type == EXPR_ARRAY, true);
+      gfc_add_expr_to_block (&block, tmp);
+
+      /* Finish the copying loops.  */
+      gfc_trans_scalarizing_loops (&loop, &block);
+
+      desc = loop.temp_ss->data.info.descriptor;
+    }
+  else if (expr->expr_type == EXPR_FUNCTION && dim_ok (info))
+    {
+      desc = info->descriptor;
+      se->string_length = ss->string_length;
+    }
+  else
+    {
+      /* We pass sections without copying to a temporary.  Make a new
+	 descriptor and point it at the section we want.  The loop variable
+	 limits will be the limits of the section.
+	 A function may decide to repack the array to speed up access, but
+	 we're not bothered about that here.  */
+      int dim, ndim;
+      tree parm;
+      tree parmtype;
+      tree stride;
+      tree from;
+      tree to;
+      tree base;
+
+      /* Set the string_length for a character array.  */
+      if (expr->ts.type == BT_CHARACTER)
+	se->string_length =  gfc_get_expr_charlen (expr);
+
+      desc = info->descriptor;
+      if (se->direct_byref && !se->byref_noassign)
+	{
+	  /* For pointer assignments we fill in the destination.  */
+	  parm = se->expr;
+	  parmtype = TREE_TYPE (parm);
+	}
+      else
+	{
+	  /* Otherwise make a new one.  */
+	  parmtype = gfc_get_element_type (TREE_TYPE (desc));
+	  parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, 0,
+						loop.from, loop.to, 0,
+						GFC_ARRAY_UNKNOWN, false);
+	  parm = gfc_create_var (parmtype, "parm");
+	}
+
+      offset = gfc_index_zero_node;
+
+      /* The following can be somewhat confusing.  We have two
+         descriptors, a new one and the original array.
+         {parm, parmtype, dim} refer to the new one.
+         {desc, type, n, loop} refer to the original, which maybe
+         a descriptorless array.
+         The bounds of the scalarization are the bounds of the section.
+         We don't have to worry about numeric overflows when calculating
+         the offsets because all elements are within the array data.  */
+
+      /* Set the dtype.  */
+      tmp = gfc_conv_descriptor_dtype (parm);
+      gfc_add_modify (&loop.pre, tmp, gfc_get_dtype (parmtype));
+
+      /* Set offset for assignments to pointer only to zero if it is not
+         the full array.  */
+      if (se->direct_byref
+	  && info->ref && info->ref->u.ar.type != AR_FULL)
+	base = gfc_index_zero_node;
+      else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
+	base = gfc_evaluate_now (gfc_conv_array_offset (desc), &loop.pre);
+      else
+	base = NULL_TREE;
+
+      ndim = info->ref ? info->ref->u.ar.dimen : info->dimen;
+      for (n = 0; n < ndim; n++)
+	{
+	  stride = gfc_conv_array_stride (desc, n);
+
+	  /* Work out the offset.  */
+	  if (info->ref
+	      && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
+	    {
+	      gcc_assert (info->subscript[n]
+		      && info->subscript[n]->type == GFC_SS_SCALAR);
+	      start = info->subscript[n]->data.scalar.expr;
+	    }
+	  else
+	    {
+	      /* Evaluate and remember the start of the section.  */
+	      start = info->start[n];
+	      stride = gfc_evaluate_now (stride, &loop.pre);
+	    }
+
+	  tmp = gfc_conv_array_lbound (desc, n);
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (tmp),
+				 start, tmp);
+	  tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
+				 tmp, stride);
+	  offset = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp),
+				    offset, tmp);
+
+	  if (info->ref
+	      && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
+	    {
+	      /* For elemental dimensions, we only need the offset.  */
+	      continue;
+	    }
+
+	  /* Vector subscripts need copying and are handled elsewhere.  */
+	  if (info->ref)
+	    gcc_assert (info->ref->u.ar.dimen_type[n] == DIMEN_RANGE);
+ 
+	  /* look for the corresponding scalarizer dimension: dim.  */
+	  for (dim = 0; dim < ndim; dim++)
+	    if (info->dim[dim] == n)
+	      break;
+
+	  /* loop exited early: the DIM being looked for has been found.  */
+	  gcc_assert (dim < ndim);
+
+	  /* Set the new lower bound.  */
+	  from = loop.from[dim];
+	  to = loop.to[dim];
+
+	  /* If we have an array section or are assigning make sure that
+	     the lower bound is 1.  References to the full
+	     array should otherwise keep the original bounds.  */
+	  if ((!info->ref
+	          || info->ref->u.ar.type != AR_FULL)
+	      && !integer_onep (from))
+	    {
+	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				     gfc_array_index_type, gfc_index_one_node,
+				     from);
+	      to = fold_build2_loc (input_location, PLUS_EXPR,
+				    gfc_array_index_type, to, tmp);
+	      from = gfc_index_one_node;
+	    }
+	  gfc_conv_descriptor_lbound_set (&loop.pre, parm,
+					  gfc_rank_cst[dim], from);
+
+	  /* Set the new upper bound.  */
+	  gfc_conv_descriptor_ubound_set (&loop.pre, parm,
+					  gfc_rank_cst[dim], to);
+
+	  /* Multiply the stride by the section stride to get the
+	     total stride.  */
+	  stride = fold_build2_loc (input_location, MULT_EXPR,
+				    gfc_array_index_type,
+				    stride, info->stride[n]);
+
+	  if (se->direct_byref
+	      && info->ref
+	      && info->ref->u.ar.type != AR_FULL)
+	    {
+	      base = fold_build2_loc (input_location, MINUS_EXPR,
+				      TREE_TYPE (base), base, stride);
+	    }
+	  else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
+	    {
+	      tmp = gfc_conv_array_lbound (desc, n);
+	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				     TREE_TYPE (base), tmp, loop.from[dim]);
+	      tmp = fold_build2_loc (input_location, MULT_EXPR,
+				     TREE_TYPE (base), tmp,
+				     gfc_conv_array_stride (desc, n));
+	      base = fold_build2_loc (input_location, PLUS_EXPR,
+				     TREE_TYPE (base), tmp, base);
+	    }
+
+	  /* Store the new stride.  */
+	  gfc_conv_descriptor_stride_set (&loop.pre, parm,
+					  gfc_rank_cst[dim], stride);
+	}
+
+      if (se->data_not_needed)
+	gfc_conv_descriptor_data_set (&loop.pre, parm,
+				      gfc_index_zero_node);
+      else
+	/* Point the data pointer at the 1st element in the section.  */
+	gfc_get_dataptr_offset (&loop.pre, parm, desc, offset,
+				subref_array_target, expr);
+
+      if ((se->direct_byref || GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
+	  && !se->data_not_needed)
+	{
+	  /* Set the offset.  */
+	  gfc_conv_descriptor_offset_set (&loop.pre, parm, base);
+	}
+      else
+	{
+	  /* Only the callee knows what the correct offset it, so just set
+	     it to zero here.  */
+	  gfc_conv_descriptor_offset_set (&loop.pre, parm, gfc_index_zero_node);
+	}
+      desc = parm;
+    }
+
+  if (!se->direct_byref || se->byref_noassign)
+    {
+      /* Get a pointer to the new descriptor.  */
+      if (se->want_pointer)
+	se->expr = gfc_build_addr_expr (NULL_TREE, desc);
+      else
+	se->expr = desc;
+    }
+
+  gfc_add_block_to_block (&se->pre, &loop.pre);
+  gfc_add_block_to_block (&se->post, &loop.post);
+
+  /* Cleanup the scalarizer.  */
+  gfc_cleanup_loop (&loop);
+}
+
+/* Helper function for gfc_conv_array_parameter if array size needs to be
+   computed.  */
+
+static void
+array_parameter_size (tree desc, gfc_expr *expr, tree *size)
+{
+  tree elem;
+  if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
+    *size = GFC_TYPE_ARRAY_SIZE (TREE_TYPE (desc));
+  else if (expr->rank > 1)
+    *size = build_call_expr_loc (input_location,
+			     gfor_fndecl_size0, 1,
+			     gfc_build_addr_expr (NULL, desc));
+  else
+    {
+      tree ubound = gfc_conv_descriptor_ubound_get (desc, gfc_index_zero_node);
+      tree lbound = gfc_conv_descriptor_lbound_get (desc, gfc_index_zero_node);
+
+      *size = fold_build2_loc (input_location, MINUS_EXPR,
+			       gfc_array_index_type, ubound, lbound);
+      *size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			       *size, gfc_index_one_node);
+      *size = fold_build2_loc (input_location, MAX_EXPR, gfc_array_index_type,
+			       *size, gfc_index_zero_node);
+    }
+  elem = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (desc)));
+  *size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			   *size, fold_convert (gfc_array_index_type, elem));
+}
+
+/* Convert an array for passing as an actual parameter.  */
+/* TODO: Optimize passing g77 arrays.  */
+
+void
+gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
+			  const gfc_symbol *fsym, const char *proc_name,
+			  tree *size)
+{
+  tree ptr;
+  tree desc;
+  tree tmp = NULL_TREE;
+  tree stmt;
+  tree parent = DECL_CONTEXT (current_function_decl);
+  bool full_array_var;
+  bool this_array_result;
+  bool contiguous;
+  bool no_pack;
+  bool array_constructor;
+  bool good_allocatable;
+  bool ultimate_ptr_comp;
+  bool ultimate_alloc_comp;
+  gfc_symbol *sym;
+  stmtblock_t block;
+  gfc_ref *ref;
+
+  ultimate_ptr_comp = false;
+  ultimate_alloc_comp = false;
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    {
+      if (ref->next == NULL)
+        break;
+
+      if (ref->type == REF_COMPONENT)
+	{
+	  ultimate_ptr_comp = ref->u.c.component->attr.pointer;
+	  ultimate_alloc_comp = ref->u.c.component->attr.allocatable;
+	}
+    }
+
+  full_array_var = false;
+  contiguous = false;
+
+  if (expr->expr_type == EXPR_VARIABLE && ref && !ultimate_ptr_comp)
+    full_array_var = gfc_full_array_ref_p (ref, &contiguous);
+
+  sym = full_array_var ? expr->symtree->n.sym : NULL;
+
+  /* The symbol should have an array specification.  */
+  gcc_assert (!sym || sym->as || ref->u.ar.as);
+
+  if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_CHARACTER)
+    {
+      get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp);
+      expr->ts.u.cl->backend_decl = tmp;
+      se->string_length = tmp;
+    }
+
+  /* Is this the result of the enclosing procedure?  */
+  this_array_result = (full_array_var && sym->attr.flavor == FL_PROCEDURE);
+  if (this_array_result
+	&& (sym->backend_decl != current_function_decl)
+	&& (sym->backend_decl != parent))
+    this_array_result = false;
+
+  /* Passing address of the array if it is not pointer or assumed-shape.  */
+  if (full_array_var && g77 && !this_array_result
+      && sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
+    {
+      tmp = gfc_get_symbol_decl (sym);
+
+      if (sym->ts.type == BT_CHARACTER)
+	se->string_length = sym->ts.u.cl->backend_decl;
+
+      if (!sym->attr.pointer
+	    && sym->as
+	    && sym->as->type != AS_ASSUMED_SHAPE 
+            && !sym->attr.allocatable)
+        {
+	  /* Some variables are declared directly, others are declared as
+	     pointers and allocated on the heap.  */
+          if (sym->attr.dummy || POINTER_TYPE_P (TREE_TYPE (tmp)))
+            se->expr = tmp;
+          else
+	    se->expr = gfc_build_addr_expr (NULL_TREE, tmp);
+	  if (size)
+	    array_parameter_size (tmp, expr, size);
+	  return;
+        }
+
+      if (sym->attr.allocatable)
+        {
+	  if (sym->attr.dummy || sym->attr.result)
+	    {
+	      gfc_conv_expr_descriptor (se, expr, ss);
+	      tmp = se->expr;
+	    }
+	  if (size)
+	    array_parameter_size (tmp, expr, size);
+	  se->expr = gfc_conv_array_data (tmp);
+          return;
+        }
+    }
+
+  /* A convenient reduction in scope.  */
+  contiguous = g77 && !this_array_result && contiguous;
+
+  /* There is no need to pack and unpack the array, if it is contiguous
+     and not a deferred- or assumed-shape array, or if it is simply
+     contiguous.  */
+  no_pack = ((sym && sym->as
+		  && !sym->attr.pointer
+		  && sym->as->type != AS_DEFERRED
+		  && sym->as->type != AS_ASSUMED_SHAPE)
+		      ||
+	     (ref && ref->u.ar.as
+		  && ref->u.ar.as->type != AS_DEFERRED
+		  && ref->u.ar.as->type != AS_ASSUMED_SHAPE)
+		      ||
+	     gfc_is_simply_contiguous (expr, false));
+
+  no_pack = contiguous && no_pack;
+
+  /* Array constructors are always contiguous and do not need packing.  */
+  array_constructor = g77 && !this_array_result && expr->expr_type == EXPR_ARRAY;
+
+  /* Same is true of contiguous sections from allocatable variables.  */
+  good_allocatable = contiguous
+		       && expr->symtree
+		       && expr->symtree->n.sym->attr.allocatable;
+
+  /* Or ultimate allocatable components.  */
+  ultimate_alloc_comp = contiguous && ultimate_alloc_comp; 
+
+  if (no_pack || array_constructor || good_allocatable || ultimate_alloc_comp)
+    {
+      gfc_conv_expr_descriptor (se, expr, ss);
+      if (expr->ts.type == BT_CHARACTER)
+	se->string_length = expr->ts.u.cl->backend_decl;
+      if (size)
+	array_parameter_size (se->expr, expr, size);
+      se->expr = gfc_conv_array_data (se->expr);
+      return;
+    }
+
+  if (this_array_result)
+    {
+      /* Result of the enclosing function.  */
+      gfc_conv_expr_descriptor (se, expr, ss);
+      if (size)
+	array_parameter_size (se->expr, expr, size);
+      se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
+
+      if (g77 && TREE_TYPE (TREE_TYPE (se->expr)) != NULL_TREE
+	      && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (se->expr))))
+	se->expr = gfc_conv_array_data (build_fold_indirect_ref_loc (input_location,
+								 se->expr));
+
+      return;
+    }
+  else
+    {
+      /* Every other type of array.  */
+      se->want_pointer = 1;
+      gfc_conv_expr_descriptor (se, expr, ss);
+      if (size)
+	array_parameter_size (build_fold_indirect_ref_loc (input_location,
+						       se->expr),
+				  expr, size);
+    }
+
+  /* Deallocate the allocatable components of structures that are
+     not variable.  */
+  if ((expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS)
+	&& expr->ts.u.derived->attr.alloc_comp
+	&& expr->expr_type != EXPR_VARIABLE)
+    {
+      tmp = build_fold_indirect_ref_loc (input_location, se->expr);
+      tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);
+
+      /* The components shall be deallocated before their containing entity.  */
+      gfc_prepend_expr_to_block (&se->post, tmp);
+    }
+
+  if (g77 || (fsym && fsym->attr.contiguous
+	      && !gfc_is_simply_contiguous (expr, false)))
+    {
+      tree origptr = NULL_TREE;
+
+      desc = se->expr;
+
+      /* For contiguous arrays, save the original value of the descriptor.  */
+      if (!g77)
+	{
+	  origptr = gfc_create_var (pvoid_type_node, "origptr");
+	  tmp = build_fold_indirect_ref_loc (input_location, desc);
+	  tmp = gfc_conv_array_data (tmp);
+	  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+				 TREE_TYPE (origptr), origptr,
+				 fold_convert (TREE_TYPE (origptr), tmp));
+	  gfc_add_expr_to_block (&se->pre, tmp);
+	}
+
+      /* Repack the array.  */
+      if (gfc_option.warn_array_temp)
+	{
+	  if (fsym)
+	    gfc_warning ("Creating array temporary at %L for argument '%s'",
+			 &expr->where, fsym->name);
+	  else
+	    gfc_warning ("Creating array temporary at %L", &expr->where);
+	}
+
+      ptr = build_call_expr_loc (input_location,
+			     gfor_fndecl_in_pack, 1, desc);
+
+      if (fsym && fsym->attr.optional && sym && sym->attr.optional)
+	{
+	  tmp = gfc_conv_expr_present (sym);
+	  ptr = build3_loc (input_location, COND_EXPR, TREE_TYPE (se->expr),
+			tmp, fold_convert (TREE_TYPE (se->expr), ptr),
+			fold_convert (TREE_TYPE (se->expr), null_pointer_node));
+	}
+
+      ptr = gfc_evaluate_now (ptr, &se->pre);
+
+      /* Use the packed data for the actual argument, except for contiguous arrays,
+	 where the descriptor's data component is set.  */
+      if (g77)
+	se->expr = ptr;
+      else
+	{
+	  tmp = build_fold_indirect_ref_loc (input_location, desc);
+	  gfc_conv_descriptor_data_set (&se->pre, tmp, ptr);
+	}
+
+      if (gfc_option.rtcheck & GFC_RTCHECK_ARRAY_TEMPS)
+	{
+	  char * msg;
+
+	  if (fsym && proc_name)
+	    asprintf (&msg, "An array temporary was created for argument "
+		      "'%s' of procedure '%s'", fsym->name, proc_name);
+	  else
+	    asprintf (&msg, "An array temporary was created");
+
+	  tmp = build_fold_indirect_ref_loc (input_location,
+					 desc);
+	  tmp = gfc_conv_array_data (tmp);
+	  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				 fold_convert (TREE_TYPE (tmp), ptr), tmp);
+
+	  if (fsym && fsym->attr.optional && sym && sym->attr.optional)
+	    tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+				   boolean_type_node,
+				   gfc_conv_expr_present (sym), tmp);
+
+	  gfc_trans_runtime_check (false, true, tmp, &se->pre,
+				   &expr->where, msg);
+	  gfc_free (msg);
+	}
+
+      gfc_start_block (&block);
+
+      /* Copy the data back.  */
+      if (fsym == NULL || fsym->attr.intent != INTENT_IN)
+	{
+	  tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_in_unpack, 2, desc, ptr);
+	  gfc_add_expr_to_block (&block, tmp);
+	}
+
+      /* Free the temporary.  */
+      tmp = gfc_call_free (convert (pvoid_type_node, ptr));
+      gfc_add_expr_to_block (&block, tmp);
+
+      stmt = gfc_finish_block (&block);
+
+      gfc_init_block (&block);
+      /* Only if it was repacked.  This code needs to be executed before the
+         loop cleanup code.  */
+      tmp = build_fold_indirect_ref_loc (input_location,
+				     desc);
+      tmp = gfc_conv_array_data (tmp);
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			     fold_convert (TREE_TYPE (tmp), ptr), tmp);
+
+      if (fsym && fsym->attr.optional && sym && sym->attr.optional)
+	tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+			       boolean_type_node,
+			       gfc_conv_expr_present (sym), tmp);
+
+      tmp = build3_v (COND_EXPR, tmp, stmt, build_empty_stmt (input_location));
+
+      gfc_add_expr_to_block (&block, tmp);
+      gfc_add_block_to_block (&block, &se->post);
+
+      gfc_init_block (&se->post);
+
+      /* Reset the descriptor pointer.  */
+      if (!g77)
+        {
+          tmp = build_fold_indirect_ref_loc (input_location, desc);
+          gfc_conv_descriptor_data_set (&se->post, tmp, origptr);
+        }
+
+      gfc_add_block_to_block (&se->post, &block);
+    }
+}
+
+
+/* Generate code to deallocate an array, if it is allocated.  */
+
+tree
+gfc_trans_dealloc_allocated (tree descriptor)
+{ 
+  tree tmp;
+  tree var;
+  stmtblock_t block;
+
+  gfc_start_block (&block);
+
+  var = gfc_conv_descriptor_data_get (descriptor);
+  STRIP_NOPS (var);
+
+  /* Call array_deallocate with an int * present in the second argument.
+     Although it is ignored here, it's presence ensures that arrays that
+     are already deallocated are ignored.  */
+  tmp = gfc_deallocate_with_status (var, NULL_TREE, true, NULL);
+  gfc_add_expr_to_block (&block, tmp);
+
+  /* Zero the data pointer.  */
+  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+			 var, build_int_cst (TREE_TYPE (var), 0));
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* This helper function calculates the size in words of a full array.  */
+
+static tree
+get_full_array_size (stmtblock_t *block, tree decl, int rank)
+{
+  tree idx;
+  tree nelems;
+  tree tmp;
+  idx = gfc_rank_cst[rank - 1];
+  nelems = gfc_conv_descriptor_ubound_get (decl, idx);
+  tmp = gfc_conv_descriptor_lbound_get (decl, idx);
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			 nelems, tmp);
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			 tmp, gfc_index_one_node);
+  tmp = gfc_evaluate_now (tmp, block);
+
+  nelems = gfc_conv_descriptor_stride_get (decl, idx);
+  tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			 nelems, tmp);
+  return gfc_evaluate_now (tmp, block);
+}
+
+
+/* Allocate dest to the same size as src, and copy src -> dest.
+   If no_malloc is set, only the copy is done.  */
+
+static tree
+duplicate_allocatable (tree dest, tree src, tree type, int rank,
+		       bool no_malloc)
+{
+  tree tmp;
+  tree size;
+  tree nelems;
+  tree null_cond;
+  tree null_data;
+  stmtblock_t block;
+
+  /* If the source is null, set the destination to null.  Then,
+     allocate memory to the destination.  */
+  gfc_init_block (&block);
+
+  if (rank == 0)
+    {
+      tmp = null_pointer_node;
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, type, dest, tmp);
+      gfc_add_expr_to_block (&block, tmp);
+      null_data = gfc_finish_block (&block);
+
+      gfc_init_block (&block);
+      size = TYPE_SIZE_UNIT (TREE_TYPE (type));
+      if (!no_malloc)
+	{
+	  tmp = gfc_call_malloc (&block, type, size);
+	  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+				 dest, fold_convert (type, tmp));
+	  gfc_add_expr_to_block (&block, tmp);
+	}
+
+      tmp = built_in_decls[BUILT_IN_MEMCPY];
+      tmp = build_call_expr_loc (input_location, tmp, 3,
+				 dest, src, size);
+    }
+  else
+    {
+      gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
+      null_data = gfc_finish_block (&block);
+
+      gfc_init_block (&block);
+      nelems = get_full_array_size (&block, src, rank);
+      tmp = fold_convert (gfc_array_index_type,
+			  TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+      size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			      nelems, tmp);
+      if (!no_malloc)
+	{
+	  tmp = TREE_TYPE (gfc_conv_descriptor_data_get (src));
+	  tmp = gfc_call_malloc (&block, tmp, size);
+	  gfc_conv_descriptor_data_set (&block, dest, tmp);
+	}
+
+      /* We know the temporary and the value will be the same length,
+	 so can use memcpy.  */
+      tmp = built_in_decls[BUILT_IN_MEMCPY];
+      tmp = build_call_expr_loc (input_location,
+			tmp, 3, gfc_conv_descriptor_data_get (dest),
+			gfc_conv_descriptor_data_get (src), size);
+    }
+
+  gfc_add_expr_to_block (&block, tmp);
+  tmp = gfc_finish_block (&block);
+
+  /* Null the destination if the source is null; otherwise do
+     the allocate and copy.  */
+  if (rank == 0)
+    null_cond = src;
+  else
+    null_cond = gfc_conv_descriptor_data_get (src);
+
+  null_cond = convert (pvoid_type_node, null_cond);
+  null_cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			       null_cond, null_pointer_node);
+  return build3_v (COND_EXPR, null_cond, tmp, null_data);
+}
+
+
+/* Allocate dest to the same size as src, and copy data src -> dest.  */
+
+tree
+gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank)
+{
+  return duplicate_allocatable (dest, src, type, rank, false);
+}
+
+
+/* Copy data src -> dest.  */
+
+tree
+gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank)
+{
+  return duplicate_allocatable (dest, src, type, rank, true);
+}
+
+
+/* Recursively traverse an object of derived type, generating code to
+   deallocate, nullify or copy allocatable components.  This is the work horse
+   function for the functions named in this enum.  */
+
+enum {DEALLOCATE_ALLOC_COMP = 1, NULLIFY_ALLOC_COMP, COPY_ALLOC_COMP,
+      COPY_ONLY_ALLOC_COMP};
+
+static tree
+structure_alloc_comps (gfc_symbol * der_type, tree decl,
+		       tree dest, int rank, int purpose)
+{
+  gfc_component *c;
+  gfc_loopinfo loop;
+  stmtblock_t fnblock;
+  stmtblock_t loopbody;
+  tree decl_type;
+  tree tmp;
+  tree comp;
+  tree dcmp;
+  tree nelems;
+  tree index;
+  tree var;
+  tree cdecl;
+  tree ctype;
+  tree vref, dref;
+  tree null_cond = NULL_TREE;
+
+  gfc_init_block (&fnblock);
+
+  decl_type = TREE_TYPE (decl);
+
+  if ((POINTER_TYPE_P (decl_type) && rank != 0)
+	|| (TREE_CODE (decl_type) == REFERENCE_TYPE && rank == 0))
+
+    decl = build_fold_indirect_ref_loc (input_location,
+				    decl);
+
+  /* Just in case in gets dereferenced.  */
+  decl_type = TREE_TYPE (decl);
+
+  /* If this an array of derived types with allocatable components
+     build a loop and recursively call this function.  */
+  if (TREE_CODE (decl_type) == ARRAY_TYPE
+	|| GFC_DESCRIPTOR_TYPE_P (decl_type))
+    {
+      tmp = gfc_conv_array_data (decl);
+      var = build_fold_indirect_ref_loc (input_location,
+				     tmp);
+	
+      /* Get the number of elements - 1 and set the counter.  */
+      if (GFC_DESCRIPTOR_TYPE_P (decl_type))
+	{
+	  /* Use the descriptor for an allocatable array.  Since this
+	     is a full array reference, we only need the descriptor
+	     information from dimension = rank.  */
+	  tmp = get_full_array_size (&fnblock, decl, rank);
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type, tmp,
+				 gfc_index_one_node);
+
+	  null_cond = gfc_conv_descriptor_data_get (decl);
+	  null_cond = fold_build2_loc (input_location, NE_EXPR,
+				       boolean_type_node, null_cond,
+				       build_int_cst (TREE_TYPE (null_cond), 0));
+	}
+      else
+	{
+	  /*  Otherwise use the TYPE_DOMAIN information.  */
+	  tmp =  array_type_nelts (decl_type);
+	  tmp = fold_convert (gfc_array_index_type, tmp);
+	}
+
+      /* Remember that this is, in fact, the no. of elements - 1.  */
+      nelems = gfc_evaluate_now (tmp, &fnblock);
+      index = gfc_create_var (gfc_array_index_type, "S");
+
+      /* Build the body of the loop.  */
+      gfc_init_block (&loopbody);
+
+      vref = gfc_build_array_ref (var, index, NULL);
+
+      if (purpose == COPY_ALLOC_COMP)
+        {
+	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
+	    {
+	      tmp = gfc_duplicate_allocatable (dest, decl, decl_type, rank);
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+	  tmp = build_fold_indirect_ref_loc (input_location,
+					 gfc_conv_array_data (dest));
+	  dref = gfc_build_array_ref (tmp, index, NULL);
+	  tmp = structure_alloc_comps (der_type, vref, dref, rank, purpose);
+	}
+      else if (purpose == COPY_ONLY_ALLOC_COMP)
+        {
+	  tmp = build_fold_indirect_ref_loc (input_location,
+					 gfc_conv_array_data (dest));
+	  dref = gfc_build_array_ref (tmp, index, NULL);
+	  tmp = structure_alloc_comps (der_type, vref, dref, rank,
+				       COPY_ALLOC_COMP);
+	}
+      else
+        tmp = structure_alloc_comps (der_type, vref, NULL_TREE, rank, purpose);
+
+      gfc_add_expr_to_block (&loopbody, tmp);
+
+      /* Build the loop and return.  */
+      gfc_init_loopinfo (&loop);
+      loop.dimen = 1;
+      loop.from[0] = gfc_index_zero_node;
+      loop.loopvar[0] = index;
+      loop.to[0] = nelems;
+      gfc_trans_scalarizing_loops (&loop, &loopbody);
+      gfc_add_block_to_block (&fnblock, &loop.pre);
+
+      tmp = gfc_finish_block (&fnblock);
+      if (null_cond != NULL_TREE)
+	tmp = build3_v (COND_EXPR, null_cond, tmp,
+			build_empty_stmt (input_location));
+
+      return tmp;
+    }
+
+  /* Otherwise, act on the components or recursively call self to
+     act on a chain of components.  */
+  for (c = der_type->components; c; c = c->next)
+    {
+      bool cmp_has_alloc_comps = (c->ts.type == BT_DERIVED
+				  || c->ts.type == BT_CLASS)
+				    && c->ts.u.derived->attr.alloc_comp;
+      cdecl = c->backend_decl;
+      ctype = TREE_TYPE (cdecl);
+
+      switch (purpose)
+	{
+	case DEALLOCATE_ALLOC_COMP:
+	  if (cmp_has_alloc_comps && !c->attr.pointer)
+	    {
+	      /* Do not deallocate the components of ultimate pointer
+		 components.  */
+	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      decl, cdecl, NULL_TREE);
+	      rank = c->as ? c->as->rank : 0;
+	      tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE,
+					   rank, purpose);
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+
+	  if (c->attr.allocatable && c->attr.dimension && !c->attr.proc_pointer)
+	    {
+	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      decl, cdecl, NULL_TREE);
+	      tmp = gfc_trans_dealloc_allocated (comp);
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+	  else if (c->attr.allocatable)
+	    {
+	      /* Allocatable scalar components.  */
+	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      decl, cdecl, NULL_TREE);
+
+	      tmp = gfc_deallocate_scalar_with_status (comp, NULL, true, NULL,
+						       c->ts);
+	      gfc_add_expr_to_block (&fnblock, tmp);
+
+	      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+				     void_type_node, comp,
+				     build_int_cst (TREE_TYPE (comp), 0));
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+	  else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
+	    {
+	      /* Allocatable scalar CLASS components.  */
+	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      decl, cdecl, NULL_TREE);
+	      
+	      /* Add reference to '_data' component.  */
+	      tmp = CLASS_DATA (c)->backend_decl;
+	      comp = fold_build3_loc (input_location, COMPONENT_REF,
+				      TREE_TYPE (tmp), comp, tmp, NULL_TREE);
+
+	      tmp = gfc_deallocate_scalar_with_status (comp, NULL, true, NULL,
+						       CLASS_DATA (c)->ts);
+	      gfc_add_expr_to_block (&fnblock, tmp);
+
+	      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+				     void_type_node, comp,
+				     build_int_cst (TREE_TYPE (comp), 0));
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+	  break;
+
+	case NULLIFY_ALLOC_COMP:
+	  if (c->attr.pointer)
+	    continue;
+	  else if (c->attr.allocatable && c->attr.dimension)
+	    {
+	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      decl, cdecl, NULL_TREE);
+	      gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node);
+	    }
+	  else if (c->attr.allocatable)
+	    {
+	      /* Allocatable scalar components.  */
+	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      decl, cdecl, NULL_TREE);
+	      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+				     void_type_node, comp,
+				     build_int_cst (TREE_TYPE (comp), 0));
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+	  else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable)
+	    {
+	      /* Allocatable scalar CLASS components.  */
+	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      decl, cdecl, NULL_TREE);
+	      /* Add reference to '_data' component.  */
+	      tmp = CLASS_DATA (c)->backend_decl;
+	      comp = fold_build3_loc (input_location, COMPONENT_REF,
+				      TREE_TYPE (tmp), comp, tmp, NULL_TREE);
+	      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+				     void_type_node, comp,
+				     build_int_cst (TREE_TYPE (comp), 0));
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+          else if (cmp_has_alloc_comps)
+	    {
+	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
+				      decl, cdecl, NULL_TREE);
+	      rank = c->as ? c->as->rank : 0;
+	      tmp = structure_alloc_comps (c->ts.u.derived, comp, NULL_TREE,
+					   rank, purpose);
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+	  break;
+
+	case COPY_ALLOC_COMP:
+	  if (c->attr.pointer)
+	    continue;
+
+	  /* We need source and destination components.  */
+	  comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl,
+				  cdecl, NULL_TREE);
+	  dcmp = fold_build3_loc (input_location, COMPONENT_REF, ctype, dest,
+				  cdecl, NULL_TREE);
+	  dcmp = fold_convert (TREE_TYPE (comp), dcmp);
+
+	  if (c->attr.allocatable && !c->attr.proc_pointer
+	      && !cmp_has_alloc_comps)
+	    {
+	      rank = c->as ? c->as->rank : 0;
+	      tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank);
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+
+          if (cmp_has_alloc_comps)
+	    {
+	      rank = c->as ? c->as->rank : 0;
+	      tmp = fold_convert (TREE_TYPE (dcmp), comp);
+	      gfc_add_modify (&fnblock, dcmp, tmp);
+	      tmp = structure_alloc_comps (c->ts.u.derived, comp, dcmp,
+					   rank, purpose);
+	      gfc_add_expr_to_block (&fnblock, tmp);
+	    }
+	  break;
+
+	default:
+	  gcc_unreachable ();
+	  break;
+	}
+    }
+
+  return gfc_finish_block (&fnblock);
+}
+
+/* Recursively traverse an object of derived type, generating code to
+   nullify allocatable components.  */
+
+tree
+gfc_nullify_alloc_comp (gfc_symbol * der_type, tree decl, int rank)
+{
+  return structure_alloc_comps (der_type, decl, NULL_TREE, rank,
+				NULLIFY_ALLOC_COMP);
+}
+
+
+/* Recursively traverse an object of derived type, generating code to
+   deallocate allocatable components.  */
+
+tree
+gfc_deallocate_alloc_comp (gfc_symbol * der_type, tree decl, int rank)
+{
+  return structure_alloc_comps (der_type, decl, NULL_TREE, rank,
+				DEALLOCATE_ALLOC_COMP);
+}
+
+
+/* Recursively traverse an object of derived type, generating code to
+   copy it and its allocatable components.  */
+
+tree
+gfc_copy_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank)
+{
+  return structure_alloc_comps (der_type, decl, dest, rank, COPY_ALLOC_COMP);
+}
+
+
+/* Recursively traverse an object of derived type, generating code to
+   copy only its allocatable components.  */
+
+tree
+gfc_copy_only_alloc_comp (gfc_symbol * der_type, tree decl, tree dest, int rank)
+{
+  return structure_alloc_comps (der_type, decl, dest, rank, COPY_ONLY_ALLOC_COMP);
+}
+
+
+/* Returns the value of LBOUND for an expression.  This could be broken out
+   from gfc_conv_intrinsic_bound but this seemed to be simpler.  This is
+   called by gfc_alloc_allocatable_for_assignment.  */
+static tree
+get_std_lbound (gfc_expr *expr, tree desc, int dim, bool assumed_size)
+{
+  tree lbound;
+  tree ubound;
+  tree stride;
+  tree cond, cond1, cond3, cond4;
+  tree tmp;
+  gfc_ref *ref;
+
+  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
+    {
+      tmp = gfc_rank_cst[dim];
+      lbound = gfc_conv_descriptor_lbound_get (desc, tmp);
+      ubound = gfc_conv_descriptor_ubound_get (desc, tmp);
+      stride = gfc_conv_descriptor_stride_get (desc, tmp);
+      cond1 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
+			       ubound, lbound);
+      cond3 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
+			       stride, gfc_index_zero_node);
+      cond3 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+			       boolean_type_node, cond3, cond1);
+      cond4 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+			       stride, gfc_index_zero_node);
+      if (assumed_size)
+	cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				tmp, build_int_cst (gfc_array_index_type,
+						    expr->rank - 1));
+      else
+	cond = boolean_false_node;
+
+      cond1 = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+			       boolean_type_node, cond3, cond4);
+      cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+			      boolean_type_node, cond, cond1);
+
+      return fold_build3_loc (input_location, COND_EXPR,
+			      gfc_array_index_type, cond,
+			      lbound, gfc_index_one_node);
+    }
+
+  if (expr->expr_type == EXPR_FUNCTION)
+    {
+      /* A conversion function, so use the argument.  */
+      gcc_assert (expr->value.function.isym
+		  && expr->value.function.isym->conversion);
+      expr = expr->value.function.actual->expr;
+    }
+
+  if (expr->expr_type == EXPR_VARIABLE)
+    {
+      tmp = TREE_TYPE (expr->symtree->n.sym->backend_decl);
+      for (ref = expr->ref; ref; ref = ref->next)
+	{
+	  if (ref->type == REF_COMPONENT
+		&& ref->u.c.component->as
+		&& ref->next
+		&& ref->next->u.ar.type == AR_FULL)
+	    tmp = TREE_TYPE (ref->u.c.component->backend_decl);
+	}
+      return GFC_TYPE_ARRAY_LBOUND(tmp, dim);
+    }
+
+  return gfc_index_one_node;
+}
+
+
+/* Returns true if an expression represents an lhs that can be reallocated
+   on assignment.  */
+
+bool
+gfc_is_reallocatable_lhs (gfc_expr *expr)
+{
+  gfc_ref * ref;
+
+  if (!expr->ref)
+    return false;
+
+  /* An allocatable variable.  */
+  if (expr->symtree->n.sym->attr.allocatable
+	&& expr->ref
+	&& expr->ref->type == REF_ARRAY
+	&& expr->ref->u.ar.type == AR_FULL)
+    return true;
+
+  /* All that can be left are allocatable components.  */
+  if ((expr->symtree->n.sym->ts.type != BT_DERIVED
+       && expr->symtree->n.sym->ts.type != BT_CLASS)
+	|| !expr->symtree->n.sym->ts.u.derived->attr.alloc_comp)
+    return false;
+
+  /* Find a component ref followed by an array reference.  */
+  for (ref = expr->ref; ref; ref = ref->next)
+    if (ref->next
+	  && ref->type == REF_COMPONENT
+	  && ref->next->type == REF_ARRAY
+	  && !ref->next->next)
+      break;
+
+  if (!ref)
+    return false;
+
+  /* Return true if valid reallocatable lhs.  */
+  if (ref->u.c.component->attr.allocatable
+	&& ref->next->u.ar.type == AR_FULL)
+    return true;
+
+  return false;
+}
+
+
+/* Allocate the lhs of an assignment to an allocatable array, otherwise
+   reallocate it.  */
+
+tree
+gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
+				      gfc_expr *expr1,
+				      gfc_expr *expr2)
+{
+  stmtblock_t realloc_block;
+  stmtblock_t alloc_block;
+  stmtblock_t fblock;
+  gfc_ss *rss;
+  gfc_ss *lss;
+  tree realloc_expr;
+  tree alloc_expr;
+  tree size1;
+  tree size2;
+  tree array1;
+  tree cond;
+  tree tmp;
+  tree tmp2;
+  tree lbound;
+  tree ubound;
+  tree desc;
+  tree desc2;
+  tree offset;
+  tree jump_label1;
+  tree jump_label2;
+  tree neq_size;
+  tree lbd;
+  int n;
+  int dim;
+  gfc_array_spec * as;
+
+  /* x = f(...) with x allocatable.  In this case, expr1 is the rhs.
+     Find the lhs expression in the loop chain and set expr1 and
+     expr2 accordingly.  */
+  if (expr1->expr_type == EXPR_FUNCTION && expr2 == NULL)
+    {
+      expr2 = expr1;
+      /* Find the ss for the lhs.  */
+      lss = loop->ss;
+      for (; lss && lss != gfc_ss_terminator; lss = lss->loop_chain)
+	if (lss->expr && lss->expr->expr_type == EXPR_VARIABLE)
+	  break;
+      if (lss == gfc_ss_terminator)
+	return NULL_TREE;
+      expr1 = lss->expr;
+    }
+
+  /* Bail out if this is not a valid allocate on assignment.  */
+  if (!gfc_is_reallocatable_lhs (expr1)
+	|| (expr2 && !expr2->rank))
+    return NULL_TREE;
+
+  /* Find the ss for the lhs.  */
+  lss = loop->ss;
+  for (; lss && lss != gfc_ss_terminator; lss = lss->loop_chain)
+    if (lss->expr == expr1)
+      break;
+
+  if (lss == gfc_ss_terminator)
+    return NULL_TREE;
+
+  /* Find an ss for the rhs. For operator expressions, we see the
+     ss's for the operands. Any one of these will do.  */
+  rss = loop->ss;
+  for (; rss && rss != gfc_ss_terminator; rss = rss->loop_chain)
+    if (rss->expr != expr1 && rss != loop->temp_ss)
+      break;
+
+  if (expr2 && rss == gfc_ss_terminator)
+    return NULL_TREE;
+
+  gfc_start_block (&fblock);
+
+  /* Since the lhs is allocatable, this must be a descriptor type.
+     Get the data and array size.  */
+  desc = lss->data.info.descriptor;
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
+  array1 = gfc_conv_descriptor_data_get (desc);
+
+  /* 7.4.1.3 "If variable is an allocated allocatable variable, it is
+     deallocated if expr is an array of different shape or any of the
+     corresponding length type parameter values of variable and expr
+     differ."  This assures F95 compatibility.  */
+  jump_label1 = gfc_build_label_decl (NULL_TREE);
+  jump_label2 = gfc_build_label_decl (NULL_TREE);
+
+  /* Allocate if data is NULL.  */
+  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			 array1, build_int_cst (TREE_TYPE (array1), 0));
+  tmp = build3_v (COND_EXPR, cond,
+		  build1_v (GOTO_EXPR, jump_label1),
+		  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&fblock, tmp);
+
+  /* Get arrayspec if expr is a full array.  */
+  if (expr2 && expr2->expr_type == EXPR_FUNCTION
+	&& expr2->value.function.isym
+	&& expr2->value.function.isym->conversion)
+    {
+      /* For conversion functions, take the arg.  */
+      gfc_expr *arg = expr2->value.function.actual->expr;
+      as = gfc_get_full_arrayspec_from_expr (arg);
+    }
+  else if (expr2)
+    as = gfc_get_full_arrayspec_from_expr (expr2);
+  else
+    as = NULL;
+
+  /* If the lhs shape is not the same as the rhs jump to setting the
+     bounds and doing the reallocation.......  */ 
+  for (n = 0; n < expr1->rank; n++)
+    {
+      /* Check the shape.  */
+      lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]);
+      ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
+      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+			     gfc_array_index_type,
+			     loop->to[n], loop->from[n]);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR,
+			     gfc_array_index_type,
+			     tmp, lbound);
+      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+			     gfc_array_index_type,
+			     tmp, ubound);
+      cond = fold_build2_loc (input_location, NE_EXPR,
+			      boolean_type_node,
+			      tmp, gfc_index_zero_node);
+      tmp = build3_v (COND_EXPR, cond,
+		      build1_v (GOTO_EXPR, jump_label1),
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&fblock, tmp);	  
+    }
+
+  /* ....else jump past the (re)alloc code.  */
+  tmp = build1_v (GOTO_EXPR, jump_label2);
+  gfc_add_expr_to_block (&fblock, tmp);
+    
+  /* Add the label to start automatic (re)allocation.  */
+  tmp = build1_v (LABEL_EXPR, jump_label1);
+  gfc_add_expr_to_block (&fblock, tmp);
+
+  size1 = gfc_conv_descriptor_size (desc, expr1->rank);
+
+  /* Get the rhs size.  Fix both sizes.  */
+  if (expr2)
+    desc2 = rss->data.info.descriptor;
+  else
+    desc2 = NULL_TREE;
+  size2 = gfc_index_one_node;
+  for (n = 0; n < expr2->rank; n++)
+    {
+      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+			     gfc_array_index_type,
+			     loop->to[n], loop->from[n]);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR,
+			     gfc_array_index_type,
+			     tmp, gfc_index_one_node);
+      size2 = fold_build2_loc (input_location, MULT_EXPR,
+			       gfc_array_index_type,
+			       tmp, size2);
+    }
+
+  size1 = gfc_evaluate_now (size1, &fblock);
+  size2 = gfc_evaluate_now (size2, &fblock);
+
+  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			  size1, size2);
+  neq_size = gfc_evaluate_now (cond, &fblock);
+
+
+  /* Now modify the lhs descriptor and the associated scalarizer
+     variables. F2003 7.4.1.3: "If variable is or becomes an
+     unallocated allocatable variable, then it is allocated with each
+     deferred type parameter equal to the corresponding type parameters
+     of expr , with the shape of expr , and with each lower bound equal
+     to the corresponding element of LBOUND(expr)."  
+     Reuse size1 to keep a dimension-by-dimension track of the
+     stride of the new array.  */
+  size1 = gfc_index_one_node;
+  offset = gfc_index_zero_node;
+
+  for (n = 0; n < expr2->rank; n++)
+    {
+      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+			     gfc_array_index_type,
+			     loop->to[n], loop->from[n]);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR,
+			     gfc_array_index_type,
+			     tmp, gfc_index_one_node);
+
+      lbound = gfc_index_one_node;
+      ubound = tmp;
+
+      if (as)
+	{
+	  lbd = get_std_lbound (expr2, desc2, n,
+				as->type == AS_ASSUMED_SIZE);
+	  ubound = fold_build2_loc (input_location,
+				    MINUS_EXPR,
+				    gfc_array_index_type,
+				    ubound, lbound);
+	  ubound = fold_build2_loc (input_location,
+				    PLUS_EXPR,
+				    gfc_array_index_type,
+				    ubound, lbd);
+	  lbound = lbd;
+	}
+
+      gfc_conv_descriptor_lbound_set (&fblock, desc,
+				      gfc_rank_cst[n],
+				      lbound);
+      gfc_conv_descriptor_ubound_set (&fblock, desc,
+				      gfc_rank_cst[n],
+				      ubound);
+      gfc_conv_descriptor_stride_set (&fblock, desc,
+				      gfc_rank_cst[n],
+				      size1);
+      lbound = gfc_conv_descriptor_lbound_get (desc,
+					       gfc_rank_cst[n]);
+      tmp2 = fold_build2_loc (input_location, MULT_EXPR,
+			      gfc_array_index_type,
+			      lbound, size1);
+      offset = fold_build2_loc (input_location, MINUS_EXPR,
+				gfc_array_index_type,
+				offset, tmp2);
+      size1 = fold_build2_loc (input_location, MULT_EXPR,
+			       gfc_array_index_type,
+			       tmp, size1);
+    }
+
+  /* Set the lhs descriptor and scalarizer offsets.  For rank > 1,
+     the array offset is saved and the info.offset is used for a
+     running offset.  Use the saved_offset instead.  */
+  tmp = gfc_conv_descriptor_offset (desc);
+  gfc_add_modify (&fblock, tmp, offset);
+  if (lss->data.info.saved_offset
+	&& TREE_CODE (lss->data.info.saved_offset) == VAR_DECL)
+      gfc_add_modify (&fblock, lss->data.info.saved_offset, tmp);
+
+  /* Now set the deltas for the lhs.  */
+  for (n = 0; n < expr1->rank; n++)
+    {
+      tmp = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]);
+      dim = lss->data.info.dim[n];
+      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+			     gfc_array_index_type, tmp,
+			     loop->from[dim]);
+      if (lss->data.info.delta[dim]
+	    && TREE_CODE (lss->data.info.delta[dim]) == VAR_DECL)
+	gfc_add_modify (&fblock, lss->data.info.delta[dim], tmp);
+    }
+
+  /* Get the new lhs size in bytes.  */
+  if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
+    {
+      tmp = expr2->ts.u.cl->backend_decl;
+      gcc_assert (expr1->ts.u.cl->backend_decl);
+      tmp = fold_convert (TREE_TYPE (expr1->ts.u.cl->backend_decl), tmp);
+      gfc_add_modify (&fblock, expr1->ts.u.cl->backend_decl, tmp);
+    }
+  else if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->backend_decl)
+    {
+      tmp = TYPE_SIZE_UNIT (TREE_TYPE (gfc_typenode_for_spec (&expr1->ts)));
+      tmp = fold_build2_loc (input_location, MULT_EXPR,
+			     gfc_array_index_type, tmp,
+			     expr1->ts.u.cl->backend_decl);
+    }
+  else
+    tmp = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&expr1->ts));
+  tmp = fold_convert (gfc_array_index_type, tmp);
+  size2 = fold_build2_loc (input_location, MULT_EXPR,
+			   gfc_array_index_type,
+			   tmp, size2);
+  size2 = fold_convert (size_type_node, size2);
+  size2 = gfc_evaluate_now (size2, &fblock);
+
+  /* Realloc expression.  Note that the scalarizer uses desc.data
+     in the array reference - (*desc.data)[<element>]. */
+  gfc_init_block (&realloc_block);
+  tmp = build_call_expr_loc (input_location,
+			     built_in_decls[BUILT_IN_REALLOC], 2,
+			     fold_convert (pvoid_type_node, array1),
+			     size2);
+  gfc_conv_descriptor_data_set (&realloc_block,
+				desc, tmp);
+  realloc_expr = gfc_finish_block (&realloc_block);
+
+  /* Only reallocate if sizes are different.  */
+  tmp = build3_v (COND_EXPR, neq_size, realloc_expr,
+		  build_empty_stmt (input_location));
+  realloc_expr = tmp;
+
+
+  /* Malloc expression.  */
+  gfc_init_block (&alloc_block);
+  tmp = build_call_expr_loc (input_location,
+			     built_in_decls[BUILT_IN_MALLOC], 1,
+			     size2);
+  gfc_conv_descriptor_data_set (&alloc_block,
+				desc, tmp);
+  tmp = gfc_conv_descriptor_dtype (desc);
+  gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+  alloc_expr = gfc_finish_block (&alloc_block);
+
+  /* Malloc if not allocated; realloc otherwise.  */
+  tmp = build_int_cst (TREE_TYPE (array1), 0);
+  cond = fold_build2_loc (input_location, EQ_EXPR,
+			  boolean_type_node,
+			  array1, tmp);
+  tmp = build3_v (COND_EXPR, cond, alloc_expr, realloc_expr);
+  gfc_add_expr_to_block (&fblock, tmp);
+
+  /* Make sure that the scalarizer data pointer is updated.  */
+  if (lss->data.info.data
+	&& TREE_CODE (lss->data.info.data) == VAR_DECL)
+    {
+      tmp = gfc_conv_descriptor_data_get (desc);
+      gfc_add_modify (&fblock, lss->data.info.data, tmp);
+    }
+
+  /* Add the exit label.  */
+  tmp = build1_v (LABEL_EXPR, jump_label2);
+  gfc_add_expr_to_block (&fblock, tmp);
+
+  return gfc_finish_block (&fblock);
+}
+
+
+/* NULLIFY an allocatable/pointer array on function entry, free it on exit.
+   Do likewise, recursively if necessary, with the allocatable components of
+   derived types.  */
+
+void
+gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
+{
+  tree type;
+  tree tmp;
+  tree descriptor;
+  stmtblock_t init;
+  stmtblock_t cleanup;
+  locus loc;
+  int rank;
+  bool sym_has_alloc_comp;
+
+  sym_has_alloc_comp = (sym->ts.type == BT_DERIVED
+			|| sym->ts.type == BT_CLASS)
+			  && sym->ts.u.derived->attr.alloc_comp;
+
+  /* Make sure the frontend gets these right.  */
+  if (!(sym->attr.pointer || sym->attr.allocatable || sym_has_alloc_comp))
+    fatal_error ("Possible front-end bug: Deferred array size without pointer, "
+		 "allocatable attribute or derived type without allocatable "
+		 "components.");
+
+  gfc_save_backend_locus (&loc);
+  gfc_set_backend_locus (&sym->declared_at);
+  gfc_init_block (&init);
+
+  gcc_assert (TREE_CODE (sym->backend_decl) == VAR_DECL
+		|| TREE_CODE (sym->backend_decl) == PARM_DECL);
+
+  if (sym->ts.type == BT_CHARACTER
+      && !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
+    {
+      gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
+      gfc_trans_vla_type_sizes (sym, &init);
+    }
+
+  /* Dummy, use associated and result variables don't need anything special.  */
+  if (sym->attr.dummy || sym->attr.use_assoc || sym->attr.result)
+    {
+      gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+      gfc_restore_backend_locus (&loc);
+      return;
+    }
+
+  descriptor = sym->backend_decl;
+
+  /* Although static, derived types with default initializers and
+     allocatable components must not be nulled wholesale; instead they
+     are treated component by component.  */
+  if (TREE_STATIC (descriptor) && !sym_has_alloc_comp)
+    {
+      /* SAVEd variables are not freed on exit.  */
+      gfc_trans_static_array_pointer (sym);
+
+      gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+      gfc_restore_backend_locus (&loc);
+      return;
+    }
+
+  /* Get the descriptor type.  */
+  type = TREE_TYPE (sym->backend_decl);
+
+  if (sym_has_alloc_comp && !(sym->attr.pointer || sym->attr.allocatable))
+    {
+      if (!sym->attr.save
+	  && !(TREE_STATIC (sym->backend_decl) && sym->attr.is_main_program))
+	{
+	  if (sym->value == NULL
+	      || !gfc_has_default_initializer (sym->ts.u.derived))
+	    {
+	      rank = sym->as ? sym->as->rank : 0;
+	      tmp = gfc_nullify_alloc_comp (sym->ts.u.derived,
+					    descriptor, rank);
+	      gfc_add_expr_to_block (&init, tmp);
+	    }
+	  else
+	    gfc_init_default_dt (sym, &init, false);
+	}
+    }
+  else if (!GFC_DESCRIPTOR_TYPE_P (type))
+    {
+      /* If the backend_decl is not a descriptor, we must have a pointer
+	 to one.  */
+      descriptor = build_fold_indirect_ref_loc (input_location,
+						sym->backend_decl);
+      type = TREE_TYPE (descriptor);
+    }
+  
+  /* NULLIFY the data pointer.  */
+  if (GFC_DESCRIPTOR_TYPE_P (type) && !sym->attr.save)
+    gfc_conv_descriptor_data_set (&init, descriptor, null_pointer_node);
+
+  gfc_restore_backend_locus (&loc);
+  gfc_init_block (&cleanup);
+
+  /* Allocatable arrays need to be freed when they go out of scope.
+     The allocatable components of pointers must not be touched.  */
+  if (sym_has_alloc_comp && !(sym->attr.function || sym->attr.result)
+      && !sym->attr.pointer && !sym->attr.save)
+    {
+      int rank;
+      rank = sym->as ? sym->as->rank : 0;
+      tmp = gfc_deallocate_alloc_comp (sym->ts.u.derived, descriptor, rank);
+      gfc_add_expr_to_block (&cleanup, tmp);
+    }
+
+  if (sym->attr.allocatable && sym->attr.dimension
+      && !sym->attr.save && !sym->attr.result)
+    {
+      tmp = gfc_trans_dealloc_allocated (sym->backend_decl);
+      gfc_add_expr_to_block (&cleanup, tmp);
+    }
+
+  gfc_add_init_cleanup (block, gfc_finish_block (&init),
+			gfc_finish_block (&cleanup));
+}
+
+/************ Expression Walking Functions ******************/
+
+/* Walk a variable reference.
+
+   Possible extension - multiple component subscripts.
+    x(:,:) = foo%a(:)%b(:)
+   Transforms to
+    forall (i=..., j=...)
+      x(i,j) = foo%a(j)%b(i)
+    end forall
+   This adds a fair amount of complexity because you need to deal with more
+   than one ref.  Maybe handle in a similar manner to vector subscripts.
+   Maybe not worth the effort.  */
+
+
+static gfc_ss *
+gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
+{
+  gfc_ref *ref;
+  gfc_array_ref *ar;
+  gfc_ss *newss;
+  int n;
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
+      break;
+
+  for (; ref; ref = ref->next)
+    {
+      if (ref->type == REF_SUBSTRING)
+	{
+	  newss = gfc_get_ss ();
+	  newss->type = GFC_SS_SCALAR;
+	  newss->expr = ref->u.ss.start;
+	  newss->next = ss;
+	  ss = newss;
+
+	  newss = gfc_get_ss ();
+	  newss->type = GFC_SS_SCALAR;
+	  newss->expr = ref->u.ss.end;
+	  newss->next = ss;
+	  ss = newss;
+	}
+
+      /* We're only interested in array sections from now on.  */
+      if (ref->type != REF_ARRAY)
+	continue;
+
+      ar = &ref->u.ar;
+
+      if (ar->as->rank == 0)
+	{
+	  /* Scalar coarray.  */
+	  continue;
+	}
+
+      switch (ar->type)
+	{
+	case AR_ELEMENT:
+	  for (n = 0; n < ar->dimen; n++)
+	    {
+	      newss = gfc_get_ss ();
+	      newss->type = GFC_SS_SCALAR;
+	      newss->expr = ar->start[n];
+	      newss->next = ss;
+	      ss = newss;
+	    }
+	  break;
+
+	case AR_FULL:
+	  newss = gfc_get_ss ();
+	  newss->type = GFC_SS_SECTION;
+	  newss->expr = expr;
+	  newss->next = ss;
+	  newss->data.info.dimen = ar->as->rank;
+	  newss->data.info.ref = ref;
+
+	  /* Make sure array is the same as array(:,:), this way
+	     we don't need to special case all the time.  */
+	  ar->dimen = ar->as->rank;
+	  for (n = 0; n < ar->dimen; n++)
+	    {
+	      newss->data.info.dim[n] = n;
+	      ar->dimen_type[n] = DIMEN_RANGE;
+
+	      gcc_assert (ar->start[n] == NULL);
+	      gcc_assert (ar->end[n] == NULL);
+	      gcc_assert (ar->stride[n] == NULL);
+	    }
+	  ss = newss;
+	  break;
+
+	case AR_SECTION:
+	  newss = gfc_get_ss ();
+	  newss->type = GFC_SS_SECTION;
+	  newss->expr = expr;
+	  newss->next = ss;
+	  newss->data.info.dimen = 0;
+	  newss->data.info.ref = ref;
+
+          /* We add SS chains for all the subscripts in the section.  */
+	  for (n = 0; n < ar->dimen; n++)
+	    {
+	      gfc_ss *indexss;
+
+	      switch (ar->dimen_type[n])
+		{
+		case DIMEN_ELEMENT:
+		  /* Add SS for elemental (scalar) subscripts.  */
+		  gcc_assert (ar->start[n]);
+		  indexss = gfc_get_ss ();
+		  indexss->type = GFC_SS_SCALAR;
+		  indexss->expr = ar->start[n];
+		  indexss->next = gfc_ss_terminator;
+		  indexss->loop_chain = gfc_ss_terminator;
+		  newss->data.info.subscript[n] = indexss;
+		  break;
+
+		case DIMEN_RANGE:
+                  /* We don't add anything for sections, just remember this
+                     dimension for later.  */
+		  newss->data.info.dim[newss->data.info.dimen] = n;
+		  newss->data.info.dimen++;
+		  break;
+
+		case DIMEN_VECTOR:
+		  /* Create a GFC_SS_VECTOR index in which we can store
+		     the vector's descriptor.  */
+		  indexss = gfc_get_ss ();
+		  indexss->type = GFC_SS_VECTOR;
+		  indexss->expr = ar->start[n];
+		  indexss->next = gfc_ss_terminator;
+		  indexss->loop_chain = gfc_ss_terminator;
+		  newss->data.info.subscript[n] = indexss;
+		  newss->data.info.dim[newss->data.info.dimen] = n;
+		  newss->data.info.dimen++;
+		  break;
+
+		default:
+		  /* We should know what sort of section it is by now.  */
+		  gcc_unreachable ();
+		}
+	    }
+	  /* We should have at least one non-elemental dimension.  */
+	  gcc_assert (newss->data.info.dimen > 0);
+	  ss = newss;
+	  break;
+
+	default:
+	  /* We should know what sort of section it is by now.  */
+	  gcc_unreachable ();
+	}
+
+    }
+  return ss;
+}
+
+
+/* Walk an expression operator. If only one operand of a binary expression is
+   scalar, we must also add the scalar term to the SS chain.  */
+
+static gfc_ss *
+gfc_walk_op_expr (gfc_ss * ss, gfc_expr * expr)
+{
+  gfc_ss *head;
+  gfc_ss *head2;
+  gfc_ss *newss;
+
+  head = gfc_walk_subexpr (ss, expr->value.op.op1);
+  if (expr->value.op.op2 == NULL)
+    head2 = head;
+  else
+    head2 = gfc_walk_subexpr (head, expr->value.op.op2);
+
+  /* All operands are scalar.  Pass back and let the caller deal with it.  */
+  if (head2 == ss)
+    return head2;
+
+  /* All operands require scalarization.  */
+  if (head != ss && (expr->value.op.op2 == NULL || head2 != head))
+    return head2;
+
+  /* One of the operands needs scalarization, the other is scalar.
+     Create a gfc_ss for the scalar expression.  */
+  newss = gfc_get_ss ();
+  newss->type = GFC_SS_SCALAR;
+  if (head == ss)
+    {
+      /* First operand is scalar.  We build the chain in reverse order, so
+         add the scalar SS after the second operand.  */
+      head = head2;
+      while (head && head->next != ss)
+	head = head->next;
+      /* Check we haven't somehow broken the chain.  */
+      gcc_assert (head);
+      newss->next = ss;
+      head->next = newss;
+      newss->expr = expr->value.op.op1;
+    }
+  else				/* head2 == head */
+    {
+      gcc_assert (head2 == head);
+      /* Second operand is scalar.  */
+      newss->next = head2;
+      head2 = newss;
+      newss->expr = expr->value.op.op2;
+    }
+
+  return head2;
+}
+
+
+/* Reverse a SS chain.  */
+
+gfc_ss *
+gfc_reverse_ss (gfc_ss * ss)
+{
+  gfc_ss *next;
+  gfc_ss *head;
+
+  gcc_assert (ss != NULL);
+
+  head = gfc_ss_terminator;
+  while (ss != gfc_ss_terminator)
+    {
+      next = ss->next;
+      /* Check we didn't somehow break the chain.  */
+      gcc_assert (next != NULL);
+      ss->next = head;
+      head = ss;
+      ss = next;
+    }
+
+  return (head);
+}
+
+
+/* Walk the arguments of an elemental function.  */
+
+gfc_ss *
+gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
+				  gfc_ss_type type)
+{
+  int scalar;
+  gfc_ss *head;
+  gfc_ss *tail;
+  gfc_ss *newss;
+
+  head = gfc_ss_terminator;
+  tail = NULL;
+  scalar = 1;
+  for (; arg; arg = arg->next)
+    {
+      if (!arg->expr || arg->expr->expr_type == EXPR_NULL)
+	continue;
+
+      newss = gfc_walk_subexpr (head, arg->expr);
+      if (newss == head)
+	{
+	  /* Scalar argument.  */
+	  newss = gfc_get_ss ();
+	  newss->type = type;
+	  newss->expr = arg->expr;
+	  newss->next = head;
+	}
+      else
+	scalar = 0;
+
+      head = newss;
+      if (!tail)
+        {
+          tail = head;
+          while (tail->next != gfc_ss_terminator)
+            tail = tail->next;
+        }
+    }
+
+  if (scalar)
+    {
+      /* If all the arguments are scalar we don't need the argument SS.  */
+      gfc_free_ss_chain (head);
+      /* Pass it back.  */
+      return ss;
+    }
+
+  /* Add it onto the existing chain.  */
+  tail->next = ss;
+  return head;
+}
+
+
+/* Walk a function call.  Scalar functions are passed back, and taken out of
+   scalarization loops.  For elemental functions we walk their arguments.
+   The result of functions returning arrays is stored in a temporary outside
+   the loop, so that the function is only called once.  Hence we do not need
+   to walk their arguments.  */
+
+static gfc_ss *
+gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr)
+{
+  gfc_ss *newss;
+  gfc_intrinsic_sym *isym;
+  gfc_symbol *sym;
+  gfc_component *comp = NULL;
+  int n;
+
+  isym = expr->value.function.isym;
+
+  /* Handle intrinsic functions separately.  */
+  if (isym)
+    return gfc_walk_intrinsic_function (ss, expr, isym);
+
+  sym = expr->value.function.esym;
+  if (!sym)
+      sym = expr->symtree->n.sym;
+
+  /* A function that returns arrays.  */
+  gfc_is_proc_ptr_comp (expr, &comp);
+  if ((!comp && gfc_return_by_reference (sym) && sym->result->attr.dimension)
+      || (comp && comp->attr.dimension))
+    {
+      newss = gfc_get_ss ();
+      newss->type = GFC_SS_FUNCTION;
+      newss->expr = expr;
+      newss->next = ss;
+      newss->data.info.dimen = expr->rank;
+      for (n = 0; n < newss->data.info.dimen; n++)
+	newss->data.info.dim[n] = n;
+      return newss;
+    }
+
+  /* Walk the parameters of an elemental function.  For now we always pass
+     by reference.  */
+  if (sym->attr.elemental)
+    return gfc_walk_elemental_function_args (ss, expr->value.function.actual,
+					     GFC_SS_REFERENCE);
+
+  /* Scalar functions are OK as these are evaluated outside the scalarization
+     loop.  Pass back and let the caller deal with it.  */
+  return ss;
+}
+
+
+/* An array temporary is constructed for array constructors.  */
+
+static gfc_ss *
+gfc_walk_array_constructor (gfc_ss * ss, gfc_expr * expr)
+{
+  gfc_ss *newss;
+  int n;
+
+  newss = gfc_get_ss ();
+  newss->type = GFC_SS_CONSTRUCTOR;
+  newss->expr = expr;
+  newss->next = ss;
+  newss->data.info.dimen = expr->rank;
+  for (n = 0; n < expr->rank; n++)
+    newss->data.info.dim[n] = n;
+
+  return newss;
+}
+
+
+/* Walk an expression.  Add walked expressions to the head of the SS chain.
+   A wholly scalar expression will not be added.  */
+
+gfc_ss *
+gfc_walk_subexpr (gfc_ss * ss, gfc_expr * expr)
+{
+  gfc_ss *head;
+
+  switch (expr->expr_type)
+    {
+    case EXPR_VARIABLE:
+      head = gfc_walk_variable_expr (ss, expr);
+      return head;
+
+    case EXPR_OP:
+      head = gfc_walk_op_expr (ss, expr);
+      return head;
+
+    case EXPR_FUNCTION:
+      head = gfc_walk_function_expr (ss, expr);
+      return head;
+
+    case EXPR_CONSTANT:
+    case EXPR_NULL:
+    case EXPR_STRUCTURE:
+      /* Pass back and let the caller deal with it.  */
+      break;
+
+    case EXPR_ARRAY:
+      head = gfc_walk_array_constructor (ss, expr);
+      return head;
+
+    case EXPR_SUBSTRING:
+      /* Pass back and let the caller deal with it.  */
+      break;
+
+    default:
+      internal_error ("bad expression type during walk (%d)",
+		      expr->expr_type);
+    }
+  return ss;
+}
+
+
+/* Entry point for expression walking.
+   A return value equal to the passed chain means this is
+   a scalar expression.  It is up to the caller to take whatever action is
+   necessary to translate these.  */
+
+gfc_ss *
+gfc_walk_expr (gfc_expr * expr)
+{
+  gfc_ss *res;
+
+  res = gfc_walk_subexpr (gfc_ss_terminator, expr);
+  return gfc_reverse_ss (res);
+}
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
new file mode 100644
index 000000000..1b3575969
--- /dev/null
+++ b/gcc/fortran/trans-array.h
@@ -0,0 +1,166 @@
+/* Header for array handling functions
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* Generate code to free an array.  */
+tree gfc_array_deallocate (tree, tree, gfc_expr*);
+
+/* Generate code to initialize an allocate an array.  Statements are added to
+   se, which should contain an expression for the array descriptor.  */
+bool gfc_array_allocate (gfc_se *, gfc_expr *, tree);
+
+/* Allow the bounds of a loop to be set from a callee's array spec.  */
+void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
+					  gfc_se *, gfc_array_spec *);
+
+/* Generate code to create a temporary array.  */
+tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *,
+				  gfc_ss_info *, tree, tree, bool, bool, bool,
+				  locus *);
+
+/* Generate function entry code for allocation of compiler allocated array
+   variables.  */
+void gfc_trans_auto_array_allocation (tree, gfc_symbol *, gfc_wrapped_block *);
+/* Generate entry and exit code for dummy array parameters.  */
+void gfc_trans_dummy_array_bias (gfc_symbol *, tree, gfc_wrapped_block *);
+/* Generate entry and exit code for g77 calling convention arrays.  */
+void gfc_trans_g77_array (gfc_symbol *, gfc_wrapped_block *);
+/* Generate code to deallocate an array, if it is allocated.  */
+tree gfc_trans_dealloc_allocated (tree);
+
+tree gfc_duplicate_allocatable (tree dest, tree src, tree type, int rank);
+
+tree gfc_copy_allocatable_data (tree dest, tree src, tree type, int rank);
+
+tree gfc_nullify_alloc_comp (gfc_symbol *, tree, int);
+
+tree gfc_deallocate_alloc_comp (gfc_symbol *, tree, int);
+
+tree gfc_copy_alloc_comp (gfc_symbol *, tree, tree, int);
+
+tree gfc_copy_only_alloc_comp (gfc_symbol *, tree, tree, int);
+
+tree gfc_alloc_allocatable_for_assignment (gfc_loopinfo*, gfc_expr*, gfc_expr*);
+
+bool gfc_is_reallocatable_lhs (gfc_expr *);
+
+/* Add initialization for deferred arrays.  */
+void gfc_trans_deferred_array (gfc_symbol *, gfc_wrapped_block *);
+/* Generate an initializer for a static pointer or allocatable array.  */
+void gfc_trans_static_array_pointer (gfc_symbol *);
+
+/* Generate scalarization information for an expression.  */
+gfc_ss *gfc_walk_expr (gfc_expr *);
+/* Workhorse for gfc_walk_expr.  */
+gfc_ss *gfc_walk_subexpr (gfc_ss *, gfc_expr *);
+/* Walk the arguments of an elemental function.  */
+gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_actual_arglist *,
+					  gfc_ss_type);
+/* Walk an intrinsic function.  */
+gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *,
+				     gfc_intrinsic_sym *);
+/* Reverse the order of an SS chain.  */
+gfc_ss *gfc_reverse_ss (gfc_ss *);
+
+/* Free the SS associated with a loop.  */
+void gfc_cleanup_loop (gfc_loopinfo *);
+/* Associate a SS chain with a loop.  */
+void gfc_add_ss_to_loop (gfc_loopinfo *, gfc_ss *);
+/* Mark a SS chain as used in this loop.  */
+void gfc_mark_ss_chain_used (gfc_ss *, unsigned);
+/* Free a gfc_ss chain.  */
+void gfc_free_ss_chain (gfc_ss *);
+
+/* Calculates the lower bound and stride of array sections.  */
+void gfc_conv_ss_startstride (gfc_loopinfo *);
+
+void gfc_init_loopinfo (gfc_loopinfo *);
+void gfc_copy_loopinfo_to_se (gfc_se *, gfc_loopinfo *);
+
+/* Marks the start of a scalarized expression, and declares loop variables.  */
+void gfc_start_scalarized_body (gfc_loopinfo *, stmtblock_t *);
+/* Generates one actual loop for a scalarized expression.  */
+void  gfc_trans_scalarized_loop_end (gfc_loopinfo *, int, stmtblock_t *);
+/* Generates the actual loops for a scalarized expression.  */
+void gfc_trans_scalarizing_loops (gfc_loopinfo *, stmtblock_t *);
+/* Mark the end of the main loop body and the start of the copying loop.  */
+void gfc_trans_scalarized_loop_boundary (gfc_loopinfo *, stmtblock_t *);
+/* Initialize the scalarization loop parameters.  */
+void gfc_conv_loop_setup (gfc_loopinfo *, locus *);
+/* Resolve array assignment dependencies.  */
+void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *);
+/* Build a null array descriptor constructor.  */
+tree gfc_build_null_descriptor (tree);
+
+/* Get a single array element.  */
+void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_symbol *, locus *);
+/* Translate a reference to a temporary array.  */
+void gfc_conv_tmp_array_ref (gfc_se * se);
+/* Translate a reference to an array temporary.  */
+void gfc_conv_tmp_ref (gfc_se *);
+
+/* Evaluate an array expression.  */
+void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *, gfc_ss *);
+/* Convert an array for passing as an actual function parameter.  */
+void gfc_conv_array_parameter (gfc_se *, gfc_expr *, gfc_ss *, bool,
+			       const gfc_symbol *, const char *, tree *);
+/* Evaluate and transpose a matrix expression.  */
+void gfc_conv_array_transpose (gfc_se *, gfc_expr *);
+
+/* These work with both descriptors and descriptorless arrays.  */
+tree gfc_conv_array_data (tree);
+tree gfc_conv_array_offset (tree);
+/* Return either an INT_CST or an expression for that part of the descriptor.  */
+tree gfc_conv_array_stride (tree, int);
+tree gfc_conv_array_lbound (tree, int);
+tree gfc_conv_array_ubound (tree, int);
+
+/* Build expressions for accessing components of an array descriptor.  */
+tree gfc_conv_descriptor_data_get (tree);
+tree gfc_conv_descriptor_data_addr (tree);
+tree gfc_conv_descriptor_offset_get (tree);
+tree gfc_conv_descriptor_dtype (tree);
+tree gfc_conv_descriptor_stride_get (tree, tree);
+tree gfc_conv_descriptor_lbound_get (tree, tree);
+tree gfc_conv_descriptor_ubound_get (tree, tree);
+
+void gfc_conv_descriptor_data_set (stmtblock_t *, tree, tree);
+void gfc_conv_descriptor_offset_set (stmtblock_t *, tree, tree);
+void gfc_conv_descriptor_stride_set (stmtblock_t *, tree, tree, tree);
+void gfc_conv_descriptor_lbound_set (stmtblock_t *, tree, tree, tree);
+void gfc_conv_descriptor_ubound_set (stmtblock_t *, tree, tree, tree);
+
+/* Shift lower bound of descriptor, updating ubound and offset.  */
+void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
+
+/* Add pre-loop scalarization code for intrinsic functions which require
+   special handling.  */
+void gfc_add_intrinsic_ss_code (gfc_loopinfo *, gfc_ss *);
+
+/* Functions for constant array constructor processing.  */
+unsigned HOST_WIDE_INT gfc_constant_array_constructor_p (gfc_constructor_base);
+tree gfc_build_constant_array_constructor (gfc_expr *, tree);
+
+/* Copy a string from src to dest.  */
+void gfc_trans_string_copy (stmtblock_t *, tree, tree, int, tree, tree, int);
+
+/* Calculate extent / size of an array.  */
+tree gfc_conv_array_extent_dim (tree, tree, tree*);
+tree gfc_conv_descriptor_size (tree, int);
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
new file mode 100644
index 000000000..08c6f8fd9
--- /dev/null
+++ b/gcc/fortran/trans-common.c
@@ -0,0 +1,1258 @@
+/* Common block and equivalence list handling
+   Copyright (C) 2000, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Canqun Yang <canqun@nudt.edu.cn>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */     
+
+/* The core algorithm is based on Andy Vaught's g95 tree.  Also the
+   way to build UNION_TYPE is borrowed from Richard Henderson.
+ 
+   Transform common blocks.  An integral part of this is processing
+   equivalence variables.  Equivalenced variables that are not in a
+   common block end up in a private block of their own.
+
+   Each common block or local equivalence list is declared as a union.
+   Variables within the block are represented as a field within the
+   block with the proper offset. 
+ 
+   So if two variables are equivalenced, they just point to a common
+   area in memory.
+ 
+   Mathematically, laying out an equivalence block is equivalent to
+   solving a linear system of equations.  The matrix is usually a
+   sparse matrix in which each row contains all zero elements except
+   for a +1 and a -1, a sort of a generalized Vandermonde matrix.  The
+   matrix is usually block diagonal.  The system can be
+   overdetermined, underdetermined or have a unique solution.  If the
+   system is inconsistent, the program is not standard conforming.
+   The solution vector is integral, since all of the pivots are +1 or -1.
+ 
+   How we lay out an equivalence block is a little less complicated.
+   In an equivalence list with n elements, there are n-1 conditions to
+   be satisfied.  The conditions partition the variables into what we
+   will call segments.  If A and B are equivalenced then A and B are
+   in the same segment.  If B and C are equivalenced as well, then A,
+   B and C are in a segment and so on.  Each segment is a block of
+   memory that has one or more variables equivalenced in some way.  A
+   common block is made up of a series of segments that are joined one
+   after the other.  In the linear system, a segment is a block
+   diagonal.
+ 
+   To lay out a segment we first start with some variable and
+   determine its length.  The first variable is assumed to start at
+   offset one and extends to however long it is.  We then traverse the
+   list of equivalences to find an unused condition that involves at
+   least one of the variables currently in the segment.
+ 
+   Each equivalence condition amounts to the condition B+b=C+c where B
+   and C are the offsets of the B and C variables, and b and c are
+   constants which are nonzero for array elements, substrings or
+   structure components.  So for
+ 
+     EQUIVALENCE(B(2), C(3))
+   we have
+     B + 2*size of B's elements = C + 3*size of C's elements.
+ 
+   If B and C are known we check to see if the condition already
+   holds.  If B is known we can solve for C.  Since we know the length
+   of C, we can see if the minimum and maximum extents of the segment
+   are affected.  Eventually, we make a full pass through the
+   equivalence list without finding any new conditions and the segment
+   is fully specified.
+ 
+   At this point, the segment is added to the current common block.
+   Since we know the minimum extent of the segment, everything in the
+   segment is translated to its position in the common block.  The
+   usual case here is that there are no equivalence statements and the
+   common block is series of segments with one variable each, which is
+   a diagonal matrix in the matrix formulation.
+ 
+   Each segment is described by a chain of segment_info structures.  Each
+   segment_info structure describes the extents of a single variable within
+   the segment.  This list is maintained in the order the elements are
+   positioned withing the segment.  If two elements have the same starting
+   offset the smaller will come first.  If they also have the same size their
+   ordering is undefined. 
+   
+   Once all common blocks have been created, the list of equivalences
+   is examined for still-unused equivalence conditions.  We create a
+   block for each merged equivalence list.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "tree.h"
+#include "output.h"	/* For decl_default_tls_model.  */
+#include "gfortran.h"
+#include "trans.h"
+#include "trans-types.h"
+#include "trans-const.h"
+#include "target-memory.h"
+
+
+/* Holds a single variable in an equivalence set.  */
+typedef struct segment_info
+{
+  gfc_symbol *sym;
+  HOST_WIDE_INT offset;
+  HOST_WIDE_INT length;
+  /* This will contain the field type until the field is created.  */
+  tree field;
+  struct segment_info *next;
+} segment_info;
+
+static segment_info * current_segment;
+static gfc_namespace *gfc_common_ns = NULL;
+
+
+/* Make a segment_info based on a symbol.  */
+
+static segment_info *
+get_segment_info (gfc_symbol * sym, HOST_WIDE_INT offset)
+{
+  segment_info *s;
+
+  /* Make sure we've got the character length.  */
+  if (sym->ts.type == BT_CHARACTER)
+    gfc_conv_const_charlen (sym->ts.u.cl);
+
+  /* Create the segment_info and fill it in.  */
+  s = (segment_info *) gfc_getmem (sizeof (segment_info));
+  s->sym = sym;
+  /* We will use this type when building the segment aggregate type.  */
+  s->field = gfc_sym_type (sym);
+  s->length = int_size_in_bytes (s->field);
+  s->offset = offset;
+
+  return s;
+}
+
+
+/* Add a copy of a segment list to the namespace.  This is specifically for
+   equivalence segments, so that dependency checking can be done on
+   equivalence group members.  */
+
+static void
+copy_equiv_list_to_ns (segment_info *c)
+{
+  segment_info *f;
+  gfc_equiv_info *s;
+  gfc_equiv_list *l;
+
+  l = (gfc_equiv_list *) gfc_getmem (sizeof (gfc_equiv_list));
+
+  l->next = c->sym->ns->equiv_lists;
+  c->sym->ns->equiv_lists = l;
+
+  for (f = c; f; f = f->next)
+    {
+      s = (gfc_equiv_info *) gfc_getmem (sizeof (gfc_equiv_info));
+      s->next = l->equiv;
+      l->equiv = s;
+      s->sym = f->sym;
+      s->offset = f->offset;
+      s->length = f->length;
+    }
+}
+
+
+/* Add combine segment V and segment LIST.  */
+
+static segment_info *
+add_segments (segment_info *list, segment_info *v)
+{
+  segment_info *s;
+  segment_info *p;
+  segment_info *next;
+
+  p = NULL;
+  s = list;
+
+  while (v)
+    {
+      /* Find the location of the new element.  */
+      while (s)
+	{
+	  if (v->offset < s->offset)
+	    break;
+	  if (v->offset == s->offset
+	      && v->length <= s->length)
+	    break;
+
+	  p = s;
+	  s = s->next;
+	}
+
+      /* Insert the new element in between p and s.  */
+      next = v->next;
+      v->next = s;
+      if (p == NULL)
+	list = v;
+      else
+	p->next = v;
+
+      p = v;
+      v = next;
+    }
+
+  return list;
+}
+
+
+/* Construct mangled common block name from symbol name.  */
+
+/* We need the bind(c) flag to tell us how/if we should mangle the symbol
+   name.  There are few calls to this function, so few places that this
+   would need to be added.  At the moment, there is only one call, in
+   build_common_decl().  We can't attempt to look up the common block
+   because we may be building it for the first time and therefore, it won't
+   be in the common_root.  We also need the binding label, if it's bind(c).
+   Therefore, send in the pointer to the common block, so whatever info we
+   have so far can be used.  All of the necessary info should be available
+   in the gfc_common_head by now, so it should be accurate to test the
+   isBindC flag and use the binding label given if it is bind(c).
+
+   We may NOT know yet if it's bind(c) or not, but we can try at least.
+   Will have to figure out what to do later if it's labeled bind(c)
+   after this is called.  */
+
+static tree
+gfc_sym_mangled_common_id (gfc_common_head *com)
+{
+  int has_underscore;
+  char mangled_name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+
+  /* Get the name out of the common block pointer.  */
+  strcpy (name, com->name);
+
+  /* If we're suppose to do a bind(c).  */
+  if (com->is_bind_c == 1 && com->binding_label[0] != '\0')
+    return get_identifier (com->binding_label);
+
+  if (strcmp (name, BLANK_COMMON_NAME) == 0)
+    return get_identifier (name);
+
+  if (gfc_option.flag_underscoring)
+    {
+      has_underscore = strchr (name, '_') != 0;
+      if (gfc_option.flag_second_underscore && has_underscore)
+        snprintf (mangled_name, sizeof mangled_name, "%s__", name);
+      else
+        snprintf (mangled_name, sizeof mangled_name, "%s_", name);
+
+      return get_identifier (mangled_name);
+    }
+  else
+    return get_identifier (name);
+}
+
+
+/* Build a field declaration for a common variable or a local equivalence
+   object.  */
+
+static void
+build_field (segment_info *h, tree union_type, record_layout_info rli)
+{
+  tree field;
+  tree name;
+  HOST_WIDE_INT offset = h->offset;
+  unsigned HOST_WIDE_INT desired_align, known_align;
+
+  name = get_identifier (h->sym->name);
+  field = build_decl (h->sym->declared_at.lb->location,
+		      FIELD_DECL, name, h->field);
+  known_align = (offset & -offset) * BITS_PER_UNIT;
+  if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
+    known_align = BIGGEST_ALIGNMENT;
+
+  desired_align = update_alignment_for_field (rli, field, known_align);
+  if (desired_align > known_align)
+    DECL_PACKED (field) = 1;
+
+  DECL_FIELD_CONTEXT (field) = union_type;
+  DECL_FIELD_OFFSET (field) = size_int (offset);
+  DECL_FIELD_BIT_OFFSET (field) = bitsize_zero_node;
+  SET_DECL_OFFSET_ALIGN (field, known_align);
+
+  rli->offset = size_binop (MAX_EXPR, rli->offset,
+                            size_binop (PLUS_EXPR,
+                                        DECL_FIELD_OFFSET (field),
+                                        DECL_SIZE_UNIT (field)));
+  /* If this field is assigned to a label, we create another two variables.
+     One will hold the address of target label or format label. The other will
+     hold the length of format label string.  */
+  if (h->sym->attr.assign)
+    {
+      tree len;
+      tree addr;
+
+      gfc_allocate_lang_decl (field);
+      GFC_DECL_ASSIGN (field) = 1;
+      len = gfc_create_var_np (gfc_charlen_type_node,h->sym->name);
+      addr = gfc_create_var_np (pvoid_type_node, h->sym->name);
+      TREE_STATIC (len) = 1;
+      TREE_STATIC (addr) = 1;
+      DECL_INITIAL (len) = build_int_cst (NULL_TREE, -2);
+      gfc_set_decl_location (len, &h->sym->declared_at);
+      gfc_set_decl_location (addr, &h->sym->declared_at);
+      GFC_DECL_STRING_LEN (field) = pushdecl_top_level (len);
+      GFC_DECL_ASSIGN_ADDR (field) = pushdecl_top_level (addr);
+    }
+
+  /* If this field is volatile, mark it.  */
+  if (h->sym->attr.volatile_)
+    {
+      tree new_type;
+      TREE_THIS_VOLATILE (field) = 1;
+      TREE_SIDE_EFFECTS (field) = 1;
+      new_type = build_qualified_type (TREE_TYPE (field), TYPE_QUAL_VOLATILE);
+      TREE_TYPE (field) = new_type;
+    }
+
+  h->field = field;
+}
+
+
+/* Get storage for local equivalence.  */
+
+static tree
+build_equiv_decl (tree union_type, bool is_init, bool is_saved)
+{
+  tree decl;
+  char name[15];
+  static int serial = 0;
+
+  if (is_init)
+    {
+      decl = gfc_create_var (union_type, "equiv");
+      TREE_STATIC (decl) = 1;
+      GFC_DECL_COMMON_OR_EQUIV (decl) = 1;
+      return decl;
+    }
+
+  snprintf (name, sizeof (name), "equiv.%d", serial++);
+  decl = build_decl (input_location,
+		     VAR_DECL, get_identifier (name), union_type);
+  DECL_ARTIFICIAL (decl) = 1;
+  DECL_IGNORED_P (decl) = 1;
+
+  if (!gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
+      || is_saved)
+    TREE_STATIC (decl) = 1;
+
+  TREE_ADDRESSABLE (decl) = 1;
+  TREE_USED (decl) = 1;
+  GFC_DECL_COMMON_OR_EQUIV (decl) = 1;
+
+  /* The source location has been lost, and doesn't really matter.
+     We need to set it to something though.  */
+  gfc_set_decl_location (decl, &gfc_current_locus);
+
+  gfc_add_decl_to_function (decl);
+
+  return decl;
+}
+
+
+/* Get storage for common block.  */
+
+static tree
+build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
+{
+  gfc_symbol *common_sym;
+  tree decl;
+
+  /* Create a namespace to store symbols for common blocks.  */
+  if (gfc_common_ns == NULL)
+    gfc_common_ns = gfc_get_namespace (NULL, 0);
+
+  gfc_get_symbol (com->name, gfc_common_ns, &common_sym);
+  decl = common_sym->backend_decl;
+
+  /* Update the size of this common block as needed.  */
+  if (decl != NULL_TREE)
+    {
+      tree size = TYPE_SIZE_UNIT (union_type);
+      if (tree_int_cst_lt (DECL_SIZE_UNIT (decl), size))
+        {
+	  /* Named common blocks of the same name shall be of the same size
+	     in all scoping units of a program in which they appear, but
+	     blank common blocks may be of different sizes.  */
+	  if (strcmp (com->name, BLANK_COMMON_NAME))
+	    gfc_warning ("Named COMMON block '%s' at %L shall be of the "
+			 "same size", com->name, &com->where);
+	  DECL_SIZE (decl) = TYPE_SIZE (union_type);
+	  DECL_SIZE_UNIT (decl) = size;
+	  DECL_MODE (decl) = TYPE_MODE (union_type);
+	  TREE_TYPE (decl) = union_type;
+	  layout_decl (decl, 0);
+	}
+     }
+
+  /* If this common block has been declared in a previous program unit,
+     and either it is already initialized or there is no new initialization
+     for it, just return.  */
+  if ((decl != NULL_TREE) && (!is_init || DECL_INITIAL (decl)))
+    return decl;
+
+  /* If there is no backend_decl for the common block, build it.  */
+  if (decl == NULL_TREE)
+    {
+      decl = build_decl (input_location,
+			 VAR_DECL, get_identifier (com->name), union_type);
+      gfc_set_decl_assembler_name (decl, gfc_sym_mangled_common_id (com));
+      TREE_PUBLIC (decl) = 1;
+      TREE_STATIC (decl) = 1;
+      DECL_IGNORED_P (decl) = 1;
+      if (!com->is_bind_c)
+	DECL_ALIGN (decl) = BIGGEST_ALIGNMENT;
+      else
+        {
+	  /* Do not set the alignment for bind(c) common blocks to
+	     BIGGEST_ALIGNMENT because that won't match what C does.  Also,
+	     for common blocks with one element, the alignment must be
+	     that of the field within the common block in order to match
+	     what C will do.  */
+	  tree field = NULL_TREE;
+	  field = TYPE_FIELDS (TREE_TYPE (decl));
+	  if (DECL_CHAIN (field) == NULL_TREE)
+	    DECL_ALIGN (decl) = TYPE_ALIGN (TREE_TYPE (field));
+	}
+      DECL_USER_ALIGN (decl) = 0;
+      GFC_DECL_COMMON_OR_EQUIV (decl) = 1;
+
+      gfc_set_decl_location (decl, &com->where);
+
+      if (com->threadprivate)
+	DECL_TLS_MODEL (decl) = decl_default_tls_model (decl);
+
+      /* Place the back end declaration for this common block in
+         GLOBAL_BINDING_LEVEL.  */
+      common_sym->backend_decl = pushdecl_top_level (decl);
+    }
+
+  /* Has no initial values.  */
+  if (!is_init)
+    {
+      DECL_INITIAL (decl) = NULL_TREE;
+      DECL_COMMON (decl) = 1;
+      DECL_DEFER_OUTPUT (decl) = 1;
+    }
+  else
+    {
+      DECL_INITIAL (decl) = error_mark_node;
+      DECL_COMMON (decl) = 0;
+      DECL_DEFER_OUTPUT (decl) = 0;
+    }
+  return decl;
+}
+
+
+/* Return a field that is the size of the union, if an equivalence has
+   overlapping initializers.  Merge the initializers into a single
+   initializer for this new field, then free the old ones.  */ 
+
+static tree
+get_init_field (segment_info *head, tree union_type, tree *field_init,
+		record_layout_info rli)
+{
+  segment_info *s;
+  HOST_WIDE_INT length = 0;
+  HOST_WIDE_INT offset = 0;
+  unsigned HOST_WIDE_INT known_align, desired_align;
+  bool overlap = false;
+  tree tmp, field;
+  tree init;
+  unsigned char *data, *chk;
+  VEC(constructor_elt,gc) *v = NULL;
+
+  tree type = unsigned_char_type_node;
+  int i;
+
+  /* Obtain the size of the union and check if there are any overlapping
+     initializers.  */
+  for (s = head; s; s = s->next)
+    {
+      HOST_WIDE_INT slen = s->offset + s->length;
+      if (s->sym->value)
+	{
+	  if (s->offset < offset)
+            overlap = true;
+	  offset = slen;
+	}
+      length = length < slen ? slen : length;
+    }
+
+  if (!overlap)
+    return NULL_TREE;
+
+  /* Now absorb all the initializer data into a single vector,
+     whilst checking for overlapping, unequal values.  */
+  data = (unsigned char*)gfc_getmem ((size_t)length);
+  chk = (unsigned char*)gfc_getmem ((size_t)length);
+
+  /* TODO - change this when default initialization is implemented.  */
+  memset (data, '\0', (size_t)length);
+  memset (chk, '\0', (size_t)length);
+  for (s = head; s; s = s->next)
+    if (s->sym->value)
+      gfc_merge_initializers (s->sym->ts, s->sym->value,
+			      &data[s->offset],
+			      &chk[s->offset],
+			     (size_t)s->length);
+  
+  for (i = 0; i < length; i++)
+    CONSTRUCTOR_APPEND_ELT (v, NULL, build_int_cst (type, data[i]));
+
+  gfc_free (data);
+  gfc_free (chk);
+
+  /* Build a char[length] array to hold the initializers.  Much of what
+     follows is borrowed from build_field, above.  */
+
+  tmp = build_int_cst (gfc_array_index_type, length - 1);
+  tmp = build_range_type (gfc_array_index_type,
+			  gfc_index_zero_node, tmp);
+  tmp = build_array_type (type, tmp);
+  field = build_decl (gfc_current_locus.lb->location,
+		      FIELD_DECL, NULL_TREE, tmp);
+
+  known_align = BIGGEST_ALIGNMENT;
+
+  desired_align = update_alignment_for_field (rli, field, known_align);
+  if (desired_align > known_align)
+    DECL_PACKED (field) = 1;
+
+  DECL_FIELD_CONTEXT (field) = union_type;
+  DECL_FIELD_OFFSET (field) = size_int (0);
+  DECL_FIELD_BIT_OFFSET (field) = bitsize_zero_node;
+  SET_DECL_OFFSET_ALIGN (field, known_align);
+
+  rli->offset = size_binop (MAX_EXPR, rli->offset,
+                            size_binop (PLUS_EXPR,
+                                        DECL_FIELD_OFFSET (field),
+                                        DECL_SIZE_UNIT (field)));
+
+  init = build_constructor (TREE_TYPE (field), v);
+  TREE_CONSTANT (init) = 1;
+
+  *field_init = init;
+
+  for (s = head; s; s = s->next)
+    {
+      if (s->sym->value == NULL)
+	continue;
+
+      gfc_free_expr (s->sym->value);
+      s->sym->value = NULL;
+    }
+
+  return field;
+}
+
+
+/* Declare memory for the common block or local equivalence, and create
+   backend declarations for all of the elements.  */
+
+static void
+create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
+{
+  segment_info *s, *next_s;
+  tree union_type;
+  tree *field_link;
+  tree field;
+  tree field_init = NULL_TREE;
+  record_layout_info rli;
+  tree decl;
+  bool is_init = false;
+  bool is_saved = false;
+
+  /* Declare the variables inside the common block.
+     If the current common block contains any equivalence object, then
+     make a UNION_TYPE node, otherwise RECORD_TYPE. This will let the
+     alias analyzer work well when there is no address overlapping for
+     common variables in the current common block.  */
+  if (saw_equiv)
+    union_type = make_node (UNION_TYPE);
+  else
+    union_type = make_node (RECORD_TYPE);
+
+  rli = start_record_layout (union_type);
+  field_link = &TYPE_FIELDS (union_type);
+
+  /* Check for overlapping initializers and replace them with a single,
+     artificial field that contains all the data.  */
+  if (saw_equiv)
+    field = get_init_field (head, union_type, &field_init, rli);
+  else
+    field = NULL_TREE;
+
+  if (field != NULL_TREE)
+    {
+      is_init = true;
+      *field_link = field;
+      field_link = &DECL_CHAIN (field);
+    }
+
+  for (s = head; s; s = s->next)
+    {
+      build_field (s, union_type, rli);
+
+      /* Link the field into the type.  */
+      *field_link = s->field;
+      field_link = &DECL_CHAIN (s->field);
+
+      /* Has initial value.  */
+      if (s->sym->value)
+        is_init = true;
+
+      /* Has SAVE attribute.  */
+      if (s->sym->attr.save)
+        is_saved = true;
+    }
+
+  finish_record_layout (rli, true);
+
+  if (com)
+    decl = build_common_decl (com, union_type, is_init);
+  else
+    decl = build_equiv_decl (union_type, is_init, is_saved);
+
+  if (is_init)
+    {
+      tree ctor, tmp;
+      VEC(constructor_elt,gc) *v = NULL;
+
+      if (field != NULL_TREE && field_init != NULL_TREE)
+	CONSTRUCTOR_APPEND_ELT (v, field, field_init);
+      else
+	for (s = head; s; s = s->next)
+	  {
+	    if (s->sym->value)
+	      {
+		/* Add the initializer for this field.  */
+		tmp = gfc_conv_initializer (s->sym->value, &s->sym->ts,
+					    TREE_TYPE (s->field),
+					    s->sym->attr.dimension,
+					    s->sym->attr.pointer
+					    || s->sym->attr.allocatable, false);
+
+		CONSTRUCTOR_APPEND_ELT (v, s->field, tmp);
+	      }
+	  }
+
+      gcc_assert (!VEC_empty (constructor_elt, v));
+      ctor = build_constructor (union_type, v);
+      TREE_CONSTANT (ctor) = 1;
+      TREE_STATIC (ctor) = 1;
+      DECL_INITIAL (decl) = ctor;
+
+#ifdef ENABLE_CHECKING
+      {
+	tree field, value;
+	unsigned HOST_WIDE_INT idx;
+	FOR_EACH_CONSTRUCTOR_ELT (CONSTRUCTOR_ELTS (ctor), idx, field, value)
+	  gcc_assert (TREE_CODE (field) == FIELD_DECL);
+      }
+#endif
+    }
+
+  /* Build component reference for each variable.  */
+  for (s = head; s; s = next_s)
+    {
+      tree var_decl;
+
+      var_decl = build_decl (s->sym->declared_at.lb->location,
+			     VAR_DECL, DECL_NAME (s->field),
+			     TREE_TYPE (s->field));
+      TREE_STATIC (var_decl) = TREE_STATIC (decl);
+      TREE_USED (var_decl) = TREE_USED (decl);
+      if (s->sym->attr.use_assoc)
+	DECL_IGNORED_P (var_decl) = 1;
+      if (s->sym->attr.target)
+	TREE_ADDRESSABLE (var_decl) = 1;
+      /* This is a fake variable just for debugging purposes.  */
+      TREE_ASM_WRITTEN (var_decl) = 1;
+      /* Fake variables are not visible from other translation units. */
+      TREE_PUBLIC (var_decl) = 0;
+
+      /* To preserve identifier names in COMMON, chain to procedure
+         scope unless at top level in a module definition.  */
+      if (com
+          && s->sym->ns->proc_name
+          && s->sym->ns->proc_name->attr.flavor == FL_MODULE)
+	var_decl = pushdecl_top_level (var_decl);
+      else
+	gfc_add_decl_to_function (var_decl);
+
+      SET_DECL_VALUE_EXPR (var_decl,
+			   fold_build3_loc (input_location, COMPONENT_REF,
+					    TREE_TYPE (s->field),
+					    decl, s->field, NULL_TREE));
+      DECL_HAS_VALUE_EXPR_P (var_decl) = 1;
+      GFC_DECL_COMMON_OR_EQUIV (var_decl) = 1;
+
+      if (s->sym->attr.assign)
+	{
+	  gfc_allocate_lang_decl (var_decl);
+	  GFC_DECL_ASSIGN (var_decl) = 1;
+	  GFC_DECL_STRING_LEN (var_decl) = GFC_DECL_STRING_LEN (s->field);
+	  GFC_DECL_ASSIGN_ADDR (var_decl) = GFC_DECL_ASSIGN_ADDR (s->field);
+	}
+
+      s->sym->backend_decl = var_decl;
+
+      next_s = s->next;
+      gfc_free (s);
+    }
+}
+
+
+/* Given a symbol, find it in the current segment list. Returns NULL if
+   not found.  */
+
+static segment_info *
+find_segment_info (gfc_symbol *symbol)
+{
+  segment_info *n;
+
+  for (n = current_segment; n; n = n->next)
+    {
+      if (n->sym == symbol)
+	return n;
+    }
+
+  return NULL;
+}
+
+
+/* Given an expression node, make sure it is a constant integer and return
+   the mpz_t value.  */
+
+static mpz_t *
+get_mpz (gfc_expr *e)
+{
+
+  if (e->expr_type != EXPR_CONSTANT)
+    gfc_internal_error ("get_mpz(): Not an integer constant");
+
+  return &e->value.integer;
+}
+
+
+/* Given an array specification and an array reference, figure out the
+   array element number (zero based). Bounds and elements are guaranteed
+   to be constants.  If something goes wrong we generate an error and
+   return zero.  */
+ 
+static HOST_WIDE_INT
+element_number (gfc_array_ref *ar)
+{
+  mpz_t multiplier, offset, extent, n;
+  gfc_array_spec *as;
+  HOST_WIDE_INT i, rank;
+
+  as = ar->as;
+  rank = as->rank;
+  mpz_init_set_ui (multiplier, 1);
+  mpz_init_set_ui (offset, 0);
+  mpz_init (extent);
+  mpz_init (n);
+
+  for (i = 0; i < rank; i++)
+    { 
+      if (ar->dimen_type[i] != DIMEN_ELEMENT)
+        gfc_internal_error ("element_number(): Bad dimension type");
+
+      mpz_sub (n, *get_mpz (ar->start[i]), *get_mpz (as->lower[i]));
+ 
+      mpz_mul (n, n, multiplier);
+      mpz_add (offset, offset, n);
+ 
+      mpz_sub (extent, *get_mpz (as->upper[i]), *get_mpz (as->lower[i]));
+      mpz_add_ui (extent, extent, 1);
+ 
+      if (mpz_sgn (extent) < 0)
+        mpz_set_ui (extent, 0);
+ 
+      mpz_mul (multiplier, multiplier, extent);
+    } 
+ 
+  i = mpz_get_ui (offset);
+ 
+  mpz_clear (multiplier);
+  mpz_clear (offset);
+  mpz_clear (extent);
+  mpz_clear (n);
+ 
+  return i;
+}
+
+
+/* Given a single element of an equivalence list, figure out the offset
+   from the base symbol.  For simple variables or full arrays, this is
+   simply zero.  For an array element we have to calculate the array
+   element number and multiply by the element size. For a substring we
+   have to calculate the further reference.  */
+
+static HOST_WIDE_INT
+calculate_offset (gfc_expr *e)
+{
+  HOST_WIDE_INT n, element_size, offset;
+  gfc_typespec *element_type;
+  gfc_ref *reference;
+
+  offset = 0;
+  element_type = &e->symtree->n.sym->ts;
+
+  for (reference = e->ref; reference; reference = reference->next)
+    switch (reference->type)
+      {
+      case REF_ARRAY:
+        switch (reference->u.ar.type)
+          {
+          case AR_FULL:
+	    break;
+
+          case AR_ELEMENT:
+	    n = element_number (&reference->u.ar);
+	    if (element_type->type == BT_CHARACTER)
+	      gfc_conv_const_charlen (element_type->u.cl);
+	    element_size =
+              int_size_in_bytes (gfc_typenode_for_spec (element_type));
+	    offset += n * element_size;
+	    break;
+
+          default:
+	    gfc_error ("Bad array reference at %L", &e->where);
+          }
+        break;
+      case REF_SUBSTRING:
+        if (reference->u.ss.start != NULL)
+	  offset += mpz_get_ui (*get_mpz (reference->u.ss.start)) - 1;
+        break;
+      default:
+        gfc_error ("Illegal reference type at %L as EQUIVALENCE object",
+                   &e->where);
+    }
+  return offset;
+}
+
+
+/* Add a new segment_info structure to the current segment.  eq1 is already
+   in the list, eq2 is not.  */
+
+static void
+new_condition (segment_info *v, gfc_equiv *eq1, gfc_equiv *eq2)
+{
+  HOST_WIDE_INT offset1, offset2;
+  segment_info *a;
+
+  offset1 = calculate_offset (eq1->expr);
+  offset2 = calculate_offset (eq2->expr);
+
+  a = get_segment_info (eq2->expr->symtree->n.sym,
+			v->offset + offset1 - offset2);
+ 
+  current_segment = add_segments (current_segment, a);
+}
+
+
+/* Given two equivalence structures that are both already in the list, make
+   sure that this new condition is not violated, generating an error if it
+   is.  */
+
+static void
+confirm_condition (segment_info *s1, gfc_equiv *eq1, segment_info *s2,
+                   gfc_equiv *eq2)
+{
+  HOST_WIDE_INT offset1, offset2;
+
+  offset1 = calculate_offset (eq1->expr);
+  offset2 = calculate_offset (eq2->expr);
+
+  if (s1->offset + offset1 != s2->offset + offset2)
+    gfc_error ("Inconsistent equivalence rules involving '%s' at %L and "
+	       "'%s' at %L", s1->sym->name, &s1->sym->declared_at,
+	       s2->sym->name, &s2->sym->declared_at);
+}
+
+
+/* Process a new equivalence condition. eq1 is know to be in segment f.
+   If eq2 is also present then confirm that the condition holds.
+   Otherwise add a new variable to the segment list.  */
+
+static void
+add_condition (segment_info *f, gfc_equiv *eq1, gfc_equiv *eq2)
+{
+  segment_info *n;
+
+  n = find_segment_info (eq2->expr->symtree->n.sym);
+
+  if (n == NULL)
+    new_condition (f, eq1, eq2);
+  else
+    confirm_condition (f, eq1, n, eq2);
+}
+
+
+/* Given a segment element, search through the equivalence lists for unused
+   conditions that involve the symbol.  Add these rules to the segment.  */
+
+static bool
+find_equivalence (segment_info *n)
+{
+  gfc_equiv *e1, *e2, *eq;
+  bool found;
+
+  found = FALSE;
+
+  for (e1 = n->sym->ns->equiv; e1; e1 = e1->next)
+    {
+      eq = NULL;
+
+      /* Search the equivalence list, including the root (first) element
+         for the symbol that owns the segment.  */
+      for (e2 = e1; e2; e2 = e2->eq)
+	{
+	  if (!e2->used && e2->expr->symtree->n.sym == n->sym)
+	    {
+	      eq = e2;
+	      break;
+	    }
+	}
+
+      /* Go to the next root element.  */
+      if (eq == NULL)
+	continue;
+
+      eq->used = 1;
+
+      /* Now traverse the equivalence list matching the offsets.  */
+      for (e2 = e1; e2; e2 = e2->eq)
+	{
+	  if (!e2->used && e2 != eq)
+	    {
+	      add_condition (n, eq, e2);
+	      e2->used = 1;
+	      found = TRUE;
+	    }
+	}
+    }
+  return found;
+}
+
+
+/* Add all symbols equivalenced within a segment.  We need to scan the
+   segment list multiple times to include indirect equivalences.  Since
+   a new segment_info can inserted at the beginning of the segment list,
+   depending on its offset, we have to force a final pass through the
+   loop by demanding that completion sees a pass with no matches; i.e.,
+   all symbols with equiv_built set and no new equivalences found.  */
+
+static void
+add_equivalences (bool *saw_equiv)
+{
+  segment_info *f;
+  bool seen_one, more;
+
+  seen_one = false;
+  more = TRUE;
+  while (more)
+    {
+      more = FALSE;
+      for (f = current_segment; f; f = f->next)
+	{
+	  if (!f->sym->equiv_built)
+	    {
+	      f->sym->equiv_built = 1;
+	      seen_one = find_equivalence (f);
+	      if (seen_one)
+		{
+		  *saw_equiv = true;
+		  more = true;
+		}
+	    }
+	}
+    }
+
+  /* Add a copy of this segment list to the namespace.  */
+  copy_equiv_list_to_ns (current_segment);
+}
+
+
+/* Returns the offset necessary to properly align the current equivalence.
+   Sets *palign to the required alignment.  */
+
+static HOST_WIDE_INT
+align_segment (unsigned HOST_WIDE_INT *palign)
+{
+  segment_info *s;
+  unsigned HOST_WIDE_INT offset;
+  unsigned HOST_WIDE_INT max_align;
+  unsigned HOST_WIDE_INT this_align;
+  unsigned HOST_WIDE_INT this_offset;
+
+  max_align = 1;
+  offset = 0;
+  for (s = current_segment; s; s = s->next)
+    {
+      this_align = TYPE_ALIGN_UNIT (s->field);
+      if (s->offset & (this_align - 1))
+	{
+	  /* Field is misaligned.  */
+	  this_offset = this_align - ((s->offset + offset) & (this_align - 1));
+	  if (this_offset & (max_align - 1))
+	    {
+	      /* Aligning this field would misalign a previous field.  */
+	      gfc_error ("The equivalence set for variable '%s' "
+			 "declared at %L violates alignment requirements",
+			 s->sym->name, &s->sym->declared_at);
+	    }
+	  offset += this_offset;
+	}
+      max_align = this_align;
+    }
+  if (palign)
+    *palign = max_align;
+  return offset;
+}
+
+
+/* Adjust segment offsets by the given amount.  */
+
+static void
+apply_segment_offset (segment_info *s, HOST_WIDE_INT offset)
+{
+  for (; s; s = s->next)
+    s->offset += offset;
+}
+
+
+/* Lay out a symbol in a common block.  If the symbol has already been seen
+   then check the location is consistent.  Otherwise create segments
+   for that symbol and all the symbols equivalenced with it.  */
+
+/* Translate a single common block.  */
+
+static void
+translate_common (gfc_common_head *common, gfc_symbol *var_list)
+{
+  gfc_symbol *sym;
+  segment_info *s;
+  segment_info *common_segment;
+  HOST_WIDE_INT offset;
+  HOST_WIDE_INT current_offset;
+  unsigned HOST_WIDE_INT align;
+  bool saw_equiv;
+
+  common_segment = NULL;
+  offset = 0;
+  current_offset = 0;
+  align = 1;
+  saw_equiv = false;
+
+  /* Add symbols to the segment.  */
+  for (sym = var_list; sym; sym = sym->common_next)
+    {
+      current_segment = common_segment;
+      s = find_segment_info (sym);
+
+      /* Symbol has already been added via an equivalence.  Multiple
+	 use associations of the same common block result in equiv_built
+	 being set but no information about the symbol in the segment.  */
+      if (s && sym->equiv_built)
+	{
+	  /* Ensure the current location is properly aligned.  */
+	  align = TYPE_ALIGN_UNIT (s->field);
+	  current_offset = (current_offset + align - 1) &~ (align - 1);
+
+	  /* Verify that it ended up where we expect it.  */
+	  if (s->offset != current_offset)
+	    {
+	      gfc_error ("Equivalence for '%s' does not match ordering of "
+			 "COMMON '%s' at %L", sym->name,
+			 common->name, &common->where);
+	    }
+	}
+      else
+	{
+	  /* A symbol we haven't seen before.  */
+	  s = current_segment = get_segment_info (sym, current_offset);
+
+	  /* Add all objects directly or indirectly equivalenced with this
+	     symbol.  */
+	  add_equivalences (&saw_equiv);
+
+	  if (current_segment->offset < 0)
+	    gfc_error ("The equivalence set for '%s' cause an invalid "
+		       "extension to COMMON '%s' at %L", sym->name,
+		       common->name, &common->where);
+
+	  if (gfc_option.flag_align_commons)
+	    offset = align_segment (&align);
+
+	  if (offset)
+	    {
+	      /* The required offset conflicts with previous alignment
+		 requirements.  Insert padding immediately before this
+		 segment.  */
+	      if (gfc_option.warn_align_commons)
+		{
+		  if (strcmp (common->name, BLANK_COMMON_NAME))
+		    gfc_warning ("Padding of %d bytes required before '%s' in "
+				 "COMMON '%s' at %L; reorder elements or use "
+				 "-fno-align-commons", (int)offset,
+				 s->sym->name, common->name, &common->where);
+		  else
+		    gfc_warning ("Padding of %d bytes required before '%s' in "
+				 "COMMON at %L; reorder elements or use "
+				 "-fno-align-commons", (int)offset,
+				 s->sym->name, &common->where);
+		}
+	    }
+
+	  /* Apply the offset to the new segments.  */
+	  apply_segment_offset (current_segment, offset);
+	  current_offset += offset;
+
+	  /* Add the new segments to the common block.  */
+	  common_segment = add_segments (common_segment, current_segment);
+	}
+
+      /* The offset of the next common variable.  */
+      current_offset += s->length;
+    }
+
+  if (common_segment == NULL)
+    {
+      gfc_error ("COMMON '%s' at %L does not exist",
+		 common->name, &common->where);
+      return;
+    }
+
+  if (common_segment->offset != 0 && gfc_option.warn_align_commons)
+    {
+      if (strcmp (common->name, BLANK_COMMON_NAME))
+	gfc_warning ("COMMON '%s' at %L requires %d bytes of padding; "
+		     "reorder elements or use -fno-align-commons",
+		     common->name, &common->where, (int)common_segment->offset);
+      else
+	gfc_warning ("COMMON at %L requires %d bytes of padding; "
+		     "reorder elements or use -fno-align-commons",
+		     &common->where, (int)common_segment->offset);
+    }
+
+  create_common (common, common_segment, saw_equiv);
+}
+
+
+/* Create a new block for each merged equivalence list.  */
+
+static void
+finish_equivalences (gfc_namespace *ns)
+{
+  gfc_equiv *z, *y;
+  gfc_symbol *sym;
+  gfc_common_head * c;
+  HOST_WIDE_INT offset;
+  unsigned HOST_WIDE_INT align;
+  bool dummy;
+
+  for (z = ns->equiv; z; z = z->next)
+    for (y = z->eq; y; y = y->eq)
+      {
+        if (y->used) 
+	  continue;
+        sym = z->expr->symtree->n.sym;
+        current_segment = get_segment_info (sym, 0);
+
+        /* All objects directly or indirectly equivalenced with this
+	   symbol.  */
+        add_equivalences (&dummy);
+
+	/* Align the block.  */
+	offset = align_segment (&align);
+
+	/* Ensure all offsets are positive.  */
+	offset -= current_segment->offset & ~(align - 1);
+
+	apply_segment_offset (current_segment, offset);
+
+	/* Create the decl.  If this is a module equivalence, it has a
+	   unique name, pointed to by z->module.  This is written to a
+	   gfc_common_header to push create_common into using
+	   build_common_decl, so that the equivalence appears as an
+	   external symbol.  Otherwise, a local declaration is built using
+	   build_equiv_decl.  */
+	if (z->module)
+	  {
+	    c = gfc_get_common_head ();
+	    /* We've lost the real location, so use the location of the
+	       enclosing procedure.  */
+	    c->where = ns->proc_name->declared_at;
+	    strcpy (c->name, z->module);
+	  }
+	else
+	  c = NULL;
+
+        create_common (c, current_segment, true);
+        break;
+      }
+}
+
+
+/* Work function for translating a named common block.  */
+
+static void
+named_common (gfc_symtree *st)
+{
+  translate_common (st->n.common, st->n.common->head);
+}
+
+
+/* Translate the common blocks in a namespace. Unlike other variables,
+   these have to be created before code, because the backend_decl depends
+   on the rest of the common block.  */
+
+void
+gfc_trans_common (gfc_namespace *ns)
+{
+  gfc_common_head *c;
+
+  /* Translate the blank common block.  */
+  if (ns->blank_common.head != NULL)
+    {
+      c = gfc_get_common_head ();
+      c->where = ns->blank_common.head->common_head->where;
+      strcpy (c->name, BLANK_COMMON_NAME);
+      translate_common (c, ns->blank_common.head);
+    }
+
+  /* Translate all named common blocks.  */
+  gfc_traverse_symtree (ns->common_root, named_common);
+
+  /* Translate local equivalence.  */
+  finish_equivalences (ns);
+
+  /* Commit the newly created symbols for common blocks and module
+     equivalences.  */
+  gfc_commit_symbols ();
+}
diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c
new file mode 100644
index 000000000..3d8d4ef8e
--- /dev/null
+++ b/gcc/fortran/trans-const.c
@@ -0,0 +1,402 @@
+/* Translation of constants
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* trans-const.c -- convert constant values */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "realmpfr.h"
+#include "diagnostic-core.h"	/* For fatal_error.  */
+#include "double-int.h"
+#include "gfortran.h"
+#include "trans.h"
+#include "trans-const.h"
+#include "trans-types.h"
+#include "target-memory.h"
+
+tree gfc_rank_cst[GFC_MAX_DIMENSIONS + 1];
+
+/* Build a constant with given type from an int_cst.  */
+
+tree
+gfc_build_const (tree type, tree intval)
+{
+  tree val;
+  tree zero;
+
+  switch (TREE_CODE (type))
+    {
+    case INTEGER_TYPE:
+      val = convert (type, intval);
+      break;
+
+    case REAL_TYPE:
+      val = build_real_from_int_cst (type, intval);
+      break;
+
+    case COMPLEX_TYPE:
+      val = build_real_from_int_cst (TREE_TYPE (type), intval);
+      zero = build_real_from_int_cst (TREE_TYPE (type), integer_zero_node);
+      val = build_complex (type, val, zero);
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+  return val;
+}
+
+/* Build a string constant with C char type.  */
+
+tree
+gfc_build_string_const (int length, const char *s)
+{
+  tree str;
+  tree len;
+
+  str = build_string (length, s);
+  len = build_int_cst (NULL_TREE, length);
+  TREE_TYPE (str) =
+    build_array_type (gfc_character1_type_node,
+		      build_range_type (gfc_charlen_type_node,
+					integer_one_node, len));
+  return str;
+}
+
+
+/* Build a string constant with a type given by its kind; take care of
+   non-default character kinds.  */
+
+tree
+gfc_build_wide_string_const (int kind, int length, const gfc_char_t *string)
+{
+  int i;
+  tree str, len;
+  size_t size;
+  char *s;
+
+  i = gfc_validate_kind (BT_CHARACTER, kind, false);
+  size = length * gfc_character_kinds[i].bit_size / 8;
+
+  s = XCNEWVAR (char, size);
+  gfc_encode_character (kind, length, string, (unsigned char *) s, size);
+
+  str = build_string (size, s);
+  gfc_free (s);
+
+  len = build_int_cst (NULL_TREE, length);
+  TREE_TYPE (str) =
+    build_array_type (gfc_get_char_type (kind),
+		      build_range_type (gfc_charlen_type_node,
+					integer_one_node, len));
+  return str;
+}
+
+
+/* Build a Fortran character constant from a zero-terminated string.
+   There a two version of this function, one that translates the string
+   and one that doesn't.  */
+tree
+gfc_build_cstring_const (const char *string)
+{
+  return gfc_build_string_const (strlen (string) + 1, string);
+}
+
+tree
+gfc_build_localized_cstring_const (const char *msgid)
+{
+  const char *localized = _(msgid);
+  return gfc_build_string_const (strlen (localized) + 1, localized);
+}
+
+
+/* Return a string constant with the given length.  Used for static
+   initializers.  The constant will be padded or truncated to match 
+   length.  */
+
+tree
+gfc_conv_string_init (tree length, gfc_expr * expr)
+{
+  gfc_char_t *s;
+  HOST_WIDE_INT len;
+  int slen;
+  tree str;
+  bool free_s = false;
+
+  gcc_assert (expr->expr_type == EXPR_CONSTANT);
+  gcc_assert (expr->ts.type == BT_CHARACTER);
+  gcc_assert (INTEGER_CST_P (length));
+  gcc_assert (TREE_INT_CST_HIGH (length) == 0);
+
+  len = TREE_INT_CST_LOW (length);
+  slen = expr->value.character.length;
+
+  if (len > slen)
+    {
+      s = gfc_get_wide_string (len);
+      memcpy (s, expr->value.character.string, slen * sizeof (gfc_char_t));
+      gfc_wide_memset (&s[slen], ' ', len - slen);
+      free_s = true;
+    }
+  else
+    s = expr->value.character.string;
+
+  str = gfc_build_wide_string_const (expr->ts.kind, len, s);
+
+  if (free_s)
+    gfc_free (s);
+
+  return str;
+}
+
+
+/* Create a tree node for the string length if it is constant.  */
+
+void
+gfc_conv_const_charlen (gfc_charlen * cl)
+{
+  if (!cl || cl->backend_decl)
+    return;
+
+  if (cl->length && cl->length->expr_type == EXPR_CONSTANT)
+    {
+      cl->backend_decl = gfc_conv_mpz_to_tree (cl->length->value.integer,
+					       cl->length->ts.kind);
+      cl->backend_decl = fold_convert (gfc_charlen_type_node,
+					cl->backend_decl);
+    }
+}
+
+void
+gfc_init_constants (void)
+{
+  int n;
+
+  for (n = 0; n <= GFC_MAX_DIMENSIONS; n++)
+    gfc_rank_cst[n] = build_int_cst (gfc_array_index_type, n);
+}
+
+/* Converts a GMP integer into a backend tree node.  */
+
+tree
+gfc_conv_mpz_to_tree (mpz_t i, int kind)
+{
+  double_int val = mpz_get_double_int (gfc_get_int_type (kind), i, true);
+  return double_int_to_tree (gfc_get_int_type (kind), val);
+}
+
+/* Converts a backend tree into a GMP integer.  */
+
+void
+gfc_conv_tree_to_mpz (mpz_t i, tree source)
+{
+  double_int val = tree_to_double_int (source);
+  mpz_set_double_int (i, val, TYPE_UNSIGNED (TREE_TYPE (source)));
+}
+
+/* Converts a real constant into backend form.  */
+
+tree
+gfc_conv_mpfr_to_tree (mpfr_t f, int kind, int is_snan)
+{
+  tree type;
+  int n;
+  REAL_VALUE_TYPE real;
+
+  n = gfc_validate_kind (BT_REAL, kind, false);
+  gcc_assert (gfc_real_kinds[n].radix == 2);
+
+  type = gfc_get_real_type (kind);
+  if (mpfr_nan_p (f) && is_snan)
+     real_from_string (&real, "SNaN");
+  else
+    real_from_mpfr (&real, f, type, GFC_RND_MODE);
+
+  return build_real (type, real);
+}
+
+/* Returns a real constant that is +Infinity if the target
+   supports infinities for this floating-point mode, and
+   +HUGE_VAL otherwise (the largest representable number).  */
+
+tree
+gfc_build_inf_or_huge (tree type, int kind)
+{
+  if (HONOR_INFINITIES (TYPE_MODE (type)))
+    {
+      REAL_VALUE_TYPE real;
+      real_inf (&real);
+      return build_real (type, real);
+    }
+  else
+    {
+      int k = gfc_validate_kind (BT_REAL, kind, false);
+      return gfc_conv_mpfr_to_tree (gfc_real_kinds[k].huge, kind, 0);
+    }
+}
+
+/* Converts a backend tree into a real constant.  */
+
+void
+gfc_conv_tree_to_mpfr (mpfr_ptr f, tree source)
+{
+  mpfr_from_real (f, TREE_REAL_CST_PTR (source), GFC_RND_MODE);
+}
+
+/* Translate any literal constant to a tree.  Constants never have
+   pre or post chains.  Character literal constants are special
+   special because they have a value and a length, so they cannot be
+   returned as a single tree.  It is up to the caller to set the
+   length somewhere if necessary.
+
+   Returns the translated constant, or aborts if it gets a type it
+   can't handle.  */
+
+tree
+gfc_conv_constant_to_tree (gfc_expr * expr)
+{
+  tree res;
+
+  gcc_assert (expr->expr_type == EXPR_CONSTANT);
+
+  /* If it is has a prescribed memory representation, we build a string
+     constant and VIEW_CONVERT to its type.  */
+ 
+  switch (expr->ts.type)
+    {
+    case BT_INTEGER:
+      if (expr->representation.string)
+	return fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+			 gfc_get_int_type (expr->ts.kind),
+			 gfc_build_string_const (expr->representation.length,
+						 expr->representation.string));
+      else
+	return gfc_conv_mpz_to_tree (expr->value.integer, expr->ts.kind);
+
+    case BT_REAL:
+      if (expr->representation.string)
+	return fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+			 gfc_get_real_type (expr->ts.kind),
+			 gfc_build_string_const (expr->representation.length,
+						 expr->representation.string));
+      else
+	return gfc_conv_mpfr_to_tree (expr->value.real, expr->ts.kind, expr->is_snan);
+
+    case BT_LOGICAL:
+      if (expr->representation.string)
+	{
+	  tree tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+			gfc_get_int_type (expr->ts.kind),
+			gfc_build_string_const (expr->representation.length,
+						expr->representation.string));
+	  if (!integer_zerop (tmp) && !integer_onep (tmp))
+	    gfc_warning ("Assigning value other than 0 or 1 to LOGICAL"
+			 " has undefined result at %L", &expr->where);
+	  return fold_convert (gfc_get_logical_type (expr->ts.kind), tmp);
+	}
+      else
+	return build_int_cst (gfc_get_logical_type (expr->ts.kind),
+			      expr->value.logical);
+
+    case BT_COMPLEX:
+      if (expr->representation.string)
+	return fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+			 gfc_get_complex_type (expr->ts.kind),
+			 gfc_build_string_const (expr->representation.length,
+						 expr->representation.string));
+      else
+	{
+	  tree real = gfc_conv_mpfr_to_tree (mpc_realref (expr->value.complex),
+					  expr->ts.kind, expr->is_snan);
+	  tree imag = gfc_conv_mpfr_to_tree (mpc_imagref (expr->value.complex),
+					  expr->ts.kind, expr->is_snan);
+
+	  return build_complex (gfc_typenode_for_spec (&expr->ts),
+				real, imag);
+	}
+
+    case BT_CHARACTER:
+      res = gfc_build_wide_string_const (expr->ts.kind,
+					 expr->value.character.length,
+					 expr->value.character.string);
+      return res;
+
+    case BT_HOLLERITH:
+      return gfc_build_string_const (expr->representation.length,
+				     expr->representation.string);
+
+    default:
+      fatal_error ("gfc_conv_constant_to_tree(): invalid type: %s",
+		   gfc_typename (&expr->ts));
+    }
+}
+
+
+/* Like gfc_conv_constant_to_tree, but for a simplified expression.
+   We can handle character literal constants here as well.  */
+
+void
+gfc_conv_constant (gfc_se * se, gfc_expr * expr)
+{
+  /* We may be receiving an expression for C_NULL_PTR or C_NULL_FUNPTR.  If
+     so, the expr_type will not yet be an EXPR_CONSTANT.  We need to make
+     it so here.  */
+  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived
+      && expr->ts.u.derived->attr.is_iso_c)
+    {
+      if (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR 
+          || expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_FUNPTR)
+        {
+          /* Create a new EXPR_CONSTANT expression for our local uses.  */
+          expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0);
+        }
+    }
+
+  if (expr->expr_type != EXPR_CONSTANT)
+    {
+      gfc_expr *e = gfc_get_int_expr (gfc_default_integer_kind, NULL, 0);
+      gfc_error ("non-constant initialization expression at %L", &expr->where);
+      se->expr = gfc_conv_constant_to_tree (e);
+      return;
+    }
+
+  if (se->ss != NULL)
+    {
+      gcc_assert (se->ss != gfc_ss_terminator);
+      gcc_assert (se->ss->type == GFC_SS_SCALAR);
+      gcc_assert (se->ss->expr == expr);
+
+      se->expr = se->ss->data.scalar.expr;
+      se->string_length = se->ss->string_length;
+      gfc_advance_se_ss_chain (se);
+      return;
+    }
+
+  /* Translate the constant and put it in the simplifier structure.  */
+  se->expr = gfc_conv_constant_to_tree (expr);
+
+  /* If this is a CHARACTER string, set its length in the simplifier
+     structure, too.  */
+  if (expr->ts.type == BT_CHARACTER)
+    se->string_length = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (se->expr)));
+}
diff --git a/gcc/fortran/trans-const.h b/gcc/fortran/trans-const.h
new file mode 100644
index 000000000..9dbe9f8d9
--- /dev/null
+++ b/gcc/fortran/trans-const.h
@@ -0,0 +1,64 @@
+/* Header for code constant translation functions
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* Converts between INT_CST and GMP integer representations.  */
+tree gfc_conv_mpz_to_tree (mpz_t, int);
+void gfc_conv_tree_to_mpz (mpz_t, tree);
+
+/* Converts between REAL_CST and MPFR floating-point representations.  */
+tree gfc_conv_mpfr_to_tree (mpfr_t, int, int);
+void gfc_conv_tree_to_mpfr (mpfr_ptr, tree);
+
+/* Build a tree containing a real infinity (or HUGE if infinities are
+   not supported for the given type.  */
+tree gfc_build_inf_or_huge (tree, int);
+
+/* Build a tree for a constant.  Must be an EXPR_CONSTANT gfc_expr.
+   For CHARACTER literal constants, the caller still has to set the
+   string length as a separate operation.  */
+tree gfc_conv_constant_to_tree (gfc_expr *);
+
+/* Like gfc_conv_noncharacter_constant, but works on simplified expression
+   structures.  Also sets the length of CHARACTER strings in the gfc_se.  */
+void gfc_conv_constant (gfc_se *, gfc_expr *);
+
+tree gfc_build_string_const (int, const char *);
+tree gfc_build_wide_string_const (int, int, const gfc_char_t *);
+tree gfc_build_cstring_const (const char *);
+tree gfc_build_localized_cstring_const (const char *);
+
+/* Translate a string constant for a static initializer.  */
+tree gfc_conv_string_init (tree, gfc_expr *);
+
+/* Create a tree node for the string length if it is constant.  */
+void gfc_conv_const_charlen (gfc_charlen *);
+
+/* Initialize the nodes for constants.  */
+void gfc_init_constants (void);
+
+/* Build a constant with given type from an int_cst.  */
+tree gfc_build_const (tree, tree);
+
+/* Integer constants 0..GFC_MAX_DIMENSIONS.  */
+extern GTY(()) tree gfc_rank_cst[GFC_MAX_DIMENSIONS + 1];
+
+#define gfc_index_zero_node gfc_rank_cst[0]
+#define gfc_index_one_node gfc_rank_cst[1]
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
new file mode 100644
index 000000000..5b5e7881c
--- /dev/null
+++ b/gcc/fortran/trans-decl.c
@@ -0,0 +1,5091 @@
+/* Backend function setup
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+   2011
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* trans-decl.c -- Handling of backend function and variable decls, etc */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"
+#include "tree.h"
+#include "tree-dump.h"
+#include "gimple.h"	/* For create_tmp_var_raw.  */
+#include "ggc.h"
+#include "diagnostic-core.h"	/* For internal_error.  */
+#include "toplev.h"	/* For announce_function.  */
+#include "output.h"	/* For decl_default_tls_model.  */
+#include "target.h"
+#include "function.h"
+#include "flags.h"
+#include "cgraph.h"
+#include "debug.h"
+#include "gfortran.h"
+#include "pointer-set.h"
+#include "constructor.h"
+#include "trans.h"
+#include "trans-types.h"
+#include "trans-array.h"
+#include "trans-const.h"
+/* Only for gfc_trans_code.  Shouldn't need to include this.  */
+#include "trans-stmt.h"
+
+#define MAX_LABEL_VALUE 99999
+
+
+/* Holds the result of the function if no result variable specified.  */
+
+static GTY(()) tree current_fake_result_decl;
+static GTY(()) tree parent_fake_result_decl;
+
+
+/* Holds the variable DECLs for the current function.  */
+
+static GTY(()) tree saved_function_decls;
+static GTY(()) tree saved_parent_function_decls;
+
+static struct pointer_set_t *nonlocal_dummy_decl_pset;
+static GTY(()) tree nonlocal_dummy_decls;
+
+/* Holds the variable DECLs that are locals.  */
+
+static GTY(()) tree saved_local_decls;
+
+/* The namespace of the module we're currently generating.  Only used while
+   outputting decls for module variables.  Do not rely on this being set.  */
+
+static gfc_namespace *module_namespace;
+
+/* The currently processed procedure symbol.  */
+static gfc_symbol* current_procedure_symbol = NULL;
+
+
+/* List of static constructor functions.  */
+
+tree gfc_static_ctors;
+
+
+/* Function declarations for builtin library functions.  */
+
+tree gfor_fndecl_pause_numeric;
+tree gfor_fndecl_pause_string;
+tree gfor_fndecl_stop_numeric;
+tree gfor_fndecl_stop_numeric_f08;
+tree gfor_fndecl_stop_string;
+tree gfor_fndecl_error_stop_numeric;
+tree gfor_fndecl_error_stop_string;
+tree gfor_fndecl_runtime_error;
+tree gfor_fndecl_runtime_error_at;
+tree gfor_fndecl_runtime_warning_at;
+tree gfor_fndecl_os_error;
+tree gfor_fndecl_generate_error;
+tree gfor_fndecl_set_args;
+tree gfor_fndecl_set_fpe;
+tree gfor_fndecl_set_options;
+tree gfor_fndecl_set_convert;
+tree gfor_fndecl_set_record_marker;
+tree gfor_fndecl_set_max_subrecord_length;
+tree gfor_fndecl_ctime;
+tree gfor_fndecl_fdate;
+tree gfor_fndecl_ttynam;
+tree gfor_fndecl_in_pack;
+tree gfor_fndecl_in_unpack;
+tree gfor_fndecl_associated;
+
+
+/* Math functions.  Many other math functions are handled in
+   trans-intrinsic.c.  */
+
+gfc_powdecl_list gfor_fndecl_math_powi[4][3];
+tree gfor_fndecl_math_ishftc4;
+tree gfor_fndecl_math_ishftc8;
+tree gfor_fndecl_math_ishftc16;
+
+
+/* String functions.  */
+
+tree gfor_fndecl_compare_string;
+tree gfor_fndecl_concat_string;
+tree gfor_fndecl_string_len_trim;
+tree gfor_fndecl_string_index;
+tree gfor_fndecl_string_scan;
+tree gfor_fndecl_string_verify;
+tree gfor_fndecl_string_trim;
+tree gfor_fndecl_string_minmax;
+tree gfor_fndecl_adjustl;
+tree gfor_fndecl_adjustr;
+tree gfor_fndecl_select_string;
+tree gfor_fndecl_compare_string_char4;
+tree gfor_fndecl_concat_string_char4;
+tree gfor_fndecl_string_len_trim_char4;
+tree gfor_fndecl_string_index_char4;
+tree gfor_fndecl_string_scan_char4;
+tree gfor_fndecl_string_verify_char4;
+tree gfor_fndecl_string_trim_char4;
+tree gfor_fndecl_string_minmax_char4;
+tree gfor_fndecl_adjustl_char4;
+tree gfor_fndecl_adjustr_char4;
+tree gfor_fndecl_select_string_char4;
+
+
+/* Conversion between character kinds.  */
+tree gfor_fndecl_convert_char1_to_char4;
+tree gfor_fndecl_convert_char4_to_char1;
+
+
+/* Other misc. runtime library functions.  */
+tree gfor_fndecl_size0;
+tree gfor_fndecl_size1;
+tree gfor_fndecl_iargc;
+
+/* Intrinsic functions implemented in Fortran.  */
+tree gfor_fndecl_sc_kind;
+tree gfor_fndecl_si_kind;
+tree gfor_fndecl_sr_kind;
+
+/* BLAS gemm functions.  */
+tree gfor_fndecl_sgemm;
+tree gfor_fndecl_dgemm;
+tree gfor_fndecl_cgemm;
+tree gfor_fndecl_zgemm;
+
+
+static void
+gfc_add_decl_to_parent_function (tree decl)
+{
+  gcc_assert (decl);
+  DECL_CONTEXT (decl) = DECL_CONTEXT (current_function_decl);
+  DECL_NONLOCAL (decl) = 1;
+  DECL_CHAIN (decl) = saved_parent_function_decls;
+  saved_parent_function_decls = decl;
+}
+
+void
+gfc_add_decl_to_function (tree decl)
+{
+  gcc_assert (decl);
+  TREE_USED (decl) = 1;
+  DECL_CONTEXT (decl) = current_function_decl;
+  DECL_CHAIN (decl) = saved_function_decls;
+  saved_function_decls = decl;
+}
+
+static void
+add_decl_as_local (tree decl)
+{
+  gcc_assert (decl);
+  TREE_USED (decl) = 1;
+  DECL_CONTEXT (decl) = current_function_decl;
+  DECL_CHAIN (decl) = saved_local_decls;
+  saved_local_decls = decl;
+}
+
+
+/* Build a  backend label declaration.  Set TREE_USED for named labels.
+   The context of the label is always the current_function_decl.  All
+   labels are marked artificial.  */
+
+tree
+gfc_build_label_decl (tree label_id)
+{
+  /* 2^32 temporaries should be enough.  */
+  static unsigned int tmp_num = 1;
+  tree label_decl;
+  char *label_name;
+
+  if (label_id == NULL_TREE)
+    {
+      /* Build an internal label name.  */
+      ASM_FORMAT_PRIVATE_NAME (label_name, "L", tmp_num++);
+      label_id = get_identifier (label_name);
+    }
+  else
+    label_name = NULL;
+
+  /* Build the LABEL_DECL node. Labels have no type.  */
+  label_decl = build_decl (input_location,
+			   LABEL_DECL, label_id, void_type_node);
+  DECL_CONTEXT (label_decl) = current_function_decl;
+  DECL_MODE (label_decl) = VOIDmode;
+
+  /* We always define the label as used, even if the original source
+     file never references the label.  We don't want all kinds of
+     spurious warnings for old-style Fortran code with too many
+     labels.  */
+  TREE_USED (label_decl) = 1;
+
+  DECL_ARTIFICIAL (label_decl) = 1;
+  return label_decl;
+}
+
+
+/* Set the backend source location of a decl.  */
+
+void
+gfc_set_decl_location (tree decl, locus * loc)
+{
+  DECL_SOURCE_LOCATION (decl) = loc->lb->location;
+}
+
+
+/* Return the backend label declaration for a given label structure,
+   or create it if it doesn't exist yet.  */
+
+tree
+gfc_get_label_decl (gfc_st_label * lp)
+{
+  if (lp->backend_decl)
+    return lp->backend_decl;
+  else
+    {
+      char label_name[GFC_MAX_SYMBOL_LEN + 1];
+      tree label_decl;
+
+      /* Validate the label declaration from the front end.  */
+      gcc_assert (lp != NULL && lp->value <= MAX_LABEL_VALUE);
+
+      /* Build a mangled name for the label.  */
+      sprintf (label_name, "__label_%.6d", lp->value);
+
+      /* Build the LABEL_DECL node.  */
+      label_decl = gfc_build_label_decl (get_identifier (label_name));
+
+      /* Tell the debugger where the label came from.  */
+      if (lp->value <= MAX_LABEL_VALUE)	/* An internal label.  */
+	gfc_set_decl_location (label_decl, &lp->where);
+      else
+	DECL_ARTIFICIAL (label_decl) = 1;
+
+      /* Store the label in the label list and return the LABEL_DECL.  */
+      lp->backend_decl = label_decl;
+      return label_decl;
+    }
+}
+
+
+/* Convert a gfc_symbol to an identifier of the same name.  */
+
+static tree
+gfc_sym_identifier (gfc_symbol * sym)
+{
+  if (sym->attr.is_main_program && strcmp (sym->name, "main") == 0)
+    return (get_identifier ("MAIN__"));
+  else
+    return (get_identifier (sym->name));
+}
+
+
+/* Construct mangled name from symbol name.  */
+
+static tree
+gfc_sym_mangled_identifier (gfc_symbol * sym)
+{
+  char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
+
+  /* Prevent the mangling of identifiers that have an assigned
+     binding label (mainly those that are bind(c)).  */
+  if (sym->attr.is_bind_c == 1
+      && sym->binding_label[0] != '\0')
+    return get_identifier(sym->binding_label);
+  
+  if (sym->module == NULL)
+    return gfc_sym_identifier (sym);
+  else
+    {
+      snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
+      return get_identifier (name);
+    }
+}
+
+
+/* Construct mangled function name from symbol name.  */
+
+static tree
+gfc_sym_mangled_function_id (gfc_symbol * sym)
+{
+  int has_underscore;
+  char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
+
+  /* It may be possible to simply use the binding label if it's
+     provided, and remove the other checks.  Then we could use it
+     for other things if we wished.  */
+  if ((sym->attr.is_bind_c == 1 || sym->attr.is_iso_c == 1) &&
+      sym->binding_label[0] != '\0')
+    /* use the binding label rather than the mangled name */
+    return get_identifier (sym->binding_label);
+
+  if (sym->module == NULL || sym->attr.proc == PROC_EXTERNAL
+      || (sym->module != NULL && (sym->attr.external
+	    || sym->attr.if_source == IFSRC_IFBODY)))
+    {
+      /* Main program is mangled into MAIN__.  */
+      if (sym->attr.is_main_program)
+	return get_identifier ("MAIN__");
+
+      /* Intrinsic procedures are never mangled.  */
+      if (sym->attr.proc == PROC_INTRINSIC)
+	return get_identifier (sym->name);
+
+      if (gfc_option.flag_underscoring)
+	{
+	  has_underscore = strchr (sym->name, '_') != 0;
+	  if (gfc_option.flag_second_underscore && has_underscore)
+	    snprintf (name, sizeof name, "%s__", sym->name);
+	  else
+	    snprintf (name, sizeof name, "%s_", sym->name);
+	  return get_identifier (name);
+	}
+      else
+	return get_identifier (sym->name);
+    }
+  else
+    {
+      snprintf (name, sizeof name, "__%s_MOD_%s", sym->module, sym->name);
+      return get_identifier (name);
+    }
+}
+
+
+void
+gfc_set_decl_assembler_name (tree decl, tree name)
+{
+  tree target_mangled = targetm.mangle_decl_assembler_name (decl, name);
+  SET_DECL_ASSEMBLER_NAME (decl, target_mangled);
+}
+
+
+/* Returns true if a variable of specified size should go on the stack.  */
+
+int
+gfc_can_put_var_on_stack (tree size)
+{
+  unsigned HOST_WIDE_INT low;
+
+  if (!INTEGER_CST_P (size))
+    return 0;
+
+  if (gfc_option.flag_max_stack_var_size < 0)
+    return 1;
+
+  if (TREE_INT_CST_HIGH (size) != 0)
+    return 0;
+
+  low = TREE_INT_CST_LOW (size);
+  if (low > (unsigned HOST_WIDE_INT) gfc_option.flag_max_stack_var_size)
+    return 0;
+
+/* TODO: Set a per-function stack size limit.  */
+
+  return 1;
+}
+
+
+/* gfc_finish_cray_pointee sets DECL_VALUE_EXPR for a Cray pointee to
+   an expression involving 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.  */
+
+static void
+gfc_finish_cray_pointee (tree decl, gfc_symbol *sym)
+{
+  tree ptr_decl = gfc_get_symbol_decl (sym->cp_pointer);
+  tree value;
+
+  /* Parameters need to be dereferenced.  */
+  if (sym->cp_pointer->attr.dummy) 
+    ptr_decl = build_fold_indirect_ref_loc (input_location,
+					ptr_decl);
+
+  /* Check to see if we're dealing with a variable-sized array.  */
+  if (sym->attr.dimension
+      && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE) 
+    {  
+      /* These decls will be dereferenced later, so we don't dereference
+	 them here.  */
+      value = convert (TREE_TYPE (decl), ptr_decl);
+    }
+  else
+    {
+      ptr_decl = convert (build_pointer_type (TREE_TYPE (decl)),
+			  ptr_decl);
+      value = build_fold_indirect_ref_loc (input_location,
+				       ptr_decl);
+    }
+
+  SET_DECL_VALUE_EXPR (decl, value);
+  DECL_HAS_VALUE_EXPR_P (decl) = 1;
+  GFC_DECL_CRAY_POINTEE (decl) = 1;
+  /* This is a fake variable just for debugging purposes.  */
+  TREE_ASM_WRITTEN (decl) = 1;
+}
+
+
+/* Finish processing of a declaration without an initial value.  */
+
+static void
+gfc_finish_decl (tree decl)
+{
+  gcc_assert (TREE_CODE (decl) == PARM_DECL
+	      || DECL_INITIAL (decl) == NULL_TREE);
+
+  if (TREE_CODE (decl) != VAR_DECL)
+    return;
+
+  if (DECL_SIZE (decl) == NULL_TREE
+      && TYPE_SIZE (TREE_TYPE (decl)) != NULL_TREE)
+    layout_decl (decl, 0);
+
+  /* A few consistency checks.  */
+  /* A static variable with an incomplete type is an error if it is
+     initialized. Also if it is not file scope. Otherwise, let it
+     through, but if it is not `extern' then it may cause an error
+     message later.  */
+  /* An automatic variable with an incomplete type is an error.  */
+
+  /* We should know the storage size.  */
+  gcc_assert (DECL_SIZE (decl) != NULL_TREE
+	      || (TREE_STATIC (decl) 
+		  ? (!DECL_INITIAL (decl) || !DECL_CONTEXT (decl))
+		  : DECL_EXTERNAL (decl)));
+
+  /* The storage size should be constant.  */
+  gcc_assert ((!DECL_EXTERNAL (decl) && !TREE_STATIC (decl))
+	      || !DECL_SIZE (decl)
+	      || TREE_CODE (DECL_SIZE (decl)) == INTEGER_CST);
+}
+
+
+/* Apply symbol attributes to a variable, and add it to the function scope.  */
+
+static void
+gfc_finish_var_decl (tree decl, gfc_symbol * sym)
+{
+  tree new_type;
+  /* TREE_ADDRESSABLE means the address of this variable is actually needed.
+     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.  */
+
+  /* Set DECL_VALUE_EXPR for Cray Pointees.  */
+  if (sym->attr.cray_pointee)
+    gfc_finish_cray_pointee (decl, sym);
+
+  if (sym->attr.target)
+    TREE_ADDRESSABLE (decl) = 1;
+  /* If it wasn't used we wouldn't be getting it.  */
+  TREE_USED (decl) = 1;
+
+  /* Chain this decl to the pending declarations.  Don't do pushdecl()
+     because this would add them to the current scope rather than the
+     function scope.  */
+  if (current_function_decl != NULL_TREE)
+    {
+      if (sym->ns->proc_name->backend_decl == current_function_decl
+	  || sym->result == sym)
+	gfc_add_decl_to_function (decl);
+      else if (sym->ns->proc_name->attr.flavor == FL_LABEL)
+	/* This is a BLOCK construct.  */
+	add_decl_as_local (decl);
+      else
+	gfc_add_decl_to_parent_function (decl);
+    }
+
+  if (sym->attr.cray_pointee)
+    return;
+
+  if(sym->attr.is_bind_c == 1)
+    {
+      /* We need to put variables that are bind(c) into the common
+	 segment of the object file, because this is what C would do.
+	 gfortran would typically put them in either the BSS or
+	 initialized data segments, and only mark them as common if
+	 they were part of common blocks.  However, if they are not put
+	 into common space, then C cannot initialize global Fortran
+	 variables that it interoperates with and the draft says that
+	 either Fortran or C should be able to initialize it (but not
+	 both, of course.) (J3/04-007, section 15.3).  */
+      TREE_PUBLIC(decl) = 1;
+      DECL_COMMON(decl) = 1;
+    }
+  
+  /* If a variable is USE associated, it's always external.  */
+  if (sym->attr.use_assoc)
+    {
+      DECL_EXTERNAL (decl) = 1;
+      TREE_PUBLIC (decl) = 1;
+    }
+  else if (sym->module && !sym->attr.result && !sym->attr.dummy)
+    {
+      /* TODO: Don't set sym->module for result or dummy variables.  */
+      gcc_assert (current_function_decl == NULL_TREE || sym->result == sym);
+      /* This is the declaration of a module variable.  */
+      TREE_PUBLIC (decl) = 1;
+      TREE_STATIC (decl) = 1;
+    }
+
+  /* Derived types are a bit peculiar because of the possibility of
+     a default initializer; this must be applied each time the variable
+     comes into scope it therefore need not be static.  These variables
+     are SAVE_NONE but have an initializer.  Otherwise explicitly
+     initialized variables are SAVE_IMPLICIT and explicitly saved are
+     SAVE_EXPLICIT.  */
+  if (!sym->attr.use_assoc
+	&& (sym->attr.save != SAVE_NONE || sym->attr.data
+	      || (sym->value && sym->ns->proc_name->attr.is_main_program)))
+    TREE_STATIC (decl) = 1;
+
+  if (sym->attr.volatile_)
+    {
+      TREE_THIS_VOLATILE (decl) = 1;
+      TREE_SIDE_EFFECTS (decl) = 1;
+      new_type = build_qualified_type (TREE_TYPE (decl), TYPE_QUAL_VOLATILE);
+      TREE_TYPE (decl) = new_type;
+    } 
+
+  /* Keep variables larger than max-stack-var-size off stack.  */
+  if (!sym->ns->proc_name->attr.recursive
+      && INTEGER_CST_P (DECL_SIZE_UNIT (decl))
+      && !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
+	 /* Put variable length auto array pointers always into stack.  */
+      && (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE
+	  || sym->attr.dimension == 0
+	  || sym->as->type != AS_EXPLICIT
+	  || sym->attr.pointer
+	  || sym->attr.allocatable)
+      && !DECL_ARTIFICIAL (decl))
+    TREE_STATIC (decl) = 1;
+
+  /* Handle threadprivate variables.  */
+  if (sym->attr.threadprivate
+      && (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
+    DECL_TLS_MODEL (decl) = decl_default_tls_model (decl);
+
+  if (!sym->attr.target
+      && !sym->attr.pointer
+      && !sym->attr.cray_pointee
+      && !sym->attr.proc_pointer)
+    DECL_RESTRICTED_P (decl) = 1;
+}
+
+
+/* Allocate the lang-specific part of a decl.  */
+
+void
+gfc_allocate_lang_decl (tree decl)
+{
+  DECL_LANG_SPECIFIC (decl) = ggc_alloc_cleared_lang_decl(sizeof
+							  (struct lang_decl));
+}
+
+/* Remember a symbol to generate initialization/cleanup code at function
+   entry/exit.  */
+
+static void
+gfc_defer_symbol_init (gfc_symbol * sym)
+{
+  gfc_symbol *p;
+  gfc_symbol *last;
+  gfc_symbol *head;
+
+  /* Don't add a symbol twice.  */
+  if (sym->tlink)
+    return;
+
+  last = head = sym->ns->proc_name;
+  p = last->tlink;
+
+  /* Make sure that setup code for dummy variables which are used in the
+     setup of other variables is generated first.  */
+  if (sym->attr.dummy)
+    {
+      /* Find the first dummy arg seen after us, or the first non-dummy arg.
+         This is a circular list, so don't go past the head.  */
+      while (p != head
+             && (!p->attr.dummy || p->dummy_order > sym->dummy_order))
+        {
+          last = p;
+          p = p->tlink;
+        }
+    }
+  /* Insert in between last and p.  */
+  last->tlink = sym;
+  sym->tlink = p;
+}
+
+
+/* Used in gfc_get_symbol_decl and gfc_get_derived_type to obtain the
+   backend_decl for a module symbol, if it all ready exists.  If the
+   module gsymbol does not exist, it is created.  If the symbol does
+   not exist, it is added to the gsymbol namespace.  Returns true if
+   an existing backend_decl is found.  */
+
+bool
+gfc_get_module_backend_decl (gfc_symbol *sym)
+{
+  gfc_gsymbol *gsym;
+  gfc_symbol *s;
+  gfc_symtree *st;
+
+  gsym =  gfc_find_gsymbol (gfc_gsym_root, sym->module);
+
+  if (!gsym || (gsym->ns && gsym->type == GSYM_MODULE))
+    {
+      st = NULL;
+      s = NULL;
+
+      if (gsym)
+	gfc_find_symbol (sym->name, gsym->ns, 0, &s);
+
+      if (!s)
+	{
+	  if (!gsym)
+	    {
+	      gsym = gfc_get_gsymbol (sym->module);
+	      gsym->type = GSYM_MODULE;
+	      gsym->ns = gfc_get_namespace (NULL, 0);
+	    }
+
+	  st = gfc_new_symtree (&gsym->ns->sym_root, sym->name);
+	  st->n.sym = sym;
+	  sym->refs++;
+	}
+      else if (sym->attr.flavor == FL_DERIVED)
+	{
+	  if (!s->backend_decl)
+	    s->backend_decl = gfc_get_derived_type (s);
+	  gfc_copy_dt_decls_ifequal (s, sym, true);
+	  return true;
+	}
+      else if (s->backend_decl)
+	{
+	  if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
+	    gfc_copy_dt_decls_ifequal (s->ts.u.derived, sym->ts.u.derived,
+				       true);
+	  else if (sym->ts.type == BT_CHARACTER)
+	    sym->ts.u.cl->backend_decl = s->ts.u.cl->backend_decl;
+	  sym->backend_decl = s->backend_decl;
+	  return true;
+	}
+    }
+  return false;
+}
+
+
+/* Create an array index type variable with function scope.  */
+
+static tree
+create_index_var (const char * pfx, int nest)
+{
+  tree decl;
+
+  decl = gfc_create_var_np (gfc_array_index_type, pfx);
+  if (nest)
+    gfc_add_decl_to_parent_function (decl);
+  else
+    gfc_add_decl_to_function (decl);
+  return decl;
+}
+
+
+/* Create variables to hold all the non-constant bits of info for a
+   descriptorless array.  Remember these in the lang-specific part of the
+   type.  */
+
+static void
+gfc_build_qualified_array (tree decl, gfc_symbol * sym)
+{
+  tree type;
+  int dim;
+  int nest;
+  gfc_namespace* procns;
+
+  type = TREE_TYPE (decl);
+
+  /* We just use the descriptor, if there is one.  */
+  if (GFC_DESCRIPTOR_TYPE_P (type))
+    return;
+
+  gcc_assert (GFC_ARRAY_TYPE_P (type));
+  procns = gfc_find_proc_namespace (sym->ns);
+  nest = (procns->proc_name->backend_decl != current_function_decl)
+	 && !sym->attr.contained;
+
+  for (dim = 0; dim < GFC_TYPE_ARRAY_RANK (type); dim++)
+    {
+      if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE)
+	{
+	  GFC_TYPE_ARRAY_LBOUND (type, dim) = create_index_var ("lbound", nest);
+	  TREE_NO_WARNING (GFC_TYPE_ARRAY_LBOUND (type, dim)) = 1;
+	}
+      /* Don't try to use the unknown bound for assumed shape arrays.  */
+      if (GFC_TYPE_ARRAY_UBOUND (type, dim) == NULL_TREE
+          && (sym->as->type != AS_ASSUMED_SIZE
+              || dim < GFC_TYPE_ARRAY_RANK (type) - 1))
+	{
+	  GFC_TYPE_ARRAY_UBOUND (type, dim) = create_index_var ("ubound", nest);
+	  TREE_NO_WARNING (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 1;
+	}
+
+      if (GFC_TYPE_ARRAY_STRIDE (type, dim) == NULL_TREE)
+	{
+	  GFC_TYPE_ARRAY_STRIDE (type, dim) = create_index_var ("stride", nest);
+	  TREE_NO_WARNING (GFC_TYPE_ARRAY_STRIDE (type, dim)) = 1;
+	}
+    }
+  if (GFC_TYPE_ARRAY_OFFSET (type) == NULL_TREE)
+    {
+      GFC_TYPE_ARRAY_OFFSET (type) = gfc_create_var_np (gfc_array_index_type,
+							"offset");
+      TREE_NO_WARNING (GFC_TYPE_ARRAY_OFFSET (type)) = 1;
+
+      if (nest)
+	gfc_add_decl_to_parent_function (GFC_TYPE_ARRAY_OFFSET (type));
+      else
+	gfc_add_decl_to_function (GFC_TYPE_ARRAY_OFFSET (type));
+    }
+
+  if (GFC_TYPE_ARRAY_SIZE (type) == NULL_TREE
+      && sym->as->type != AS_ASSUMED_SIZE)
+    {
+      GFC_TYPE_ARRAY_SIZE (type) = create_index_var ("size", nest);
+      TREE_NO_WARNING (GFC_TYPE_ARRAY_SIZE (type)) = 1;
+    }
+
+  if (POINTER_TYPE_P (type))
+    {
+      gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (type)));
+      gcc_assert (TYPE_LANG_SPECIFIC (type)
+		  == TYPE_LANG_SPECIFIC (TREE_TYPE (type)));
+      type = TREE_TYPE (type);
+    }
+
+  if (! COMPLETE_TYPE_P (type) && GFC_TYPE_ARRAY_SIZE (type))
+    {
+      tree size, range;
+
+      size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			      GFC_TYPE_ARRAY_SIZE (type), gfc_index_one_node);
+      range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
+				size);
+      TYPE_DOMAIN (type) = range;
+      layout_type (type);
+    }
+
+  if (TYPE_NAME (type) != NULL_TREE
+      && GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1) != NULL_TREE
+      && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1)) == VAR_DECL)
+    {
+      tree gtype = DECL_ORIGINAL_TYPE (TYPE_NAME (type));
+
+      for (dim = 0; dim < sym->as->rank - 1; dim++)
+	{
+	  gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE);
+	  gtype = TREE_TYPE (gtype);
+	}
+      gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE);
+      if (TYPE_MAX_VALUE (TYPE_DOMAIN (gtype)) == NULL)
+	TYPE_NAME (type) = NULL_TREE;
+    }
+
+  if (TYPE_NAME (type) == NULL_TREE)
+    {
+      tree gtype = TREE_TYPE (type), rtype, type_decl;
+
+      for (dim = sym->as->rank - 1; dim >= 0; dim--)
+	{
+	  tree lbound, ubound;
+	  lbound = GFC_TYPE_ARRAY_LBOUND (type, dim);
+	  ubound = GFC_TYPE_ARRAY_UBOUND (type, dim);
+	  rtype = build_range_type (gfc_array_index_type, lbound, ubound);
+	  gtype = build_array_type (gtype, rtype);
+	  /* Ensure the bound variables aren't optimized out at -O0.
+	     For -O1 and above they often will be optimized out, but
+	     can be tracked by VTA.  Also set DECL_NAMELESS, so that
+	     the artificial lbound.N or ubound.N DECL_NAME doesn't
+	     end up in debug info.  */
+	  if (lbound && TREE_CODE (lbound) == VAR_DECL
+	      && DECL_ARTIFICIAL (lbound) && DECL_IGNORED_P (lbound))
+	    {
+	      if (DECL_NAME (lbound)
+		  && strstr (IDENTIFIER_POINTER (DECL_NAME (lbound)),
+			     "lbound") != 0)
+		DECL_NAMELESS (lbound) = 1;
+	      DECL_IGNORED_P (lbound) = 0;
+	    }
+	  if (ubound && TREE_CODE (ubound) == VAR_DECL
+	      && DECL_ARTIFICIAL (ubound) && DECL_IGNORED_P (ubound))
+	    {
+	      if (DECL_NAME (ubound)
+		  && strstr (IDENTIFIER_POINTER (DECL_NAME (ubound)),
+			     "ubound") != 0)
+		DECL_NAMELESS (ubound) = 1;
+	      DECL_IGNORED_P (ubound) = 0;
+	    }
+	}
+      TYPE_NAME (type) = type_decl = build_decl (input_location,
+						 TYPE_DECL, NULL, gtype);
+      DECL_ORIGINAL_TYPE (type_decl) = gtype;
+    }
+}
+
+
+/* For some dummy arguments we don't use the actual argument directly.
+   Instead we create a local decl and use that.  This allows us to perform
+   initialization, and construct full type information.  */
+
+static tree
+gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
+{
+  tree decl;
+  tree type;
+  gfc_array_spec *as;
+  char *name;
+  gfc_packed packed;
+  int n;
+  bool known_size;
+
+  if (sym->attr.pointer || sym->attr.allocatable)
+    return dummy;
+
+  /* Add to list of variables if not a fake result variable.  */
+  if (sym->attr.result || sym->attr.dummy)
+    gfc_defer_symbol_init (sym);
+
+  type = TREE_TYPE (dummy);
+  gcc_assert (TREE_CODE (dummy) == PARM_DECL
+	  && POINTER_TYPE_P (type));
+
+  /* Do we know the element size?  */
+  known_size = sym->ts.type != BT_CHARACTER
+	  || INTEGER_CST_P (sym->ts.u.cl->backend_decl);
+  
+  if (known_size && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type)))
+    {
+      /* For descriptorless arrays with known element size the actual
+         argument is sufficient.  */
+      gcc_assert (GFC_ARRAY_TYPE_P (type));
+      gfc_build_qualified_array (dummy, sym);
+      return dummy;
+    }
+
+  type = TREE_TYPE (type);
+  if (GFC_DESCRIPTOR_TYPE_P (type))
+    {
+      /* Create a descriptorless array pointer.  */
+      as = sym->as;
+      packed = PACKED_NO;
+
+      /* Even when -frepack-arrays is used, symbols with TARGET attribute
+	 are not repacked.  */
+      if (!gfc_option.flag_repack_arrays || sym->attr.target)
+	{
+	  if (as->type == AS_ASSUMED_SIZE)
+	    packed = PACKED_FULL;
+	}
+      else
+	{
+	  if (as->type == AS_EXPLICIT)
+	    {
+	      packed = PACKED_FULL;
+	      for (n = 0; n < as->rank; n++)
+		{
+		  if (!(as->upper[n]
+			&& as->lower[n]
+			&& as->upper[n]->expr_type == EXPR_CONSTANT
+			&& as->lower[n]->expr_type == EXPR_CONSTANT))
+		    packed = PACKED_PARTIAL;
+		}
+	    }
+	  else
+	    packed = PACKED_PARTIAL;
+	}
+
+      type = gfc_typenode_for_spec (&sym->ts);
+      type = gfc_get_nodesc_array_type (type, sym->as, packed,
+					!sym->attr.target);
+    }
+  else
+    {
+      /* We now have an expression for the element size, so create a fully
+	 qualified type.  Reset sym->backend decl or this will just return the
+	 old type.  */
+      DECL_ARTIFICIAL (sym->backend_decl) = 1;
+      sym->backend_decl = NULL_TREE;
+      type = gfc_sym_type (sym);
+      packed = PACKED_FULL;
+    }
+
+  ASM_FORMAT_PRIVATE_NAME (name, IDENTIFIER_POINTER (DECL_NAME (dummy)), 0);
+  decl = build_decl (input_location,
+		     VAR_DECL, get_identifier (name), type);
+
+  DECL_ARTIFICIAL (decl) = 1;
+  DECL_NAMELESS (decl) = 1;
+  TREE_PUBLIC (decl) = 0;
+  TREE_STATIC (decl) = 0;
+  DECL_EXTERNAL (decl) = 0;
+
+  /* We should never get deferred shape arrays here.  We used to because of
+     frontend bugs.  */
+  gcc_assert (sym->as->type != AS_DEFERRED);
+
+  if (packed == PACKED_PARTIAL)
+    GFC_DECL_PARTIAL_PACKED_ARRAY (decl) = 1;
+  else if (packed == PACKED_FULL)
+    GFC_DECL_PACKED_ARRAY (decl) = 1;
+
+  gfc_build_qualified_array (decl, sym);
+
+  if (DECL_LANG_SPECIFIC (dummy))
+    DECL_LANG_SPECIFIC (decl) = DECL_LANG_SPECIFIC (dummy);
+  else
+    gfc_allocate_lang_decl (decl);
+
+  GFC_DECL_SAVED_DESCRIPTOR (decl) = dummy;
+
+  if (sym->ns->proc_name->backend_decl == current_function_decl
+      || sym->attr.contained)
+    gfc_add_decl_to_function (decl);
+  else
+    gfc_add_decl_to_parent_function (decl);
+
+  return decl;
+}
+
+/* For symbol SYM with GFC_DECL_SAVED_DESCRIPTOR used in contained
+   function add a VAR_DECL to the current function with DECL_VALUE_EXPR
+   pointing to the artificial variable for debug info purposes.  */
+
+static void
+gfc_nonlocal_dummy_array_decl (gfc_symbol *sym)
+{
+  tree decl, dummy;
+
+  if (! nonlocal_dummy_decl_pset)
+    nonlocal_dummy_decl_pset = pointer_set_create ();
+
+  if (pointer_set_insert (nonlocal_dummy_decl_pset, sym->backend_decl))
+    return;
+
+  dummy = GFC_DECL_SAVED_DESCRIPTOR (sym->backend_decl);
+  decl = build_decl (input_location, VAR_DECL, DECL_NAME (dummy),
+		     TREE_TYPE (sym->backend_decl));
+  DECL_ARTIFICIAL (decl) = 0;
+  TREE_USED (decl) = 1;
+  TREE_PUBLIC (decl) = 0;
+  TREE_STATIC (decl) = 0;
+  DECL_EXTERNAL (decl) = 0;
+  if (DECL_BY_REFERENCE (dummy))
+    DECL_BY_REFERENCE (decl) = 1;
+  DECL_LANG_SPECIFIC (decl) = DECL_LANG_SPECIFIC (sym->backend_decl);
+  SET_DECL_VALUE_EXPR (decl, sym->backend_decl);
+  DECL_HAS_VALUE_EXPR_P (decl) = 1;
+  DECL_CONTEXT (decl) = DECL_CONTEXT (sym->backend_decl);
+  DECL_CHAIN (decl) = nonlocal_dummy_decls;
+  nonlocal_dummy_decls = decl;
+}
+
+/* Return a constant or a variable to use as a string length.  Does not
+   add the decl to the current scope.  */
+
+static tree
+gfc_create_string_length (gfc_symbol * sym)
+{
+  gcc_assert (sym->ts.u.cl);
+  gfc_conv_const_charlen (sym->ts.u.cl);
+
+  if (sym->ts.u.cl->backend_decl == NULL_TREE)
+    {
+      tree length;
+      char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2];
+
+      /* Also prefix the mangled name.  */
+      strcpy (&name[1], sym->name);
+      name[0] = '.';
+      length = build_decl (input_location,
+			   VAR_DECL, get_identifier (name),
+			   gfc_charlen_type_node);
+      DECL_ARTIFICIAL (length) = 1;
+      TREE_USED (length) = 1;
+      if (sym->ns->proc_name->tlink != NULL)
+	gfc_defer_symbol_init (sym);
+
+      sym->ts.u.cl->backend_decl = length;
+    }
+
+  gcc_assert (sym->ts.u.cl->backend_decl != NULL_TREE);
+  return sym->ts.u.cl->backend_decl;
+}
+
+/* If a variable is assigned a label, we add another two auxiliary
+   variables.  */
+
+static void
+gfc_add_assign_aux_vars (gfc_symbol * sym)
+{
+  tree addr;
+  tree length;
+  tree decl;
+
+  gcc_assert (sym->backend_decl);
+
+  decl = sym->backend_decl;
+  gfc_allocate_lang_decl (decl);
+  GFC_DECL_ASSIGN (decl) = 1;
+  length = build_decl (input_location,
+		       VAR_DECL, create_tmp_var_name (sym->name),
+		       gfc_charlen_type_node);
+  addr = build_decl (input_location,
+		     VAR_DECL, create_tmp_var_name (sym->name),
+		     pvoid_type_node);
+  gfc_finish_var_decl (length, sym);
+  gfc_finish_var_decl (addr, sym);
+  /*  STRING_LENGTH is also used as flag. Less than -1 means that
+      ASSIGN_ADDR can not be used. Equal -1 means that ASSIGN_ADDR is the
+      target label's address. Otherwise, value is the length of a format string
+      and ASSIGN_ADDR is its address.  */
+  if (TREE_STATIC (length))
+    DECL_INITIAL (length) = build_int_cst (NULL_TREE, -2);
+  else
+    gfc_defer_symbol_init (sym);
+
+  GFC_DECL_STRING_LEN (decl) = length;
+  GFC_DECL_ASSIGN_ADDR (decl) = addr;
+}
+
+
+static tree
+add_attributes_to_decl (symbol_attribute sym_attr, tree list)
+{
+  unsigned id;
+  tree attr;
+
+  for (id = 0; id < EXT_ATTR_NUM; id++)
+    if (sym_attr.ext_attr & (1 << id))
+      {
+	attr = build_tree_list (
+		 get_identifier (ext_attr_list[id].middle_end_name),
+				 NULL_TREE);
+	list = chainon (list, attr);
+      }
+
+  return list;
+}
+
+
+static void build_function_decl (gfc_symbol * sym, bool global);
+
+
+/* Return the decl for a gfc_symbol, create it if it doesn't already
+   exist.  */
+
+tree
+gfc_get_symbol_decl (gfc_symbol * sym)
+{
+  tree decl;
+  tree length = NULL_TREE;
+  tree attributes;
+  int byref;
+  bool intrinsic_array_parameter = false;
+
+  gcc_assert (sym->attr.referenced
+		|| sym->attr.use_assoc
+		|| sym->ns->proc_name->attr.if_source == IFSRC_IFBODY
+		|| (sym->module && sym->attr.if_source != IFSRC_DECL
+		    && sym->backend_decl));
+
+  if (sym->ns && sym->ns->proc_name && sym->ns->proc_name->attr.function)
+    byref = gfc_return_by_reference (sym->ns->proc_name);
+  else
+    byref = 0;
+
+  /* Make sure that the vtab for the declared type is completed.  */
+  if (sym->ts.type == BT_CLASS)
+    {
+      gfc_component *c = CLASS_DATA (sym);
+      if (!c->ts.u.derived->backend_decl)
+	{
+	  gfc_find_derived_vtab (c->ts.u.derived);
+	  gfc_get_derived_type (sym->ts.u.derived);
+	}
+    }
+
+  /* All deferred character length procedures need to retain the backend
+     decl, which is a pointer to the character length in the caller's
+     namespace and to declare a local character length.  */
+  if (!byref && sym->attr.function
+	&& sym->ts.type == BT_CHARACTER
+	&& sym->ts.deferred
+	&& sym->ts.u.cl->passed_length == NULL
+	&& sym->ts.u.cl->backend_decl
+	&& TREE_CODE (sym->ts.u.cl->backend_decl) == PARM_DECL)
+    {
+      sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
+      sym->ts.u.cl->backend_decl = NULL_TREE;
+      length = gfc_create_string_length (sym);
+    }
+
+  if ((sym->attr.dummy && ! sym->attr.function) || (sym->attr.result && byref))
+    {
+      /* Return via extra parameter.  */
+      if (sym->attr.result && byref
+	  && !sym->backend_decl)
+	{
+	  sym->backend_decl =
+	    DECL_ARGUMENTS (sym->ns->proc_name->backend_decl);
+	  /* For entry master function skip over the __entry
+	     argument.  */
+	  if (sym->ns->proc_name->attr.entry_master)
+	    sym->backend_decl = DECL_CHAIN (sym->backend_decl);
+	}
+
+      /* Dummy variables should already have been created.  */
+      gcc_assert (sym->backend_decl);
+
+      /* Create a character length variable.  */
+      if (sym->ts.type == BT_CHARACTER)
+	{
+	  /* For a deferred dummy, make a new string length variable.  */
+	  if (sym->ts.deferred
+		&&
+	     (sym->ts.u.cl->passed_length == sym->ts.u.cl->backend_decl))
+	    sym->ts.u.cl->backend_decl = NULL_TREE;
+
+	  if (sym->ts.deferred && sym->attr.result
+		&& sym->ts.u.cl->passed_length == NULL
+		&& sym->ts.u.cl->backend_decl)
+	    {
+	      sym->ts.u.cl->passed_length = sym->ts.u.cl->backend_decl;
+	      sym->ts.u.cl->backend_decl = NULL_TREE;
+	    }
+
+	  if (sym->ts.u.cl->backend_decl == NULL_TREE)
+	    length = gfc_create_string_length (sym);
+	  else
+	    length = sym->ts.u.cl->backend_decl;
+	  if (TREE_CODE (length) == VAR_DECL
+	      && DECL_FILE_SCOPE_P (length))
+	    {
+	      /* Add the string length to the same context as the symbol.  */
+	      if (DECL_CONTEXT (sym->backend_decl) == current_function_decl)
+	        gfc_add_decl_to_function (length);
+	      else
+		gfc_add_decl_to_parent_function (length);
+
+	      gcc_assert (DECL_CONTEXT (sym->backend_decl) ==
+			    DECL_CONTEXT (length));
+
+	      gfc_defer_symbol_init (sym);
+	    }
+	}
+
+      /* Use a copy of the descriptor for dummy arrays.  */
+      if (sym->attr.dimension && !TREE_USED (sym->backend_decl))
+        {
+	  decl = gfc_build_dummy_array_decl (sym, sym->backend_decl);
+	  /* Prevent the dummy from being detected as unused if it is copied.  */
+	  if (sym->backend_decl != NULL && decl != sym->backend_decl)
+	    DECL_ARTIFICIAL (sym->backend_decl) = 1;
+	  sym->backend_decl = decl;
+	}
+
+      TREE_USED (sym->backend_decl) = 1;
+      if (sym->attr.assign && GFC_DECL_ASSIGN (sym->backend_decl) == 0)
+	{
+	  gfc_add_assign_aux_vars (sym);
+	}
+
+      if (sym->attr.dimension
+	  && DECL_LANG_SPECIFIC (sym->backend_decl)
+	  && GFC_DECL_SAVED_DESCRIPTOR (sym->backend_decl)
+	  && DECL_CONTEXT (sym->backend_decl) != current_function_decl)
+	gfc_nonlocal_dummy_array_decl (sym);
+
+      return sym->backend_decl;
+    }
+
+  if (sym->backend_decl)
+    return sym->backend_decl;
+
+  /* Special case for array-valued named constants from intrinsic
+     procedures; those are inlined.  */
+  if (sym->attr.use_assoc && sym->from_intmod
+      && sym->attr.flavor == FL_PARAMETER)
+    intrinsic_array_parameter = true;
+
+  /* If use associated and whole file compilation, use the module
+     declaration.  */
+  if (gfc_option.flag_whole_file
+	&& (sym->attr.flavor == FL_VARIABLE
+	    || sym->attr.flavor == FL_PARAMETER)
+	&& sym->attr.use_assoc
+	&& !intrinsic_array_parameter
+	&& sym->module
+	&& gfc_get_module_backend_decl (sym))
+    return sym->backend_decl;
+
+  if (sym->attr.flavor == FL_PROCEDURE)
+    {
+      /* Catch function declarations. Only used for actual parameters,
+	 procedure pointers and procptr initialization targets.  */
+      if (sym->attr.external || sym->attr.use_assoc || sym->attr.intrinsic)
+	{
+	  decl = gfc_get_extern_function_decl (sym);
+	  gfc_set_decl_location (decl, &sym->declared_at);
+	}
+      else
+	{
+	  if (!sym->backend_decl)
+	    build_function_decl (sym, false);
+	  decl = sym->backend_decl;
+	}
+      return decl;
+    }
+
+  if (sym->attr.intrinsic)
+    internal_error ("intrinsic variable which isn't a procedure");
+
+  /* Create string length decl first so that they can be used in the
+     type declaration.  */
+  if (sym->ts.type == BT_CHARACTER)
+    length = gfc_create_string_length (sym);
+
+  /* Create the decl for the variable.  */
+  decl = build_decl (sym->declared_at.lb->location,
+		     VAR_DECL, gfc_sym_identifier (sym), gfc_sym_type (sym));
+
+  /* Add attributes to variables.  Functions are handled elsewhere.  */
+  attributes = add_attributes_to_decl (sym->attr, NULL_TREE);
+  decl_attributes (&decl, attributes, 0);
+
+  /* Symbols from modules should have their assembler names mangled.
+     This is done here rather than in gfc_finish_var_decl because it
+     is different for string length variables.  */
+  if (sym->module)
+    {
+      gfc_set_decl_assembler_name (decl, gfc_sym_mangled_identifier (sym));
+      if (sym->attr.use_assoc && !intrinsic_array_parameter)
+	DECL_IGNORED_P (decl) = 1;
+    }
+
+  if (sym->attr.dimension)
+    {
+      /* Create variables to hold the non-constant bits of array info.  */
+      gfc_build_qualified_array (decl, sym);
+
+      if (sym->attr.contiguous
+	  || ((sym->attr.allocatable || !sym->attr.dummy) && !sym->attr.pointer))
+	GFC_DECL_PACKED_ARRAY (decl) = 1;
+    }
+
+  /* Remember this variable for allocation/cleanup.  */
+  if (sym->attr.dimension || sym->attr.allocatable
+      || (sym->ts.type == BT_CLASS &&
+	  (CLASS_DATA (sym)->attr.dimension
+	   || CLASS_DATA (sym)->attr.allocatable))
+      || (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp)
+      /* This applies a derived type default initializer.  */
+      || (sym->ts.type == BT_DERIVED
+	  && sym->attr.save == SAVE_NONE
+	  && !sym->attr.data
+	  && !sym->attr.allocatable
+	  && (sym->value && !sym->ns->proc_name->attr.is_main_program)
+	  && !(sym->attr.use_assoc && !intrinsic_array_parameter)))
+    gfc_defer_symbol_init (sym);
+
+  gfc_finish_var_decl (decl, sym);
+
+  if (sym->ts.type == BT_CHARACTER)
+    {
+      /* Character variables need special handling.  */
+      gfc_allocate_lang_decl (decl);
+
+      if (TREE_CODE (length) != INTEGER_CST)
+	{
+	  char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2];
+
+	  if (sym->module)
+	    {
+	      /* Also prefix the mangled name for symbols from modules.  */
+	      strcpy (&name[1], sym->name);
+	      name[0] = '.';
+	      strcpy (&name[1],
+		      IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (length)));
+	      gfc_set_decl_assembler_name (decl, get_identifier (name));
+	    }
+	  gfc_finish_var_decl (length, sym);
+	  gcc_assert (!sym->value);
+	}
+    }
+  else if (sym->attr.subref_array_pointer)
+    {
+      /* We need the span for these beasts.  */
+      gfc_allocate_lang_decl (decl);
+    }
+
+  if (sym->attr.subref_array_pointer)
+    {
+      tree span;
+      GFC_DECL_SUBREF_ARRAY_P (decl) = 1;
+      span = build_decl (input_location,
+			 VAR_DECL, create_tmp_var_name ("span"),
+			 gfc_array_index_type);
+      gfc_finish_var_decl (span, sym);
+      TREE_STATIC (span) = TREE_STATIC (decl);
+      DECL_ARTIFICIAL (span) = 1;
+
+      GFC_DECL_SPAN (decl) = span;
+      GFC_TYPE_ARRAY_SPAN (TREE_TYPE (decl)) = span;
+    }
+
+  sym->backend_decl = decl;
+
+  if (sym->attr.assign)
+    gfc_add_assign_aux_vars (sym);
+
+  if (intrinsic_array_parameter)
+    {
+      TREE_STATIC (decl) = 1;
+      DECL_EXTERNAL (decl) = 0;
+    }
+
+  if (TREE_STATIC (decl)
+      && !(sym->attr.use_assoc && !intrinsic_array_parameter)
+      && (sym->attr.save || sym->ns->proc_name->attr.is_main_program
+	  || gfc_option.flag_max_stack_var_size == 0
+	  || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE))
+    {
+      /* Add static initializer. For procedures, it is only needed if
+	 SAVE is specified otherwise they need to be reinitialized
+	 every time the procedure is entered. The TREE_STATIC is
+	 in this case due to -fmax-stack-var-size=.  */
+      DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts,
+						  TREE_TYPE (decl),
+						  sym->attr.dimension,
+						  sym->attr.pointer
+						  || sym->attr.allocatable,
+						  sym->attr.proc_pointer);
+    }
+
+  if (!TREE_STATIC (decl)
+      && POINTER_TYPE_P (TREE_TYPE (decl))
+      && !sym->attr.pointer
+      && !sym->attr.allocatable
+      && !sym->attr.proc_pointer)
+    DECL_BY_REFERENCE (decl) = 1;
+
+  return decl;
+}
+
+
+/* Substitute a temporary variable in place of the real one.  */
+
+void
+gfc_shadow_sym (gfc_symbol * sym, tree decl, gfc_saved_var * save)
+{
+  save->attr = sym->attr;
+  save->decl = sym->backend_decl;
+
+  gfc_clear_attr (&sym->attr);
+  sym->attr.referenced = 1;
+  sym->attr.flavor = FL_VARIABLE;
+
+  sym->backend_decl = decl;
+}
+
+
+/* Restore the original variable.  */
+
+void
+gfc_restore_sym (gfc_symbol * sym, gfc_saved_var * save)
+{
+  sym->attr = save->attr;
+  sym->backend_decl = save->decl;
+}
+
+
+/* Declare a procedure pointer.  */
+
+static tree
+get_proc_pointer_decl (gfc_symbol *sym)
+{
+  tree decl;
+  tree attributes;
+
+  decl = sym->backend_decl;
+  if (decl)
+    return decl;
+
+  decl = build_decl (input_location,
+		     VAR_DECL, get_identifier (sym->name),
+		     build_pointer_type (gfc_get_function_type (sym)));
+
+  if ((sym->ns->proc_name
+      && sym->ns->proc_name->backend_decl == current_function_decl)
+      || sym->attr.contained)
+    gfc_add_decl_to_function (decl);
+  else if (sym->ns->proc_name->attr.flavor != FL_MODULE)
+    gfc_add_decl_to_parent_function (decl);
+
+  sym->backend_decl = decl;
+
+  /* If a variable is USE associated, it's always external.  */
+  if (sym->attr.use_assoc)
+    {
+      DECL_EXTERNAL (decl) = 1;
+      TREE_PUBLIC (decl) = 1;
+    }
+  else if (sym->module && sym->ns->proc_name->attr.flavor == FL_MODULE)
+    {
+      /* This is the declaration of a module variable.  */
+      TREE_PUBLIC (decl) = 1;
+      TREE_STATIC (decl) = 1;
+    }
+
+  if (!sym->attr.use_assoc
+	&& (sym->attr.save != SAVE_NONE || sym->attr.data
+	      || (sym->value && sym->ns->proc_name->attr.is_main_program)))
+    TREE_STATIC (decl) = 1;
+
+  if (TREE_STATIC (decl) && sym->value)
+    {
+      /* Add static initializer.  */
+      DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts,
+						  TREE_TYPE (decl),
+						  sym->attr.dimension,
+						  false, true);
+    }
+
+  attributes = add_attributes_to_decl (sym->attr, NULL_TREE);
+  decl_attributes (&decl, attributes, 0);
+
+  return decl;
+}
+
+
+/* Get a basic decl for an external function.  */
+
+tree
+gfc_get_extern_function_decl (gfc_symbol * sym)
+{
+  tree type;
+  tree fndecl;
+  tree attributes;
+  gfc_expr e;
+  gfc_intrinsic_sym *isym;
+  gfc_expr argexpr;
+  char s[GFC_MAX_SYMBOL_LEN + 23]; /* "_gfortran_f2c_specific" and '\0'.  */
+  tree name;
+  tree mangled_name;
+  gfc_gsymbol *gsym;
+  bool proc_formal_arg;
+
+  if (sym->backend_decl)
+    return sym->backend_decl;
+
+  /* We should never be creating external decls for alternate entry points.
+     The procedure may be an alternate entry point, but we don't want/need
+     to know that.  */
+  gcc_assert (!(sym->attr.entry || sym->attr.entry_master));
+
+  if (sym->attr.proc_pointer)
+    return get_proc_pointer_decl (sym);
+
+  /* See if this is an external procedure from the same file.  If so,
+     return the backend_decl.  */
+  gsym =  gfc_find_gsymbol (gfc_gsym_root, sym->name);
+
+  /* Do not use procedures that have a procedure argument because this
+     can result in problems of multiple decls during inlining.  */
+  proc_formal_arg = false;
+  if (gsym && gsym->ns && gsym->ns->proc_name)
+    {
+      gfc_formal_arglist *formal = gsym->ns->proc_name->formal;
+      for (; formal; formal = formal->next)
+	{
+	  if (formal->sym && formal->sym->attr.flavor == FL_PROCEDURE)
+	    {
+	      proc_formal_arg = true;
+	      break;
+	    }
+	}
+    }
+
+  if (gfc_option.flag_whole_file
+	&& (!sym->attr.use_assoc || sym->attr.if_source != IFSRC_DECL)
+	&& !sym->backend_decl
+	&& gsym && gsym->ns
+	&& !proc_formal_arg
+	&& ((gsym->type == GSYM_SUBROUTINE) || (gsym->type == GSYM_FUNCTION))
+	&& (gsym->ns->proc_name->backend_decl || !sym->attr.intrinsic))
+    {
+      if (!gsym->ns->proc_name->backend_decl)
+	{
+	  /* By construction, the external function cannot be
+	     a contained procedure.  */
+	  locus old_loc;
+	  tree save_fn_decl = current_function_decl;
+
+	  current_function_decl = NULL_TREE;
+	  gfc_save_backend_locus (&old_loc);
+	  push_cfun (cfun);
+
+	  gfc_create_function_decl (gsym->ns, true);
+
+	  pop_cfun ();
+	  gfc_restore_backend_locus (&old_loc);
+	  current_function_decl = save_fn_decl;
+	}
+
+      /* If the namespace has entries, the proc_name is the
+	 entry master.  Find the entry and use its backend_decl.
+	 otherwise, use the proc_name backend_decl.  */
+      if (gsym->ns->entries)
+	{
+	  gfc_entry_list *entry = gsym->ns->entries;
+
+	  for (; entry; entry = entry->next)
+	    {
+	      if (strcmp (gsym->name, entry->sym->name) == 0)
+		{
+	          sym->backend_decl = entry->sym->backend_decl;
+		  break;
+		}
+	    }
+	}
+      else
+	sym->backend_decl = gsym->ns->proc_name->backend_decl;
+
+      if (sym->backend_decl)
+	{
+	  /* Avoid problems of double deallocation of the backend declaration
+	     later in gfc_trans_use_stmts; cf. PR 45087.  */
+	  if (sym->attr.if_source != IFSRC_DECL && sym->attr.use_assoc)
+	    sym->attr.use_assoc = 0;
+
+	  return sym->backend_decl;
+	}
+    }
+
+  /* See if this is a module procedure from the same file.  If so,
+     return the backend_decl.  */
+  if (sym->module)
+    gsym =  gfc_find_gsymbol (gfc_gsym_root, sym->module);
+
+  if (gfc_option.flag_whole_file
+	&& gsym && gsym->ns
+	&& gsym->type == GSYM_MODULE)
+    {
+      gfc_symbol *s;
+
+      s = NULL;
+      gfc_find_symbol (sym->name, gsym->ns, 0, &s);
+      if (s && s->backend_decl)
+	{
+	  if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
+	    gfc_copy_dt_decls_ifequal (s->ts.u.derived, sym->ts.u.derived,
+				       true);
+	  else if (sym->ts.type == BT_CHARACTER)
+	    sym->ts.u.cl->backend_decl = s->ts.u.cl->backend_decl;
+	  sym->backend_decl = s->backend_decl;
+	  return sym->backend_decl;
+	}
+    }
+
+  if (sym->attr.intrinsic)
+    {
+      /* Call the resolution function to get the actual name.  This is
+         a nasty hack which relies on the resolution functions only looking
+	 at the first argument.  We pass NULL for the second argument
+	 otherwise things like AINT get confused.  */
+      isym = gfc_find_function (sym->name);
+      gcc_assert (isym->resolve.f0 != NULL);
+
+      memset (&e, 0, sizeof (e));
+      e.expr_type = EXPR_FUNCTION;
+
+      memset (&argexpr, 0, sizeof (argexpr));
+      gcc_assert (isym->formal);
+      argexpr.ts = isym->formal->ts;
+
+      if (isym->formal->next == NULL)
+	isym->resolve.f1 (&e, &argexpr);
+      else
+	{
+	  if (isym->formal->next->next == NULL)
+	    isym->resolve.f2 (&e, &argexpr, NULL);
+	  else
+	    {
+	      if (isym->formal->next->next->next == NULL)
+		isym->resolve.f3 (&e, &argexpr, NULL, NULL);
+	      else
+		{
+		  /* All specific intrinsics take less than 5 arguments.  */
+		  gcc_assert (isym->formal->next->next->next->next == NULL);
+		  isym->resolve.f4 (&e, &argexpr, NULL, NULL, NULL);
+		}
+	    }
+	}
+
+      if (gfc_option.flag_f2c
+	  && ((e.ts.type == BT_REAL && e.ts.kind == gfc_default_real_kind)
+	      || e.ts.type == BT_COMPLEX))
+	{
+	  /* Specific which needs a different implementation if f2c
+	     calling conventions are used.  */
+	  sprintf (s, "_gfortran_f2c_specific%s", e.value.function.name);
+	}
+      else
+	sprintf (s, "_gfortran_specific%s", e.value.function.name);
+
+      name = get_identifier (s);
+      mangled_name = name;
+    }
+  else
+    {
+      name = gfc_sym_identifier (sym);
+      mangled_name = gfc_sym_mangled_function_id (sym);
+    }
+
+  type = gfc_get_function_type (sym);
+  fndecl = build_decl (input_location,
+		       FUNCTION_DECL, name, type);
+
+  /* Initialize DECL_EXTERNAL and TREE_PUBLIC before calling decl_attributes;
+     TREE_PUBLIC specifies whether a function is globally addressable (i.e.
+     the the opposite of declaring a function as static in C).  */
+  DECL_EXTERNAL (fndecl) = 1;
+  TREE_PUBLIC (fndecl) = 1;
+
+  attributes = add_attributes_to_decl (sym->attr, NULL_TREE);
+  decl_attributes (&fndecl, attributes, 0);
+
+  gfc_set_decl_assembler_name (fndecl, mangled_name);
+
+  /* Set the context of this decl.  */
+  if (0 && sym->ns && sym->ns->proc_name)
+    {
+      /* TODO: Add external decls to the appropriate scope.  */
+      DECL_CONTEXT (fndecl) = sym->ns->proc_name->backend_decl;
+    }
+  else
+    {
+      /* Global declaration, e.g. intrinsic subroutine.  */
+      DECL_CONTEXT (fndecl) = NULL_TREE;
+    }
+
+  /* Set attributes for PURE functions. A call to PURE function in the
+     Fortran 95 sense is both pure and without side effects in the C
+     sense.  */
+  if (sym->attr.pure || sym->attr.elemental)
+    {
+      if (sym->attr.function && !gfc_return_by_reference (sym))
+	DECL_PURE_P (fndecl) = 1;
+      /* TODO: check if pure SUBROUTINEs don't have INTENT(OUT)
+	 parameters and don't use alternate returns (is this
+	 allowed?). In that case, calls to them are meaningless, and
+	 can be optimized away. See also in build_function_decl().  */
+      TREE_SIDE_EFFECTS (fndecl) = 0;
+    }
+
+  /* Mark non-returning functions.  */
+  if (sym->attr.noreturn)
+      TREE_THIS_VOLATILE(fndecl) = 1;
+
+  sym->backend_decl = fndecl;
+
+  if (DECL_CONTEXT (fndecl) == NULL_TREE)
+    pushdecl_top_level (fndecl);
+
+  return fndecl;
+}
+
+
+/* Create a declaration for a procedure.  For external functions (in the C
+   sense) use gfc_get_extern_function_decl.  HAS_ENTRIES is true if this is
+   a master function with alternate entry points.  */
+
+static void
+build_function_decl (gfc_symbol * sym, bool global)
+{
+  tree fndecl, type, attributes;
+  symbol_attribute attr;
+  tree result_decl;
+  gfc_formal_arglist *f;
+
+  gcc_assert (!sym->attr.external);
+
+  if (sym->backend_decl)
+    return;
+
+  /* Set the line and filename.  sym->declared_at seems to point to the
+     last statement for subroutines, but it'll do for now.  */
+  gfc_set_backend_locus (&sym->declared_at);
+
+  /* Allow only one nesting level.  Allow public declarations.  */
+  gcc_assert (current_function_decl == NULL_TREE
+	      || DECL_FILE_SCOPE_P (current_function_decl)
+	      || (TREE_CODE (DECL_CONTEXT (current_function_decl))
+		  == NAMESPACE_DECL));
+
+  type = gfc_get_function_type (sym);
+  fndecl = build_decl (input_location,
+		       FUNCTION_DECL, gfc_sym_identifier (sym), type);
+
+  attr = sym->attr;
+
+  /* Initialize DECL_EXTERNAL and TREE_PUBLIC before calling decl_attributes;
+     TREE_PUBLIC specifies whether a function is globally addressable (i.e.
+     the the opposite of declaring a function as static in C).  */
+  DECL_EXTERNAL (fndecl) = 0;
+
+  if (!current_function_decl
+      && !sym->attr.entry_master && !sym->attr.is_main_program)
+    TREE_PUBLIC (fndecl) = 1;
+
+  attributes = add_attributes_to_decl (attr, NULL_TREE);
+  decl_attributes (&fndecl, attributes, 0);
+
+  /* Figure out the return type of the declared function, and build a
+     RESULT_DECL for it.  If this is a subroutine with alternate
+     returns, build a RESULT_DECL for it.  */
+  result_decl = NULL_TREE;
+  /* TODO: Shouldn't this just be TREE_TYPE (TREE_TYPE (fndecl)).  */
+  if (attr.function)
+    {
+      if (gfc_return_by_reference (sym))
+	type = void_type_node;
+      else
+	{
+	  if (sym->result != sym)
+	    result_decl = gfc_sym_identifier (sym->result);
+
+	  type = TREE_TYPE (TREE_TYPE (fndecl));
+	}
+    }
+  else
+    {
+      /* Look for alternate return placeholders.  */
+      int has_alternate_returns = 0;
+      for (f = sym->formal; f; f = f->next)
+	{
+	  if (f->sym == NULL)
+	    {
+	      has_alternate_returns = 1;
+	      break;
+	    }
+	}
+
+      if (has_alternate_returns)
+	type = integer_type_node;
+      else
+	type = void_type_node;
+    }
+
+  result_decl = build_decl (input_location,
+			    RESULT_DECL, result_decl, type);
+  DECL_ARTIFICIAL (result_decl) = 1;
+  DECL_IGNORED_P (result_decl) = 1;
+  DECL_CONTEXT (result_decl) = fndecl;
+  DECL_RESULT (fndecl) = result_decl;
+
+  /* Don't call layout_decl for a RESULT_DECL.
+     layout_decl (result_decl, 0);  */
+
+  /* TREE_STATIC means the function body is defined here.  */
+  TREE_STATIC (fndecl) = 1;
+
+  /* Set attributes for PURE functions. A call to a PURE function in the
+     Fortran 95 sense is both pure and without side effects in the C
+     sense.  */
+  if (attr.pure || attr.elemental)
+    {
+      /* TODO: check if a pure SUBROUTINE has no INTENT(OUT) arguments
+	 including an alternate return. In that case it can also be
+	 marked as PURE. See also in gfc_get_extern_function_decl().  */
+      if (attr.function && !gfc_return_by_reference (sym))
+	DECL_PURE_P (fndecl) = 1;
+      TREE_SIDE_EFFECTS (fndecl) = 0;
+    }
+
+
+  /* Layout the function declaration and put it in the binding level
+     of the current function.  */
+
+  if (global)
+    pushdecl_top_level (fndecl);
+  else
+    pushdecl (fndecl);
+
+  /* Perform name mangling if this is a top level or module procedure.  */
+  if (current_function_decl == NULL_TREE)
+    gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id (sym));
+
+  sym->backend_decl = fndecl;
+}
+
+
+/* Create the DECL_ARGUMENTS for a procedure.  */
+
+static void
+create_function_arglist (gfc_symbol * sym)
+{
+  tree fndecl;
+  gfc_formal_arglist *f;
+  tree typelist, hidden_typelist;
+  tree arglist, hidden_arglist;
+  tree type;
+  tree parm;
+
+  fndecl = sym->backend_decl;
+
+  /* Build formal argument list. Make sure that their TREE_CONTEXT is
+     the new FUNCTION_DECL node.  */
+  arglist = NULL_TREE;
+  hidden_arglist = NULL_TREE;
+  typelist = TYPE_ARG_TYPES (TREE_TYPE (fndecl));
+
+  if (sym->attr.entry_master)
+    {
+      type = TREE_VALUE (typelist);
+      parm = build_decl (input_location,
+			 PARM_DECL, get_identifier ("__entry"), type);
+      
+      DECL_CONTEXT (parm) = fndecl;
+      DECL_ARG_TYPE (parm) = type;
+      TREE_READONLY (parm) = 1;
+      gfc_finish_decl (parm);
+      DECL_ARTIFICIAL (parm) = 1;
+
+      arglist = chainon (arglist, parm);
+      typelist = TREE_CHAIN (typelist);
+    }
+
+  if (gfc_return_by_reference (sym))
+    {
+      tree type = TREE_VALUE (typelist), length = NULL;
+
+      if (sym->ts.type == BT_CHARACTER)
+	{
+	  /* Length of character result.  */
+	  tree len_type = TREE_VALUE (TREE_CHAIN (typelist));
+
+	  length = build_decl (input_location,
+			       PARM_DECL,
+			       get_identifier (".__result"),
+			       len_type);
+	  if (!sym->ts.u.cl->length)
+	    {
+	      sym->ts.u.cl->backend_decl = length;
+	      TREE_USED (length) = 1;
+	    }
+	  gcc_assert (TREE_CODE (length) == PARM_DECL);
+	  DECL_CONTEXT (length) = fndecl;
+	  DECL_ARG_TYPE (length) = len_type;
+	  TREE_READONLY (length) = 1;
+	  DECL_ARTIFICIAL (length) = 1;
+	  gfc_finish_decl (length);
+	  if (sym->ts.u.cl->backend_decl == NULL
+	      || sym->ts.u.cl->backend_decl == length)
+	    {
+	      gfc_symbol *arg;
+	      tree backend_decl;
+
+	      if (sym->ts.u.cl->backend_decl == NULL)
+		{
+		  tree len = build_decl (input_location,
+					 VAR_DECL,
+					 get_identifier ("..__result"),
+					 gfc_charlen_type_node);
+		  DECL_ARTIFICIAL (len) = 1;
+		  TREE_USED (len) = 1;
+		  sym->ts.u.cl->backend_decl = len;
+		}
+
+	      /* Make sure PARM_DECL type doesn't point to incomplete type.  */
+	      arg = sym->result ? sym->result : sym;
+	      backend_decl = arg->backend_decl;
+	      /* Temporary clear it, so that gfc_sym_type creates complete
+		 type.  */
+	      arg->backend_decl = NULL;
+	      type = gfc_sym_type (arg);
+	      arg->backend_decl = backend_decl;
+	      type = build_reference_type (type);
+	    }
+	}
+
+      parm = build_decl (input_location,
+			 PARM_DECL, get_identifier ("__result"), type);
+
+      DECL_CONTEXT (parm) = fndecl;
+      DECL_ARG_TYPE (parm) = TREE_VALUE (typelist);
+      TREE_READONLY (parm) = 1;
+      DECL_ARTIFICIAL (parm) = 1;
+      gfc_finish_decl (parm);
+
+      arglist = chainon (arglist, parm);
+      typelist = TREE_CHAIN (typelist);
+
+      if (sym->ts.type == BT_CHARACTER)
+	{
+	  gfc_allocate_lang_decl (parm);
+	  arglist = chainon (arglist, length);
+	  typelist = TREE_CHAIN (typelist);
+	}
+    }
+
+  hidden_typelist = typelist;
+  for (f = sym->formal; f; f = f->next)
+    if (f->sym != NULL)	/* Ignore alternate returns.  */
+      hidden_typelist = TREE_CHAIN (hidden_typelist);
+
+  for (f = sym->formal; f; f = f->next)
+    {
+      char name[GFC_MAX_SYMBOL_LEN + 2];
+
+      /* Ignore alternate returns.  */
+      if (f->sym == NULL)
+	continue;
+
+      type = TREE_VALUE (typelist);
+
+      if (f->sym->ts.type == BT_CHARACTER
+	  && (!sym->attr.is_bind_c || sym->attr.entry_master))
+	{
+	  tree len_type = TREE_VALUE (hidden_typelist);
+	  tree length = NULL_TREE;
+	  if (!f->sym->ts.deferred)
+	    gcc_assert (len_type == gfc_charlen_type_node);
+	  else
+	    gcc_assert (POINTER_TYPE_P (len_type));
+
+	  strcpy (&name[1], f->sym->name);
+	  name[0] = '_';
+	  length = build_decl (input_location,
+			       PARM_DECL, get_identifier (name), len_type);
+
+	  hidden_arglist = chainon (hidden_arglist, length);
+	  DECL_CONTEXT (length) = fndecl;
+	  DECL_ARTIFICIAL (length) = 1;
+	  DECL_ARG_TYPE (length) = len_type;
+	  TREE_READONLY (length) = 1;
+	  gfc_finish_decl (length);
+
+	  /* Remember the passed value.  */
+          if (f->sym->ts.u.cl->passed_length != NULL)
+            {
+	      /* This can happen if the same type is used for multiple
+		 arguments. We need to copy cl as otherwise
+		 cl->passed_length gets overwritten.  */
+	      f->sym->ts.u.cl = gfc_new_charlen (f->sym->ns, f->sym->ts.u.cl);
+            }
+	  f->sym->ts.u.cl->passed_length = length;
+
+	  /* Use the passed value for assumed length variables.  */
+	  if (!f->sym->ts.u.cl->length)
+	    {
+	      TREE_USED (length) = 1;
+	      gcc_assert (!f->sym->ts.u.cl->backend_decl);
+	      f->sym->ts.u.cl->backend_decl = length;
+	    }
+
+	  hidden_typelist = TREE_CHAIN (hidden_typelist);
+
+	  if (f->sym->ts.u.cl->backend_decl == NULL
+	      || f->sym->ts.u.cl->backend_decl == length)
+	    {
+	      if (f->sym->ts.u.cl->backend_decl == NULL)
+		gfc_create_string_length (f->sym);
+
+	      /* Make sure PARM_DECL type doesn't point to incomplete type.  */
+	      if (f->sym->attr.flavor == FL_PROCEDURE)
+		type = build_pointer_type (gfc_get_function_type (f->sym));
+	      else
+		type = gfc_sym_type (f->sym);
+	    }
+	}
+
+      /* For non-constant length array arguments, make sure they use
+	 a different type node from TYPE_ARG_TYPES type.  */
+      if (f->sym->attr.dimension
+	  && type == TREE_VALUE (typelist)
+	  && TREE_CODE (type) == POINTER_TYPE
+	  && GFC_ARRAY_TYPE_P (type)
+	  && f->sym->as->type != AS_ASSUMED_SIZE
+	  && ! COMPLETE_TYPE_P (TREE_TYPE (type)))
+	{
+	  if (f->sym->attr.flavor == FL_PROCEDURE)
+	    type = build_pointer_type (gfc_get_function_type (f->sym));
+	  else
+	    type = gfc_sym_type (f->sym);
+	}
+
+      if (f->sym->attr.proc_pointer)
+        type = build_pointer_type (type);
+
+      if (f->sym->attr.volatile_)
+	type = build_qualified_type (type, TYPE_QUAL_VOLATILE);
+
+      /* Build the argument declaration.  */
+      parm = build_decl (input_location,
+			 PARM_DECL, gfc_sym_identifier (f->sym), type);
+
+      if (f->sym->attr.volatile_)
+	{
+	  TREE_THIS_VOLATILE (parm) = 1;
+	  TREE_SIDE_EFFECTS (parm) = 1;
+	}
+
+      /* Fill in arg stuff.  */
+      DECL_CONTEXT (parm) = fndecl;
+      DECL_ARG_TYPE (parm) = TREE_VALUE (typelist);
+      /* All implementation args are read-only.  */
+      TREE_READONLY (parm) = 1;
+      if (POINTER_TYPE_P (type)
+	  && (!f->sym->attr.proc_pointer
+	      && f->sym->attr.flavor != FL_PROCEDURE))
+	DECL_BY_REFERENCE (parm) = 1;
+
+      gfc_finish_decl (parm);
+
+      f->sym->backend_decl = parm;
+
+      arglist = chainon (arglist, parm);
+      typelist = TREE_CHAIN (typelist);
+    }
+
+  /* Add the hidden string length parameters, unless the procedure
+     is bind(C).  */
+  if (!sym->attr.is_bind_c)
+    arglist = chainon (arglist, hidden_arglist);
+
+  gcc_assert (hidden_typelist == NULL_TREE
+              || TREE_VALUE (hidden_typelist) == void_type_node);
+  DECL_ARGUMENTS (fndecl) = arglist;
+}
+
+/* Do the setup necessary before generating the body of a function.  */
+
+static void
+trans_function_start (gfc_symbol * sym)
+{
+  tree fndecl;
+
+  fndecl = sym->backend_decl;
+
+  /* Let GCC know the current scope is this function.  */
+  current_function_decl = fndecl;
+
+  /* Let the world know what we're about to do.  */
+  announce_function (fndecl);
+
+  if (DECL_FILE_SCOPE_P (fndecl))
+    {
+      /* Create RTL for function declaration.  */
+      rest_of_decl_compilation (fndecl, 1, 0);
+    }
+
+  /* Create RTL for function definition.  */
+  make_decl_rtl (fndecl);
+
+  init_function_start (fndecl);
+
+  /* Even though we're inside a function body, we still don't want to
+     call expand_expr to calculate the size of a variable-sized array.
+     We haven't necessarily assigned RTL to all variables yet, so it's
+     not safe to try to expand expressions involving them.  */
+  cfun->dont_save_pending_sizes_p = 1;
+
+  /* function.c requires a push at the start of the function.  */
+  pushlevel (0);
+}
+
+/* Create thunks for alternate entry points.  */
+
+static void
+build_entry_thunks (gfc_namespace * ns, bool global)
+{
+  gfc_formal_arglist *formal;
+  gfc_formal_arglist *thunk_formal;
+  gfc_entry_list *el;
+  gfc_symbol *thunk_sym;
+  stmtblock_t body;
+  tree thunk_fndecl;
+  tree tmp;
+  locus old_loc;
+
+  /* This should always be a toplevel function.  */
+  gcc_assert (current_function_decl == NULL_TREE);
+
+  gfc_save_backend_locus (&old_loc);
+  for (el = ns->entries; el; el = el->next)
+    {
+      VEC(tree,gc) *args = NULL;
+      VEC(tree,gc) *string_args = NULL;
+
+      thunk_sym = el->sym;
+      
+      build_function_decl (thunk_sym, global);
+      create_function_arglist (thunk_sym);
+
+      trans_function_start (thunk_sym);
+
+      thunk_fndecl = thunk_sym->backend_decl;
+
+      gfc_init_block (&body);
+
+      /* Pass extra parameter identifying this entry point.  */
+      tmp = build_int_cst (gfc_array_index_type, el->id);
+      VEC_safe_push (tree, gc, args, tmp);
+
+      if (thunk_sym->attr.function)
+	{
+	  if (gfc_return_by_reference (ns->proc_name))
+	    {
+	      tree ref = DECL_ARGUMENTS (current_function_decl);
+	      VEC_safe_push (tree, gc, args, ref);
+	      if (ns->proc_name->ts.type == BT_CHARACTER)
+		VEC_safe_push (tree, gc, args, DECL_CHAIN (ref));
+	    }
+	}
+
+      for (formal = ns->proc_name->formal; formal; formal = formal->next)
+	{
+	  /* Ignore alternate returns.  */
+	  if (formal->sym == NULL)
+	    continue;
+
+	  /* We don't have a clever way of identifying arguments, so resort to
+	     a brute-force search.  */
+	  for (thunk_formal = thunk_sym->formal;
+	       thunk_formal;
+	       thunk_formal = thunk_formal->next)
+	    {
+	      if (thunk_formal->sym == formal->sym)
+		break;
+	    }
+
+	  if (thunk_formal)
+	    {
+	      /* Pass the argument.  */
+	      DECL_ARTIFICIAL (thunk_formal->sym->backend_decl) = 1;
+	      VEC_safe_push (tree, gc, args, thunk_formal->sym->backend_decl);
+	      if (formal->sym->ts.type == BT_CHARACTER)
+		{
+		  tmp = thunk_formal->sym->ts.u.cl->backend_decl;
+		  VEC_safe_push (tree, gc, string_args, tmp);
+		}
+	    }
+	  else
+	    {
+	      /* Pass NULL for a missing argument.  */
+	      VEC_safe_push (tree, gc, args, null_pointer_node);
+	      if (formal->sym->ts.type == BT_CHARACTER)
+		{
+		  tmp = build_int_cst (gfc_charlen_type_node, 0);
+		  VEC_safe_push (tree, gc, string_args, tmp);
+		}
+	    }
+	}
+
+      /* Call the master function.  */
+      VEC_safe_splice (tree, gc, args, string_args);
+      tmp = ns->proc_name->backend_decl;
+      tmp = build_call_expr_loc_vec (input_location, tmp, args);
+      if (ns->proc_name->attr.mixed_entry_master)
+	{
+	  tree union_decl, field;
+	  tree master_type = TREE_TYPE (ns->proc_name->backend_decl);
+
+	  union_decl = build_decl (input_location,
+				   VAR_DECL, get_identifier ("__result"),
+				   TREE_TYPE (master_type));
+	  DECL_ARTIFICIAL (union_decl) = 1;
+	  DECL_EXTERNAL (union_decl) = 0;
+	  TREE_PUBLIC (union_decl) = 0;
+	  TREE_USED (union_decl) = 1;
+	  layout_decl (union_decl, 0);
+	  pushdecl (union_decl);
+
+	  DECL_CONTEXT (union_decl) = current_function_decl;
+	  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+				 TREE_TYPE (union_decl), union_decl, tmp);
+	  gfc_add_expr_to_block (&body, tmp);
+
+	  for (field = TYPE_FIELDS (TREE_TYPE (union_decl));
+	       field; field = DECL_CHAIN (field))
+	    if (strcmp (IDENTIFIER_POINTER (DECL_NAME (field)),
+		thunk_sym->result->name) == 0)
+	      break;
+	  gcc_assert (field != NULL_TREE);
+	  tmp = fold_build3_loc (input_location, COMPONENT_REF,
+				 TREE_TYPE (field), union_decl, field,
+				 NULL_TREE);
+	  tmp = fold_build2_loc (input_location, MODIFY_EXPR, 
+			     TREE_TYPE (DECL_RESULT (current_function_decl)),
+			     DECL_RESULT (current_function_decl), tmp);
+	  tmp = build1_v (RETURN_EXPR, tmp);
+	}
+      else if (TREE_TYPE (DECL_RESULT (current_function_decl))
+	       != void_type_node)
+	{
+	  tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+			     TREE_TYPE (DECL_RESULT (current_function_decl)),
+			     DECL_RESULT (current_function_decl), tmp);
+	  tmp = build1_v (RETURN_EXPR, tmp);
+	}
+      gfc_add_expr_to_block (&body, tmp);
+
+      /* Finish off this function and send it for code generation.  */
+      DECL_SAVED_TREE (thunk_fndecl) = gfc_finish_block (&body);
+      tmp = getdecls ();
+      poplevel (1, 0, 1);
+      BLOCK_SUPERCONTEXT (DECL_INITIAL (thunk_fndecl)) = thunk_fndecl;
+      DECL_SAVED_TREE (thunk_fndecl)
+	= build3_v (BIND_EXPR, tmp, DECL_SAVED_TREE (thunk_fndecl),
+		    DECL_INITIAL (thunk_fndecl));
+
+      /* Output the GENERIC tree.  */
+      dump_function (TDI_original, thunk_fndecl);
+
+      /* Store the end of the function, so that we get good line number
+	 info for the epilogue.  */
+      cfun->function_end_locus = input_location;
+
+      /* We're leaving the context of this function, so zap cfun.
+	 It's still in DECL_STRUCT_FUNCTION, and we'll restore it in
+	 tree_rest_of_compilation.  */
+      set_cfun (NULL);
+
+      current_function_decl = NULL_TREE;
+
+      cgraph_finalize_function (thunk_fndecl, true);
+
+      /* We share the symbols in the formal argument list with other entry
+	 points and the master function.  Clear them so that they are
+	 recreated for each function.  */
+      for (formal = thunk_sym->formal; formal; formal = formal->next)
+	if (formal->sym != NULL)  /* Ignore alternate returns.  */
+	  {
+	    formal->sym->backend_decl = NULL_TREE;
+	    if (formal->sym->ts.type == BT_CHARACTER)
+	      formal->sym->ts.u.cl->backend_decl = NULL_TREE;
+	  }
+
+      if (thunk_sym->attr.function)
+	{
+	  if (thunk_sym->ts.type == BT_CHARACTER)
+	    thunk_sym->ts.u.cl->backend_decl = NULL_TREE;
+	  if (thunk_sym->result->ts.type == BT_CHARACTER)
+	    thunk_sym->result->ts.u.cl->backend_decl = NULL_TREE;
+	}
+    }
+
+  gfc_restore_backend_locus (&old_loc);
+}
+
+
+/* Create a decl for a function, and create any thunks for alternate entry
+   points. If global is true, generate the function in the global binding
+   level, otherwise in the current binding level (which can be global).  */
+
+void
+gfc_create_function_decl (gfc_namespace * ns, bool global)
+{
+  /* Create a declaration for the master function.  */
+  build_function_decl (ns->proc_name, global);
+
+  /* Compile the entry thunks.  */
+  if (ns->entries)
+    build_entry_thunks (ns, global);
+
+  /* Now create the read argument list.  */
+  create_function_arglist (ns->proc_name);
+}
+
+/* Return the decl used to hold the function return value.  If
+   parent_flag is set, the context is the parent_scope.  */
+
+tree
+gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag)
+{
+  tree decl;
+  tree length;
+  tree this_fake_result_decl;
+  tree this_function_decl;
+
+  char name[GFC_MAX_SYMBOL_LEN + 10];
+
+  if (parent_flag)
+    {
+      this_fake_result_decl = parent_fake_result_decl;
+      this_function_decl = DECL_CONTEXT (current_function_decl);
+    }
+  else
+    {
+      this_fake_result_decl = current_fake_result_decl;
+      this_function_decl = current_function_decl;
+    }
+
+  if (sym
+      && sym->ns->proc_name->backend_decl == this_function_decl
+      && sym->ns->proc_name->attr.entry_master
+      && sym != sym->ns->proc_name)
+    {
+      tree t = NULL, var;
+      if (this_fake_result_decl != NULL)
+	for (t = TREE_CHAIN (this_fake_result_decl); t; t = TREE_CHAIN (t))
+	  if (strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t)), sym->name) == 0)
+	    break;
+      if (t)
+	return TREE_VALUE (t);
+      decl = gfc_get_fake_result_decl (sym->ns->proc_name, parent_flag);
+
+      if (parent_flag)
+	this_fake_result_decl = parent_fake_result_decl;
+      else
+	this_fake_result_decl = current_fake_result_decl;
+
+      if (decl && sym->ns->proc_name->attr.mixed_entry_master)
+	{
+	  tree field;
+
+	  for (field = TYPE_FIELDS (TREE_TYPE (decl));
+	       field; field = DECL_CHAIN (field))
+	    if (strcmp (IDENTIFIER_POINTER (DECL_NAME (field)),
+		sym->name) == 0)
+	      break;
+
+	  gcc_assert (field != NULL_TREE);
+	  decl = fold_build3_loc (input_location, COMPONENT_REF,
+				  TREE_TYPE (field), decl, field, NULL_TREE);
+	}
+
+      var = create_tmp_var_raw (TREE_TYPE (decl), sym->name);
+      if (parent_flag)
+	gfc_add_decl_to_parent_function (var);
+      else
+	gfc_add_decl_to_function (var);
+
+      SET_DECL_VALUE_EXPR (var, decl);
+      DECL_HAS_VALUE_EXPR_P (var) = 1;
+      GFC_DECL_RESULT (var) = 1;
+
+      TREE_CHAIN (this_fake_result_decl)
+	  = tree_cons (get_identifier (sym->name), var,
+		       TREE_CHAIN (this_fake_result_decl));
+      return var;
+    }
+
+  if (this_fake_result_decl != NULL_TREE)
+    return TREE_VALUE (this_fake_result_decl);
+
+  /* Only when gfc_get_fake_result_decl is called by gfc_trans_return,
+     sym is NULL.  */
+  if (!sym)
+    return NULL_TREE;
+
+  if (sym->ts.type == BT_CHARACTER)
+    {
+      if (sym->ts.u.cl->backend_decl == NULL_TREE)
+	length = gfc_create_string_length (sym);
+      else
+	length = sym->ts.u.cl->backend_decl;
+      if (TREE_CODE (length) == VAR_DECL
+	  && DECL_CONTEXT (length) == NULL_TREE)
+	gfc_add_decl_to_function (length);
+    }
+
+  if (gfc_return_by_reference (sym))
+    {
+      decl = DECL_ARGUMENTS (this_function_decl);
+
+      if (sym->ns->proc_name->backend_decl == this_function_decl
+	  && sym->ns->proc_name->attr.entry_master)
+	decl = DECL_CHAIN (decl);
+
+      TREE_USED (decl) = 1;
+      if (sym->as)
+	decl = gfc_build_dummy_array_decl (sym, decl);
+    }
+  else
+    {
+      sprintf (name, "__result_%.20s",
+	       IDENTIFIER_POINTER (DECL_NAME (this_function_decl)));
+
+      if (!sym->attr.mixed_entry_master && sym->attr.function)
+	decl = build_decl (DECL_SOURCE_LOCATION (this_function_decl),
+			   VAR_DECL, get_identifier (name),
+			   gfc_sym_type (sym));
+      else
+	decl = build_decl (DECL_SOURCE_LOCATION (this_function_decl),
+			   VAR_DECL, get_identifier (name),
+			   TREE_TYPE (TREE_TYPE (this_function_decl)));
+      DECL_ARTIFICIAL (decl) = 1;
+      DECL_EXTERNAL (decl) = 0;
+      TREE_PUBLIC (decl) = 0;
+      TREE_USED (decl) = 1;
+      GFC_DECL_RESULT (decl) = 1;
+      TREE_ADDRESSABLE (decl) = 1;
+
+      layout_decl (decl, 0);
+
+      if (parent_flag)
+	gfc_add_decl_to_parent_function (decl);
+      else
+	gfc_add_decl_to_function (decl);
+    }
+
+  if (parent_flag)
+    parent_fake_result_decl = build_tree_list (NULL, decl);
+  else
+    current_fake_result_decl = build_tree_list (NULL, decl);
+
+  return decl;
+}
+
+
+/* Builds a function decl.  The remaining parameters are the types of the
+   function arguments.  Negative nargs indicates a varargs function.  */
+
+static tree
+build_library_function_decl_1 (tree name, const char *spec,
+			       tree rettype, int nargs, va_list p)
+{
+  tree arglist;
+  tree argtype;
+  tree fntype;
+  tree fndecl;
+  int n;
+
+  /* Library functions must be declared with global scope.  */
+  gcc_assert (current_function_decl == NULL_TREE);
+
+  /* Create a list of the argument types.  */
+  for (arglist = NULL_TREE, n = abs (nargs); n > 0; n--)
+    {
+      argtype = va_arg (p, tree);
+      arglist = gfc_chainon_list (arglist, argtype);
+    }
+
+  if (nargs >= 0)
+    {
+      /* Terminate the list.  */
+      arglist = chainon (arglist, void_list_node);
+    }
+
+  /* Build the function type and decl.  */
+  fntype = build_function_type (rettype, arglist);
+  if (spec)
+    {
+      tree attr_args = build_tree_list (NULL_TREE,
+					build_string (strlen (spec), spec));
+      tree attrs = tree_cons (get_identifier ("fn spec"),
+			      attr_args, TYPE_ATTRIBUTES (fntype));
+      fntype = build_type_attribute_variant (fntype, attrs);
+    }
+  fndecl = build_decl (input_location,
+		       FUNCTION_DECL, name, fntype);
+
+  /* Mark this decl as external.  */
+  DECL_EXTERNAL (fndecl) = 1;
+  TREE_PUBLIC (fndecl) = 1;
+
+  pushdecl (fndecl);
+
+  rest_of_decl_compilation (fndecl, 1, 0);
+
+  return fndecl;
+}
+
+/* Builds a function decl.  The remaining parameters are the types of the
+   function arguments.  Negative nargs indicates a varargs function.  */
+
+tree
+gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...)
+{
+  tree ret;
+  va_list args;
+  va_start (args, nargs);
+  ret = build_library_function_decl_1 (name, NULL, rettype, nargs, args);
+  va_end (args);
+  return ret;
+}
+
+/* Builds a function decl.  The remaining parameters are the types of the
+   function arguments.  Negative nargs indicates a varargs function.
+   The SPEC parameter specifies the function argument and return type
+   specification according to the fnspec function type attribute.  */
+
+tree
+gfc_build_library_function_decl_with_spec (tree name, const char *spec,
+					   tree rettype, int nargs, ...)
+{
+  tree ret;
+  va_list args;
+  va_start (args, nargs);
+  ret = build_library_function_decl_1 (name, spec, rettype, nargs, args);
+  va_end (args);
+  return ret;
+}
+
+static void
+gfc_build_intrinsic_function_decls (void)
+{
+  tree gfc_int4_type_node = gfc_get_int_type (4);
+  tree gfc_int8_type_node = gfc_get_int_type (8);
+  tree gfc_int16_type_node = gfc_get_int_type (16);
+  tree gfc_logical4_type_node = gfc_get_logical_type (4);
+  tree pchar1_type_node = gfc_get_pchar_type (1);
+  tree pchar4_type_node = gfc_get_pchar_type (4);
+
+  /* String functions.  */
+  gfor_fndecl_compare_string = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("compare_string")), "..R.R",
+	integer_type_node, 4, gfc_charlen_type_node, pchar1_type_node,
+	gfc_charlen_type_node, pchar1_type_node);
+  DECL_PURE_P (gfor_fndecl_compare_string) = 1;
+  TREE_NOTHROW (gfor_fndecl_compare_string) = 1;
+
+  gfor_fndecl_concat_string = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("concat_string")), "..W.R.R",
+	void_type_node, 6, gfc_charlen_type_node, pchar1_type_node,
+	gfc_charlen_type_node, pchar1_type_node,
+	gfc_charlen_type_node, pchar1_type_node);
+  TREE_NOTHROW (gfor_fndecl_concat_string) = 1;
+
+  gfor_fndecl_string_len_trim = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("string_len_trim")), "..R",
+	gfc_charlen_type_node, 2, gfc_charlen_type_node, pchar1_type_node);
+  DECL_PURE_P (gfor_fndecl_string_len_trim) = 1;
+  TREE_NOTHROW (gfor_fndecl_string_len_trim) = 1;
+
+  gfor_fndecl_string_index = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("string_index")), "..R.R.",
+	gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node,
+	gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node);
+  DECL_PURE_P (gfor_fndecl_string_index) = 1;
+  TREE_NOTHROW (gfor_fndecl_string_index) = 1;
+
+  gfor_fndecl_string_scan = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("string_scan")), "..R.R.",
+	gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node,
+	gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node);
+  DECL_PURE_P (gfor_fndecl_string_scan) = 1;
+  TREE_NOTHROW (gfor_fndecl_string_scan) = 1;
+
+  gfor_fndecl_string_verify = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("string_verify")), "..R.R.",
+	gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar1_type_node,
+	gfc_charlen_type_node, pchar1_type_node, gfc_logical4_type_node);
+  DECL_PURE_P (gfor_fndecl_string_verify) = 1;
+  TREE_NOTHROW (gfor_fndecl_string_verify) = 1;
+
+  gfor_fndecl_string_trim = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("string_trim")), ".Ww.R",
+	void_type_node, 4, build_pointer_type (gfc_charlen_type_node),
+	build_pointer_type (pchar1_type_node), gfc_charlen_type_node,
+	pchar1_type_node);
+
+  gfor_fndecl_string_minmax = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("string_minmax")), ".Ww.R",
+	void_type_node, -4, build_pointer_type (gfc_charlen_type_node),
+	build_pointer_type (pchar1_type_node), integer_type_node,
+	integer_type_node);
+
+  gfor_fndecl_adjustl = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("adjustl")), ".W.R",
+	void_type_node, 3, pchar1_type_node, gfc_charlen_type_node,
+	pchar1_type_node);
+  TREE_NOTHROW (gfor_fndecl_adjustl) = 1;
+
+  gfor_fndecl_adjustr = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("adjustr")), ".W.R",
+	void_type_node, 3, pchar1_type_node, gfc_charlen_type_node,
+	pchar1_type_node);
+  TREE_NOTHROW (gfor_fndecl_adjustr) = 1;
+
+  gfor_fndecl_select_string =  gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("select_string")), ".R.R.",
+	integer_type_node, 4, pvoid_type_node, integer_type_node,
+	pchar1_type_node, gfc_charlen_type_node);
+  DECL_PURE_P (gfor_fndecl_select_string) = 1;
+  TREE_NOTHROW (gfor_fndecl_select_string) = 1;
+
+  gfor_fndecl_compare_string_char4 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("compare_string_char4")), "..R.R",
+	integer_type_node, 4, gfc_charlen_type_node, pchar4_type_node,
+	gfc_charlen_type_node, pchar4_type_node);
+  DECL_PURE_P (gfor_fndecl_compare_string_char4) = 1;
+  TREE_NOTHROW (gfor_fndecl_compare_string_char4) = 1;
+
+  gfor_fndecl_concat_string_char4 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("concat_string_char4")), "..W.R.R",
+	void_type_node, 6, gfc_charlen_type_node, pchar4_type_node,
+	gfc_charlen_type_node, pchar4_type_node, gfc_charlen_type_node,
+	pchar4_type_node);
+  TREE_NOTHROW (gfor_fndecl_concat_string_char4) = 1;
+
+  gfor_fndecl_string_len_trim_char4 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("string_len_trim_char4")), "..R",
+	gfc_charlen_type_node, 2, gfc_charlen_type_node, pchar4_type_node);
+  DECL_PURE_P (gfor_fndecl_string_len_trim_char4) = 1;
+  TREE_NOTHROW (gfor_fndecl_string_len_trim_char4) = 1;
+
+  gfor_fndecl_string_index_char4 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("string_index_char4")), "..R.R.",
+	gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node,
+	gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node);
+  DECL_PURE_P (gfor_fndecl_string_index_char4) = 1;
+  TREE_NOTHROW (gfor_fndecl_string_index_char4) = 1;
+
+  gfor_fndecl_string_scan_char4 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("string_scan_char4")), "..R.R.",
+	gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node,
+	gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node);
+  DECL_PURE_P (gfor_fndecl_string_scan_char4) = 1;
+  TREE_NOTHROW (gfor_fndecl_string_scan_char4) = 1;
+
+  gfor_fndecl_string_verify_char4 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("string_verify_char4")), "..R.R.",
+	gfc_charlen_type_node, 5, gfc_charlen_type_node, pchar4_type_node,
+	gfc_charlen_type_node, pchar4_type_node, gfc_logical4_type_node);
+  DECL_PURE_P (gfor_fndecl_string_verify_char4) = 1;
+  TREE_NOTHROW (gfor_fndecl_string_verify_char4) = 1;
+
+  gfor_fndecl_string_trim_char4 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("string_trim_char4")), ".Ww.R",
+	void_type_node, 4, build_pointer_type (gfc_charlen_type_node),
+	build_pointer_type (pchar4_type_node), gfc_charlen_type_node,
+	pchar4_type_node);
+
+  gfor_fndecl_string_minmax_char4 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("string_minmax_char4")), ".Ww.R",
+	void_type_node, -4, build_pointer_type (gfc_charlen_type_node),
+	build_pointer_type (pchar4_type_node), integer_type_node,
+	integer_type_node);
+
+  gfor_fndecl_adjustl_char4 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("adjustl_char4")), ".W.R",
+	void_type_node, 3, pchar4_type_node, gfc_charlen_type_node,
+	pchar4_type_node);
+  TREE_NOTHROW (gfor_fndecl_adjustl_char4) = 1;
+
+  gfor_fndecl_adjustr_char4 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("adjustr_char4")), ".W.R",
+	void_type_node, 3, pchar4_type_node, gfc_charlen_type_node,
+	pchar4_type_node);
+  TREE_NOTHROW (gfor_fndecl_adjustr_char4) = 1;
+
+  gfor_fndecl_select_string_char4 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("select_string_char4")), ".R.R.",
+	integer_type_node, 4, pvoid_type_node, integer_type_node,
+	pvoid_type_node, gfc_charlen_type_node);
+  DECL_PURE_P (gfor_fndecl_select_string_char4) = 1;
+  TREE_NOTHROW (gfor_fndecl_select_string_char4) = 1;
+
+
+  /* Conversion between character kinds.  */
+
+  gfor_fndecl_convert_char1_to_char4 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("convert_char1_to_char4")), ".w.R",
+	void_type_node, 3, build_pointer_type (pchar4_type_node),
+	gfc_charlen_type_node, pchar1_type_node);
+
+  gfor_fndecl_convert_char4_to_char1 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("convert_char4_to_char1")), ".w.R",
+	void_type_node, 3, build_pointer_type (pchar1_type_node),
+	gfc_charlen_type_node, pchar4_type_node);
+
+  /* Misc. functions.  */
+
+  gfor_fndecl_ttynam = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("ttynam")), ".W",
+	void_type_node, 3, pchar_type_node, gfc_charlen_type_node,
+	integer_type_node);
+
+  gfor_fndecl_fdate = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("fdate")), ".W",
+	void_type_node, 2, pchar_type_node, gfc_charlen_type_node);
+
+  gfor_fndecl_ctime = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("ctime")), ".W",
+	void_type_node, 3, pchar_type_node, gfc_charlen_type_node,
+	gfc_int8_type_node);
+
+  gfor_fndecl_sc_kind = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("selected_char_kind")), "..R",
+	gfc_int4_type_node, 2, gfc_charlen_type_node, pchar_type_node);
+  DECL_PURE_P (gfor_fndecl_sc_kind) = 1;
+  TREE_NOTHROW (gfor_fndecl_sc_kind) = 1;
+
+  gfor_fndecl_si_kind = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("selected_int_kind")), ".R",
+	gfc_int4_type_node, 1, pvoid_type_node);
+  DECL_PURE_P (gfor_fndecl_si_kind) = 1;
+  TREE_NOTHROW (gfor_fndecl_si_kind) = 1;
+
+  gfor_fndecl_sr_kind = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("selected_real_kind2008")), ".RR",
+	gfc_int4_type_node, 3, pvoid_type_node, pvoid_type_node,
+	pvoid_type_node);
+  DECL_PURE_P (gfor_fndecl_sr_kind) = 1;
+  TREE_NOTHROW (gfor_fndecl_sr_kind) = 1;
+
+  /* Power functions.  */
+  {
+    tree ctype, rtype, itype, jtype;
+    int rkind, ikind, jkind;
+#define NIKINDS 3
+#define NRKINDS 4
+    static int ikinds[NIKINDS] = {4, 8, 16};
+    static int rkinds[NRKINDS] = {4, 8, 10, 16};
+    char name[PREFIX_LEN + 12]; /* _gfortran_pow_?n_?n */
+
+    for (ikind=0; ikind < NIKINDS; ikind++)
+      {
+	itype = gfc_get_int_type (ikinds[ikind]);
+
+	for (jkind=0; jkind < NIKINDS; jkind++)
+	  {
+	    jtype = gfc_get_int_type (ikinds[jkind]);
+	    if (itype && jtype)
+	      {
+		sprintf(name, PREFIX("pow_i%d_i%d"), ikinds[ikind],
+			ikinds[jkind]);
+		gfor_fndecl_math_powi[jkind][ikind].integer =
+		  gfc_build_library_function_decl (get_identifier (name),
+		    jtype, 2, jtype, itype);
+		TREE_READONLY (gfor_fndecl_math_powi[jkind][ikind].integer) = 1;
+		TREE_NOTHROW (gfor_fndecl_math_powi[jkind][ikind].integer) = 1;
+	      }
+	  }
+
+	for (rkind = 0; rkind < NRKINDS; rkind ++)
+	  {
+	    rtype = gfc_get_real_type (rkinds[rkind]);
+	    if (rtype && itype)
+	      {
+		sprintf(name, PREFIX("pow_r%d_i%d"), rkinds[rkind],
+			ikinds[ikind]);
+		gfor_fndecl_math_powi[rkind][ikind].real =
+		  gfc_build_library_function_decl (get_identifier (name),
+		    rtype, 2, rtype, itype);
+		TREE_READONLY (gfor_fndecl_math_powi[rkind][ikind].real) = 1;
+		TREE_NOTHROW (gfor_fndecl_math_powi[rkind][ikind].real) = 1;
+	      }
+
+	    ctype = gfc_get_complex_type (rkinds[rkind]);
+	    if (ctype && itype)
+	      {
+		sprintf(name, PREFIX("pow_c%d_i%d"), rkinds[rkind],
+			ikinds[ikind]);
+		gfor_fndecl_math_powi[rkind][ikind].cmplx =
+		  gfc_build_library_function_decl (get_identifier (name),
+		    ctype, 2,ctype, itype);
+		TREE_READONLY (gfor_fndecl_math_powi[rkind][ikind].cmplx) = 1;
+		TREE_NOTHROW (gfor_fndecl_math_powi[rkind][ikind].cmplx) = 1;
+	      }
+	  }
+      }
+#undef NIKINDS
+#undef NRKINDS
+  }
+
+  gfor_fndecl_math_ishftc4 = gfc_build_library_function_decl (
+	get_identifier (PREFIX("ishftc4")),
+	gfc_int4_type_node, 3, gfc_int4_type_node, gfc_int4_type_node,
+	gfc_int4_type_node);
+  TREE_READONLY (gfor_fndecl_math_ishftc4) = 1;
+  TREE_NOTHROW (gfor_fndecl_math_ishftc4) = 1;
+	
+  gfor_fndecl_math_ishftc8 = gfc_build_library_function_decl (
+	get_identifier (PREFIX("ishftc8")),
+	gfc_int8_type_node, 3, gfc_int8_type_node, gfc_int4_type_node,
+	gfc_int4_type_node);
+  TREE_READONLY (gfor_fndecl_math_ishftc8) = 1;
+  TREE_NOTHROW (gfor_fndecl_math_ishftc8) = 1;
+
+  if (gfc_int16_type_node)
+    {
+      gfor_fndecl_math_ishftc16 = gfc_build_library_function_decl (
+	get_identifier (PREFIX("ishftc16")),
+	gfc_int16_type_node, 3, gfc_int16_type_node, gfc_int4_type_node,
+	gfc_int4_type_node);
+      TREE_READONLY (gfor_fndecl_math_ishftc16) = 1;
+      TREE_NOTHROW (gfor_fndecl_math_ishftc16) = 1;
+    }
+
+  /* BLAS functions.  */
+  {
+    tree pint = build_pointer_type (integer_type_node);
+    tree ps = build_pointer_type (gfc_get_real_type (gfc_default_real_kind));
+    tree pd = build_pointer_type (gfc_get_real_type (gfc_default_double_kind));
+    tree pc = build_pointer_type (gfc_get_complex_type (gfc_default_real_kind));
+    tree pz = build_pointer_type
+		(gfc_get_complex_type (gfc_default_double_kind));
+
+    gfor_fndecl_sgemm = gfc_build_library_function_decl
+			  (get_identifier
+			     (gfc_option.flag_underscoring ? "sgemm_"
+							   : "sgemm"),
+			   void_type_node, 15, pchar_type_node,
+			   pchar_type_node, pint, pint, pint, ps, ps, pint,
+			   ps, pint, ps, ps, pint, integer_type_node,
+			   integer_type_node);
+    gfor_fndecl_dgemm = gfc_build_library_function_decl
+			  (get_identifier
+			     (gfc_option.flag_underscoring ? "dgemm_"
+							   : "dgemm"),
+			   void_type_node, 15, pchar_type_node,
+			   pchar_type_node, pint, pint, pint, pd, pd, pint,
+			   pd, pint, pd, pd, pint, integer_type_node,
+			   integer_type_node);
+    gfor_fndecl_cgemm = gfc_build_library_function_decl
+			  (get_identifier
+			     (gfc_option.flag_underscoring ? "cgemm_"
+							   : "cgemm"),
+			   void_type_node, 15, pchar_type_node,
+			   pchar_type_node, pint, pint, pint, pc, pc, pint,
+			   pc, pint, pc, pc, pint, integer_type_node,
+			   integer_type_node);
+    gfor_fndecl_zgemm = gfc_build_library_function_decl
+			  (get_identifier
+			     (gfc_option.flag_underscoring ? "zgemm_"
+							   : "zgemm"),
+			   void_type_node, 15, pchar_type_node,
+			   pchar_type_node, pint, pint, pint, pz, pz, pint,
+			   pz, pint, pz, pz, pint, integer_type_node,
+			   integer_type_node);
+  }
+
+  /* Other functions.  */
+  gfor_fndecl_size0 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("size0")), ".R",
+	gfc_array_index_type, 1, pvoid_type_node);
+  DECL_PURE_P (gfor_fndecl_size0) = 1;
+  TREE_NOTHROW (gfor_fndecl_size0) = 1;
+
+  gfor_fndecl_size1 = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("size1")), ".R",
+	gfc_array_index_type, 2, pvoid_type_node, gfc_array_index_type);
+  DECL_PURE_P (gfor_fndecl_size1) = 1;
+  TREE_NOTHROW (gfor_fndecl_size1) = 1;
+
+  gfor_fndecl_iargc = gfc_build_library_function_decl (
+	get_identifier (PREFIX ("iargc")), gfc_int4_type_node, 0);
+  TREE_NOTHROW (gfor_fndecl_iargc) = 1;
+}
+
+
+/* Make prototypes for runtime library functions.  */
+
+void
+gfc_build_builtin_function_decls (void)
+{
+  tree gfc_int4_type_node = gfc_get_int_type (4);
+
+  gfor_fndecl_stop_numeric = gfc_build_library_function_decl (
+	get_identifier (PREFIX("stop_numeric")),
+	void_type_node, 1, gfc_int4_type_node);
+  /* STOP doesn't return.  */
+  TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric) = 1;
+
+  gfor_fndecl_stop_numeric_f08 = gfc_build_library_function_decl (
+	get_identifier (PREFIX("stop_numeric_f08")),
+	void_type_node, 1, gfc_int4_type_node);
+  /* STOP doesn't return.  */
+  TREE_THIS_VOLATILE (gfor_fndecl_stop_numeric_f08) = 1;
+
+  gfor_fndecl_stop_string = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("stop_string")), ".R.",
+	void_type_node, 2, pchar_type_node, gfc_int4_type_node);
+  /* STOP doesn't return.  */
+  TREE_THIS_VOLATILE (gfor_fndecl_stop_string) = 1;
+
+  gfor_fndecl_error_stop_numeric = gfc_build_library_function_decl (
+        get_identifier (PREFIX("error_stop_numeric")),
+        void_type_node, 1, gfc_int4_type_node);
+  /* ERROR STOP doesn't return.  */
+  TREE_THIS_VOLATILE (gfor_fndecl_error_stop_numeric) = 1;
+
+  gfor_fndecl_error_stop_string = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("error_stop_string")), ".R.",
+	void_type_node, 2, pchar_type_node, gfc_int4_type_node);
+  /* ERROR STOP doesn't return.  */
+  TREE_THIS_VOLATILE (gfor_fndecl_error_stop_string) = 1;
+
+  gfor_fndecl_pause_numeric = gfc_build_library_function_decl (
+	get_identifier (PREFIX("pause_numeric")),
+	void_type_node, 1, gfc_int4_type_node);
+
+  gfor_fndecl_pause_string = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("pause_string")), ".R.",
+	void_type_node, 2, pchar_type_node, gfc_int4_type_node);
+
+  gfor_fndecl_runtime_error = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("runtime_error")), ".R",
+	void_type_node, -1, pchar_type_node);
+  /* The runtime_error function does not return.  */
+  TREE_THIS_VOLATILE (gfor_fndecl_runtime_error) = 1;
+
+  gfor_fndecl_runtime_error_at = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("runtime_error_at")), ".RR",
+	void_type_node, -2, pchar_type_node, pchar_type_node);
+  /* The runtime_error_at function does not return.  */
+  TREE_THIS_VOLATILE (gfor_fndecl_runtime_error_at) = 1;
+  
+  gfor_fndecl_runtime_warning_at = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("runtime_warning_at")), ".RR",
+	void_type_node, -2, pchar_type_node, pchar_type_node);
+
+  gfor_fndecl_generate_error = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("generate_error")), ".R.R",
+	void_type_node, 3, pvoid_type_node, integer_type_node,
+	pchar_type_node);
+
+  gfor_fndecl_os_error = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("os_error")), ".R",
+	void_type_node, 1, pchar_type_node);
+  /* The runtime_error function does not return.  */
+  TREE_THIS_VOLATILE (gfor_fndecl_os_error) = 1;
+
+  gfor_fndecl_set_args = gfc_build_library_function_decl (
+	get_identifier (PREFIX("set_args")),
+	void_type_node, 2, integer_type_node,
+	build_pointer_type (pchar_type_node));
+
+  gfor_fndecl_set_fpe = gfc_build_library_function_decl (
+	get_identifier (PREFIX("set_fpe")),
+	void_type_node, 1, integer_type_node);
+
+  /* Keep the array dimension in sync with the call, later in this file.  */
+  gfor_fndecl_set_options = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("set_options")), "..R",
+	void_type_node, 2, integer_type_node,
+	build_pointer_type (integer_type_node));
+
+  gfor_fndecl_set_convert = gfc_build_library_function_decl (
+	get_identifier (PREFIX("set_convert")),
+	void_type_node, 1, integer_type_node);
+
+  gfor_fndecl_set_record_marker = gfc_build_library_function_decl (
+	get_identifier (PREFIX("set_record_marker")),
+	void_type_node, 1, integer_type_node);
+
+  gfor_fndecl_set_max_subrecord_length = gfc_build_library_function_decl (
+	get_identifier (PREFIX("set_max_subrecord_length")),
+	void_type_node, 1, integer_type_node);
+
+  gfor_fndecl_in_pack = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("internal_pack")), ".r",
+	pvoid_type_node, 1, pvoid_type_node);
+
+  gfor_fndecl_in_unpack = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("internal_unpack")), ".wR",
+	void_type_node, 2, pvoid_type_node, pvoid_type_node);
+
+  gfor_fndecl_associated = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("associated")), ".RR",
+	integer_type_node, 2, ppvoid_type_node, ppvoid_type_node);
+  DECL_PURE_P (gfor_fndecl_associated) = 1;
+  TREE_NOTHROW (gfor_fndecl_associated) = 1;
+
+  gfc_build_intrinsic_function_decls ();
+  gfc_build_intrinsic_lib_fndecls ();
+  gfc_build_io_library_fndecls ();
+}
+
+
+/* Evaluate the length of dummy character variables.  */
+
+static void
+gfc_trans_dummy_character (gfc_symbol *sym, gfc_charlen *cl,
+			   gfc_wrapped_block *block)
+{
+  stmtblock_t init;
+
+  gfc_finish_decl (cl->backend_decl);
+
+  gfc_start_block (&init);
+
+  /* Evaluate the string length expression.  */
+  gfc_conv_string_length (cl, NULL, &init);
+
+  gfc_trans_vla_type_sizes (sym, &init);
+
+  gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+}
+
+
+/* Allocate and cleanup an automatic character variable.  */
+
+static void
+gfc_trans_auto_character_variable (gfc_symbol * sym, gfc_wrapped_block * block)
+{
+  stmtblock_t init;
+  tree decl;
+  tree tmp;
+
+  gcc_assert (sym->backend_decl);
+  gcc_assert (sym->ts.u.cl && sym->ts.u.cl->length);
+
+  gfc_init_block (&init);
+
+  /* Evaluate the string length expression.  */
+  gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
+
+  gfc_trans_vla_type_sizes (sym, &init);
+
+  decl = sym->backend_decl;
+
+  /* Emit a DECL_EXPR for this variable, which will cause the
+     gimplifier to allocate storage, and all that good stuff.  */
+  tmp = fold_build1_loc (input_location, DECL_EXPR, TREE_TYPE (decl), decl);
+  gfc_add_expr_to_block (&init, tmp);
+
+  gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+}
+
+/* Set the initial value of ASSIGN statement auxiliary variable explicitly.  */
+
+static void
+gfc_trans_assign_aux_var (gfc_symbol * sym, gfc_wrapped_block * block)
+{
+  stmtblock_t init;
+
+  gcc_assert (sym->backend_decl);
+  gfc_start_block (&init);
+
+  /* Set the initial value to length. See the comments in
+     function gfc_add_assign_aux_vars in this file.  */
+  gfc_add_modify (&init, GFC_DECL_STRING_LEN (sym->backend_decl),
+		  build_int_cst (NULL_TREE, -2));
+
+  gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+}
+
+static void
+gfc_trans_vla_one_sizepos (tree *tp, stmtblock_t *body)
+{
+  tree t = *tp, var, val;
+
+  if (t == NULL || t == error_mark_node)
+    return;
+  if (TREE_CONSTANT (t) || DECL_P (t))
+    return;
+
+  if (TREE_CODE (t) == SAVE_EXPR)
+    {
+      if (SAVE_EXPR_RESOLVED_P (t))
+	{
+	  *tp = TREE_OPERAND (t, 0);
+	  return;
+	}
+      val = TREE_OPERAND (t, 0);
+    }
+  else
+    val = t;
+
+  var = gfc_create_var_np (TREE_TYPE (t), NULL);
+  gfc_add_decl_to_function (var);
+  gfc_add_modify (body, var, val);
+  if (TREE_CODE (t) == SAVE_EXPR)
+    TREE_OPERAND (t, 0) = var;
+  *tp = var;
+}
+
+static void
+gfc_trans_vla_type_sizes_1 (tree type, stmtblock_t *body)
+{
+  tree t;
+
+  if (type == NULL || type == error_mark_node)
+    return;
+
+  type = TYPE_MAIN_VARIANT (type);
+
+  if (TREE_CODE (type) == INTEGER_TYPE)
+    {
+      gfc_trans_vla_one_sizepos (&TYPE_MIN_VALUE (type), body);
+      gfc_trans_vla_one_sizepos (&TYPE_MAX_VALUE (type), body);
+
+      for (t = TYPE_NEXT_VARIANT (type); t; t = TYPE_NEXT_VARIANT (t))
+	{
+	  TYPE_MIN_VALUE (t) = TYPE_MIN_VALUE (type);
+	  TYPE_MAX_VALUE (t) = TYPE_MAX_VALUE (type);
+	}
+    }
+  else if (TREE_CODE (type) == ARRAY_TYPE)
+    {
+      gfc_trans_vla_type_sizes_1 (TREE_TYPE (type), body);
+      gfc_trans_vla_type_sizes_1 (TYPE_DOMAIN (type), body);
+      gfc_trans_vla_one_sizepos (&TYPE_SIZE (type), body);
+      gfc_trans_vla_one_sizepos (&TYPE_SIZE_UNIT (type), body);
+
+      for (t = TYPE_NEXT_VARIANT (type); t; t = TYPE_NEXT_VARIANT (t))
+	{
+	  TYPE_SIZE (t) = TYPE_SIZE (type);
+	  TYPE_SIZE_UNIT (t) = TYPE_SIZE_UNIT (type);
+	}
+    }
+}
+
+/* Make sure all type sizes and array domains are either constant,
+   or variable or parameter decls.  This is a simplified variant
+   of gimplify_type_sizes, but we can't use it here, as none of the
+   variables in the expressions have been gimplified yet.
+   As type sizes and domains for various variable length arrays
+   contain VAR_DECLs that are only initialized at gfc_trans_deferred_vars
+   time, without this routine gimplify_type_sizes in the middle-end
+   could result in the type sizes being gimplified earlier than where
+   those variables are initialized.  */
+
+void
+gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body)
+{
+  tree type = TREE_TYPE (sym->backend_decl);
+
+  if (TREE_CODE (type) == FUNCTION_TYPE
+      && (sym->attr.function || sym->attr.result || sym->attr.entry))
+    {
+      if (! current_fake_result_decl)
+	return;
+
+      type = TREE_TYPE (TREE_VALUE (current_fake_result_decl));
+    }
+
+  while (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+
+  if (GFC_DESCRIPTOR_TYPE_P (type))
+    {
+      tree etype = GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
+
+      while (POINTER_TYPE_P (etype))
+	etype = TREE_TYPE (etype);
+
+      gfc_trans_vla_type_sizes_1 (etype, body);
+    }
+
+  gfc_trans_vla_type_sizes_1 (type, body);
+}
+
+
+/* Initialize a derived type by building an lvalue from the symbol
+   and using trans_assignment to do the work. Set dealloc to false
+   if no deallocation prior the assignment is needed.  */
+void
+gfc_init_default_dt (gfc_symbol * sym, stmtblock_t * block, bool dealloc)
+{
+  gfc_expr *e;
+  tree tmp;
+  tree present;
+
+  gcc_assert (block);
+
+  gcc_assert (!sym->attr.allocatable);
+  gfc_set_sym_referenced (sym);
+  e = gfc_lval_expr_from_sym (sym);
+  tmp = gfc_trans_assignment (e, sym->value, false, dealloc);
+  if (sym->attr.dummy && (sym->attr.optional
+			  || sym->ns->proc_name->attr.entry_master))
+    {
+      present = gfc_conv_expr_present (sym);
+      tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), present,
+			tmp, build_empty_stmt (input_location));
+    }
+  gfc_add_expr_to_block (block, tmp);
+  gfc_free_expr (e);
+}
+
+
+/* Initialize INTENT(OUT) derived type dummies.  As well as giving
+   them their default initializer, if they do not have allocatable
+   components, they have their allocatable components deallocated. */
+
+static void
+init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block)
+{
+  stmtblock_t init;
+  gfc_formal_arglist *f;
+  tree tmp;
+  tree present;
+
+  gfc_init_block (&init);
+  for (f = proc_sym->formal; f; f = f->next)
+    if (f->sym && f->sym->attr.intent == INTENT_OUT
+	&& !f->sym->attr.pointer
+	&& f->sym->ts.type == BT_DERIVED)
+      {
+	if (f->sym->ts.u.derived->attr.alloc_comp && !f->sym->value)
+	  {
+	    tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived,
+					     f->sym->backend_decl,
+					     f->sym->as ? f->sym->as->rank : 0);
+
+	    if (f->sym->attr.optional
+		|| f->sym->ns->proc_name->attr.entry_master)
+	      {
+		present = gfc_conv_expr_present (f->sym);
+		tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
+				  present, tmp,
+				  build_empty_stmt (input_location));
+	      }
+
+	    gfc_add_expr_to_block (&init, tmp);
+	  }
+       else if (f->sym->value)
+	  gfc_init_default_dt (f->sym, &init, true);
+      }
+    else if (f->sym && f->sym->attr.intent == INTENT_OUT
+	     && f->sym->ts.type == BT_CLASS
+	     && !CLASS_DATA (f->sym)->attr.class_pointer
+	     && CLASS_DATA (f->sym)->ts.u.derived->attr.alloc_comp)
+      {
+	tree decl = build_fold_indirect_ref_loc (input_location,
+						 f->sym->backend_decl);
+	tmp = CLASS_DATA (f->sym)->backend_decl;
+	tmp = fold_build3_loc (input_location, COMPONENT_REF,
+			       TREE_TYPE (tmp), decl, tmp, NULL_TREE);
+	tmp = build_fold_indirect_ref_loc (input_location, tmp);
+	tmp = gfc_deallocate_alloc_comp (CLASS_DATA (f->sym)->ts.u.derived,
+					 tmp,
+					 CLASS_DATA (f->sym)->as ?
+					 CLASS_DATA (f->sym)->as->rank : 0);
+
+	if (f->sym->attr.optional || f->sym->ns->proc_name->attr.entry_master)
+	  {
+	    present = gfc_conv_expr_present (f->sym);
+	    tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
+			      present, tmp,
+			      build_empty_stmt (input_location));
+	  }
+
+	gfc_add_expr_to_block (&init, tmp);
+      }
+
+  gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+}
+
+
+/* Generate function entry and exit code, and add it to the function body.
+   This includes:
+    Allocation and initialization of array variables.
+    Allocation of character string variables.
+    Initialization and possibly repacking of dummy arrays.
+    Initialization of ASSIGN statement auxiliary variable.
+    Initialization of ASSOCIATE names.
+    Automatic deallocation.  */
+
+void
+gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
+{
+  locus loc;
+  gfc_symbol *sym;
+  gfc_formal_arglist *f;
+  stmtblock_t tmpblock;
+  bool seen_trans_deferred_array = false;
+  tree tmp = NULL;
+  gfc_expr *e;
+  gfc_se se;
+  stmtblock_t init;
+
+  /* Deal with implicit return variables.  Explicit return variables will
+     already have been added.  */
+  if (gfc_return_by_reference (proc_sym) && proc_sym->result == proc_sym)
+    {
+      if (!current_fake_result_decl)
+	{
+	  gfc_entry_list *el = NULL;
+	  if (proc_sym->attr.entry_master)
+	    {
+	      for (el = proc_sym->ns->entries; el; el = el->next)
+		if (el->sym != el->sym->result)
+		  break;
+	    }
+	  /* TODO: move to the appropriate place in resolve.c.  */
+	  if (warn_return_type && el == NULL)
+	    gfc_warning ("Return value of function '%s' at %L not set",
+			 proc_sym->name, &proc_sym->declared_at);
+	}
+      else if (proc_sym->as)
+	{
+	  tree result = TREE_VALUE (current_fake_result_decl);
+	  gfc_trans_dummy_array_bias (proc_sym, result, block);
+
+	  /* An automatic character length, pointer array result.  */
+	  if (proc_sym->ts.type == BT_CHARACTER
+		&& TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL)
+	    gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, block);
+	}
+      else if (proc_sym->ts.type == BT_CHARACTER)
+	{
+	  if (proc_sym->ts.deferred)
+	    {
+	      tmp = NULL;
+	      gfc_save_backend_locus (&loc);
+	      gfc_set_backend_locus (&proc_sym->declared_at);
+	      gfc_start_block (&init);
+	      /* Zero the string length on entry.  */
+	      gfc_add_modify (&init, proc_sym->ts.u.cl->backend_decl,
+			      build_int_cst (gfc_charlen_type_node, 0));
+	      /* Null the pointer.  */
+	      e = gfc_lval_expr_from_sym (proc_sym);
+	      gfc_init_se (&se, NULL);
+	      se.want_pointer = 1;
+	      gfc_conv_expr (&se, e);
+	      gfc_free_expr (e);
+	      tmp = se.expr;
+	      gfc_add_modify (&init, tmp,
+			      fold_convert (TREE_TYPE (se.expr),
+					    null_pointer_node));
+	      gfc_restore_backend_locus (&loc);
+
+	      /* Pass back the string length on exit.  */
+	      tmp = proc_sym->ts.u.cl->passed_length;
+	      tmp = build_fold_indirect_ref_loc (input_location, tmp);
+	      tmp = fold_convert (gfc_charlen_type_node, tmp);
+	      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+				     gfc_charlen_type_node, tmp,
+				     proc_sym->ts.u.cl->backend_decl);
+	      gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
+	    }
+	  else if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == VAR_DECL)
+	    gfc_trans_dummy_character (proc_sym, proc_sym->ts.u.cl, block);
+	}
+      else
+	gcc_assert (gfc_option.flag_f2c
+		    && proc_sym->ts.type == BT_COMPLEX);
+    }
+
+  /* Initialize the INTENT(OUT) derived type dummy arguments.  This
+     should be done here so that the offsets and lbounds of arrays
+     are available.  */
+  gfc_save_backend_locus (&loc);
+  gfc_set_backend_locus (&proc_sym->declared_at);
+  init_intent_out_dt (proc_sym, block);
+  gfc_restore_backend_locus (&loc);
+
+  for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
+    {
+      bool sym_has_alloc_comp = (sym->ts.type == BT_DERIVED)
+				   && sym->ts.u.derived->attr.alloc_comp;
+      if (sym->assoc)
+	continue;
+
+      if (sym->attr.subref_array_pointer
+	  && GFC_DECL_SPAN (sym->backend_decl)
+	  && !TREE_STATIC (GFC_DECL_SPAN (sym->backend_decl)))
+	{
+	  gfc_init_block (&tmpblock);
+	  gfc_add_modify (&tmpblock, GFC_DECL_SPAN (sym->backend_decl),
+			  build_int_cst (gfc_array_index_type, 0));
+	  gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock),
+				NULL_TREE);
+	}
+
+      if (sym->attr.dimension)
+	{
+          /* Assumed-size Cray pointees need to be treated as AS_EXPLICIT.  */
+          array_type tmp = sym->as->type;
+          if (tmp == AS_ASSUMED_SIZE && sym->as->cp_was_assumed)
+            tmp = AS_EXPLICIT;
+          switch (tmp)
+	    {
+	    case AS_EXPLICIT:
+	      if (sym->attr.dummy || sym->attr.result)
+		gfc_trans_dummy_array_bias (sym, sym->backend_decl, block);
+	      else if (sym->attr.pointer || sym->attr.allocatable)
+		{
+		  if (TREE_STATIC (sym->backend_decl))
+		    {
+		      gfc_save_backend_locus (&loc);
+		      gfc_set_backend_locus (&sym->declared_at);
+		      gfc_trans_static_array_pointer (sym);
+		      gfc_restore_backend_locus (&loc);
+		    }
+		  else
+		    {
+		      seen_trans_deferred_array = true;
+		      gfc_trans_deferred_array (sym, block);
+		    }
+		}
+	      else
+		{
+		  gfc_save_backend_locus (&loc);
+		  gfc_set_backend_locus (&sym->declared_at);
+
+		  if (sym_has_alloc_comp)
+		    {
+		      seen_trans_deferred_array = true;
+		      gfc_trans_deferred_array (sym, block);
+		    }
+		  else if (sym->ts.type == BT_DERIVED
+			     && sym->value
+			     && !sym->attr.data
+			     && sym->attr.save == SAVE_NONE)
+		    {
+		      gfc_start_block (&tmpblock);
+		      gfc_init_default_dt (sym, &tmpblock, false);
+		      gfc_add_init_cleanup (block,
+					    gfc_finish_block (&tmpblock),
+					    NULL_TREE);
+		    }
+
+		  gfc_trans_auto_array_allocation (sym->backend_decl,
+						   sym, block);
+		  gfc_restore_backend_locus (&loc);
+		}
+	      break;
+
+	    case AS_ASSUMED_SIZE:
+	      /* Must be a dummy parameter.  */
+	      gcc_assert (sym->attr.dummy || sym->as->cp_was_assumed);
+
+	      /* We should always pass assumed size arrays the g77 way.  */
+	      if (sym->attr.dummy)
+		gfc_trans_g77_array (sym, block);
+	      break;
+
+	    case AS_ASSUMED_SHAPE:
+	      /* Must be a dummy parameter.  */
+	      gcc_assert (sym->attr.dummy);
+
+	      gfc_trans_dummy_array_bias (sym, sym->backend_decl, block);
+	      break;
+
+	    case AS_DEFERRED:
+	      seen_trans_deferred_array = true;
+	      gfc_trans_deferred_array (sym, block);
+	      break;
+
+	    default:
+	      gcc_unreachable ();
+	    }
+	  if (sym_has_alloc_comp && !seen_trans_deferred_array)
+	    gfc_trans_deferred_array (sym, block);
+	}
+      else if ((!sym->attr.dummy || sym->ts.deferred)
+		&& (sym->attr.allocatable
+		    || (sym->ts.type == BT_CLASS
+			&& CLASS_DATA (sym)->attr.allocatable)))
+	{
+	  if (!sym->attr.save)
+	    {
+	      /* Nullify and automatic deallocation of allocatable
+		 scalars.  */
+	      e = gfc_lval_expr_from_sym (sym);
+	      if (sym->ts.type == BT_CLASS)
+		gfc_add_data_component (e);
+
+	      gfc_init_se (&se, NULL);
+	      se.want_pointer = 1;
+	      gfc_conv_expr (&se, e);
+	      gfc_free_expr (e);
+
+	      gfc_save_backend_locus (&loc);
+	      gfc_set_backend_locus (&sym->declared_at);
+	      gfc_start_block (&init);
+
+	      if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT)
+		{
+		  /* Nullify when entering the scope.  */
+		  gfc_add_modify (&init, se.expr,
+				  fold_convert (TREE_TYPE (se.expr),
+					        null_pointer_node));
+		}
+
+	      if ((sym->attr.dummy ||sym->attr.result)
+		    && sym->ts.type == BT_CHARACTER
+		    && sym->ts.deferred)
+		{
+		  /* Character length passed by reference.  */
+		  tmp = sym->ts.u.cl->passed_length;
+		  tmp = build_fold_indirect_ref_loc (input_location, tmp);
+		  tmp = fold_convert (gfc_charlen_type_node, tmp);
+
+		  if (!sym->attr.dummy || sym->attr.intent == INTENT_OUT)
+		    /* Zero the string length when entering the scope.  */
+		    gfc_add_modify (&init, sym->ts.u.cl->backend_decl,
+				build_int_cst (gfc_charlen_type_node, 0));
+		  else
+		    gfc_add_modify (&init, sym->ts.u.cl->backend_decl, tmp);
+
+		  gfc_restore_backend_locus (&loc);
+
+		  /* Pass the final character length back.  */
+		  if (sym->attr.intent != INTENT_IN)
+		    tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+					   gfc_charlen_type_node, tmp,
+					   sym->ts.u.cl->backend_decl);
+		  else
+		    tmp = NULL_TREE;
+		}
+	      else
+		gfc_restore_backend_locus (&loc);
+
+	      /* Deallocate when leaving the scope. Nullifying is not
+		 needed.  */
+	      if (!sym->attr.result && !sym->attr.dummy)
+		tmp = gfc_deallocate_scalar_with_status (se.expr, NULL, true,
+							 NULL, sym->ts);
+
+	      if (sym->ts.type == BT_CLASS)
+		{
+		  /* Initialize _vptr to declared type.  */
+		  gfc_symbol *vtab = gfc_find_derived_vtab (sym->ts.u.derived);
+		  tree rhs;
+
+		  gfc_save_backend_locus (&loc);
+		  gfc_set_backend_locus (&sym->declared_at);
+		  e = gfc_lval_expr_from_sym (sym);
+		  gfc_add_vptr_component (e);
+		  gfc_init_se (&se, NULL);
+		  se.want_pointer = 1;
+		  gfc_conv_expr (&se, e);
+		  gfc_free_expr (e);
+		  rhs = gfc_build_addr_expr (TREE_TYPE (se.expr),
+					     gfc_get_symbol_decl (vtab));
+		  gfc_add_modify (&init, se.expr, rhs);
+		  gfc_restore_backend_locus (&loc);
+		}
+
+	      gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
+	    }
+	}
+      else if (sym->ts.type == BT_CHARACTER && sym->ts.deferred)
+	{
+	  tree tmp = NULL;
+	  stmtblock_t init;
+
+	  /* If we get to here, all that should be left are pointers.  */
+	  gcc_assert (sym->attr.pointer);
+
+	  if (sym->attr.dummy)
+	    {
+	      gfc_start_block (&init);
+
+	      /* Character length passed by reference.  */
+	      tmp = sym->ts.u.cl->passed_length;
+	      tmp = build_fold_indirect_ref_loc (input_location, tmp);
+	      tmp = fold_convert (gfc_charlen_type_node, tmp);
+	      gfc_add_modify (&init, sym->ts.u.cl->backend_decl, tmp);
+	      /* Pass the final character length back.  */
+	      if (sym->attr.intent != INTENT_IN)
+		tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+				       gfc_charlen_type_node, tmp,
+				       sym->ts.u.cl->backend_decl);
+	      else
+		tmp = NULL_TREE;
+	      gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
+	    }
+	}
+      else if (sym->ts.deferred)
+	gfc_fatal_error ("Deferred type parameter not yet supported");
+      else if (sym_has_alloc_comp)
+	gfc_trans_deferred_array (sym, block);
+      else if (sym->ts.type == BT_CHARACTER)
+	{
+	  gfc_save_backend_locus (&loc);
+	  gfc_set_backend_locus (&sym->declared_at);
+	  if (sym->attr.dummy || sym->attr.result)
+	    gfc_trans_dummy_character (sym, sym->ts.u.cl, block);
+	  else
+	    gfc_trans_auto_character_variable (sym, block);
+	  gfc_restore_backend_locus (&loc);
+	}
+      else if (sym->attr.assign)
+	{
+	  gfc_save_backend_locus (&loc);
+	  gfc_set_backend_locus (&sym->declared_at);
+	  gfc_trans_assign_aux_var (sym, block);
+	  gfc_restore_backend_locus (&loc);
+	}
+      else if (sym->ts.type == BT_DERIVED
+		 && sym->value
+		 && !sym->attr.data
+		 && sym->attr.save == SAVE_NONE)
+	{
+	  gfc_start_block (&tmpblock);
+	  gfc_init_default_dt (sym, &tmpblock, false);
+	  gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock),
+				NULL_TREE);
+	}
+      else
+	gcc_unreachable ();
+    }
+
+  gfc_init_block (&tmpblock);
+
+  for (f = proc_sym->formal; f; f = f->next)
+    {
+      if (f->sym && f->sym->tlink == NULL && f->sym->ts.type == BT_CHARACTER)
+	{
+	  gcc_assert (f->sym->ts.u.cl->backend_decl != NULL);
+	  if (TREE_CODE (f->sym->ts.u.cl->backend_decl) == PARM_DECL)
+	    gfc_trans_vla_type_sizes (f->sym, &tmpblock);
+	}
+    }
+
+  if (gfc_return_by_reference (proc_sym) && proc_sym->ts.type == BT_CHARACTER
+      && current_fake_result_decl != NULL)
+    {
+      gcc_assert (proc_sym->ts.u.cl->backend_decl != NULL);
+      if (TREE_CODE (proc_sym->ts.u.cl->backend_decl) == PARM_DECL)
+	gfc_trans_vla_type_sizes (proc_sym, &tmpblock);
+    }
+
+  gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), NULL_TREE);
+}
+
+static GTY ((param_is (struct module_htab_entry))) htab_t module_htab;
+
+/* Hash and equality functions for module_htab.  */
+
+static hashval_t
+module_htab_do_hash (const void *x)
+{
+  return htab_hash_string (((const struct module_htab_entry *)x)->name);
+}
+
+static int
+module_htab_eq (const void *x1, const void *x2)
+{
+  return strcmp ((((const struct module_htab_entry *)x1)->name),
+		 (const char *)x2) == 0;
+}
+
+/* Hash and equality functions for module_htab's decls.  */
+
+static hashval_t
+module_htab_decls_hash (const void *x)
+{
+  const_tree t = (const_tree) x;
+  const_tree n = DECL_NAME (t);
+  if (n == NULL_TREE)
+    n = TYPE_NAME (TREE_TYPE (t));
+  return htab_hash_string (IDENTIFIER_POINTER (n));
+}
+
+static int
+module_htab_decls_eq (const void *x1, const void *x2)
+{
+  const_tree t1 = (const_tree) x1;
+  const_tree n1 = DECL_NAME (t1);
+  if (n1 == NULL_TREE)
+    n1 = TYPE_NAME (TREE_TYPE (t1));
+  return strcmp (IDENTIFIER_POINTER (n1), (const char *) x2) == 0;
+}
+
+struct module_htab_entry *
+gfc_find_module (const char *name)
+{
+  void **slot;
+
+  if (! module_htab)
+    module_htab = htab_create_ggc (10, module_htab_do_hash,
+				   module_htab_eq, NULL);
+
+  slot = htab_find_slot_with_hash (module_htab, name,
+				   htab_hash_string (name), INSERT);
+  if (*slot == NULL)
+    {
+      struct module_htab_entry *entry = ggc_alloc_cleared_module_htab_entry ();
+
+      entry->name = gfc_get_string (name);
+      entry->decls = htab_create_ggc (10, module_htab_decls_hash,
+				      module_htab_decls_eq, NULL);
+      *slot = (void *) entry;
+    }
+  return (struct module_htab_entry *) *slot;
+}
+
+void
+gfc_module_add_decl (struct module_htab_entry *entry, tree decl)
+{
+  void **slot;
+  const char *name;
+
+  if (DECL_NAME (decl))
+    name = IDENTIFIER_POINTER (DECL_NAME (decl));
+  else
+    {
+      gcc_assert (TREE_CODE (decl) == TYPE_DECL);
+      name = IDENTIFIER_POINTER (TYPE_NAME (TREE_TYPE (decl)));
+    }
+  slot = htab_find_slot_with_hash (entry->decls, name,
+				   htab_hash_string (name), INSERT);
+  if (*slot == NULL)
+    *slot = (void *) decl;
+}
+
+static struct module_htab_entry *cur_module;
+
+/* Output an initialized decl for a module variable.  */
+
+static void
+gfc_create_module_variable (gfc_symbol * sym)
+{
+  tree decl;
+
+  /* Module functions with alternate entries are dealt with later and
+     would get caught by the next condition.  */
+  if (sym->attr.entry)
+    return;
+
+  /* Make sure we convert the types of the derived types from iso_c_binding
+     into (void *).  */
+  if (sym->attr.flavor != FL_PROCEDURE && sym->attr.is_iso_c
+      && sym->ts.type == BT_DERIVED)
+    sym->backend_decl = gfc_typenode_for_spec (&(sym->ts));
+
+  if (sym->attr.flavor == FL_DERIVED
+      && sym->backend_decl
+      && TREE_CODE (sym->backend_decl) == RECORD_TYPE)
+    {
+      decl = sym->backend_decl;
+      gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE);
+
+      /* -fwhole-file mixes up the contexts so these asserts are unnecessary.  */
+      if (!(gfc_option.flag_whole_file && sym->attr.use_assoc))
+	{
+	  gcc_assert (TYPE_CONTEXT (decl) == NULL_TREE
+		      || TYPE_CONTEXT (decl) == sym->ns->proc_name->backend_decl);
+	  gcc_assert (DECL_CONTEXT (TYPE_STUB_DECL (decl)) == NULL_TREE
+		      || DECL_CONTEXT (TYPE_STUB_DECL (decl))
+			   == sym->ns->proc_name->backend_decl);
+	}
+      TYPE_CONTEXT (decl) = sym->ns->proc_name->backend_decl;
+      DECL_CONTEXT (TYPE_STUB_DECL (decl)) = sym->ns->proc_name->backend_decl;
+      gfc_module_add_decl (cur_module, TYPE_STUB_DECL (decl));
+    }
+
+  /* Only output variables, procedure pointers and array valued,
+     or derived type, parameters.  */
+  if (sym->attr.flavor != FL_VARIABLE
+	&& !(sym->attr.flavor == FL_PARAMETER
+	       && (sym->attr.dimension || sym->ts.type == BT_DERIVED))
+	&& !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer))
+    return;
+
+  if ((sym->attr.in_common || sym->attr.in_equivalence) && sym->backend_decl)
+    {
+      decl = sym->backend_decl;
+      gcc_assert (DECL_FILE_SCOPE_P (decl));
+      gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE);
+      DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl;
+      gfc_module_add_decl (cur_module, decl);
+    }
+
+  /* Don't generate variables from other modules. Variables from
+     COMMONs will already have been generated.  */
+  if (sym->attr.use_assoc || sym->attr.in_common)
+    return;
+
+  /* Equivalenced variables arrive here after creation.  */
+  if (sym->backend_decl
+      && (sym->equiv_built || sym->attr.in_equivalence))
+    return;
+
+  if (sym->backend_decl && !sym->attr.vtab && !sym->attr.target)
+    internal_error ("backend decl for module variable %s already exists",
+		    sym->name);
+
+  /* We always want module variables to be created.  */
+  sym->attr.referenced = 1;
+  /* Create the decl.  */
+  decl = gfc_get_symbol_decl (sym);
+
+  /* Create the variable.  */
+  pushdecl (decl);
+  gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE);
+  DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl;
+  rest_of_decl_compilation (decl, 1, 0);
+  gfc_module_add_decl (cur_module, decl);
+
+  /* Also add length of strings.  */
+  if (sym->ts.type == BT_CHARACTER)
+    {
+      tree length;
+
+      length = sym->ts.u.cl->backend_decl;
+      gcc_assert (length || sym->attr.proc_pointer);
+      if (length && !INTEGER_CST_P (length))
+        {
+          pushdecl (length);
+          rest_of_decl_compilation (length, 1, 0);
+        }
+    }
+}
+
+/* Emit debug information for USE statements.  */
+
+static void
+gfc_trans_use_stmts (gfc_namespace * ns)
+{
+  gfc_use_list *use_stmt;
+  for (use_stmt = ns->use_stmts; use_stmt; use_stmt = use_stmt->next)
+    {
+      struct module_htab_entry *entry
+	= gfc_find_module (use_stmt->module_name);
+      gfc_use_rename *rent;
+
+      if (entry->namespace_decl == NULL)
+	{
+	  entry->namespace_decl
+	    = build_decl (input_location,
+			  NAMESPACE_DECL,
+			  get_identifier (use_stmt->module_name),
+			  void_type_node);
+	  DECL_EXTERNAL (entry->namespace_decl) = 1;
+	}
+      gfc_set_backend_locus (&use_stmt->where);
+      if (!use_stmt->only_flag)
+	(*debug_hooks->imported_module_or_decl) (entry->namespace_decl,
+						 NULL_TREE,
+						 ns->proc_name->backend_decl,
+						 false);
+      for (rent = use_stmt->rename; rent; rent = rent->next)
+	{
+	  tree decl, local_name;
+	  void **slot;
+
+	  if (rent->op != INTRINSIC_NONE)
+	    continue;
+
+	  slot = htab_find_slot_with_hash (entry->decls, rent->use_name,
+					   htab_hash_string (rent->use_name),
+					   INSERT);
+	  if (*slot == NULL)
+	    {
+	      gfc_symtree *st;
+
+	      st = gfc_find_symtree (ns->sym_root,
+				     rent->local_name[0]
+				     ? rent->local_name : rent->use_name);
+	      gcc_assert (st);
+
+	      /* Sometimes, generic interfaces wind up being over-ruled by a
+		 local symbol (see PR41062).  */
+	      if (!st->n.sym->attr.use_assoc)
+		continue;
+
+	      if (st->n.sym->backend_decl
+		  && DECL_P (st->n.sym->backend_decl)
+		  && st->n.sym->module
+		  && strcmp (st->n.sym->module, use_stmt->module_name) == 0)
+		{
+		  gcc_assert (DECL_EXTERNAL (entry->namespace_decl)
+			      || (TREE_CODE (st->n.sym->backend_decl)
+				  != VAR_DECL));
+		  decl = copy_node (st->n.sym->backend_decl);
+		  DECL_CONTEXT (decl) = entry->namespace_decl;
+		  DECL_EXTERNAL (decl) = 1;
+		  DECL_IGNORED_P (decl) = 0;
+		  DECL_INITIAL (decl) = NULL_TREE;
+		}
+	      else
+		{
+		  *slot = error_mark_node;
+		  htab_clear_slot (entry->decls, slot);
+		  continue;
+		}
+	      *slot = decl;
+	    }
+	  decl = (tree) *slot;
+	  if (rent->local_name[0])
+	    local_name = get_identifier (rent->local_name);
+	  else
+	    local_name = NULL_TREE;
+	  gfc_set_backend_locus (&rent->where);
+	  (*debug_hooks->imported_module_or_decl) (decl, local_name,
+						   ns->proc_name->backend_decl,
+						   !use_stmt->only_flag);
+	}
+    }
+}
+
+
+/* Return true if expr is a constant initializer that gfc_conv_initializer
+   will handle.  */
+
+static bool
+check_constant_initializer (gfc_expr *expr, gfc_typespec *ts, bool array,
+			    bool pointer)
+{
+  gfc_constructor *c;
+  gfc_component *cm;
+
+  if (pointer)
+    return true;
+  else if (array)
+    {
+      if (expr->expr_type == EXPR_CONSTANT || expr->expr_type == EXPR_NULL)
+	return true;
+      else if (expr->expr_type == EXPR_STRUCTURE)
+	return check_constant_initializer (expr, ts, false, false);
+      else if (expr->expr_type != EXPR_ARRAY)
+	return false;
+      for (c = gfc_constructor_first (expr->value.constructor);
+	   c; c = gfc_constructor_next (c))
+	{
+	  if (c->iterator)
+	    return false;
+	  if (c->expr->expr_type == EXPR_STRUCTURE)
+	    {
+	      if (!check_constant_initializer (c->expr, ts, false, false))
+		return false;
+	    }
+	  else if (c->expr->expr_type != EXPR_CONSTANT)
+	    return false;
+	}
+      return true;
+    }
+  else switch (ts->type)
+    {
+    case BT_DERIVED:
+      if (expr->expr_type != EXPR_STRUCTURE)
+	return false;
+      cm = expr->ts.u.derived->components;
+      for (c = gfc_constructor_first (expr->value.constructor);
+	   c; c = gfc_constructor_next (c), cm = cm->next)
+	{
+	  if (!c->expr || cm->attr.allocatable)
+	    continue;
+	  if (!check_constant_initializer (c->expr, &cm->ts,
+					   cm->attr.dimension,
+					   cm->attr.pointer))
+	    return false;
+	}
+      return true;
+    default:
+      return expr->expr_type == EXPR_CONSTANT;
+    }
+}
+
+/* Emit debug info for parameters and unreferenced variables with
+   initializers.  */
+
+static void
+gfc_emit_parameter_debug_info (gfc_symbol *sym)
+{
+  tree decl;
+
+  if (sym->attr.flavor != FL_PARAMETER
+      && (sym->attr.flavor != FL_VARIABLE || sym->attr.referenced))
+    return;
+
+  if (sym->backend_decl != NULL
+      || sym->value == NULL
+      || sym->attr.use_assoc
+      || sym->attr.dummy
+      || sym->attr.result
+      || sym->attr.function
+      || sym->attr.intrinsic
+      || sym->attr.pointer
+      || sym->attr.allocatable
+      || sym->attr.cray_pointee
+      || sym->attr.threadprivate
+      || sym->attr.is_bind_c
+      || sym->attr.subref_array_pointer
+      || sym->attr.assign)
+    return;
+
+  if (sym->ts.type == BT_CHARACTER)
+    {
+      gfc_conv_const_charlen (sym->ts.u.cl);
+      if (sym->ts.u.cl->backend_decl == NULL
+	  || TREE_CODE (sym->ts.u.cl->backend_decl) != INTEGER_CST)
+	return;
+    }
+  else if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.alloc_comp)
+    return;
+
+  if (sym->as)
+    {
+      int n;
+
+      if (sym->as->type != AS_EXPLICIT)
+	return;
+      for (n = 0; n < sym->as->rank; n++)
+	if (sym->as->lower[n]->expr_type != EXPR_CONSTANT
+	    || sym->as->upper[n] == NULL
+	    || sym->as->upper[n]->expr_type != EXPR_CONSTANT)
+	  return;
+    }
+
+  if (!check_constant_initializer (sym->value, &sym->ts,
+				   sym->attr.dimension, false))
+    return;
+
+  /* Create the decl for the variable or constant.  */
+  decl = build_decl (input_location,
+		     sym->attr.flavor == FL_PARAMETER ? CONST_DECL : VAR_DECL,
+		     gfc_sym_identifier (sym), gfc_sym_type (sym));
+  if (sym->attr.flavor == FL_PARAMETER)
+    TREE_READONLY (decl) = 1;
+  gfc_set_decl_location (decl, &sym->declared_at);
+  if (sym->attr.dimension)
+    GFC_DECL_PACKED_ARRAY (decl) = 1;
+  DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl;
+  TREE_STATIC (decl) = 1;
+  TREE_USED (decl) = 1;
+  if (DECL_CONTEXT (decl) && TREE_CODE (DECL_CONTEXT (decl)) == NAMESPACE_DECL)
+    TREE_PUBLIC (decl) = 1;
+  DECL_INITIAL (decl) = gfc_conv_initializer (sym->value, &sym->ts,
+					      TREE_TYPE (decl),
+					      sym->attr.dimension,
+					      false, false);
+  debug_hooks->global_decl (decl);
+}
+
+/* Generate all the required code for module variables.  */
+
+void
+gfc_generate_module_vars (gfc_namespace * ns)
+{
+  module_namespace = ns;
+  cur_module = gfc_find_module (ns->proc_name->name);
+
+  /* Check if the frontend left the namespace in a reasonable state.  */
+  gcc_assert (ns->proc_name && !ns->proc_name->tlink);
+
+  /* Generate COMMON blocks.  */
+  gfc_trans_common (ns);
+
+  /* Create decls for all the module variables.  */
+  gfc_traverse_ns (ns, gfc_create_module_variable);
+
+  cur_module = NULL;
+
+  gfc_trans_use_stmts (ns);
+  gfc_traverse_ns (ns, gfc_emit_parameter_debug_info);
+}
+
+
+static void
+gfc_generate_contained_functions (gfc_namespace * parent)
+{
+  gfc_namespace *ns;
+
+  /* We create all the prototypes before generating any code.  */
+  for (ns = parent->contained; ns; ns = ns->sibling)
+    {
+      /* Skip namespaces from used modules.  */
+      if (ns->parent != parent)
+	continue;
+
+      gfc_create_function_decl (ns, false);
+    }
+
+  for (ns = parent->contained; ns; ns = ns->sibling)
+    {
+      /* Skip namespaces from used modules.  */
+      if (ns->parent != parent)
+	continue;
+
+      gfc_generate_function_code (ns);
+    }
+}
+
+
+/* Drill down through expressions for the array specification bounds and
+   character length calling generate_local_decl for all those variables
+   that have not already been declared.  */
+
+static void
+generate_local_decl (gfc_symbol *);
+
+/* Traverse expr, marking all EXPR_VARIABLE symbols referenced.  */
+
+static bool
+expr_decls (gfc_expr *e, gfc_symbol *sym,
+	    int *f ATTRIBUTE_UNUSED)
+{
+  if (e->expr_type != EXPR_VARIABLE
+	    || sym == e->symtree->n.sym
+	    || e->symtree->n.sym->mark
+	    || e->symtree->n.sym->ns != sym->ns)
+	return false;
+
+  generate_local_decl (e->symtree->n.sym);
+  return false;
+}
+
+static void
+generate_expr_decls (gfc_symbol *sym, gfc_expr *e)
+{
+  gfc_traverse_expr (e, sym, expr_decls, 0);
+}
+
+
+/* Check for dependencies in the character length and array spec.  */
+
+static void
+generate_dependency_declarations (gfc_symbol *sym)
+{
+  int i;
+
+  if (sym->ts.type == BT_CHARACTER
+      && sym->ts.u.cl
+      && sym->ts.u.cl->length
+      && sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+    generate_expr_decls (sym, sym->ts.u.cl->length);
+
+  if (sym->as && sym->as->rank)
+    {
+      for (i = 0; i < sym->as->rank; i++)
+	{
+          generate_expr_decls (sym, sym->as->lower[i]);
+          generate_expr_decls (sym, sym->as->upper[i]);
+	}
+    }
+}
+
+
+/* Generate decls for all local variables.  We do this to ensure correct
+   handling of expressions which only appear in the specification of
+   other functions.  */
+
+static void
+generate_local_decl (gfc_symbol * sym)
+{
+  if (sym->attr.flavor == FL_VARIABLE)
+    {
+      if (!sym->attr.dummy && !sym->ns->proc_name->attr.entry_master)
+	generate_dependency_declarations (sym);
+
+      if (sym->attr.referenced)
+	gfc_get_symbol_decl (sym);
+
+      /* Warnings for unused dummy arguments.  */
+      else if (sym->attr.dummy)
+	{
+	  /* INTENT(out) dummy arguments are likely meant to be set.  */
+	  if (gfc_option.warn_unused_dummy_argument
+	      && sym->attr.intent == INTENT_OUT)
+	    {
+	      if (sym->ts.type != BT_DERIVED)
+		gfc_warning ("Dummy argument '%s' at %L was declared "
+			     "INTENT(OUT) but was not set",  sym->name,
+			     &sym->declared_at);
+	      else if (!gfc_has_default_initializer (sym->ts.u.derived))
+		gfc_warning ("Derived-type dummy argument '%s' at %L was "
+			     "declared INTENT(OUT) but was not set and "
+			     "does not have a default initializer",
+			     sym->name, &sym->declared_at);
+	      if (sym->backend_decl != NULL_TREE)
+		TREE_NO_WARNING(sym->backend_decl) = 1;
+	    }
+	  else if (gfc_option.warn_unused_dummy_argument)
+	    {
+	      gfc_warning ("Unused dummy argument '%s' at %L", sym->name,
+			 &sym->declared_at);
+	      if (sym->backend_decl != NULL_TREE)
+		TREE_NO_WARNING(sym->backend_decl) = 1;
+	    }
+	}
+
+      /* Warn for unused variables, but not if they're inside a common
+	 block, a namelist, or are use-associated.  */
+      else if (warn_unused_variable
+	       && !(sym->attr.in_common || sym->attr.use_assoc || sym->mark
+		    || sym->attr.in_namelist))
+	gfc_warning ("Unused variable '%s' declared at %L", sym->name,
+		     &sym->declared_at);
+
+      /* For variable length CHARACTER parameters, the PARM_DECL already
+	 references the length variable, so force gfc_get_symbol_decl
+	 even when not referenced.  If optimize > 0, it will be optimized
+	 away anyway.  But do this only after emitting -Wunused-parameter
+	 warning if requested.  */
+      if (sym->attr.dummy && !sym->attr.referenced
+	    && sym->ts.type == BT_CHARACTER
+	    && sym->ts.u.cl->backend_decl != NULL
+	    && TREE_CODE (sym->ts.u.cl->backend_decl) == VAR_DECL)
+	{
+	  sym->attr.referenced = 1;
+	  gfc_get_symbol_decl (sym);
+	}
+
+      /* INTENT(out) dummy arguments and result variables with allocatable
+	 components are reset by default and need to be set referenced to
+	 generate the code for nullification and automatic lengths.  */
+      if (!sym->attr.referenced
+	    && sym->ts.type == BT_DERIVED
+	    && sym->ts.u.derived->attr.alloc_comp
+	    && !sym->attr.pointer
+	    && ((sym->attr.dummy && sym->attr.intent == INTENT_OUT)
+		  ||
+		(sym->attr.result && sym != sym->result)))
+	{
+	  sym->attr.referenced = 1;
+	  gfc_get_symbol_decl (sym);
+	}
+
+      /* Check for dependencies in the array specification and string
+	length, adding the necessary declarations to the function.  We
+	mark the symbol now, as well as in traverse_ns, to prevent
+	getting stuck in a circular dependency.  */
+      sym->mark = 1;
+    }
+  else if (sym->attr.flavor == FL_PARAMETER)
+    {
+      if (warn_unused_parameter
+           && !sym->attr.referenced
+           && !sym->attr.use_assoc)
+	gfc_warning ("Unused parameter '%s' declared at %L", sym->name,
+		     &sym->declared_at);
+    }
+  else if (sym->attr.flavor == FL_PROCEDURE)
+    {
+      /* TODO: move to the appropriate place in resolve.c.  */
+      if (warn_return_type
+	  && sym->attr.function
+	  && sym->result
+	  && sym != sym->result
+	  && !sym->result->attr.referenced
+	  && !sym->attr.use_assoc
+	  && sym->attr.if_source != IFSRC_IFBODY)
+	{
+	  gfc_warning ("Return value '%s' of function '%s' declared at "
+		       "%L not set", sym->result->name, sym->name,
+		        &sym->result->declared_at);
+
+	  /* Prevents "Unused variable" warning for RESULT variables.  */
+	  sym->result->mark = 1;
+	}
+    }
+
+  if (sym->attr.dummy == 1)
+    {
+      /* Modify the tree type for scalar character dummy arguments of bind(c)
+	 procedures if they are passed by value.  The tree type for them will
+	 be promoted to INTEGER_TYPE for the middle end, which appears to be
+	 what C would do with characters passed by-value.  The value attribute
+         implies the dummy is a scalar.  */
+      if (sym->attr.value == 1 && sym->backend_decl != NULL
+	  && sym->ts.type == BT_CHARACTER && sym->ts.is_c_interop
+	  && sym->ns->proc_name != NULL && sym->ns->proc_name->attr.is_bind_c)
+	gfc_conv_scalar_char_value (sym, NULL, NULL);
+    }
+
+  /* Make sure we convert the types of the derived types from iso_c_binding
+     into (void *).  */
+  if (sym->attr.flavor != FL_PROCEDURE && sym->attr.is_iso_c
+      && sym->ts.type == BT_DERIVED)
+    sym->backend_decl = gfc_typenode_for_spec (&(sym->ts));
+}
+
+static void
+generate_local_vars (gfc_namespace * ns)
+{
+  gfc_traverse_ns (ns, generate_local_decl);
+}
+
+
+/* Generate a switch statement to jump to the correct entry point.  Also
+   creates the label decls for the entry points.  */
+
+static tree
+gfc_trans_entry_master_switch (gfc_entry_list * el)
+{
+  stmtblock_t block;
+  tree label;
+  tree tmp;
+  tree val;
+
+  gfc_init_block (&block);
+  for (; el; el = el->next)
+    {
+      /* Add the case label.  */
+      label = gfc_build_label_decl (NULL_TREE);
+      val = build_int_cst (gfc_array_index_type, el->id);
+      tmp = build3_v (CASE_LABEL_EXPR, val, NULL_TREE, label);
+      gfc_add_expr_to_block (&block, tmp);
+
+      /* And jump to the actual entry point.  */
+      label = gfc_build_label_decl (NULL_TREE);
+      tmp = build1_v (GOTO_EXPR, label);
+      gfc_add_expr_to_block (&block, tmp);
+
+      /* Save the label decl.  */
+      el->label = label;
+    }
+  tmp = gfc_finish_block (&block);
+  /* The first argument selects the entry point.  */
+  val = DECL_ARGUMENTS (current_function_decl);
+  tmp = build3_v (SWITCH_EXPR, val, tmp, NULL_TREE);
+  return tmp;
+}
+
+
+/* Add code to string lengths of actual arguments passed to a function against
+   the expected lengths of the dummy arguments.  */
+
+static void
+add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
+{
+  gfc_formal_arglist *formal;
+
+  for (formal = sym->formal; formal; formal = formal->next)
+    if (formal->sym && formal->sym->ts.type == BT_CHARACTER)
+      {
+	enum tree_code comparison;
+	tree cond;
+	tree argname;
+	gfc_symbol *fsym;
+	gfc_charlen *cl;
+	const char *message;
+
+	fsym = formal->sym;
+	cl = fsym->ts.u.cl;
+
+	gcc_assert (cl);
+	gcc_assert (cl->passed_length != NULL_TREE);
+	gcc_assert (cl->backend_decl != NULL_TREE);
+
+	/* For POINTER, ALLOCATABLE and assumed-shape dummy arguments, the
+	   string lengths must match exactly.  Otherwise, it is only required
+	   that the actual string length is *at least* the expected one.
+	   Sequence association allows for a mismatch of the string length
+	   if the actual argument is (part of) an array, but only if the
+	   dummy argument is an array. (See "Sequence association" in
+	   Section 12.4.1.4 for F95 and 12.4.1.5 for F2003.)  */
+	if (fsym->attr.pointer || fsym->attr.allocatable
+	    || (fsym->as && fsym->as->type == AS_ASSUMED_SHAPE))
+	  {
+	    comparison = NE_EXPR;
+	    message = _("Actual string length does not match the declared one"
+			" for dummy argument '%s' (%ld/%ld)");
+	  }
+	else if (fsym->as && fsym->as->rank != 0)
+	  continue;
+	else
+	  {
+	    comparison = LT_EXPR;
+	    message = _("Actual string length is shorter than the declared one"
+			" for dummy argument '%s' (%ld/%ld)");
+	  }
+
+	/* Build the condition.  For optional arguments, an actual length
+	   of 0 is also acceptable if the associated string is NULL, which
+	   means the argument was not passed.  */
+	cond = fold_build2_loc (input_location, comparison, boolean_type_node,
+				cl->passed_length, cl->backend_decl);
+	if (fsym->attr.optional)
+	  {
+	    tree not_absent;
+	    tree not_0length;
+	    tree absent_failed;
+
+	    not_0length = fold_build2_loc (input_location, NE_EXPR,
+					   boolean_type_node,
+					   cl->passed_length,
+					   build_zero_cst (gfc_charlen_type_node));
+	    /* The symbol needs to be referenced for gfc_get_symbol_decl.  */
+	    fsym->attr.referenced = 1;
+	    not_absent = gfc_conv_expr_present (fsym);
+
+	    absent_failed = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+					     boolean_type_node, not_0length,
+					     not_absent);
+
+	    cond = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+				    boolean_type_node, cond, absent_failed);
+	  }
+
+	/* Build the runtime check.  */
+	argname = gfc_build_cstring_const (fsym->name);
+	argname = gfc_build_addr_expr (pchar_type_node, argname);
+	gfc_trans_runtime_check (true, false, cond, block, &fsym->declared_at,
+				 message, argname,
+				 fold_convert (long_integer_type_node,
+					       cl->passed_length),
+				 fold_convert (long_integer_type_node,
+					       cl->backend_decl));
+      }
+}
+
+
+static void
+create_main_function (tree fndecl)
+{
+  tree old_context;
+  tree ftn_main;
+  tree tmp, decl, result_decl, argc, argv, typelist, arglist;
+  stmtblock_t body;
+
+  old_context = current_function_decl;
+
+  if (old_context)
+    {
+      push_function_context ();
+      saved_parent_function_decls = saved_function_decls;
+      saved_function_decls = NULL_TREE;
+    }
+
+  /* main() function must be declared with global scope.  */
+  gcc_assert (current_function_decl == NULL_TREE);
+
+  /* Declare the function.  */
+  tmp =  build_function_type_list (integer_type_node, integer_type_node,
+				   build_pointer_type (pchar_type_node),
+				   NULL_TREE);
+  main_identifier_node = get_identifier ("main");
+  ftn_main = build_decl (input_location, FUNCTION_DECL,
+      			 main_identifier_node, tmp);
+  DECL_EXTERNAL (ftn_main) = 0;
+  TREE_PUBLIC (ftn_main) = 1;
+  TREE_STATIC (ftn_main) = 1;
+  DECL_ATTRIBUTES (ftn_main)
+      = tree_cons (get_identifier("externally_visible"), NULL_TREE, NULL_TREE);
+
+  /* Setup the result declaration (for "return 0").  */
+  result_decl = build_decl (input_location,
+			    RESULT_DECL, NULL_TREE, integer_type_node);
+  DECL_ARTIFICIAL (result_decl) = 1;
+  DECL_IGNORED_P (result_decl) = 1;
+  DECL_CONTEXT (result_decl) = ftn_main;
+  DECL_RESULT (ftn_main) = result_decl;
+
+  pushdecl (ftn_main);
+
+  /* Get the arguments.  */
+
+  arglist = NULL_TREE;
+  typelist = TYPE_ARG_TYPES (TREE_TYPE (ftn_main));
+
+  tmp = TREE_VALUE (typelist);
+  argc = build_decl (input_location, PARM_DECL, get_identifier ("argc"), tmp);
+  DECL_CONTEXT (argc) = ftn_main;
+  DECL_ARG_TYPE (argc) = TREE_VALUE (typelist);
+  TREE_READONLY (argc) = 1;
+  gfc_finish_decl (argc);
+  arglist = chainon (arglist, argc);
+
+  typelist = TREE_CHAIN (typelist);
+  tmp = TREE_VALUE (typelist);
+  argv = build_decl (input_location, PARM_DECL, get_identifier ("argv"), tmp);
+  DECL_CONTEXT (argv) = ftn_main;
+  DECL_ARG_TYPE (argv) = TREE_VALUE (typelist);
+  TREE_READONLY (argv) = 1;
+  DECL_BY_REFERENCE (argv) = 1;
+  gfc_finish_decl (argv);
+  arglist = chainon (arglist, argv);
+
+  DECL_ARGUMENTS (ftn_main) = arglist;
+  current_function_decl = ftn_main;
+  announce_function (ftn_main);
+
+  rest_of_decl_compilation (ftn_main, 1, 0);
+  make_decl_rtl (ftn_main);
+  init_function_start (ftn_main);
+  pushlevel (0);
+
+  gfc_init_block (&body);
+
+  /* Call some libgfortran initialization routines, call then MAIN__(). */
+
+  /* Call _gfortran_set_args (argc, argv).  */
+  TREE_USED (argc) = 1;
+  TREE_USED (argv) = 1;
+  tmp = build_call_expr_loc (input_location,
+			 gfor_fndecl_set_args, 2, argc, argv);
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Add a call to set_options to set up the runtime library Fortran
+     language standard parameters.  */
+  {
+    tree array_type, array, var;
+    VEC(constructor_elt,gc) *v = NULL;
+
+    /* Passing a new option to the library requires four modifications:
+     + add it to the tree_cons list below
+          + change the array size in the call to build_array_type
+          + change the first argument to the library call
+            gfor_fndecl_set_options
+          + modify the library (runtime/compile_options.c)!  */
+
+    CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+                            build_int_cst (integer_type_node,
+                                           gfc_option.warn_std));
+    CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+                            build_int_cst (integer_type_node,
+                                           gfc_option.allow_std));
+    CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+                            build_int_cst (integer_type_node, pedantic));
+    CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+                            build_int_cst (integer_type_node,
+                                           gfc_option.flag_dump_core));
+    CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+                            build_int_cst (integer_type_node,
+                                           gfc_option.flag_backtrace));
+    CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+                            build_int_cst (integer_type_node,
+                                           gfc_option.flag_sign_zero));
+    CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+                            build_int_cst (integer_type_node,
+                                           (gfc_option.rtcheck
+                                            & GFC_RTCHECK_BOUNDS)));
+    CONSTRUCTOR_APPEND_ELT (v, NULL_TREE,
+                            build_int_cst (integer_type_node,
+                                           gfc_option.flag_range_check));
+
+    array_type = build_array_type (integer_type_node,
+		       build_index_type (build_int_cst (NULL_TREE, 7)));
+    array = build_constructor (array_type, v);
+    TREE_CONSTANT (array) = 1;
+    TREE_STATIC (array) = 1;
+
+    /* Create a static variable to hold the jump table.  */
+    var = gfc_create_var (array_type, "options");
+    TREE_CONSTANT (var) = 1;
+    TREE_STATIC (var) = 1;
+    TREE_READONLY (var) = 1;
+    DECL_INITIAL (var) = array;
+    var = gfc_build_addr_expr (build_pointer_type (integer_type_node), var);
+
+    tmp = build_call_expr_loc (input_location,
+			   gfor_fndecl_set_options, 2,
+			   build_int_cst (integer_type_node, 8), var);
+    gfc_add_expr_to_block (&body, tmp);
+  }
+
+  /* If -ffpe-trap option was provided, add a call to set_fpe so that
+     the library will raise a FPE when needed.  */
+  if (gfc_option.fpe != 0)
+    {
+      tmp = build_call_expr_loc (input_location,
+			     gfor_fndecl_set_fpe, 1,
+			     build_int_cst (integer_type_node,
+					    gfc_option.fpe));
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* If this is the main program and an -fconvert option was provided,
+     add a call to set_convert.  */
+
+  if (gfc_option.convert != GFC_CONVERT_NATIVE)
+    {
+      tmp = build_call_expr_loc (input_location,
+			     gfor_fndecl_set_convert, 1,
+			     build_int_cst (integer_type_node,
+					    gfc_option.convert));
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* If this is the main program and an -frecord-marker option was provided,
+     add a call to set_record_marker.  */
+
+  if (gfc_option.record_marker != 0)
+    {
+      tmp = build_call_expr_loc (input_location,
+			     gfor_fndecl_set_record_marker, 1,
+			     build_int_cst (integer_type_node,
+					    gfc_option.record_marker));
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  if (gfc_option.max_subrecord_length != 0)
+    {
+      tmp = build_call_expr_loc (input_location,
+			     gfor_fndecl_set_max_subrecord_length, 1,
+			     build_int_cst (integer_type_node,
+					    gfc_option.max_subrecord_length));
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* Call MAIN__().  */
+  tmp = build_call_expr_loc (input_location,
+			 fndecl, 0);
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Mark MAIN__ as used.  */
+  TREE_USED (fndecl) = 1;
+
+  /* "return 0".  */
+  tmp = fold_build2_loc (input_location, MODIFY_EXPR, integer_type_node,
+			 DECL_RESULT (ftn_main),
+			 build_int_cst (integer_type_node, 0));
+  tmp = build1_v (RETURN_EXPR, tmp);
+  gfc_add_expr_to_block (&body, tmp);
+
+
+  DECL_SAVED_TREE (ftn_main) = gfc_finish_block (&body);
+  decl = getdecls ();
+
+  /* Finish off this function and send it for code generation.  */
+  poplevel (1, 0, 1);
+  BLOCK_SUPERCONTEXT (DECL_INITIAL (ftn_main)) = ftn_main;
+
+  DECL_SAVED_TREE (ftn_main)
+    = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (ftn_main),
+		DECL_INITIAL (ftn_main));
+
+  /* Output the GENERIC tree.  */
+  dump_function (TDI_original, ftn_main);
+
+  cgraph_finalize_function (ftn_main, true);
+
+  if (old_context)
+    {
+      pop_function_context ();
+      saved_function_decls = saved_parent_function_decls;
+    }
+  current_function_decl = old_context;
+}
+
+
+/* Get the result expression for a procedure.  */
+
+static tree
+get_proc_result (gfc_symbol* sym)
+{
+  if (sym->attr.subroutine || sym == sym->result)
+    {
+      if (current_fake_result_decl != NULL)
+	return TREE_VALUE (current_fake_result_decl);
+
+      return NULL_TREE;
+    }
+
+  return sym->result->backend_decl;
+}
+
+
+/* Generate an appropriate return-statement for a procedure.  */
+
+tree
+gfc_generate_return (void)
+{
+  gfc_symbol* sym;
+  tree result;
+  tree fndecl;
+
+  sym = current_procedure_symbol;
+  fndecl = sym->backend_decl;
+
+  if (TREE_TYPE (DECL_RESULT (fndecl)) == void_type_node)
+    result = NULL_TREE;
+  else
+    {
+      result = get_proc_result (sym);
+
+      /* Set the return value to the dummy result variable.  The
+	 types may be different for scalar default REAL functions
+	 with -ff2c, therefore we have to convert.  */
+      if (result != NULL_TREE)
+	{
+	  result = convert (TREE_TYPE (DECL_RESULT (fndecl)), result);
+	  result = fold_build2_loc (input_location, MODIFY_EXPR,
+				    TREE_TYPE (result), DECL_RESULT (fndecl),
+				    result);
+	}
+    }
+
+  return build1_v (RETURN_EXPR, result);
+}
+
+
+/* Generate code for a function.  */
+
+void
+gfc_generate_function_code (gfc_namespace * ns)
+{
+  tree fndecl;
+  tree old_context;
+  tree decl;
+  tree tmp;
+  stmtblock_t init, cleanup;
+  stmtblock_t body;
+  gfc_wrapped_block try_block;
+  tree recurcheckvar = NULL_TREE;
+  gfc_symbol *sym;
+  gfc_symbol *previous_procedure_symbol;
+  int rank;
+  bool is_recursive;
+
+  sym = ns->proc_name;
+  previous_procedure_symbol = current_procedure_symbol;
+  current_procedure_symbol = sym;
+
+  /* Check that the frontend isn't still using this.  */
+  gcc_assert (sym->tlink == NULL);
+  sym->tlink = sym;
+
+  /* Create the declaration for functions with global scope.  */
+  if (!sym->backend_decl)
+    gfc_create_function_decl (ns, false);
+
+  fndecl = sym->backend_decl;
+  old_context = current_function_decl;
+
+  if (old_context)
+    {
+      push_function_context ();
+      saved_parent_function_decls = saved_function_decls;
+      saved_function_decls = NULL_TREE;
+    }
+
+  trans_function_start (sym);
+
+  gfc_init_block (&init);
+
+  if (ns->entries && ns->proc_name->ts.type == BT_CHARACTER)
+    {
+      /* Copy length backend_decls to all entry point result
+	 symbols.  */
+      gfc_entry_list *el;
+      tree backend_decl;
+
+      gfc_conv_const_charlen (ns->proc_name->ts.u.cl);
+      backend_decl = ns->proc_name->result->ts.u.cl->backend_decl;
+      for (el = ns->entries; el; el = el->next)
+	el->sym->result->ts.u.cl->backend_decl = backend_decl;
+    }
+
+  /* Translate COMMON blocks.  */
+  gfc_trans_common (ns);
+
+  /* Null the parent fake result declaration if this namespace is
+     a module function or an external procedures.  */
+  if ((ns->parent && ns->parent->proc_name->attr.flavor == FL_MODULE)
+	|| ns->parent == NULL)
+    parent_fake_result_decl = NULL_TREE;
+
+  gfc_generate_contained_functions (ns);
+
+  nonlocal_dummy_decls = NULL;
+  nonlocal_dummy_decl_pset = NULL;
+
+  generate_local_vars (ns);
+
+  /* Keep the parent fake result declaration in module functions
+     or external procedures.  */
+  if ((ns->parent && ns->parent->proc_name->attr.flavor == FL_MODULE)
+	|| ns->parent == NULL)
+    current_fake_result_decl = parent_fake_result_decl;
+  else
+    current_fake_result_decl = NULL_TREE;
+
+  is_recursive = sym->attr.recursive
+		 || (sym->attr.entry_master
+		     && sym->ns->entries->sym->attr.recursive);
+  if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
+	&& !is_recursive
+	&& !gfc_option.flag_recursive)
+    {
+      char * msg;
+
+      asprintf (&msg, "Recursive call to nonrecursive procedure '%s'",
+		sym->name);
+      recurcheckvar = gfc_create_var (boolean_type_node, "is_recursive");
+      TREE_STATIC (recurcheckvar) = 1;
+      DECL_INITIAL (recurcheckvar) = boolean_false_node;
+      gfc_add_expr_to_block (&init, recurcheckvar);
+      gfc_trans_runtime_check (true, false, recurcheckvar, &init,
+			       &sym->declared_at, msg);
+      gfc_add_modify (&init, recurcheckvar, boolean_true_node);
+      gfc_free (msg);
+    }
+
+  /* Now generate the code for the body of this function.  */
+  gfc_init_block (&body);
+
+  if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node
+	&& sym->attr.subroutine)
+    {
+      tree alternate_return;
+      alternate_return = gfc_get_fake_result_decl (sym, 0);
+      gfc_add_modify (&body, alternate_return, integer_zero_node);
+    }
+
+  if (ns->entries)
+    {
+      /* Jump to the correct entry point.  */
+      tmp = gfc_trans_entry_master_switch (ns->entries);
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* If bounds-checking is enabled, generate code to check passed in actual
+     arguments against the expected dummy argument attributes (e.g. string
+     lengths).  */
+  if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && !sym->attr.is_bind_c)
+    add_argument_checking (&body, sym);
+
+  tmp = gfc_trans_code (ns->code);
+  gfc_add_expr_to_block (&body, tmp);
+
+  if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node)
+    {
+      tree result = get_proc_result (sym);
+
+      if (result != NULL_TREE
+	    && sym->attr.function
+	    && !sym->attr.pointer)
+	{
+	  if (sym->attr.allocatable && sym->attr.dimension == 0
+	      && sym->result == sym)
+	    gfc_add_modify (&init, result, fold_convert (TREE_TYPE (result),
+							 null_pointer_node));
+	  else if (sym->ts.type == BT_DERIVED
+	      && sym->ts.u.derived->attr.alloc_comp
+	      && !sym->attr.allocatable)
+	    {
+	      rank = sym->as ? sym->as->rank : 0;
+	      tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
+	      gfc_add_expr_to_block (&init, tmp);
+	    }
+	}
+
+      if (result == NULL_TREE)
+	{
+	  /* TODO: move to the appropriate place in resolve.c.  */
+	  if (warn_return_type && sym == sym->result)
+	    gfc_warning ("Return value of function '%s' at %L not set",
+			 sym->name, &sym->declared_at);
+	  if (warn_return_type)
+	    TREE_NO_WARNING(sym->backend_decl) = 1;
+	}
+      else
+	gfc_add_expr_to_block (&body, gfc_generate_return ());
+    }
+
+  gfc_init_block (&cleanup);
+
+  /* Reset recursion-check variable.  */
+  if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
+	 && !is_recursive
+	 && !gfc_option.gfc_flag_openmp
+	 && recurcheckvar != NULL_TREE)
+    {
+      gfc_add_modify (&cleanup, recurcheckvar, boolean_false_node);
+      recurcheckvar = NULL;
+    }
+
+  /* Finish the function body and add init and cleanup code.  */
+  tmp = gfc_finish_block (&body);
+  gfc_start_wrapped_block (&try_block, tmp);
+  /* Add code to create and cleanup arrays.  */
+  gfc_trans_deferred_vars (sym, &try_block);
+  gfc_add_init_cleanup (&try_block, gfc_finish_block (&init),
+			gfc_finish_block (&cleanup));
+
+  /* Add all the decls we created during processing.  */
+  decl = saved_function_decls;
+  while (decl)
+    {
+      tree next;
+
+      next = DECL_CHAIN (decl);
+      DECL_CHAIN (decl) = NULL_TREE;
+      pushdecl (decl);
+      decl = next;
+    }
+  saved_function_decls = NULL_TREE;
+
+  DECL_SAVED_TREE (fndecl) = gfc_finish_wrapped_block (&try_block);
+  decl = getdecls ();
+
+  /* Finish off this function and send it for code generation.  */
+  poplevel (1, 0, 1);
+  BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
+
+  DECL_SAVED_TREE (fndecl)
+    = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl),
+		DECL_INITIAL (fndecl));
+
+  if (nonlocal_dummy_decls)
+    {
+      BLOCK_VARS (DECL_INITIAL (fndecl))
+	= chainon (BLOCK_VARS (DECL_INITIAL (fndecl)), nonlocal_dummy_decls);
+      pointer_set_destroy (nonlocal_dummy_decl_pset);
+      nonlocal_dummy_decls = NULL;
+      nonlocal_dummy_decl_pset = NULL;
+    }
+
+  /* Output the GENERIC tree.  */
+  dump_function (TDI_original, fndecl);
+
+  /* Store the end of the function, so that we get good line number
+     info for the epilogue.  */
+  cfun->function_end_locus = input_location;
+
+  /* We're leaving the context of this function, so zap cfun.
+     It's still in DECL_STRUCT_FUNCTION, and we'll restore it in
+     tree_rest_of_compilation.  */
+  set_cfun (NULL);
+
+  if (old_context)
+    {
+      pop_function_context ();
+      saved_function_decls = saved_parent_function_decls;
+    }
+  current_function_decl = old_context;
+
+  if (decl_function_context (fndecl))
+    /* Register this function with cgraph just far enough to get it
+       added to our parent's nested function list.  */
+    (void) cgraph_node (fndecl);
+  else
+    cgraph_finalize_function (fndecl, true);
+
+  gfc_trans_use_stmts (ns);
+  gfc_traverse_ns (ns, gfc_emit_parameter_debug_info);
+
+  if (sym->attr.is_main_program)
+    create_main_function (fndecl);
+
+  current_procedure_symbol = previous_procedure_symbol;
+}
+
+
+void
+gfc_generate_constructors (void)
+{
+  gcc_assert (gfc_static_ctors == NULL_TREE);
+#if 0
+  tree fnname;
+  tree type;
+  tree fndecl;
+  tree decl;
+  tree tmp;
+
+  if (gfc_static_ctors == NULL_TREE)
+    return;
+
+  fnname = get_file_function_name ("I");
+  type = build_function_type_list (void_type_node, NULL_TREE);
+
+  fndecl = build_decl (input_location,
+		       FUNCTION_DECL, fnname, type);
+  TREE_PUBLIC (fndecl) = 1;
+
+  decl = build_decl (input_location,
+		     RESULT_DECL, NULL_TREE, void_type_node);
+  DECL_ARTIFICIAL (decl) = 1;
+  DECL_IGNORED_P (decl) = 1;
+  DECL_CONTEXT (decl) = fndecl;
+  DECL_RESULT (fndecl) = decl;
+
+  pushdecl (fndecl);
+
+  current_function_decl = fndecl;
+
+  rest_of_decl_compilation (fndecl, 1, 0);
+
+  make_decl_rtl (fndecl);
+
+  init_function_start (fndecl);
+
+  pushlevel (0);
+
+  for (; gfc_static_ctors; gfc_static_ctors = TREE_CHAIN (gfc_static_ctors))
+    {
+      tmp = build_call_expr_loc (input_location,
+			     TREE_VALUE (gfc_static_ctors), 0);
+      DECL_SAVED_TREE (fndecl) = build_stmt (input_location, EXPR_STMT, tmp);
+    }
+
+  decl = getdecls ();
+  poplevel (1, 0, 1);
+
+  BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
+  DECL_SAVED_TREE (fndecl)
+    = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl),
+		DECL_INITIAL (fndecl));
+
+  free_after_parsing (cfun);
+  free_after_compilation (cfun);
+
+  tree_rest_of_compilation (fndecl);
+
+  current_function_decl = NULL_TREE;
+#endif
+}
+
+/* Translates a BLOCK DATA program unit. This means emitting the
+   commons contained therein plus their initializations. We also emit
+   a globally visible symbol to make sure that each BLOCK DATA program
+   unit remains unique.  */
+
+void
+gfc_generate_block_data (gfc_namespace * ns)
+{
+  tree decl;
+  tree id;
+
+  /* Tell the backend the source location of the block data.  */
+  if (ns->proc_name)
+    gfc_set_backend_locus (&ns->proc_name->declared_at);
+  else
+    gfc_set_backend_locus (&gfc_current_locus);
+
+  /* Process the DATA statements.  */
+  gfc_trans_common (ns);
+
+  /* Create a global symbol with the mane of the block data.  This is to
+     generate linker errors if the same name is used twice.  It is never
+     really used.  */
+  if (ns->proc_name)
+    id = gfc_sym_mangled_function_id (ns->proc_name);
+  else
+    id = get_identifier ("__BLOCK_DATA__");
+
+  decl = build_decl (input_location,
+		     VAR_DECL, id, gfc_array_index_type);
+  TREE_PUBLIC (decl) = 1;
+  TREE_STATIC (decl) = 1;
+  DECL_IGNORED_P (decl) = 1;
+
+  pushdecl (decl);
+  rest_of_decl_compilation (decl, 1, 0);
+}
+
+
+/* Process the local variables of a BLOCK construct.  */
+
+void
+gfc_process_block_locals (gfc_namespace* ns)
+{
+  tree decl;
+
+  gcc_assert (saved_local_decls == NULL_TREE);
+  generate_local_vars (ns);
+
+  decl = saved_local_decls;
+  while (decl)
+    {
+      tree next;
+
+      next = DECL_CHAIN (decl);
+      DECL_CHAIN (decl) = NULL_TREE;
+      pushdecl (decl);
+      decl = next;
+    }
+  saved_local_decls = NULL_TREE;
+}
+
+
+#include "gt-fortran-trans-decl.h"
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
new file mode 100644
index 000000000..e10924a02
--- /dev/null
+++ b/gcc/fortran/trans-expr.c
@@ -0,0 +1,6474 @@
+/* Expression translation
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+   2011, 2012
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+   and Steven Bosscher <s.bosscher@student.tudelft.nl>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* trans-expr.c-- generate GENERIC trees for gfc_expr.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "diagnostic-core.h"	/* For fatal_error.  */
+#include "langhooks.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "arith.h"
+#include "constructor.h"
+#include "trans.h"
+#include "trans-const.h"
+#include "trans-types.h"
+#include "trans-array.h"
+/* Only for gfc_trans_assign and gfc_trans_pointer_assign.  */
+#include "trans-stmt.h"
+#include "dependency.h"
+
+static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr);
+static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *,
+						 gfc_expr *);
+
+/* Copy the scalarization loop variables.  */
+
+static void
+gfc_copy_se_loopvars (gfc_se * dest, gfc_se * src)
+{
+  dest->ss = src->ss;
+  dest->loop = src->loop;
+}
+
+
+/* Initialize a simple expression holder.
+
+   Care must be taken when multiple se are created with the same parent.
+   The child se must be kept in sync.  The easiest way is to delay creation
+   of a child se until after after the previous se has been translated.  */
+
+void
+gfc_init_se (gfc_se * se, gfc_se * parent)
+{
+  memset (se, 0, sizeof (gfc_se));
+  gfc_init_block (&se->pre);
+  gfc_init_block (&se->post);
+
+  se->parent = parent;
+
+  if (parent)
+    gfc_copy_se_loopvars (se, parent);
+}
+
+
+/* Advances to the next SS in the chain.  Use this rather than setting
+   se->ss = se->ss->next because all the parents needs to be kept in sync.
+   See gfc_init_se.  */
+
+void
+gfc_advance_se_ss_chain (gfc_se * se)
+{
+  gfc_se *p;
+
+  gcc_assert (se != NULL && se->ss != NULL && se->ss != gfc_ss_terminator);
+
+  p = se;
+  /* Walk down the parent chain.  */
+  while (p != NULL)
+    {
+      /* Simple consistency check.  */
+      gcc_assert (p->parent == NULL || p->parent->ss == p->ss);
+
+      p->ss = p->ss->next;
+
+      p = p->parent;
+    }
+}
+
+
+/* Ensures the result of the expression as either a temporary variable
+   or a constant so that it can be used repeatedly.  */
+
+void
+gfc_make_safe_expr (gfc_se * se)
+{
+  tree var;
+
+  if (CONSTANT_CLASS_P (se->expr))
+    return;
+
+  /* We need a temporary for this result.  */
+  var = gfc_create_var (TREE_TYPE (se->expr), NULL);
+  gfc_add_modify (&se->pre, var, se->expr);
+  se->expr = var;
+}
+
+
+/* Return an expression which determines if a dummy parameter is present.
+   Also used for arguments to procedures with multiple entry points.  */
+
+tree
+gfc_conv_expr_present (gfc_symbol * sym)
+{
+  tree decl, cond;
+
+  gcc_assert (sym->attr.dummy);
+
+  decl = gfc_get_symbol_decl (sym);
+  if (TREE_CODE (decl) != PARM_DECL)
+    {
+      /* Array parameters use a temporary descriptor, we want the real
+         parameter.  */
+      gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
+             || GFC_ARRAY_TYPE_P (TREE_TYPE (decl)));
+      decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
+    }
+
+  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, decl,
+			  fold_convert (TREE_TYPE (decl), null_pointer_node));
+
+  /* Fortran 2008 allows to pass null pointers and non-associated pointers
+     as actual argument to denote absent dummies. For array descriptors,
+     we thus also need to check the array descriptor.  */
+  if (!sym->attr.pointer && !sym->attr.allocatable
+      && sym->as && sym->as->type == AS_ASSUMED_SHAPE
+      && (gfc_option.allow_std & GFC_STD_F2008) != 0)
+    {
+      tree tmp;
+      tmp = build_fold_indirect_ref_loc (input_location, decl);
+      tmp = gfc_conv_array_data (tmp);
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp,
+			     fold_convert (TREE_TYPE (tmp), null_pointer_node));
+      cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+			      boolean_type_node, cond, tmp);
+    }
+
+  return cond;
+}
+
+
+/* Converts a missing, dummy argument into a null or zero.  */
+
+void
+gfc_conv_missing_dummy (gfc_se * se, gfc_expr * arg, gfc_typespec ts, int kind)
+{
+  tree present;
+  tree tmp;
+
+  present = gfc_conv_expr_present (arg->symtree->n.sym);
+
+  if (kind > 0)
+    {
+      /* Create a temporary and convert it to the correct type.  */
+      tmp = gfc_get_int_type (kind);
+      tmp = fold_convert (tmp, build_fold_indirect_ref_loc (input_location,
+							se->expr));
+
+      /* Test for a NULL value.  */
+      tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp), present,
+			tmp, fold_convert (TREE_TYPE (tmp), integer_one_node));
+      tmp = gfc_evaluate_now (tmp, &se->pre);
+      se->expr = gfc_build_addr_expr (NULL_TREE, tmp);
+    }
+  else
+    {
+      tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (se->expr),
+			present, se->expr,
+			build_zero_cst (TREE_TYPE (se->expr)));
+      tmp = gfc_evaluate_now (tmp, &se->pre);
+      se->expr = tmp;
+    }
+
+  if (ts.type == BT_CHARACTER)
+    {
+      tmp = build_int_cst (gfc_charlen_type_node, 0);
+      tmp = fold_build3_loc (input_location, COND_EXPR, gfc_charlen_type_node,
+			     present, se->string_length, tmp);
+      tmp = gfc_evaluate_now (tmp, &se->pre);
+      se->string_length = tmp;
+    }
+  return;
+}
+
+
+/* Get the character length of an expression, looking through gfc_refs
+   if necessary.  */
+
+tree
+gfc_get_expr_charlen (gfc_expr *e)
+{
+  gfc_ref *r;
+  tree length;
+
+  gcc_assert (e->expr_type == EXPR_VARIABLE
+	      && e->ts.type == BT_CHARACTER);
+
+  length = NULL; /* To silence compiler warning.  */
+
+  if (is_subref_array (e) && e->ts.u.cl->length)
+    {
+      gfc_se tmpse;
+      gfc_init_se (&tmpse, NULL);
+      gfc_conv_expr_type (&tmpse, e->ts.u.cl->length, gfc_charlen_type_node);
+      e->ts.u.cl->backend_decl = tmpse.expr;
+      return tmpse.expr;
+    }
+
+  /* First candidate: if the variable is of type CHARACTER, the
+     expression's length could be the length of the character
+     variable.  */
+  if (e->symtree->n.sym->ts.type == BT_CHARACTER)
+    length = e->symtree->n.sym->ts.u.cl->backend_decl;
+
+  /* Look through the reference chain for component references.  */
+  for (r = e->ref; r; r = r->next)
+    {
+      switch (r->type)
+	{
+	case REF_COMPONENT:
+	  if (r->u.c.component->ts.type == BT_CHARACTER)
+	    length = r->u.c.component->ts.u.cl->backend_decl;
+	  break;
+
+	case REF_ARRAY:
+	  /* Do nothing.  */
+	  break;
+
+	default:
+	  /* We should never got substring references here.  These will be
+	     broken down by the scalarizer.  */
+	  gcc_unreachable ();
+	  break;
+	}
+    }
+
+  gcc_assert (length != NULL);
+  return length;
+}
+
+
+/* For each character array constructor subexpression without a ts.u.cl->length,
+   replace it by its first element (if there aren't any elements, the length
+   should already be set to zero).  */
+
+static void
+flatten_array_ctors_without_strlen (gfc_expr* e)
+{
+  gfc_actual_arglist* arg;
+  gfc_constructor* c;
+
+  if (!e)
+    return;
+
+  switch (e->expr_type)
+    {
+
+    case EXPR_OP:
+      flatten_array_ctors_without_strlen (e->value.op.op1);
+      flatten_array_ctors_without_strlen (e->value.op.op2);
+      break;
+
+    case EXPR_COMPCALL:
+      /* TODO: Implement as with EXPR_FUNCTION when needed.  */
+      gcc_unreachable ();
+
+    case EXPR_FUNCTION:
+      for (arg = e->value.function.actual; arg; arg = arg->next)
+	flatten_array_ctors_without_strlen (arg->expr);
+      break;
+
+    case EXPR_ARRAY:
+
+      /* We've found what we're looking for.  */
+      if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
+	{
+	  gfc_constructor *c;
+	  gfc_expr* new_expr;
+
+	  gcc_assert (e->value.constructor);
+
+	  c = gfc_constructor_first (e->value.constructor);
+	  new_expr = c->expr;
+	  c->expr = NULL;
+
+	  flatten_array_ctors_without_strlen (new_expr);
+	  gfc_replace_expr (e, new_expr);
+	  break;
+	}
+
+      /* Otherwise, fall through to handle constructor elements.  */
+    case EXPR_STRUCTURE:
+      for (c = gfc_constructor_first (e->value.constructor);
+	   c; c = gfc_constructor_next (c))
+	flatten_array_ctors_without_strlen (c->expr);
+      break;
+
+    default:
+      break;
+
+    }
+}
+
+
+/* Generate code to initialize a string length variable. Returns the
+   value.  For array constructors, cl->length might be NULL and in this case,
+   the first element of the constructor is needed.  expr is the original
+   expression so we can access it but can be NULL if this is not needed.  */
+
+void
+gfc_conv_string_length (gfc_charlen * cl, gfc_expr * expr, stmtblock_t * pblock)
+{
+  gfc_se se;
+
+  gfc_init_se (&se, NULL);
+
+  if (!cl->length
+	&& cl->backend_decl
+	&& TREE_CODE (cl->backend_decl) == VAR_DECL)
+    return;
+
+  /* If cl->length is NULL, use gfc_conv_expr to obtain the string length but
+     "flatten" array constructors by taking their first element; all elements
+     should be the same length or a cl->length should be present.  */
+  if (!cl->length)
+    {
+      gfc_expr* expr_flat;
+      gcc_assert (expr);
+      expr_flat = gfc_copy_expr (expr);
+      flatten_array_ctors_without_strlen (expr_flat);
+      gfc_resolve_expr (expr_flat);
+
+      gfc_conv_expr (&se, expr_flat);
+      gfc_add_block_to_block (pblock, &se.pre);
+      cl->backend_decl = convert (gfc_charlen_type_node, se.string_length);
+
+      gfc_free_expr (expr_flat);
+      return;
+    }
+
+  /* Convert cl->length.  */
+
+  gcc_assert (cl->length);
+
+  gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
+  se.expr = fold_build2_loc (input_location, MAX_EXPR, gfc_charlen_type_node,
+			     se.expr, build_int_cst (gfc_charlen_type_node, 0));
+  gfc_add_block_to_block (pblock, &se.pre);
+
+  if (cl->backend_decl)
+    gfc_add_modify (pblock, cl->backend_decl, se.expr);
+  else
+    cl->backend_decl = gfc_evaluate_now (se.expr, pblock);
+}
+
+
+static void
+gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
+		    const char *name, locus *where)
+{
+  tree tmp;
+  tree type;
+  tree fault;
+  gfc_se start;
+  gfc_se end;
+  char *msg;
+
+  type = gfc_get_character_type (kind, ref->u.ss.length);
+  type = build_pointer_type (type);
+
+  gfc_init_se (&start, se);
+  gfc_conv_expr_type (&start, ref->u.ss.start, gfc_charlen_type_node);
+  gfc_add_block_to_block (&se->pre, &start.pre);
+
+  if (integer_onep (start.expr))
+    gfc_conv_string_parameter (se);
+  else
+    {
+      tmp = start.expr;
+      STRIP_NOPS (tmp);
+      /* Avoid multiple evaluation of substring start.  */
+      if (!CONSTANT_CLASS_P (tmp) && !DECL_P (tmp))
+	start.expr = gfc_evaluate_now (start.expr, &se->pre);
+
+      /* Change the start of the string.  */
+      if (TYPE_STRING_FLAG (TREE_TYPE (se->expr)))
+	tmp = se->expr;
+      else
+	tmp = build_fold_indirect_ref_loc (input_location,
+				       se->expr);
+      tmp = gfc_build_array_ref (tmp, start.expr, NULL);
+      se->expr = gfc_build_addr_expr (type, tmp);
+    }
+
+  /* Length = end + 1 - start.  */
+  gfc_init_se (&end, se);
+  if (ref->u.ss.end == NULL)
+    end.expr = se->string_length;
+  else
+    {
+      gfc_conv_expr_type (&end, ref->u.ss.end, gfc_charlen_type_node);
+      gfc_add_block_to_block (&se->pre, &end.pre);
+    }
+  tmp = end.expr;
+  STRIP_NOPS (tmp);
+  if (!CONSTANT_CLASS_P (tmp) && !DECL_P (tmp))
+    end.expr = gfc_evaluate_now (end.expr, &se->pre);
+
+  if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+    {
+      tree nonempty = fold_build2_loc (input_location, LE_EXPR,
+				       boolean_type_node, start.expr,
+				       end.expr);
+
+      /* Check lower bound.  */
+      fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+			       start.expr,
+			       build_int_cst (gfc_charlen_type_node, 1));
+      fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+			       boolean_type_node, nonempty, fault);
+      if (name)
+	asprintf (&msg, "Substring out of bounds: lower bound (%%ld) of '%s' "
+		  "is less than one", name);
+      else
+	asprintf (&msg, "Substring out of bounds: lower bound (%%ld)"
+		  "is less than one");
+      gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
+			       fold_convert (long_integer_type_node,
+					     start.expr));
+      gfc_free (msg);
+
+      /* Check upper bound.  */
+      fault = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+			       end.expr, se->string_length);
+      fault = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+			       boolean_type_node, nonempty, fault);
+      if (name)
+	asprintf (&msg, "Substring out of bounds: upper bound (%%ld) of '%s' "
+		  "exceeds string length (%%ld)", name);
+      else
+	asprintf (&msg, "Substring out of bounds: upper bound (%%ld) "
+		  "exceeds string length (%%ld)");
+      gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
+			       fold_convert (long_integer_type_node, end.expr),
+			       fold_convert (long_integer_type_node,
+					     se->string_length));
+      gfc_free (msg);
+    }
+
+  /* If the start and end expressions are equal, the length is one.  */
+  if (ref->u.ss.end
+      && gfc_dep_compare_expr (ref->u.ss.start, ref->u.ss.end) == 0)
+    tmp = build_int_cst (gfc_charlen_type_node, 1);
+  else
+    {
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_charlen_type_node,
+			     end.expr, start.expr);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_charlen_type_node,
+			     build_int_cst (gfc_charlen_type_node, 1), tmp);
+      tmp = fold_build2_loc (input_location, MAX_EXPR, gfc_charlen_type_node,
+			     tmp, build_int_cst (gfc_charlen_type_node, 0));
+    }
+
+  se->string_length = tmp;
+}
+
+
+/* Convert a derived type component reference.  */
+
+static void
+gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
+{
+  gfc_component *c;
+  tree tmp;
+  tree decl;
+  tree field;
+
+  c = ref->u.c.component;
+
+  gcc_assert (c->backend_decl);
+
+  field = c->backend_decl;
+  gcc_assert (TREE_CODE (field) == FIELD_DECL);
+  decl = se->expr;
+
+  /* Components can correspond to fields of different containing
+     types, as components are created without context, whereas
+     a concrete use of a component has the type of decl as context.
+     So, if the type doesn't match, we search the corresponding
+     FIELD_DECL in the parent type.  To not waste too much time
+     we cache this result in norestrict_decl.  */
+
+  if (DECL_FIELD_CONTEXT (field) != TREE_TYPE (decl))
+    {
+      tree f2 = c->norestrict_decl;
+      if (!f2 || DECL_FIELD_CONTEXT (f2) != TREE_TYPE (decl))
+	for (f2 = TYPE_FIELDS (TREE_TYPE (decl)); f2; f2 = DECL_CHAIN (f2))
+	  if (TREE_CODE (f2) == FIELD_DECL
+	      && DECL_NAME (f2) == DECL_NAME (field))
+	    break;
+      gcc_assert (f2);
+      c->norestrict_decl = f2;
+      field = f2;
+    }
+  tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			 decl, field, NULL_TREE);
+
+  se->expr = tmp;
+
+  if (c->ts.type == BT_CHARACTER && !c->attr.proc_pointer)
+    {
+      tmp = c->ts.u.cl->backend_decl;
+      /* Components must always be constant length.  */
+      gcc_assert (tmp && INTEGER_CST_P (tmp));
+      se->string_length = tmp;
+    }
+
+  if (((c->attr.pointer || c->attr.allocatable) && c->attr.dimension == 0
+       && c->ts.type != BT_CHARACTER)
+      || c->attr.proc_pointer)
+    se->expr = build_fold_indirect_ref_loc (input_location,
+					se->expr);
+}
+
+
+/* This function deals with component references to components of the
+   parent type for derived type extensons.  */
+static void
+conv_parent_component_references (gfc_se * se, gfc_ref * ref)
+{
+  gfc_component *c;
+  gfc_component *cmp;
+  gfc_symbol *dt;
+  gfc_ref parent;
+
+  dt = ref->u.c.sym;
+  c = ref->u.c.component;
+
+  /* Return if the component is not in the parent type.  */
+  for (cmp = dt->components; cmp; cmp = cmp->next)
+    if (strcmp (c->name, cmp->name) == 0)
+      return;
+
+  /* Build a gfc_ref to recursively call gfc_conv_component_ref.  */
+  parent.type = REF_COMPONENT;
+  parent.next = NULL;
+  parent.u.c.sym = dt;
+  parent.u.c.component = dt->components;
+
+  if (dt->backend_decl == NULL)
+    gfc_get_derived_type (dt);
+
+  /* Build the reference and call self.  */
+  gfc_conv_component_ref (se, &parent);
+  parent.u.c.sym = dt->components->ts.u.derived;
+  parent.u.c.component = c;
+  conv_parent_component_references (se, &parent);
+}
+
+/* Return the contents of a variable. Also handles reference/pointer
+   variables (all Fortran pointer references are implicit).  */
+
+static void
+gfc_conv_variable (gfc_se * se, gfc_expr * expr)
+{
+  gfc_ref *ref;
+  gfc_symbol *sym;
+  tree parent_decl = NULL_TREE;
+  int parent_flag;
+  bool return_value;
+  bool alternate_entry;
+  bool entry_master;
+
+  sym = expr->symtree->n.sym;
+  if (se->ss != NULL)
+    {
+      /* Check that something hasn't gone horribly wrong.  */
+      gcc_assert (se->ss != gfc_ss_terminator);
+      gcc_assert (se->ss->expr == expr);
+
+      /* A scalarized term.  We already know the descriptor.  */
+      se->expr = se->ss->data.info.descriptor;
+      se->string_length = se->ss->string_length;
+      for (ref = se->ss->data.info.ref; ref; ref = ref->next)
+	if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
+	  break;
+    }
+  else
+    {
+      tree se_expr = NULL_TREE;
+
+      se->expr = gfc_get_symbol_decl (sym);
+
+      /* Deal with references to a parent results or entries by storing
+	 the current_function_decl and moving to the parent_decl.  */
+      return_value = sym->attr.function && sym->result == sym;
+      alternate_entry = sym->attr.function && sym->attr.entry
+			&& sym->result == sym;
+      entry_master = sym->attr.result
+		     && sym->ns->proc_name->attr.entry_master
+		     && !gfc_return_by_reference (sym->ns->proc_name);
+      if (current_function_decl)
+	parent_decl = DECL_CONTEXT (current_function_decl);
+
+      if ((se->expr == parent_decl && return_value)
+	   || (sym->ns && sym->ns->proc_name
+	       && parent_decl
+	       && sym->ns->proc_name->backend_decl == parent_decl
+	       && (alternate_entry || entry_master)))
+	parent_flag = 1;
+      else
+	parent_flag = 0;
+
+      /* Special case for assigning the return value of a function.
+	 Self recursive functions must have an explicit return value.  */
+      if (return_value && (se->expr == current_function_decl || parent_flag))
+	se_expr = gfc_get_fake_result_decl (sym, parent_flag);
+
+      /* Similarly for alternate entry points.  */
+      else if (alternate_entry
+	       && (sym->ns->proc_name->backend_decl == current_function_decl
+		   || parent_flag))
+	{
+	  gfc_entry_list *el = NULL;
+
+	  for (el = sym->ns->entries; el; el = el->next)
+	    if (sym == el->sym)
+	      {
+		se_expr = gfc_get_fake_result_decl (sym, parent_flag);
+		break;
+	      }
+	}
+
+      else if (entry_master
+	       && (sym->ns->proc_name->backend_decl == current_function_decl
+		   || parent_flag))
+	se_expr = gfc_get_fake_result_decl (sym, parent_flag);
+
+      if (se_expr)
+	se->expr = se_expr;
+
+      /* Procedure actual arguments.  */
+      else if (sym->attr.flavor == FL_PROCEDURE
+	       && se->expr != current_function_decl)
+	{
+	  if (!sym->attr.dummy && !sym->attr.proc_pointer)
+	    {
+	      gcc_assert (TREE_CODE (se->expr) == FUNCTION_DECL);
+	      se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
+	    }
+	  return;
+	}
+
+
+      /* Dereference the expression, where needed. Since characters
+	 are entirely different from other types, they are treated
+	 separately.  */
+      if (sym->ts.type == BT_CHARACTER)
+	{
+	  /* Dereference character pointer dummy arguments
+	     or results.  */
+	  if ((sym->attr.pointer || sym->attr.allocatable)
+	      && (sym->attr.dummy
+		  || sym->attr.function
+		  || sym->attr.result))
+	    se->expr = build_fold_indirect_ref_loc (input_location,
+						se->expr);
+
+	}
+      else if (!sym->attr.value)
+	{
+          /* Dereference non-character scalar dummy arguments.  */
+	  if (sym->attr.dummy && !sym->attr.dimension)
+	    se->expr = build_fold_indirect_ref_loc (input_location,
+						se->expr);
+
+          /* Dereference scalar hidden result.  */
+	  if (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX
+	      && (sym->attr.function || sym->attr.result)
+	      && !sym->attr.dimension && !sym->attr.pointer
+	      && !sym->attr.always_explicit)
+	    se->expr = build_fold_indirect_ref_loc (input_location,
+						se->expr);
+
+	  /* Dereference non-character pointer variables.
+	     These must be dummies, results, or scalars.  */
+	  if ((sym->attr.pointer || sym->attr.allocatable
+	       || gfc_is_associate_pointer (sym))
+	      && (sym->attr.dummy
+		  || sym->attr.function
+		  || sym->attr.result
+		  || !sym->attr.dimension))
+	    se->expr = build_fold_indirect_ref_loc (input_location,
+						se->expr);
+	}
+
+      ref = expr->ref;
+    }
+
+  /* For character variables, also get the length.  */
+  if (sym->ts.type == BT_CHARACTER)
+    {
+      /* If the character length of an entry isn't set, get the length from
+         the master function instead.  */
+      if (sym->attr.entry && !sym->ts.u.cl->backend_decl)
+        se->string_length = sym->ns->proc_name->ts.u.cl->backend_decl;
+      else
+        se->string_length = sym->ts.u.cl->backend_decl;
+      gcc_assert (se->string_length);
+    }
+
+  while (ref)
+    {
+      switch (ref->type)
+	{
+	case REF_ARRAY:
+	  /* Return the descriptor if that's what we want and this is an array
+	     section reference.  */
+	  if (se->descriptor_only && ref->u.ar.type != AR_ELEMENT)
+	    return;
+/* TODO: Pointers to single elements of array sections, eg elemental subs.  */
+	  /* Return the descriptor for array pointers and allocations.  */
+	  if (se->want_pointer
+	      && ref->next == NULL && (se->descriptor_only))
+	    return;
+
+	  gfc_conv_array_ref (se, &ref->u.ar, sym, &expr->where);
+	  /* Return a pointer to an element.  */
+	  break;
+
+	case REF_COMPONENT:
+	  if (ref->u.c.sym->attr.extension)
+	    conv_parent_component_references (se, ref);
+
+	  gfc_conv_component_ref (se, ref);
+	  break;
+
+	case REF_SUBSTRING:
+	  gfc_conv_substring (se, ref, expr->ts.kind,
+			      expr->symtree->name, &expr->where);
+	  break;
+
+	default:
+	  gcc_unreachable ();
+	  break;
+	}
+      ref = ref->next;
+    }
+  /* Pointer assignment, allocation or pass by reference.  Arrays are handled
+     separately.  */
+  if (se->want_pointer)
+    {
+      if (expr->ts.type == BT_CHARACTER && !gfc_is_proc_ptr_comp (expr, NULL))
+	gfc_conv_string_parameter (se);
+      else
+	se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
+    }
+}
+
+
+/* Unary ops are easy... Or they would be if ! was a valid op.  */
+
+static void
+gfc_conv_unary_op (enum tree_code code, gfc_se * se, gfc_expr * expr)
+{
+  gfc_se operand;
+  tree type;
+
+  gcc_assert (expr->ts.type != BT_CHARACTER);
+  /* Initialize the operand.  */
+  gfc_init_se (&operand, se);
+  gfc_conv_expr_val (&operand, expr->value.op.op1);
+  gfc_add_block_to_block (&se->pre, &operand.pre);
+
+  type = gfc_typenode_for_spec (&expr->ts);
+
+  /* TRUTH_NOT_EXPR is not a "true" unary operator in GCC.
+     We must convert it to a compare to 0 (e.g. EQ_EXPR (op1, 0)).
+     All other unary operators have an equivalent GIMPLE unary operator.  */
+  if (code == TRUTH_NOT_EXPR)
+    se->expr = fold_build2_loc (input_location, EQ_EXPR, type, operand.expr,
+				build_int_cst (type, 0));
+  else
+    se->expr = fold_build1_loc (input_location, code, type, operand.expr);
+
+}
+
+/* Expand power operator to optimal multiplications when a value is raised
+   to a constant integer n. See section 4.6.3, "Evaluation of Powers" of
+   Donald E. Knuth, "Seminumerical Algorithms", Vol. 2, "The Art of Computer
+   Programming", 3rd Edition, 1998.  */
+
+/* This code is mostly duplicated from expand_powi in the backend.
+   We establish the "optimal power tree" lookup table with the defined size.
+   The items in the table are the exponents used to calculate the index
+   exponents. Any integer n less than the value can get an "addition chain",
+   with the first node being one.  */
+#define POWI_TABLE_SIZE 256
+
+/* The table is from builtins.c.  */
+static const unsigned char powi_table[POWI_TABLE_SIZE] =
+  {
+      0,   1,   1,   2,   2,   3,   3,   4,  /*   0 -   7 */
+      4,   6,   5,   6,   6,  10,   7,   9,  /*   8 -  15 */
+      8,  16,   9,  16,  10,  12,  11,  13,  /*  16 -  23 */
+     12,  17,  13,  18,  14,  24,  15,  26,  /*  24 -  31 */
+     16,  17,  17,  19,  18,  33,  19,  26,  /*  32 -  39 */
+     20,  25,  21,  40,  22,  27,  23,  44,  /*  40 -  47 */
+     24,  32,  25,  34,  26,  29,  27,  44,  /*  48 -  55 */
+     28,  31,  29,  34,  30,  60,  31,  36,  /*  56 -  63 */
+     32,  64,  33,  34,  34,  46,  35,  37,  /*  64 -  71 */
+     36,  65,  37,  50,  38,  48,  39,  69,  /*  72 -  79 */
+     40,  49,  41,  43,  42,  51,  43,  58,  /*  80 -  87 */
+     44,  64,  45,  47,  46,  59,  47,  76,  /*  88 -  95 */
+     48,  65,  49,  66,  50,  67,  51,  66,  /*  96 - 103 */
+     52,  70,  53,  74,  54, 104,  55,  74,  /* 104 - 111 */
+     56,  64,  57,  69,  58,  78,  59,  68,  /* 112 - 119 */
+     60,  61,  61,  80,  62,  75,  63,  68,  /* 120 - 127 */
+     64,  65,  65, 128,  66, 129,  67,  90,  /* 128 - 135 */
+     68,  73,  69, 131,  70,  94,  71,  88,  /* 136 - 143 */
+     72, 128,  73,  98,  74, 132,  75, 121,  /* 144 - 151 */
+     76, 102,  77, 124,  78, 132,  79, 106,  /* 152 - 159 */
+     80,  97,  81, 160,  82,  99,  83, 134,  /* 160 - 167 */
+     84,  86,  85,  95,  86, 160,  87, 100,  /* 168 - 175 */
+     88, 113,  89,  98,  90, 107,  91, 122,  /* 176 - 183 */
+     92, 111,  93, 102,  94, 126,  95, 150,  /* 184 - 191 */
+     96, 128,  97, 130,  98, 133,  99, 195,  /* 192 - 199 */
+    100, 128, 101, 123, 102, 164, 103, 138,  /* 200 - 207 */
+    104, 145, 105, 146, 106, 109, 107, 149,  /* 208 - 215 */
+    108, 200, 109, 146, 110, 170, 111, 157,  /* 216 - 223 */
+    112, 128, 113, 130, 114, 182, 115, 132,  /* 224 - 231 */
+    116, 200, 117, 132, 118, 158, 119, 206,  /* 232 - 239 */
+    120, 240, 121, 162, 122, 147, 123, 152,  /* 240 - 247 */
+    124, 166, 125, 214, 126, 138, 127, 153,  /* 248 - 255 */
+  };
+
+/* If n is larger than lookup table's max index, we use the "window
+   method".  */
+#define POWI_WINDOW_SIZE 3
+
+/* Recursive function to expand the power operator. The temporary
+   values are put in tmpvar. The function returns tmpvar[1] ** n.  */
+static tree
+gfc_conv_powi (gfc_se * se, unsigned HOST_WIDE_INT n, tree * tmpvar)
+{
+  tree op0;
+  tree op1;
+  tree tmp;
+  int digit;
+
+  if (n < POWI_TABLE_SIZE)
+    {
+      if (tmpvar[n])
+        return tmpvar[n];
+
+      op0 = gfc_conv_powi (se, n - powi_table[n], tmpvar);
+      op1 = gfc_conv_powi (se, powi_table[n], tmpvar);
+    }
+  else if (n & 1)
+    {
+      digit = n & ((1 << POWI_WINDOW_SIZE) - 1);
+      op0 = gfc_conv_powi (se, n - digit, tmpvar);
+      op1 = gfc_conv_powi (se, digit, tmpvar);
+    }
+  else
+    {
+      op0 = gfc_conv_powi (se, n >> 1, tmpvar);
+      op1 = op0;
+    }
+
+  tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (op0), op0, op1);
+  tmp = gfc_evaluate_now (tmp, &se->pre);
+
+  if (n < POWI_TABLE_SIZE)
+    tmpvar[n] = tmp;
+
+  return tmp;
+}
+
+
+/* Expand lhs ** rhs. rhs is a constant integer. If it expands successfully,
+   return 1. Else return 0 and a call to runtime library functions
+   will have to be built.  */
+static int
+gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs)
+{
+  tree cond;
+  tree tmp;
+  tree type;
+  tree vartmp[POWI_TABLE_SIZE];
+  HOST_WIDE_INT m;
+  unsigned HOST_WIDE_INT n;
+  int sgn;
+
+  /* If exponent is too large, we won't expand it anyway, so don't bother
+     with large integer values.  */
+  if (!double_int_fits_in_shwi_p (TREE_INT_CST (rhs)))
+    return 0;
+
+  m = double_int_to_shwi (TREE_INT_CST (rhs));
+  /* There's no ABS for HOST_WIDE_INT, so here we go. It also takes care
+     of the asymmetric range of the integer type.  */
+  n = (unsigned HOST_WIDE_INT) (m < 0 ? -m : m);
+
+  type = TREE_TYPE (lhs);
+  sgn = tree_int_cst_sgn (rhs);
+
+  if (((FLOAT_TYPE_P (type) && !flag_unsafe_math_optimizations)
+       || optimize_size) && (m > 2 || m < -1))
+    return 0;
+
+  /* rhs == 0  */
+  if (sgn == 0)
+    {
+      se->expr = gfc_build_const (type, integer_one_node);
+      return 1;
+    }
+
+  /* If rhs < 0 and lhs is an integer, the result is -1, 0 or 1.  */
+  if ((sgn == -1) && (TREE_CODE (type) == INTEGER_TYPE))
+    {
+      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			     lhs, build_int_cst (TREE_TYPE (lhs), -1));
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			      lhs, build_int_cst (TREE_TYPE (lhs), 1));
+
+      /* If rhs is even,
+	 result = (lhs == 1 || lhs == -1) ? 1 : 0.  */
+      if ((n & 1) == 0)
+        {
+	  tmp = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+				 boolean_type_node, tmp, cond);
+	  se->expr = fold_build3_loc (input_location, COND_EXPR, type,
+				      tmp, build_int_cst (type, 1),
+				      build_int_cst (type, 0));
+	  return 1;
+	}
+      /* If rhs is odd,
+	 result = (lhs == 1) ? 1 : (lhs == -1) ? -1 : 0.  */
+      tmp = fold_build3_loc (input_location, COND_EXPR, type, tmp,
+			     build_int_cst (type, -1),
+			     build_int_cst (type, 0));
+      se->expr = fold_build3_loc (input_location, COND_EXPR, type,
+				  cond, build_int_cst (type, 1), tmp);
+      return 1;
+    }
+
+  memset (vartmp, 0, sizeof (vartmp));
+  vartmp[1] = lhs;
+  if (sgn == -1)
+    {
+      tmp = gfc_build_const (type, integer_one_node);
+      vartmp[1] = fold_build2_loc (input_location, RDIV_EXPR, type, tmp,
+				   vartmp[1]);
+    }
+
+  se->expr = gfc_conv_powi (se, n, vartmp);
+
+  return 1;
+}
+
+
+/* Power op (**).  Constant integer exponent has special handling.  */
+
+static void
+gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
+{
+  tree gfc_int4_type_node;
+  int kind;
+  int ikind;
+  int res_ikind_1, res_ikind_2;
+  gfc_se lse;
+  gfc_se rse;
+  tree fndecl = NULL;
+
+  gfc_init_se (&lse, se);
+  gfc_conv_expr_val (&lse, expr->value.op.op1);
+  lse.expr = gfc_evaluate_now (lse.expr, &lse.pre);
+  gfc_add_block_to_block (&se->pre, &lse.pre);
+
+  gfc_init_se (&rse, se);
+  gfc_conv_expr_val (&rse, expr->value.op.op2);
+  gfc_add_block_to_block (&se->pre, &rse.pre);
+
+  if (expr->value.op.op2->ts.type == BT_INTEGER
+      && expr->value.op.op2->expr_type == EXPR_CONSTANT)
+    if (gfc_conv_cst_int_power (se, lse.expr, rse.expr))
+      return;
+
+  gfc_int4_type_node = gfc_get_int_type (4);
+
+  /* In case of integer operands with kinds 1 or 2, we call the integer kind 4
+     library routine.  But in the end, we have to convert the result back
+     if this case applies -- with res_ikind_K, we keep track whether operand K
+     falls into this case.  */
+  res_ikind_1 = -1;
+  res_ikind_2 = -1;
+
+  kind = expr->value.op.op1->ts.kind;
+  switch (expr->value.op.op2->ts.type)
+    {
+    case BT_INTEGER:
+      ikind = expr->value.op.op2->ts.kind;
+      switch (ikind)
+	{
+	case 1:
+	case 2:
+	  rse.expr = convert (gfc_int4_type_node, rse.expr);
+	  res_ikind_2 = ikind;
+	  /* Fall through.  */
+
+	case 4:
+	  ikind = 0;
+	  break;
+
+	case 8:
+	  ikind = 1;
+	  break;
+
+	case 16:
+	  ikind = 2;
+	  break;
+
+	default:
+	  gcc_unreachable ();
+	}
+      switch (kind)
+	{
+	case 1:
+	case 2:
+	  if (expr->value.op.op1->ts.type == BT_INTEGER)
+	    {
+	      lse.expr = convert (gfc_int4_type_node, lse.expr);
+	      res_ikind_1 = kind;
+	    }
+	  else
+	    gcc_unreachable ();
+	  /* Fall through.  */
+
+	case 4:
+	  kind = 0;
+	  break;
+
+	case 8:
+	  kind = 1;
+	  break;
+
+	case 10:
+	  kind = 2;
+	  break;
+
+	case 16:
+	  kind = 3;
+	  break;
+
+	default:
+	  gcc_unreachable ();
+	}
+
+      switch (expr->value.op.op1->ts.type)
+	{
+	case BT_INTEGER:
+	  if (kind == 3) /* Case 16 was not handled properly above.  */
+	    kind = 2;
+	  fndecl = gfor_fndecl_math_powi[kind][ikind].integer;
+	  break;
+
+	case BT_REAL:
+	  /* Use builtins for real ** int4.  */
+	  if (ikind == 0)
+	    {
+	      switch (kind)
+		{
+		case 0:
+		  fndecl = built_in_decls[BUILT_IN_POWIF];
+		  break;
+
+		case 1:
+		  fndecl = built_in_decls[BUILT_IN_POWI];
+		  break;
+
+		case 2:
+		  fndecl = built_in_decls[BUILT_IN_POWIL];
+		  break;
+
+		case 3:
+		  /* Use the __builtin_powil() only if real(kind=16) is
+		     actually the C long double type.  */
+		  if (!gfc_real16_is_float128)
+		    fndecl = built_in_decls[BUILT_IN_POWIL];
+		  break;
+
+		default:
+		  gcc_unreachable ();
+		}
+	    }
+
+	  /* If we don't have a good builtin for this, go for the
+	     library function.  */
+	  if (!fndecl)
+	    fndecl = gfor_fndecl_math_powi[kind][ikind].real;
+	  break;
+
+	case BT_COMPLEX:
+	  fndecl = gfor_fndecl_math_powi[kind][ikind].cmplx;
+	  break;
+
+	default:
+	  gcc_unreachable ();
+ 	}
+      break;
+
+    case BT_REAL:
+      fndecl = gfc_builtin_decl_for_float_kind (BUILT_IN_POW, kind);
+      break;
+
+    case BT_COMPLEX:
+      fndecl = gfc_builtin_decl_for_float_kind (BUILT_IN_CPOW, kind);
+      break;
+
+    default:
+      gcc_unreachable ();
+      break;
+    }
+
+  se->expr = build_call_expr_loc (input_location,
+			      fndecl, 2, lse.expr, rse.expr);
+
+  /* Convert the result back if it is of wrong integer kind.  */
+  if (res_ikind_1 != -1 && res_ikind_2 != -1)
+    {
+      /* We want the maximum of both operand kinds as result.  */
+      if (res_ikind_1 < res_ikind_2)
+	res_ikind_1 = res_ikind_2;
+      se->expr = convert (gfc_get_int_type (res_ikind_1), se->expr);
+    }
+}
+
+
+/* Generate code to allocate a string temporary.  */
+
+tree
+gfc_conv_string_tmp (gfc_se * se, tree type, tree len)
+{
+  tree var;
+  tree tmp;
+
+  if (gfc_can_put_var_on_stack (len))
+    {
+      /* Create a temporary variable to hold the result.  */
+      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+			     gfc_charlen_type_node, len,
+			     build_int_cst (gfc_charlen_type_node, 1));
+      tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
+
+      if (TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE)
+	tmp = build_array_type (TREE_TYPE (TREE_TYPE (type)), tmp);
+      else
+	tmp = build_array_type (TREE_TYPE (type), tmp);
+
+      var = gfc_create_var (tmp, "str");
+      var = gfc_build_addr_expr (type, var);
+    }
+  else
+    {
+      /* Allocate a temporary to hold the result.  */
+      var = gfc_create_var (type, "pstr");
+      tmp = gfc_call_malloc (&se->pre, type,
+			     fold_build2_loc (input_location, MULT_EXPR,
+					      TREE_TYPE (len), len,
+					      fold_convert (TREE_TYPE (len),
+							    TYPE_SIZE (type))));
+      gfc_add_modify (&se->pre, var, tmp);
+
+      /* Free the temporary afterwards.  */
+      tmp = gfc_call_free (convert (pvoid_type_node, var));
+      gfc_add_expr_to_block (&se->post, tmp);
+    }
+
+  return var;
+}
+
+
+/* Handle a string concatenation operation.  A temporary will be allocated to
+   hold the result.  */
+
+static void
+gfc_conv_concat_op (gfc_se * se, gfc_expr * expr)
+{
+  gfc_se lse, rse;
+  tree len, type, var, tmp, fndecl;
+
+  gcc_assert (expr->value.op.op1->ts.type == BT_CHARACTER
+	      && expr->value.op.op2->ts.type == BT_CHARACTER);
+  gcc_assert (expr->value.op.op1->ts.kind == expr->value.op.op2->ts.kind);
+
+  gfc_init_se (&lse, se);
+  gfc_conv_expr (&lse, expr->value.op.op1);
+  gfc_conv_string_parameter (&lse);
+  gfc_init_se (&rse, se);
+  gfc_conv_expr (&rse, expr->value.op.op2);
+  gfc_conv_string_parameter (&rse);
+
+  gfc_add_block_to_block (&se->pre, &lse.pre);
+  gfc_add_block_to_block (&se->pre, &rse.pre);
+
+  type = gfc_get_character_type (expr->ts.kind, expr->ts.u.cl);
+  len = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
+  if (len == NULL_TREE)
+    {
+      len = fold_build2_loc (input_location, PLUS_EXPR,
+			     TREE_TYPE (lse.string_length),
+			     lse.string_length, rse.string_length);
+    }
+
+  type = build_pointer_type (type);
+
+  var = gfc_conv_string_tmp (se, type, len);
+
+  /* Do the actual concatenation.  */
+  if (expr->ts.kind == 1)
+    fndecl = gfor_fndecl_concat_string;
+  else if (expr->ts.kind == 4)
+    fndecl = gfor_fndecl_concat_string_char4;
+  else
+    gcc_unreachable ();
+
+  tmp = build_call_expr_loc (input_location,
+			 fndecl, 6, len, var, lse.string_length, lse.expr,
+			 rse.string_length, rse.expr);
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  /* Add the cleanup for the operands.  */
+  gfc_add_block_to_block (&se->pre, &rse.post);
+  gfc_add_block_to_block (&se->pre, &lse.post);
+
+  se->expr = var;
+  se->string_length = len;
+}
+
+/* Translates an op expression. Common (binary) cases are handled by this
+   function, others are passed on. Recursion is used in either case.
+   We use the fact that (op1.ts == op2.ts) (except for the power
+   operator **).
+   Operators need no special handling for scalarized expressions as long as
+   they call gfc_conv_simple_val to get their operands.
+   Character strings get special handling.  */
+
+static void
+gfc_conv_expr_op (gfc_se * se, gfc_expr * expr)
+{
+  enum tree_code code;
+  gfc_se lse;
+  gfc_se rse;
+  tree tmp, type;
+  int lop;
+  int checkstring;
+
+  checkstring = 0;
+  lop = 0;
+  switch (expr->value.op.op)
+    {
+    case INTRINSIC_PARENTHESES:
+      if ((expr->ts.type == BT_REAL
+	   || expr->ts.type == BT_COMPLEX)
+	  && gfc_option.flag_protect_parens)
+	{
+	  gfc_conv_unary_op (PAREN_EXPR, se, expr);
+	  gcc_assert (FLOAT_TYPE_P (TREE_TYPE (se->expr)));
+	  return;
+	}
+
+      /* Fallthrough.  */
+    case INTRINSIC_UPLUS:
+      gfc_conv_expr (se, expr->value.op.op1);
+      return;
+
+    case INTRINSIC_UMINUS:
+      gfc_conv_unary_op (NEGATE_EXPR, se, expr);
+      return;
+
+    case INTRINSIC_NOT:
+      gfc_conv_unary_op (TRUTH_NOT_EXPR, se, expr);
+      return;
+
+    case INTRINSIC_PLUS:
+      code = PLUS_EXPR;
+      break;
+
+    case INTRINSIC_MINUS:
+      code = MINUS_EXPR;
+      break;
+
+    case INTRINSIC_TIMES:
+      code = MULT_EXPR;
+      break;
+
+    case INTRINSIC_DIVIDE:
+      /* If expr is a real or complex expr, use an RDIV_EXPR. If op1 is
+         an integer, we must round towards zero, so we use a
+         TRUNC_DIV_EXPR.  */
+      if (expr->ts.type == BT_INTEGER)
+	code = TRUNC_DIV_EXPR;
+      else
+	code = RDIV_EXPR;
+      break;
+
+    case INTRINSIC_POWER:
+      gfc_conv_power_op (se, expr);
+      return;
+
+    case INTRINSIC_CONCAT:
+      gfc_conv_concat_op (se, expr);
+      return;
+
+    case INTRINSIC_AND:
+      code = TRUTH_ANDIF_EXPR;
+      lop = 1;
+      break;
+
+    case INTRINSIC_OR:
+      code = TRUTH_ORIF_EXPR;
+      lop = 1;
+      break;
+
+      /* EQV and NEQV only work on logicals, but since we represent them
+         as integers, we can use EQ_EXPR and NE_EXPR for them in GIMPLE.  */
+    case INTRINSIC_EQ:
+    case INTRINSIC_EQ_OS:
+    case INTRINSIC_EQV:
+      code = EQ_EXPR;
+      checkstring = 1;
+      lop = 1;
+      break;
+
+    case INTRINSIC_NE:
+    case INTRINSIC_NE_OS:
+    case INTRINSIC_NEQV:
+      code = NE_EXPR;
+      checkstring = 1;
+      lop = 1;
+      break;
+
+    case INTRINSIC_GT:
+    case INTRINSIC_GT_OS:
+      code = GT_EXPR;
+      checkstring = 1;
+      lop = 1;
+      break;
+
+    case INTRINSIC_GE:
+    case INTRINSIC_GE_OS:
+      code = GE_EXPR;
+      checkstring = 1;
+      lop = 1;
+      break;
+
+    case INTRINSIC_LT:
+    case INTRINSIC_LT_OS:
+      code = LT_EXPR;
+      checkstring = 1;
+      lop = 1;
+      break;
+
+    case INTRINSIC_LE:
+    case INTRINSIC_LE_OS:
+      code = LE_EXPR;
+      checkstring = 1;
+      lop = 1;
+      break;
+
+    case INTRINSIC_USER:
+    case INTRINSIC_ASSIGN:
+      /* These should be converted into function calls by the frontend.  */
+      gcc_unreachable ();
+
+    default:
+      fatal_error ("Unknown intrinsic op");
+      return;
+    }
+
+  /* The only exception to this is **, which is handled separately anyway.  */
+  gcc_assert (expr->value.op.op1->ts.type == expr->value.op.op2->ts.type);
+
+  if (checkstring && expr->value.op.op1->ts.type != BT_CHARACTER)
+    checkstring = 0;
+
+  /* lhs */
+  gfc_init_se (&lse, se);
+  gfc_conv_expr (&lse, expr->value.op.op1);
+  gfc_add_block_to_block (&se->pre, &lse.pre);
+
+  /* rhs */
+  gfc_init_se (&rse, se);
+  gfc_conv_expr (&rse, expr->value.op.op2);
+  gfc_add_block_to_block (&se->pre, &rse.pre);
+
+  if (checkstring)
+    {
+      gfc_conv_string_parameter (&lse);
+      gfc_conv_string_parameter (&rse);
+
+      lse.expr = gfc_build_compare_string (lse.string_length, lse.expr,
+					   rse.string_length, rse.expr,
+					   expr->value.op.op1->ts.kind,
+					   code);
+      rse.expr = build_int_cst (TREE_TYPE (lse.expr), 0);
+      gfc_add_block_to_block (&lse.post, &rse.post);
+    }
+
+  type = gfc_typenode_for_spec (&expr->ts);
+
+  if (lop)
+    {
+      /* The result of logical ops is always boolean_type_node.  */
+      tmp = fold_build2_loc (input_location, code, boolean_type_node,
+			     lse.expr, rse.expr);
+      se->expr = convert (type, tmp);
+    }
+  else
+    se->expr = fold_build2_loc (input_location, code, type, lse.expr, rse.expr);
+
+  /* Add the post blocks.  */
+  gfc_add_block_to_block (&se->post, &rse.post);
+  gfc_add_block_to_block (&se->post, &lse.post);
+}
+
+/* If a string's length is one, we convert it to a single character.  */
+
+tree
+gfc_string_to_single_character (tree len, tree str, int kind)
+{
+
+  if (!INTEGER_CST_P (len) || TREE_INT_CST_HIGH (len) != 0
+      || !POINTER_TYPE_P (TREE_TYPE (str)))
+    return NULL_TREE;
+
+  if (TREE_INT_CST_LOW (len) == 1)
+    {
+      str = fold_convert (gfc_get_pchar_type (kind), str);
+      return build_fold_indirect_ref_loc (input_location, str);
+    }
+
+  if (kind == 1
+      && TREE_CODE (str) == ADDR_EXPR
+      && TREE_CODE (TREE_OPERAND (str, 0)) == ARRAY_REF
+      && TREE_CODE (TREE_OPERAND (TREE_OPERAND (str, 0), 0)) == STRING_CST
+      && array_ref_low_bound (TREE_OPERAND (str, 0))
+	 == TREE_OPERAND (TREE_OPERAND (str, 0), 1)
+      && TREE_INT_CST_LOW (len) > 1
+      && TREE_INT_CST_LOW (len)
+	 == (unsigned HOST_WIDE_INT)
+	    TREE_STRING_LENGTH (TREE_OPERAND (TREE_OPERAND (str, 0), 0)))
+    {
+      tree ret = fold_convert (gfc_get_pchar_type (kind), str);
+      ret = build_fold_indirect_ref_loc (input_location, ret);
+      if (TREE_CODE (ret) == INTEGER_CST)
+	{
+	  tree string_cst = TREE_OPERAND (TREE_OPERAND (str, 0), 0);
+	  int i, length = TREE_STRING_LENGTH (string_cst);
+	  const char *ptr = TREE_STRING_POINTER (string_cst);
+
+	  for (i = 1; i < length; i++)
+	    if (ptr[i] != ' ')
+	      return NULL_TREE;
+
+	  return ret;
+	}
+    }
+
+  return NULL_TREE;
+}
+
+
+void
+gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr)
+{
+
+  if (sym->backend_decl)
+    {
+      /* This becomes the nominal_type in
+	 function.c:assign_parm_find_data_types.  */
+      TREE_TYPE (sym->backend_decl) = unsigned_char_type_node;
+      /* This becomes the passed_type in
+	 function.c:assign_parm_find_data_types.  C promotes char to
+	 integer for argument passing.  */
+      DECL_ARG_TYPE (sym->backend_decl) = unsigned_type_node;
+
+      DECL_BY_REFERENCE (sym->backend_decl) = 0;
+    }
+
+  if (expr != NULL)
+    {
+      /* If we have a constant character expression, make it into an
+	 integer.  */
+      if ((*expr)->expr_type == EXPR_CONSTANT)
+        {
+	  gfc_typespec ts;
+          gfc_clear_ts (&ts);
+
+	  *expr = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+				    (int)(*expr)->value.character.string[0]);
+	  if ((*expr)->ts.kind != gfc_c_int_kind)
+	    {
+  	      /* The expr needs to be compatible with a C int.  If the
+		 conversion fails, then the 2 causes an ICE.  */
+	      ts.type = BT_INTEGER;
+	      ts.kind = gfc_c_int_kind;
+	      gfc_convert_type (*expr, &ts, 2);
+	    }
+	}
+      else if (se != NULL && (*expr)->expr_type == EXPR_VARIABLE)
+        {
+	  if ((*expr)->ref == NULL)
+	    {
+	      se->expr = gfc_string_to_single_character
+		(build_int_cst (integer_type_node, 1),
+		 gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind),
+				      gfc_get_symbol_decl
+				      ((*expr)->symtree->n.sym)),
+		 (*expr)->ts.kind);
+	    }
+	  else
+	    {
+	      gfc_conv_variable (se, *expr);
+	      se->expr = gfc_string_to_single_character
+		(build_int_cst (integer_type_node, 1),
+		 gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind),
+				      se->expr),
+		 (*expr)->ts.kind);
+	    }
+	}
+    }
+}
+
+/* Helper function for gfc_build_compare_string.  Return LEN_TRIM value
+   if STR is a string literal, otherwise return -1.  */
+
+static int
+gfc_optimize_len_trim (tree len, tree str, int kind)
+{
+  if (kind == 1
+      && TREE_CODE (str) == ADDR_EXPR
+      && TREE_CODE (TREE_OPERAND (str, 0)) == ARRAY_REF
+      && TREE_CODE (TREE_OPERAND (TREE_OPERAND (str, 0), 0)) == STRING_CST
+      && array_ref_low_bound (TREE_OPERAND (str, 0))
+	 == TREE_OPERAND (TREE_OPERAND (str, 0), 1)
+      && TREE_INT_CST_LOW (len) >= 1
+      && TREE_INT_CST_LOW (len)
+	 == (unsigned HOST_WIDE_INT)
+	    TREE_STRING_LENGTH (TREE_OPERAND (TREE_OPERAND (str, 0), 0)))
+    {
+      tree folded = fold_convert (gfc_get_pchar_type (kind), str);
+      folded = build_fold_indirect_ref_loc (input_location, folded);
+      if (TREE_CODE (folded) == INTEGER_CST)
+	{
+	  tree string_cst = TREE_OPERAND (TREE_OPERAND (str, 0), 0);
+	  int length = TREE_STRING_LENGTH (string_cst);
+	  const char *ptr = TREE_STRING_POINTER (string_cst);
+
+	  for (; length > 0; length--)
+	    if (ptr[length - 1] != ' ')
+	      break;
+
+	  return length;
+	}
+    }
+  return -1;
+}
+
+/* Compare two strings. If they are all single characters, the result is the
+   subtraction of them. Otherwise, we build a library call.  */
+
+tree
+gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind,
+			  enum tree_code code)
+{
+  tree sc1;
+  tree sc2;
+  tree fndecl;
+
+  gcc_assert (POINTER_TYPE_P (TREE_TYPE (str1)));
+  gcc_assert (POINTER_TYPE_P (TREE_TYPE (str2)));
+
+  sc1 = gfc_string_to_single_character (len1, str1, kind);
+  sc2 = gfc_string_to_single_character (len2, str2, kind);
+
+  if (sc1 != NULL_TREE && sc2 != NULL_TREE)
+    {
+      /* Deal with single character specially.  */
+      sc1 = fold_convert (integer_type_node, sc1);
+      sc2 = fold_convert (integer_type_node, sc2);
+      return fold_build2_loc (input_location, MINUS_EXPR, integer_type_node,
+			      sc1, sc2);
+    }
+
+  if ((code == EQ_EXPR || code == NE_EXPR)
+      && optimize
+      && INTEGER_CST_P (len1) && INTEGER_CST_P (len2))
+    {
+      /* If one string is a string literal with LEN_TRIM longer
+	 than the length of the second string, the strings
+	 compare unequal.  */
+      int len = gfc_optimize_len_trim (len1, str1, kind);
+      if (len > 0 && compare_tree_int (len2, len) < 0)
+	return integer_one_node;
+      len = gfc_optimize_len_trim (len2, str2, kind);
+      if (len > 0 && compare_tree_int (len1, len) < 0)
+	return integer_one_node;
+    }
+
+  /* Build a call for the comparison.  */
+  if (kind == 1)
+    fndecl = gfor_fndecl_compare_string;
+  else if (kind == 4)
+    fndecl = gfor_fndecl_compare_string_char4;
+  else
+    gcc_unreachable ();
+
+  return build_call_expr_loc (input_location, fndecl, 4,
+			      len1, str1, len2, str2);
+}
+
+
+/* Return the backend_decl for a procedure pointer component.  */
+
+static tree
+get_proc_ptr_comp (gfc_expr *e)
+{
+  gfc_se comp_se;
+  gfc_expr *e2;
+  expr_t old_type;
+
+  gfc_init_se (&comp_se, NULL);
+  e2 = gfc_copy_expr (e);
+  /* We have to restore the expr type later so that gfc_free_expr frees
+     the exact same thing that was allocated.
+     TODO: This is ugly.  */
+  old_type = e2->expr_type;
+  e2->expr_type = EXPR_VARIABLE;
+  gfc_conv_expr (&comp_se, e2);
+  e2->expr_type = old_type;
+  gfc_free_expr (e2);
+  return build_fold_addr_expr_loc (input_location, comp_se.expr);
+}
+
+
+static void
+conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr)
+{
+  tree tmp;
+
+  if (gfc_is_proc_ptr_comp (expr, NULL))
+    tmp = get_proc_ptr_comp (expr);
+  else if (sym->attr.dummy)
+    {
+      tmp = gfc_get_symbol_decl (sym);
+      if (sym->attr.proc_pointer)
+        tmp = build_fold_indirect_ref_loc (input_location,
+				       tmp);
+      gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE
+	      && TREE_CODE (TREE_TYPE (TREE_TYPE (tmp))) == FUNCTION_TYPE);
+    }
+  else
+    {
+      if (!sym->backend_decl)
+	sym->backend_decl = gfc_get_extern_function_decl (sym);
+
+      tmp = sym->backend_decl;
+
+      if (sym->attr.cray_pointee)
+	{
+	  /* TODO - make the cray pointee a pointer to a procedure,
+	     assign the pointer to it and use it for the call.  This
+	     will do for now!  */
+	  tmp = convert (build_pointer_type (TREE_TYPE (tmp)),
+			 gfc_get_symbol_decl (sym->cp_pointer));
+	  tmp = gfc_evaluate_now (tmp, &se->pre);
+	}
+
+      if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+	{
+	  gcc_assert (TREE_CODE (tmp) == FUNCTION_DECL);
+	  tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+	}
+    }
+  se->expr = tmp;
+}
+
+
+/* Initialize MAPPING.  */
+
+void
+gfc_init_interface_mapping (gfc_interface_mapping * mapping)
+{
+  mapping->syms = NULL;
+  mapping->charlens = NULL;
+}
+
+
+/* Free all memory held by MAPPING (but not MAPPING itself).  */
+
+void
+gfc_free_interface_mapping (gfc_interface_mapping * mapping)
+{
+  gfc_interface_sym_mapping *sym;
+  gfc_interface_sym_mapping *nextsym;
+  gfc_charlen *cl;
+  gfc_charlen *nextcl;
+
+  for (sym = mapping->syms; sym; sym = nextsym)
+    {
+      nextsym = sym->next;
+      sym->new_sym->n.sym->formal = NULL;
+      gfc_free_symbol (sym->new_sym->n.sym);
+      gfc_free_expr (sym->expr);
+      gfc_free (sym->new_sym);
+      gfc_free (sym);
+    }
+  for (cl = mapping->charlens; cl; cl = nextcl)
+    {
+      nextcl = cl->next;
+      gfc_free_expr (cl->length);
+      gfc_free (cl);
+    }
+}
+
+
+/* Return a copy of gfc_charlen CL.  Add the returned structure to
+   MAPPING so that it will be freed by gfc_free_interface_mapping.  */
+
+static gfc_charlen *
+gfc_get_interface_mapping_charlen (gfc_interface_mapping * mapping,
+				   gfc_charlen * cl)
+{
+  gfc_charlen *new_charlen;
+
+  new_charlen = gfc_get_charlen ();
+  new_charlen->next = mapping->charlens;
+  new_charlen->length = gfc_copy_expr (cl->length);
+
+  mapping->charlens = new_charlen;
+  return new_charlen;
+}
+
+
+/* A subroutine of gfc_add_interface_mapping.  Return a descriptorless
+   array variable that can be used as the actual argument for dummy
+   argument SYM.  Add any initialization code to BLOCK.  PACKED is as
+   for gfc_get_nodesc_array_type and DATA points to the first element
+   in the passed array.  */
+
+static tree
+gfc_get_interface_mapping_array (stmtblock_t * block, gfc_symbol * sym,
+				 gfc_packed packed, tree data)
+{
+  tree type;
+  tree var;
+
+  type = gfc_typenode_for_spec (&sym->ts);
+  type = gfc_get_nodesc_array_type (type, sym->as, packed,
+				    !sym->attr.target && !sym->attr.pointer
+				    && !sym->attr.proc_pointer);
+
+  var = gfc_create_var (type, "ifm");
+  gfc_add_modify (block, var, fold_convert (type, data));
+
+  return var;
+}
+
+
+/* A subroutine of gfc_add_interface_mapping.  Set the stride, upper bounds
+   and offset of descriptorless array type TYPE given that it has the same
+   size as DESC.  Add any set-up code to BLOCK.  */
+
+static void
+gfc_set_interface_mapping_bounds (stmtblock_t * block, tree type, tree desc)
+{
+  int n;
+  tree dim;
+  tree offset;
+  tree tmp;
+
+  offset = gfc_index_zero_node;
+  for (n = 0; n < GFC_TYPE_ARRAY_RANK (type); n++)
+    {
+      dim = gfc_rank_cst[n];
+      GFC_TYPE_ARRAY_STRIDE (type, n) = gfc_conv_array_stride (desc, n);
+      if (GFC_TYPE_ARRAY_LBOUND (type, n) == NULL_TREE)
+	{
+	  GFC_TYPE_ARRAY_LBOUND (type, n)
+		= gfc_conv_descriptor_lbound_get (desc, dim);
+	  GFC_TYPE_ARRAY_UBOUND (type, n)
+		= gfc_conv_descriptor_ubound_get (desc, dim);
+	}
+      else if (GFC_TYPE_ARRAY_UBOUND (type, n) == NULL_TREE)
+	{
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type,
+				 gfc_conv_descriptor_ubound_get (desc, dim),
+				 gfc_conv_descriptor_lbound_get (desc, dim));
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type,
+				 GFC_TYPE_ARRAY_LBOUND (type, n), tmp);
+	  tmp = gfc_evaluate_now (tmp, block);
+	  GFC_TYPE_ARRAY_UBOUND (type, n) = tmp;
+	}
+      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     GFC_TYPE_ARRAY_LBOUND (type, n),
+			     GFC_TYPE_ARRAY_STRIDE (type, n));
+      offset = fold_build2_loc (input_location, MINUS_EXPR,
+				gfc_array_index_type, offset, tmp);
+    }
+  offset = gfc_evaluate_now (offset, block);
+  GFC_TYPE_ARRAY_OFFSET (type) = offset;
+}
+
+
+/* Extend MAPPING so that it maps dummy argument SYM to the value stored
+   in SE.  The caller may still use se->expr and se->string_length after
+   calling this function.  */
+
+void
+gfc_add_interface_mapping (gfc_interface_mapping * mapping,
+			   gfc_symbol * sym, gfc_se * se,
+			   gfc_expr *expr)
+{
+  gfc_interface_sym_mapping *sm;
+  tree desc;
+  tree tmp;
+  tree value;
+  gfc_symbol *new_sym;
+  gfc_symtree *root;
+  gfc_symtree *new_symtree;
+
+  /* Create a new symbol to represent the actual argument.  */
+  new_sym = gfc_new_symbol (sym->name, NULL);
+  new_sym->ts = sym->ts;
+  new_sym->as = gfc_copy_array_spec (sym->as);
+  new_sym->attr.referenced = 1;
+  new_sym->attr.dimension = sym->attr.dimension;
+  new_sym->attr.contiguous = sym->attr.contiguous;
+  new_sym->attr.codimension = sym->attr.codimension;
+  new_sym->attr.pointer = sym->attr.pointer;
+  new_sym->attr.allocatable = sym->attr.allocatable;
+  new_sym->attr.flavor = sym->attr.flavor;
+  new_sym->attr.function = sym->attr.function;
+
+  /* Ensure that the interface is available and that
+     descriptors are passed for array actual arguments.  */
+  if (sym->attr.flavor == FL_PROCEDURE)
+    {
+      new_sym->formal = expr->symtree->n.sym->formal;
+      new_sym->attr.always_explicit
+	    = expr->symtree->n.sym->attr.always_explicit;
+    }
+
+  /* Create a fake symtree for it.  */
+  root = NULL;
+  new_symtree = gfc_new_symtree (&root, sym->name);
+  new_symtree->n.sym = new_sym;
+  gcc_assert (new_symtree == root);
+
+  /* Create a dummy->actual mapping.  */
+  sm = XCNEW (gfc_interface_sym_mapping);
+  sm->next = mapping->syms;
+  sm->old = sym;
+  sm->new_sym = new_symtree;
+  sm->expr = gfc_copy_expr (expr);
+  mapping->syms = sm;
+
+  /* Stabilize the argument's value.  */
+  if (!sym->attr.function && se)
+    se->expr = gfc_evaluate_now (se->expr, &se->pre);
+
+  if (sym->ts.type == BT_CHARACTER)
+    {
+      /* Create a copy of the dummy argument's length.  */
+      new_sym->ts.u.cl = gfc_get_interface_mapping_charlen (mapping, sym->ts.u.cl);
+      sm->expr->ts.u.cl = new_sym->ts.u.cl;
+
+      /* If the length is specified as "*", record the length that
+	 the caller is passing.  We should use the callee's length
+	 in all other cases.  */
+      if (!new_sym->ts.u.cl->length && se)
+	{
+	  se->string_length = gfc_evaluate_now (se->string_length, &se->pre);
+	  new_sym->ts.u.cl->backend_decl = se->string_length;
+	}
+    }
+
+  if (!se)
+    return;
+
+  /* Use the passed value as-is if the argument is a function.  */
+  if (sym->attr.flavor == FL_PROCEDURE)
+    value = se->expr;
+
+  /* If the argument is either a string or a pointer to a string,
+     convert it to a boundless character type.  */
+  else if (!sym->attr.dimension && sym->ts.type == BT_CHARACTER)
+    {
+      tmp = gfc_get_character_type_len (sym->ts.kind, NULL);
+      tmp = build_pointer_type (tmp);
+      if (sym->attr.pointer)
+        value = build_fold_indirect_ref_loc (input_location,
+					 se->expr);
+      else
+        value = se->expr;
+      value = fold_convert (tmp, value);
+    }
+
+  /* If the argument is a scalar, a pointer to an array or an allocatable,
+     dereference it.  */
+  else if (!sym->attr.dimension || sym->attr.pointer || sym->attr.allocatable)
+    value = build_fold_indirect_ref_loc (input_location,
+				     se->expr);
+
+  /* For character(*), use the actual argument's descriptor.  */
+  else if (sym->ts.type == BT_CHARACTER && !new_sym->ts.u.cl->length)
+    value = build_fold_indirect_ref_loc (input_location,
+				     se->expr);
+
+  /* If the argument is an array descriptor, use it to determine
+     information about the actual argument's shape.  */
+  else if (POINTER_TYPE_P (TREE_TYPE (se->expr))
+	   && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (se->expr))))
+    {
+      /* Get the actual argument's descriptor.  */
+      desc = build_fold_indirect_ref_loc (input_location,
+				      se->expr);
+
+      /* Create the replacement variable.  */
+      tmp = gfc_conv_descriptor_data_get (desc);
+      value = gfc_get_interface_mapping_array (&se->pre, sym,
+					       PACKED_NO, tmp);
+
+      /* Use DESC to work out the upper bounds, strides and offset.  */
+      gfc_set_interface_mapping_bounds (&se->pre, TREE_TYPE (value), desc);
+    }
+  else
+    /* Otherwise we have a packed array.  */
+    value = gfc_get_interface_mapping_array (&se->pre, sym,
+					     PACKED_FULL, se->expr);
+
+  new_sym->backend_decl = value;
+}
+
+
+/* Called once all dummy argument mappings have been added to MAPPING,
+   but before the mapping is used to evaluate expressions.  Pre-evaluate
+   the length of each argument, adding any initialization code to PRE and
+   any finalization code to POST.  */
+
+void
+gfc_finish_interface_mapping (gfc_interface_mapping * mapping,
+			      stmtblock_t * pre, stmtblock_t * post)
+{
+  gfc_interface_sym_mapping *sym;
+  gfc_expr *expr;
+  gfc_se se;
+
+  for (sym = mapping->syms; sym; sym = sym->next)
+    if (sym->new_sym->n.sym->ts.type == BT_CHARACTER
+	&& !sym->new_sym->n.sym->ts.u.cl->backend_decl)
+      {
+	expr = sym->new_sym->n.sym->ts.u.cl->length;
+	gfc_apply_interface_mapping_to_expr (mapping, expr);
+	gfc_init_se (&se, NULL);
+	gfc_conv_expr (&se, expr);
+	se.expr = fold_convert (gfc_charlen_type_node, se.expr);
+	se.expr = gfc_evaluate_now (se.expr, &se.pre);
+	gfc_add_block_to_block (pre, &se.pre);
+	gfc_add_block_to_block (post, &se.post);
+
+	sym->new_sym->n.sym->ts.u.cl->backend_decl = se.expr;
+      }
+}
+
+
+/* Like gfc_apply_interface_mapping_to_expr, but applied to
+   constructor C.  */
+
+static void
+gfc_apply_interface_mapping_to_cons (gfc_interface_mapping * mapping,
+				     gfc_constructor_base base)
+{
+  gfc_constructor *c;
+  for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c))
+    {
+      gfc_apply_interface_mapping_to_expr (mapping, c->expr);
+      if (c->iterator)
+	{
+	  gfc_apply_interface_mapping_to_expr (mapping, c->iterator->start);
+	  gfc_apply_interface_mapping_to_expr (mapping, c->iterator->end);
+	  gfc_apply_interface_mapping_to_expr (mapping, c->iterator->step);
+	}
+    }
+}
+
+
+/* Like gfc_apply_interface_mapping_to_expr, but applied to
+   reference REF.  */
+
+static void
+gfc_apply_interface_mapping_to_ref (gfc_interface_mapping * mapping,
+				    gfc_ref * ref)
+{
+  int n;
+
+  for (; ref; ref = ref->next)
+    switch (ref->type)
+      {
+      case REF_ARRAY:
+	for (n = 0; n < ref->u.ar.dimen; n++)
+	  {
+	    gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.start[n]);
+	    gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.end[n]);
+	    gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.stride[n]);
+	  }
+	gfc_apply_interface_mapping_to_expr (mapping, ref->u.ar.offset);
+	break;
+
+      case REF_COMPONENT:
+	break;
+
+      case REF_SUBSTRING:
+	gfc_apply_interface_mapping_to_expr (mapping, ref->u.ss.start);
+	gfc_apply_interface_mapping_to_expr (mapping, ref->u.ss.end);
+	break;
+      }
+}
+
+
+/* Convert intrinsic function calls into result expressions.  */
+
+static bool
+gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping *mapping)
+{
+  gfc_symbol *sym;
+  gfc_expr *new_expr;
+  gfc_expr *arg1;
+  gfc_expr *arg2;
+  int d, dup;
+
+  arg1 = expr->value.function.actual->expr;
+  if (expr->value.function.actual->next)
+    arg2 = expr->value.function.actual->next->expr;
+  else
+    arg2 = NULL;
+
+  sym = arg1->symtree->n.sym;
+
+  if (sym->attr.dummy)
+    return false;
+
+  new_expr = NULL;
+
+  switch (expr->value.function.isym->id)
+    {
+    case GFC_ISYM_LEN:
+      /* TODO figure out why this condition is necessary.  */
+      if (sym->attr.function
+	  && (arg1->ts.u.cl->length == NULL
+	      || (arg1->ts.u.cl->length->expr_type != EXPR_CONSTANT
+		  && arg1->ts.u.cl->length->expr_type != EXPR_VARIABLE)))
+	return false;
+
+      new_expr = gfc_copy_expr (arg1->ts.u.cl->length);
+      break;
+
+    case GFC_ISYM_SIZE:
+      if (!sym->as || sym->as->rank == 0)
+	return false;
+
+      if (arg2 && arg2->expr_type == EXPR_CONSTANT)
+	{
+	  dup = mpz_get_si (arg2->value.integer);
+	  d = dup - 1;
+	}
+      else
+	{
+	  dup = sym->as->rank;
+	  d = 0;
+	}
+
+      for (; d < dup; d++)
+	{
+	  gfc_expr *tmp;
+
+	  if (!sym->as->upper[d] || !sym->as->lower[d])
+	    {
+	      gfc_free_expr (new_expr);
+	      return false;
+	    }
+
+	  tmp = gfc_add (gfc_copy_expr (sym->as->upper[d]),
+					gfc_get_int_expr (gfc_default_integer_kind,
+							  NULL, 1));
+	  tmp = gfc_subtract (tmp, gfc_copy_expr (sym->as->lower[d]));
+	  if (new_expr)
+	    new_expr = gfc_multiply (new_expr, tmp);
+	  else
+	    new_expr = tmp;
+	}
+      break;
+
+    case GFC_ISYM_LBOUND:
+    case GFC_ISYM_UBOUND:
+	/* TODO These implementations of lbound and ubound do not limit if
+	   the size < 0, according to F95's 13.14.53 and 13.14.113.  */
+
+      if (!sym->as || sym->as->rank == 0)
+	return false;
+
+      if (arg2 && arg2->expr_type == EXPR_CONSTANT)
+	d = mpz_get_si (arg2->value.integer) - 1;
+      else
+	/* TODO: If the need arises, this could produce an array of
+	   ubound/lbounds.  */
+	gcc_unreachable ();
+
+      if (expr->value.function.isym->id == GFC_ISYM_LBOUND)
+	{
+	  if (sym->as->lower[d])
+	    new_expr = gfc_copy_expr (sym->as->lower[d]);
+	}
+      else
+	{
+	  if (sym->as->upper[d])
+	    new_expr = gfc_copy_expr (sym->as->upper[d]);
+	}
+      break;
+
+    default:
+      break;
+    }
+
+  gfc_apply_interface_mapping_to_expr (mapping, new_expr);
+  if (!new_expr)
+    return false;
+
+  gfc_replace_expr (expr, new_expr);
+  return true;
+}
+
+
+static void
+gfc_map_fcn_formal_to_actual (gfc_expr *expr, gfc_expr *map_expr,
+			      gfc_interface_mapping * mapping)
+{
+  gfc_formal_arglist *f;
+  gfc_actual_arglist *actual;
+
+  actual = expr->value.function.actual;
+  f = map_expr->symtree->n.sym->formal;
+
+  for (; f && actual; f = f->next, actual = actual->next)
+    {
+      if (!actual->expr)
+	continue;
+
+      gfc_add_interface_mapping (mapping, f->sym, NULL, actual->expr);
+    }
+
+  if (map_expr->symtree->n.sym->attr.dimension)
+    {
+      int d;
+      gfc_array_spec *as;
+
+      as = gfc_copy_array_spec (map_expr->symtree->n.sym->as);
+
+      for (d = 0; d < as->rank; d++)
+	{
+	  gfc_apply_interface_mapping_to_expr (mapping, as->lower[d]);
+	  gfc_apply_interface_mapping_to_expr (mapping, as->upper[d]);
+	}
+
+      expr->value.function.esym->as = as;
+    }
+
+  if (map_expr->symtree->n.sym->ts.type == BT_CHARACTER)
+    {
+      expr->value.function.esym->ts.u.cl->length
+	= gfc_copy_expr (map_expr->symtree->n.sym->ts.u.cl->length);
+
+      gfc_apply_interface_mapping_to_expr (mapping,
+			expr->value.function.esym->ts.u.cl->length);
+    }
+}
+
+
+/* EXPR is a copy of an expression that appeared in the interface
+   associated with MAPPING.  Walk it recursively looking for references to
+   dummy arguments that MAPPING maps to actual arguments.  Replace each such
+   reference with a reference to the associated actual argument.  */
+
+static void
+gfc_apply_interface_mapping_to_expr (gfc_interface_mapping * mapping,
+				     gfc_expr * expr)
+{
+  gfc_interface_sym_mapping *sym;
+  gfc_actual_arglist *actual;
+
+  if (!expr)
+    return;
+
+  /* Copying an expression does not copy its length, so do that here.  */
+  if (expr->ts.type == BT_CHARACTER && expr->ts.u.cl)
+    {
+      expr->ts.u.cl = gfc_get_interface_mapping_charlen (mapping, expr->ts.u.cl);
+      gfc_apply_interface_mapping_to_expr (mapping, expr->ts.u.cl->length);
+    }
+
+  /* Apply the mapping to any references.  */
+  gfc_apply_interface_mapping_to_ref (mapping, expr->ref);
+
+  /* ...and to the expression's symbol, if it has one.  */
+  /* TODO Find out why the condition on expr->symtree had to be moved into
+     the loop rather than being outside it, as originally.  */
+  for (sym = mapping->syms; sym; sym = sym->next)
+    if (expr->symtree && sym->old == expr->symtree->n.sym)
+      {
+	if (sym->new_sym->n.sym->backend_decl)
+	  expr->symtree = sym->new_sym;
+	else if (sym->expr)
+	  gfc_replace_expr (expr, gfc_copy_expr (sym->expr));
+	/* Replace base type for polymorphic arguments.  */
+	if (expr->ref && expr->ref->type == REF_COMPONENT
+	    && sym->expr && sym->expr->ts.type == BT_CLASS)
+	  expr->ref->u.c.sym = sym->expr->ts.u.derived;
+      }
+
+      /* ...and to subexpressions in expr->value.  */
+  switch (expr->expr_type)
+    {
+    case EXPR_VARIABLE:
+    case EXPR_CONSTANT:
+    case EXPR_NULL:
+    case EXPR_SUBSTRING:
+      break;
+
+    case EXPR_OP:
+      gfc_apply_interface_mapping_to_expr (mapping, expr->value.op.op1);
+      gfc_apply_interface_mapping_to_expr (mapping, expr->value.op.op2);
+      break;
+
+    case EXPR_FUNCTION:
+      for (actual = expr->value.function.actual; actual; actual = actual->next)
+	gfc_apply_interface_mapping_to_expr (mapping, actual->expr);
+
+      if (expr->value.function.esym == NULL
+	    && expr->value.function.isym != NULL
+	    && expr->value.function.actual->expr->symtree
+	    && gfc_map_intrinsic_function (expr, mapping))
+	break;
+
+      for (sym = mapping->syms; sym; sym = sym->next)
+	if (sym->old == expr->value.function.esym)
+	  {
+	    expr->value.function.esym = sym->new_sym->n.sym;
+	    gfc_map_fcn_formal_to_actual (expr, sym->expr, mapping);
+	    expr->value.function.esym->result = sym->new_sym->n.sym;
+	  }
+      break;
+
+    case EXPR_ARRAY:
+    case EXPR_STRUCTURE:
+      gfc_apply_interface_mapping_to_cons (mapping, expr->value.constructor);
+      break;
+
+    case EXPR_COMPCALL:
+    case EXPR_PPC:
+      gcc_unreachable ();
+      break;
+    }
+
+  return;
+}
+
+
+/* Evaluate interface expression EXPR using MAPPING.  Store the result
+   in SE.  */
+
+void
+gfc_apply_interface_mapping (gfc_interface_mapping * mapping,
+			     gfc_se * se, gfc_expr * expr)
+{
+  expr = gfc_copy_expr (expr);
+  gfc_apply_interface_mapping_to_expr (mapping, expr);
+  gfc_conv_expr (se, expr);
+  se->expr = gfc_evaluate_now (se->expr, &se->pre);
+  gfc_free_expr (expr);
+}
+
+
+/* Returns a reference to a temporary array into which a component of
+   an actual argument derived type array is copied and then returned
+   after the function call.  */
+void
+gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77,
+			   sym_intent intent, bool formal_ptr)
+{
+  gfc_se lse;
+  gfc_se rse;
+  gfc_ss *lss;
+  gfc_ss *rss;
+  gfc_loopinfo loop;
+  gfc_loopinfo loop2;
+  gfc_ss_info *info;
+  tree offset;
+  tree tmp_index;
+  tree tmp;
+  tree base_type;
+  tree size;
+  stmtblock_t body;
+  int n;
+  int dimen;
+
+  gcc_assert (expr->expr_type == EXPR_VARIABLE);
+
+  gfc_init_se (&lse, NULL);
+  gfc_init_se (&rse, NULL);
+
+  /* Walk the argument expression.  */
+  rss = gfc_walk_expr (expr);
+
+  gcc_assert (rss != gfc_ss_terminator);
+
+  /* Initialize the scalarizer.  */
+  gfc_init_loopinfo (&loop);
+  gfc_add_ss_to_loop (&loop, rss);
+
+  /* Calculate the bounds of the scalarization.  */
+  gfc_conv_ss_startstride (&loop);
+
+  /* Build an ss for the temporary.  */
+  if (expr->ts.type == BT_CHARACTER && !expr->ts.u.cl->backend_decl)
+    gfc_conv_string_length (expr->ts.u.cl, expr, &parmse->pre);
+
+  base_type = gfc_typenode_for_spec (&expr->ts);
+  if (GFC_ARRAY_TYPE_P (base_type)
+		|| GFC_DESCRIPTOR_TYPE_P (base_type))
+    base_type = gfc_get_element_type (base_type);
+
+  loop.temp_ss = gfc_get_ss ();;
+  loop.temp_ss->type = GFC_SS_TEMP;
+  loop.temp_ss->data.temp.type = base_type;
+
+  if (expr->ts.type == BT_CHARACTER)
+    loop.temp_ss->string_length = expr->ts.u.cl->backend_decl;
+  else
+    loop.temp_ss->string_length = NULL;
+
+  parmse->string_length = loop.temp_ss->string_length;
+  loop.temp_ss->data.temp.dimen = loop.dimen;
+  loop.temp_ss->next = gfc_ss_terminator;
+
+  /* Associate the SS with the loop.  */
+  gfc_add_ss_to_loop (&loop, loop.temp_ss);
+
+  /* Setup the scalarizing loops.  */
+  gfc_conv_loop_setup (&loop, &expr->where);
+
+  /* Pass the temporary descriptor back to the caller.  */
+  info = &loop.temp_ss->data.info;
+  parmse->expr = info->descriptor;
+
+  /* Setup the gfc_se structures.  */
+  gfc_copy_loopinfo_to_se (&lse, &loop);
+  gfc_copy_loopinfo_to_se (&rse, &loop);
+
+  rse.ss = rss;
+  lse.ss = loop.temp_ss;
+  gfc_mark_ss_chain_used (rss, 1);
+  gfc_mark_ss_chain_used (loop.temp_ss, 1);
+
+  /* Start the scalarized loop body.  */
+  gfc_start_scalarized_body (&loop, &body);
+
+  /* Translate the expression.  */
+  gfc_conv_expr (&rse, expr);
+
+  gfc_conv_tmp_array_ref (&lse);
+
+  if (intent != INTENT_OUT)
+    {
+      tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, true, false, true);
+      gfc_add_expr_to_block (&body, tmp);
+      gcc_assert (rse.ss == gfc_ss_terminator);
+      gfc_trans_scalarizing_loops (&loop, &body);
+    }
+  else
+    {
+      /* Make sure that the temporary declaration survives by merging
+       all the loop declarations into the current context.  */
+      for (n = 0; n < loop.dimen; n++)
+	{
+	  gfc_merge_block_scope (&body);
+	  body = loop.code[loop.order[n]];
+	}
+      gfc_merge_block_scope (&body);
+    }
+
+  /* Add the post block after the second loop, so that any
+     freeing of allocated memory is done at the right time.  */
+  gfc_add_block_to_block (&parmse->pre, &loop.pre);
+
+  /**********Copy the temporary back again.*********/
+
+  gfc_init_se (&lse, NULL);
+  gfc_init_se (&rse, NULL);
+
+  /* Walk the argument expression.  */
+  lss = gfc_walk_expr (expr);
+  rse.ss = loop.temp_ss;
+  lse.ss = lss;
+
+  /* Initialize the scalarizer.  */
+  gfc_init_loopinfo (&loop2);
+  gfc_add_ss_to_loop (&loop2, lss);
+
+  /* Calculate the bounds of the scalarization.  */
+  gfc_conv_ss_startstride (&loop2);
+
+  /* Setup the scalarizing loops.  */
+  gfc_conv_loop_setup (&loop2, &expr->where);
+
+  gfc_copy_loopinfo_to_se (&lse, &loop2);
+  gfc_copy_loopinfo_to_se (&rse, &loop2);
+
+  gfc_mark_ss_chain_used (lss, 1);
+  gfc_mark_ss_chain_used (loop.temp_ss, 1);
+
+  /* Declare the variable to hold the temporary offset and start the
+     scalarized loop body.  */
+  offset = gfc_create_var (gfc_array_index_type, NULL);
+  gfc_start_scalarized_body (&loop2, &body);
+
+  /* Build the offsets for the temporary from the loop variables.  The
+     temporary array has lbounds of zero and strides of one in all
+     dimensions, so this is very simple.  The offset is only computed
+     outside the innermost loop, so the overall transfer could be
+     optimized further.  */
+  info = &rse.ss->data.info;
+  dimen = info->dimen;
+
+  tmp_index = gfc_index_zero_node;
+  for (n = dimen - 1; n > 0; n--)
+    {
+      tree tmp_str;
+      tmp = rse.loop->loopvar[n];
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     tmp, rse.loop->from[n]);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     tmp, tmp_index);
+
+      tmp_str = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type,
+				 rse.loop->to[n-1], rse.loop->from[n-1]);
+      tmp_str = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type,
+				 tmp_str, gfc_index_one_node);
+
+      tmp_index = fold_build2_loc (input_location, MULT_EXPR,
+				   gfc_array_index_type, tmp, tmp_str);
+    }
+
+  tmp_index = fold_build2_loc (input_location, MINUS_EXPR,
+			       gfc_array_index_type,
+			       tmp_index, rse.loop->from[0]);
+  gfc_add_modify (&rse.loop->code[0], offset, tmp_index);
+
+  tmp_index = fold_build2_loc (input_location, PLUS_EXPR,
+			       gfc_array_index_type,
+			       rse.loop->loopvar[0], offset);
+
+  /* Now use the offset for the reference.  */
+  tmp = build_fold_indirect_ref_loc (input_location,
+				 info->data);
+  rse.expr = gfc_build_array_ref (tmp, tmp_index, NULL);
+
+  if (expr->ts.type == BT_CHARACTER)
+    rse.string_length = expr->ts.u.cl->backend_decl;
+
+  gfc_conv_expr (&lse, expr);
+
+  gcc_assert (lse.ss == gfc_ss_terminator);
+
+  tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, false, true);
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Generate the copying loops.  */
+  gfc_trans_scalarizing_loops (&loop2, &body);
+
+  /* Wrap the whole thing up by adding the second loop to the post-block
+     and following it by the post-block of the first loop.  In this way,
+     if the temporary needs freeing, it is done after use!  */
+  if (intent != INTENT_IN)
+    {
+      gfc_add_block_to_block (&parmse->post, &loop2.pre);
+      gfc_add_block_to_block (&parmse->post, &loop2.post);
+    }
+
+  gfc_add_block_to_block (&parmse->post, &loop.post);
+
+  gfc_cleanup_loop (&loop);
+  gfc_cleanup_loop (&loop2);
+
+  /* Pass the string length to the argument expression.  */
+  if (expr->ts.type == BT_CHARACTER)
+    parmse->string_length = expr->ts.u.cl->backend_decl;
+
+  /* Determine the offset for pointer formal arguments and set the
+     lbounds to one.  */
+  if (formal_ptr)
+    {
+      size = gfc_index_one_node;
+      offset = gfc_index_zero_node;
+      for (n = 0; n < dimen; n++)
+	{
+	  tmp = gfc_conv_descriptor_ubound_get (parmse->expr,
+						gfc_rank_cst[n]);
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, tmp,
+				 gfc_index_one_node);
+	  gfc_conv_descriptor_ubound_set (&parmse->pre,
+					  parmse->expr,
+					  gfc_rank_cst[n],
+					  tmp);
+	  gfc_conv_descriptor_lbound_set (&parmse->pre,
+					  parmse->expr,
+					  gfc_rank_cst[n],
+					  gfc_index_one_node);
+	  size = gfc_evaluate_now (size, &parmse->pre);
+	  offset = fold_build2_loc (input_location, MINUS_EXPR,
+				    gfc_array_index_type,
+				    offset, size);
+	  offset = gfc_evaluate_now (offset, &parmse->pre);
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type,
+				 rse.loop->to[n], rse.loop->from[n]);
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type,
+				 tmp, gfc_index_one_node);
+	  size = fold_build2_loc (input_location, MULT_EXPR,
+				  gfc_array_index_type, size, tmp);
+	}
+
+      gfc_conv_descriptor_offset_set (&parmse->pre, parmse->expr,
+				      offset);
+    }
+
+  /* We want either the address for the data or the address of the descriptor,
+     depending on the mode of passing array arguments.  */
+  if (g77)
+    parmse->expr = gfc_conv_descriptor_data_get (parmse->expr);
+  else
+    parmse->expr = gfc_build_addr_expr (NULL_TREE, parmse->expr);
+
+  return;
+}
+
+
+/* Generate the code for argument list functions.  */
+
+static void
+conv_arglist_function (gfc_se *se, gfc_expr *expr, const char *name)
+{
+  /* Pass by value for g77 %VAL(arg), pass the address
+     indirectly for %LOC, else by reference.  Thus %REF
+     is a "do-nothing" and %LOC is the same as an F95
+     pointer.  */
+  if (strncmp (name, "%VAL", 4) == 0)
+    gfc_conv_expr (se, expr);
+  else if (strncmp (name, "%LOC", 4) == 0)
+    {
+      gfc_conv_expr_reference (se, expr);
+      se->expr = gfc_build_addr_expr (NULL, se->expr);
+    }
+  else if (strncmp (name, "%REF", 4) == 0)
+    gfc_conv_expr_reference (se, expr);
+  else
+    gfc_error ("Unknown argument list function at %L", &expr->where);
+}
+
+
+/* Takes a derived type expression and returns the address of a temporary
+   class object of the 'declared' type.  */
+static void
+gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
+			   gfc_typespec class_ts)
+{
+  gfc_component *cmp;
+  gfc_symbol *vtab;
+  gfc_symbol *declared = class_ts.u.derived;
+  gfc_ss *ss;
+  tree ctree;
+  tree var;
+  tree tmp;
+
+  /* The derived type needs to be converted to a temporary
+     CLASS object.  */
+  tmp = gfc_typenode_for_spec (&class_ts);
+  var = gfc_create_var (tmp, "class");
+
+  /* Set the vptr.  */
+  cmp = gfc_find_component (declared, "_vptr", true, true);
+  ctree = fold_build3_loc (input_location, COMPONENT_REF,
+			   TREE_TYPE (cmp->backend_decl),
+			   var, cmp->backend_decl, NULL_TREE);
+
+  /* Remember the vtab corresponds to the derived type
+     not to the class declared type.  */
+  vtab = gfc_find_derived_vtab (e->ts.u.derived);
+  gcc_assert (vtab);
+  tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab));
+  gfc_add_modify (&parmse->pre, ctree,
+		  fold_convert (TREE_TYPE (ctree), tmp));
+
+  /* Now set the data field.  */
+  cmp = gfc_find_component (declared, "_data", true, true);
+  ctree = fold_build3_loc (input_location, COMPONENT_REF,
+			   TREE_TYPE (cmp->backend_decl),
+			   var, cmp->backend_decl, NULL_TREE);
+  ss = gfc_walk_expr (e);
+  if (ss == gfc_ss_terminator)
+    {
+      parmse->ss = NULL;
+      gfc_conv_expr_reference (parmse, e);
+      tmp = fold_convert (TREE_TYPE (ctree), parmse->expr);
+      gfc_add_modify (&parmse->pre, ctree, tmp);
+    }
+  else
+    {
+      parmse->ss = ss;
+      gfc_conv_expr (parmse, e);
+      gfc_add_modify (&parmse->pre, ctree, parmse->expr);
+    }
+
+  /* Pass the address of the class object.  */
+  parmse->expr = gfc_build_addr_expr (NULL_TREE, var);
+}
+
+
+/* The following routine generates code for the intrinsic
+   procedures from the ISO_C_BINDING module:
+    * C_LOC           (function)
+    * C_FUNLOC        (function)
+    * C_F_POINTER     (subroutine)
+    * C_F_PROCPOINTER (subroutine)
+    * C_ASSOCIATED    (function)
+   One exception which is not handled here is C_F_POINTER with non-scalar
+   arguments. Returns 1 if the call was replaced by inline code (else: 0).  */
+
+static int
+conv_isocbinding_procedure (gfc_se * se, gfc_symbol * sym,
+			    gfc_actual_arglist * arg)
+{
+  gfc_symbol *fsym;
+  gfc_ss *argss;
+
+  if (sym->intmod_sym_id == ISOCBINDING_LOC)
+    {
+      if (arg->expr->rank == 0)
+	gfc_conv_expr_reference (se, arg->expr);
+      else
+	{
+	  int f;
+	  /* This is really the actual arg because no formal arglist is
+	     created for C_LOC.	 */
+	  fsym = arg->expr->symtree->n.sym;
+
+	  /* We should want it to do g77 calling convention.  */
+	  f = (fsym != NULL)
+	    && !(fsym->attr.pointer || fsym->attr.allocatable)
+	    && fsym->as->type != AS_ASSUMED_SHAPE;
+	  f = f || !sym->attr.always_explicit;
+
+	  argss = gfc_walk_expr (arg->expr);
+	  gfc_conv_array_parameter (se, arg->expr, argss, f,
+				    NULL, NULL, NULL);
+	}
+
+      /* TODO -- the following two lines shouldn't be necessary, but if
+	 they're removed, a bug is exposed later in the code path.
+	 This workaround was thus introduced, but will have to be
+	 removed; please see PR 35150 for details about the issue.  */
+      se->expr = convert (pvoid_type_node, se->expr);
+      se->expr = gfc_evaluate_now (se->expr, &se->pre);
+
+      return 1;
+    }
+  else if (sym->intmod_sym_id == ISOCBINDING_FUNLOC)
+    {
+      arg->expr->ts.type = sym->ts.u.derived->ts.type;
+      arg->expr->ts.f90_type = sym->ts.u.derived->ts.f90_type;
+      arg->expr->ts.kind = sym->ts.u.derived->ts.kind;
+      gfc_conv_expr_reference (se, arg->expr);
+
+      return 1;
+    }
+  else if ((sym->intmod_sym_id == ISOCBINDING_F_POINTER
+	    && arg->next->expr->rank == 0)
+	   || sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER)
+    {
+      /* Convert c_f_pointer if fptr is a scalar
+	 and convert c_f_procpointer.  */
+      gfc_se cptrse;
+      gfc_se fptrse;
+
+      gfc_init_se (&cptrse, NULL);
+      gfc_conv_expr (&cptrse, arg->expr);
+      gfc_add_block_to_block (&se->pre, &cptrse.pre);
+      gfc_add_block_to_block (&se->post, &cptrse.post);
+
+      gfc_init_se (&fptrse, NULL);
+      if (sym->intmod_sym_id == ISOCBINDING_F_POINTER
+	  || gfc_is_proc_ptr_comp (arg->next->expr, NULL))
+	fptrse.want_pointer = 1;
+
+      gfc_conv_expr (&fptrse, arg->next->expr);
+      gfc_add_block_to_block (&se->pre, &fptrse.pre);
+      gfc_add_block_to_block (&se->post, &fptrse.post);
+
+      if (arg->next->expr->symtree->n.sym->attr.proc_pointer
+	  && arg->next->expr->symtree->n.sym->attr.dummy)
+	fptrse.expr = build_fold_indirect_ref_loc (input_location,
+						   fptrse.expr);
+
+      se->expr = fold_build2_loc (input_location, MODIFY_EXPR,
+				  TREE_TYPE (fptrse.expr),
+				  fptrse.expr,
+				  fold_convert (TREE_TYPE (fptrse.expr),
+						cptrse.expr));
+
+      return 1;
+    }
+  else if (sym->intmod_sym_id == ISOCBINDING_ASSOCIATED)
+    {
+      gfc_se arg1se;
+      gfc_se arg2se;
+
+      /* Build the addr_expr for the first argument.  The argument is
+	 already an *address* so we don't need to set want_pointer in
+	 the gfc_se.  */
+      gfc_init_se (&arg1se, NULL);
+      gfc_conv_expr (&arg1se, arg->expr);
+      gfc_add_block_to_block (&se->pre, &arg1se.pre);
+      gfc_add_block_to_block (&se->post, &arg1se.post);
+
+      /* See if we were given two arguments.  */
+      if (arg->next == NULL)
+	/* Only given one arg so generate a null and do a
+	   not-equal comparison against the first arg.  */
+	se->expr = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				    arg1se.expr,
+				    fold_convert (TREE_TYPE (arg1se.expr),
+						  null_pointer_node));
+      else
+	{
+	  tree eq_expr;
+	  tree not_null_expr;
+
+	  /* Given two arguments so build the arg2se from second arg.  */
+	  gfc_init_se (&arg2se, NULL);
+	  gfc_conv_expr (&arg2se, arg->next->expr);
+	  gfc_add_block_to_block (&se->pre, &arg2se.pre);
+	  gfc_add_block_to_block (&se->post, &arg2se.post);
+
+	  /* Generate test to compare that the two args are equal.  */
+	  eq_expr = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				     arg1se.expr, arg2se.expr);
+	  /* Generate test to ensure that the first arg is not null.  */
+	  not_null_expr = fold_build2_loc (input_location, NE_EXPR,
+					   boolean_type_node,
+					   arg1se.expr, null_pointer_node);
+
+	  /* Finally, the generated test must check that both arg1 is not
+	     NULL and that it is equal to the second arg.  */
+	  se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+				      boolean_type_node,
+				      not_null_expr, eq_expr);
+	}
+
+      return 1;
+    }
+
+  /* Nothing was done.  */
+  return 0;
+}
+
+/* Generate code for a procedure call.  Note can return se->post != NULL.
+   If se->direct_byref is set then se->expr contains the return parameter.
+   Return nonzero, if the call has alternate specifiers.
+   'expr' is only needed for procedure pointer components.  */
+
+int
+gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
+			 gfc_actual_arglist * args, gfc_expr * expr,
+			 VEC(tree,gc) *append_args)
+{
+  gfc_interface_mapping mapping;
+  VEC(tree,gc) *arglist;
+  VEC(tree,gc) *retargs;
+  tree tmp;
+  tree fntype;
+  gfc_se parmse;
+  gfc_ss *argss;
+  gfc_ss_info *info;
+  int byref;
+  int parm_kind;
+  tree type;
+  tree var;
+  tree len;
+  VEC(tree,gc) *stringargs;
+  tree result = NULL;
+  gfc_formal_arglist *formal;
+  gfc_actual_arglist *arg;
+  int has_alternate_specifier = 0;
+  bool need_interface_mapping;
+  bool callee_alloc;
+  gfc_typespec ts;
+  gfc_charlen cl;
+  gfc_expr *e;
+  gfc_symbol *fsym;
+  stmtblock_t post;
+  enum {MISSING = 0, ELEMENTAL, SCALAR, SCALAR_POINTER, ARRAY};
+  gfc_component *comp = NULL;
+  int arglen;
+
+  arglist = NULL;
+  retargs = NULL;
+  stringargs = NULL;
+  var = NULL_TREE;
+  len = NULL_TREE;
+  gfc_clear_ts (&ts);
+
+  if (sym->from_intmod == INTMOD_ISO_C_BINDING
+      && conv_isocbinding_procedure (se, sym, args))
+    return 0;
+
+  gfc_is_proc_ptr_comp (expr, &comp);
+
+  if (se->ss != NULL)
+    {
+      if (!sym->attr.elemental)
+	{
+	  gcc_assert (se->ss->type == GFC_SS_FUNCTION);
+	  if (se->ss->useflags)
+	    {
+	      gcc_assert ((!comp && gfc_return_by_reference (sym)
+			   && sym->result->attr.dimension)
+			  || (comp && comp->attr.dimension));
+	      gcc_assert (se->loop != NULL);
+
+	      /* Access the previously obtained result.  */
+	      gfc_conv_tmp_array_ref (se);
+	      return 0;
+	    }
+	}
+      info = &se->ss->data.info;
+    }
+  else
+    info = NULL;
+
+  gfc_init_block (&post);
+  gfc_init_interface_mapping (&mapping);
+  if (!comp)
+    {
+      formal = sym->formal;
+      need_interface_mapping = sym->attr.dimension ||
+			       (sym->ts.type == BT_CHARACTER
+				&& sym->ts.u.cl->length
+				&& sym->ts.u.cl->length->expr_type
+				   != EXPR_CONSTANT);
+    }
+  else
+    {
+      formal = comp->formal;
+      need_interface_mapping = comp->attr.dimension ||
+			       (comp->ts.type == BT_CHARACTER
+				&& comp->ts.u.cl->length
+				&& comp->ts.u.cl->length->expr_type
+				   != EXPR_CONSTANT);
+    }
+
+  /* Evaluate the arguments.  */
+  for (arg = args; arg != NULL;
+       arg = arg->next, formal = formal ? formal->next : NULL)
+    {
+      e = arg->expr;
+      fsym = formal ? formal->sym : NULL;
+      parm_kind = MISSING;
+
+      if (e == NULL)
+	{
+	  if (se->ignore_optional)
+	    {
+	      /* Some intrinsics have already been resolved to the correct
+	         parameters.  */
+	      continue;
+	    }
+	  else if (arg->label)
+	    {
+	      has_alternate_specifier = 1;
+	      continue;
+	    }
+	  else
+	    {
+	      /* Pass a NULL pointer for an absent arg.  */
+	      gfc_init_se (&parmse, NULL);
+	      parmse.expr = null_pointer_node;
+	      if (arg->missing_arg_type == BT_CHARACTER)
+		parmse.string_length = build_int_cst (gfc_charlen_type_node, 0);
+	    }
+	}
+      else if (arg->expr->expr_type == EXPR_NULL && fsym && !fsym->attr.pointer)
+	{
+	  /* Pass a NULL pointer to denote an absent arg.  */
+	  gcc_assert (fsym->attr.optional && !fsym->attr.allocatable);
+	  gfc_init_se (&parmse, NULL);
+	  parmse.expr = null_pointer_node;
+	  if (arg->missing_arg_type == BT_CHARACTER)
+	    parmse.string_length = build_int_cst (gfc_charlen_type_node, 0);
+	}
+      else if (fsym && fsym->ts.type == BT_CLASS
+		 && e->ts.type == BT_DERIVED)
+	{
+	  /* The derived type needs to be converted to a temporary
+	     CLASS object.  */
+	  gfc_init_se (&parmse, se);
+	  gfc_conv_derived_to_class (&parmse, e, fsym->ts);
+	}
+      else if (se->ss && se->ss->useflags)
+	{
+	  /* An elemental function inside a scalarized loop.  */
+	  gfc_init_se (&parmse, se);
+	  gfc_conv_expr_reference (&parmse, e);
+	  if (e->ts.type == BT_CHARACTER && !e->rank
+	      && e->expr_type == EXPR_FUNCTION)
+	    parmse.expr = build_fold_indirect_ref_loc (input_location,
+						       parmse.expr);
+	  parm_kind = ELEMENTAL;
+	}
+      else
+	{
+	  /* A scalar or transformational function.  */
+	  gfc_init_se (&parmse, NULL);
+	  argss = gfc_walk_expr (e);
+
+	  if (argss == gfc_ss_terminator)
+	    {
+	      if (e->expr_type == EXPR_VARIABLE
+		    && e->symtree->n.sym->attr.cray_pointee
+		    && fsym && fsym->attr.flavor == FL_PROCEDURE)
+		{
+		    /* The Cray pointer needs to be converted to a pointer to
+		       a type given by the expression.  */
+		    gfc_conv_expr (&parmse, e);
+		    type = build_pointer_type (TREE_TYPE (parmse.expr));
+		    tmp = gfc_get_symbol_decl (e->symtree->n.sym->cp_pointer);
+		    parmse.expr = convert (type, tmp);
+		}
+ 	      else if (fsym && fsym->attr.value)
+		{
+		  if (fsym->ts.type == BT_CHARACTER
+		      && fsym->ts.is_c_interop
+		      && fsym->ns->proc_name != NULL
+		      && fsym->ns->proc_name->attr.is_bind_c)
+		    {
+		      parmse.expr = NULL;
+		      gfc_conv_scalar_char_value (fsym, &parmse, &e);
+		      if (parmse.expr == NULL)
+			gfc_conv_expr (&parmse, e);
+		    }
+		  else
+		    gfc_conv_expr (&parmse, e);
+		}
+	      else if (arg->name && arg->name[0] == '%')
+		/* Argument list functions %VAL, %LOC and %REF are signalled
+		   through arg->name.  */
+		conv_arglist_function (&parmse, arg->expr, arg->name);
+	      else if ((e->expr_type == EXPR_FUNCTION)
+			&& ((e->value.function.esym
+			     && e->value.function.esym->result->attr.pointer)
+			    || (!e->value.function.esym
+				&& e->symtree->n.sym->attr.pointer))
+			&& fsym && fsym->attr.target)
+		{
+		  gfc_conv_expr (&parmse, e);
+		  parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
+		}
+	      else if (e->expr_type == EXPR_FUNCTION
+		       && e->symtree->n.sym->result
+		       && e->symtree->n.sym->result != e->symtree->n.sym
+		       && e->symtree->n.sym->result->attr.proc_pointer)
+		{
+		  /* Functions returning procedure pointers.  */
+		  gfc_conv_expr (&parmse, e);
+		  if (fsym && fsym->attr.proc_pointer)
+		    parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
+		}
+	      else
+		{
+		  gfc_conv_expr_reference (&parmse, e);
+
+		  /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
+		     allocated on entry, it must be deallocated.  */
+		  if (fsym && fsym->attr.allocatable
+		      && fsym->attr.intent == INTENT_OUT)
+		    {
+		      stmtblock_t block;
+
+		      gfc_init_block  (&block);
+		      tmp = gfc_deallocate_with_status (parmse.expr, NULL_TREE,
+							true, NULL);
+		      gfc_add_expr_to_block (&block, tmp);
+		      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+					     void_type_node, parmse.expr,
+					     null_pointer_node);
+		      gfc_add_expr_to_block (&block, tmp);
+
+		      if (fsym->attr.optional
+			  && e->expr_type == EXPR_VARIABLE
+			  && e->symtree->n.sym->attr.optional)
+			{
+			  tmp = fold_build3_loc (input_location, COND_EXPR,
+				     void_type_node,
+				     gfc_conv_expr_present (e->symtree->n.sym),
+					    gfc_finish_block (&block),
+					    build_empty_stmt (input_location));
+			}
+		      else
+			tmp = gfc_finish_block (&block);
+
+		      gfc_add_expr_to_block (&se->pre, tmp);
+		    }
+
+		  if (fsym && e->expr_type != EXPR_NULL
+		      && ((fsym->attr.pointer
+			   && fsym->attr.flavor != FL_PROCEDURE)
+			  || (fsym->attr.proc_pointer
+			      && !(e->expr_type == EXPR_VARIABLE
+				   && e->symtree->n.sym->attr.dummy))
+			  || (fsym->attr.proc_pointer
+			      && e->expr_type == EXPR_VARIABLE
+			      && gfc_is_proc_ptr_comp (e, NULL))
+			  || (fsym->attr.allocatable
+			      && fsym->attr.flavor != FL_PROCEDURE)))
+		    {
+		      /* Scalar pointer dummy args require an extra level of
+			 indirection. The null pointer already contains
+			 this level of indirection.  */
+		      parm_kind = SCALAR_POINTER;
+		      parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
+		    }
+		}
+	    }
+	  else
+	    {
+              /* If the procedure requires an explicit interface, the actual
+                 argument is passed according to the corresponding formal
+                 argument.  If the corresponding formal argument is a POINTER,
+                 ALLOCATABLE or assumed shape, we do not use g77's calling
+                 convention, and pass the address of the array descriptor
+                 instead. Otherwise we use g77's calling convention.  */
+	      bool f;
+	      f = (fsym != NULL)
+		  && !(fsym->attr.pointer || fsym->attr.allocatable)
+		  && fsym->as && fsym->as->type != AS_ASSUMED_SHAPE;
+	      if (comp)
+		f = f || !comp->attr.always_explicit;
+	      else
+		f = f || !sym->attr.always_explicit;
+
+	      /* If the argument is a function call that may not create
+		 a temporary for the result, we have to check that we
+		 can do it, i.e. that there is no alias between this
+		 argument and another one.  */
+	      if (gfc_get_noncopying_intrinsic_argument (e) != NULL)
+		{
+		  gfc_expr *iarg;
+		  sym_intent intent;
+
+		  if (fsym != NULL)
+		    intent = fsym->attr.intent;
+		  else
+		    intent = INTENT_UNKNOWN;
+
+		  if (gfc_check_fncall_dependency (e, intent, sym, args,
+						   NOT_ELEMENTAL))
+		    parmse.force_tmp = 1;
+
+		  iarg = e->value.function.actual->expr;
+
+		  /* Temporary needed if aliasing due to host association.  */
+		  if (sym->attr.contained
+			&& !sym->attr.pure
+			&& !sym->attr.implicit_pure
+			&& !sym->attr.use_assoc
+			&& iarg->expr_type == EXPR_VARIABLE
+			&& sym->ns == iarg->symtree->n.sym->ns)
+		    parmse.force_tmp = 1;
+
+		  /* Ditto within module.  */
+		  if (sym->attr.use_assoc
+			&& !sym->attr.pure
+			&& !sym->attr.implicit_pure
+			&& iarg->expr_type == EXPR_VARIABLE
+			&& sym->module == iarg->symtree->n.sym->module)
+		    parmse.force_tmp = 1;
+		}
+
+	      if (e->expr_type == EXPR_VARIABLE
+		    && is_subref_array (e))
+		/* The actual argument is a component reference to an
+		   array of derived types.  In this case, the argument
+		   is converted to a temporary, which is passed and then
+		   written back after the procedure call.  */
+		gfc_conv_subref_array_arg (&parmse, e, f,
+				fsym ? fsym->attr.intent : INTENT_INOUT,
+				fsym && fsym->attr.pointer);
+	      else
+	        gfc_conv_array_parameter (&parmse, e, argss, f, fsym,
+					  sym->name, NULL);
+
+	      /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
+		 allocated on entry, it must be deallocated.  */
+	      if (fsym && fsym->attr.allocatable
+		  && fsym->attr.intent == INTENT_OUT)
+		{
+		  tmp = build_fold_indirect_ref_loc (input_location,
+						     parmse.expr);
+		  tmp = gfc_trans_dealloc_allocated (tmp);
+		  if (fsym->attr.optional
+		      && e->expr_type == EXPR_VARIABLE
+		      && e->symtree->n.sym->attr.optional)
+		    tmp = fold_build3_loc (input_location, COND_EXPR,
+				     void_type_node,
+				     gfc_conv_expr_present (e->symtree->n.sym),
+				       tmp, build_empty_stmt (input_location));
+		  gfc_add_expr_to_block (&se->pre, tmp);
+		}
+	    }
+	}
+
+      /* The case with fsym->attr.optional is that of a user subroutine
+	 with an interface indicating an optional argument.  When we call
+	 an intrinsic subroutine, however, fsym is NULL, but we might still
+	 have an optional argument, so we proceed to the substitution
+	 just in case.  */
+      if (e && (fsym == NULL || fsym->attr.optional))
+	{
+	  /* If an optional argument is itself an optional dummy argument,
+	     check its presence and substitute a null if absent.  This is
+	     only needed when passing an array to an elemental procedure
+	     as then array elements are accessed - or no NULL pointer is
+	     allowed and a "1" or "0" should be passed if not present.
+	     When passing a non-array-descriptor full array to a
+	     non-array-descriptor dummy, no check is needed. For
+	     array-descriptor actual to array-descriptor dummy, see
+	     PR 41911 for why a check has to be inserted.
+	     fsym == NULL is checked as intrinsics required the descriptor
+	     but do not always set fsym.  */
+	  if (e->expr_type == EXPR_VARIABLE
+	      && e->symtree->n.sym->attr.optional
+	      && ((e->rank > 0 && sym->attr.elemental)
+		  || e->representation.length || e->ts.type == BT_CHARACTER
+		  || (e->rank > 0
+		      && (fsym == NULL
+			  || (fsym-> as
+			      && (fsym->as->type == AS_ASSUMED_SHAPE
+			      	  || fsym->as->type == AS_DEFERRED))))))
+	    gfc_conv_missing_dummy (&parmse, e, fsym ? fsym->ts : e->ts,
+				    e->representation.length);
+	}
+
+      if (fsym && e)
+	{
+	  /* Obtain the character length of an assumed character length
+	     length procedure from the typespec.  */
+	  if (fsym->ts.type == BT_CHARACTER
+	      && parmse.string_length == NULL_TREE
+	      && e->ts.type == BT_PROCEDURE
+	      && e->symtree->n.sym->ts.type == BT_CHARACTER
+	      && e->symtree->n.sym->ts.u.cl->length != NULL
+	      && e->symtree->n.sym->ts.u.cl->length->expr_type == EXPR_CONSTANT)
+	    {
+	      gfc_conv_const_charlen (e->symtree->n.sym->ts.u.cl);
+	      parmse.string_length = e->symtree->n.sym->ts.u.cl->backend_decl;
+	    }
+	}
+
+      if (fsym && need_interface_mapping && e)
+	gfc_add_interface_mapping (&mapping, fsym, &parmse, e);
+
+      gfc_add_block_to_block (&se->pre, &parmse.pre);
+      gfc_add_block_to_block (&post, &parmse.post);
+
+      /* Allocated allocatable components of derived types must be
+	 deallocated for non-variable scalars.  Non-variable arrays are
+	 dealt with in trans-array.c(gfc_conv_array_parameter).  */
+      if (e && e->ts.type == BT_DERIVED
+	    && e->ts.u.derived->attr.alloc_comp
+	    && !(e->symtree && e->symtree->n.sym->attr.pointer)
+	    && (e->expr_type != EXPR_VARIABLE && !e->rank))
+        {
+	  int parm_rank;
+	  tmp = build_fold_indirect_ref_loc (input_location,
+					 parmse.expr);
+	  parm_rank = e->rank;
+	  switch (parm_kind)
+	    {
+	    case (ELEMENTAL):
+	    case (SCALAR):
+	      parm_rank = 0;
+	      break;
+
+	    case (SCALAR_POINTER):
+              tmp = build_fold_indirect_ref_loc (input_location,
+					     tmp);
+	      break;
+	    }
+
+	  if (e->expr_type == EXPR_OP
+		&& e->value.op.op == INTRINSIC_PARENTHESES
+		&& e->value.op.op1->expr_type == EXPR_VARIABLE)
+	    {
+	      tree local_tmp;
+	      local_tmp = gfc_evaluate_now (tmp, &se->pre);
+	      local_tmp = gfc_copy_alloc_comp (e->ts.u.derived, local_tmp, tmp, parm_rank);
+	      gfc_add_expr_to_block (&se->post, local_tmp);
+	    }
+
+	  tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp, parm_rank);
+
+	  gfc_add_expr_to_block (&se->post, tmp);
+        }
+
+      /* Add argument checking of passing an unallocated/NULL actual to
+         a nonallocatable/nonpointer dummy.  */
+
+      if (gfc_option.rtcheck & GFC_RTCHECK_POINTER && e != NULL)
+        {
+	  symbol_attribute attr;
+	  char *msg;
+	  tree cond;
+
+	  if (e->expr_type == EXPR_VARIABLE || e->expr_type == EXPR_FUNCTION)
+	    attr = gfc_expr_attr (e);
+	  else
+	    goto end_pointer_check;
+
+          if (attr.optional)
+	    {
+              /* If the actual argument is an optional pointer/allocatable and
+		 the formal argument takes an nonpointer optional value,
+		 it is invalid to pass a non-present argument on, even
+		 though there is no technical reason for this in gfortran.
+		 See Fortran 2003, Section 12.4.1.6 item (7)+(8).  */
+	      tree present, null_ptr, type;
+
+	      if (attr.allocatable
+		  && (fsym == NULL || !fsym->attr.allocatable))
+		asprintf (&msg, "Allocatable actual argument '%s' is not "
+			  "allocated or not present", e->symtree->n.sym->name);
+	      else if (attr.pointer
+		       && (fsym == NULL || !fsym->attr.pointer))
+		asprintf (&msg, "Pointer actual argument '%s' is not "
+			  "associated or not present",
+			  e->symtree->n.sym->name);
+	      else if (attr.proc_pointer
+		       && (fsym == NULL || !fsym->attr.proc_pointer))
+		asprintf (&msg, "Proc-pointer actual argument '%s' is not "
+			  "associated or not present",
+			  e->symtree->n.sym->name);
+	      else
+		goto end_pointer_check;
+
+	      present = gfc_conv_expr_present (e->symtree->n.sym);
+	      type = TREE_TYPE (present);
+	      present = fold_build2_loc (input_location, EQ_EXPR,
+					 boolean_type_node, present,
+					 fold_convert (type,
+						       null_pointer_node));
+	      type = TREE_TYPE (parmse.expr);
+	      null_ptr = fold_build2_loc (input_location, EQ_EXPR,
+					  boolean_type_node, parmse.expr,
+					  fold_convert (type,
+							null_pointer_node));
+	      cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
+				      boolean_type_node, present, null_ptr);
+	    }
+          else
+	    {
+	      if (attr.allocatable
+		  && (fsym == NULL || !fsym->attr.allocatable))
+		asprintf (&msg, "Allocatable actual argument '%s' is not "
+		      "allocated", e->symtree->n.sym->name);
+	      else if (attr.pointer
+		       && (fsym == NULL || !fsym->attr.pointer))
+		asprintf (&msg, "Pointer actual argument '%s' is not "
+		      "associated", e->symtree->n.sym->name);
+	      else if (attr.proc_pointer
+		       && (fsym == NULL || !fsym->attr.proc_pointer))
+		asprintf (&msg, "Proc-pointer actual argument '%s' is not "
+		      "associated", e->symtree->n.sym->name);
+	      else
+		goto end_pointer_check;
+
+	      tmp = parmse.expr;
+
+	      /* If the argument is passed by value, we need to strip the
+		 INDIRECT_REF.  */
+	      if (!POINTER_TYPE_P (TREE_TYPE (parmse.expr)))
+		tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+
+	      cond = fold_build2_loc (input_location, EQ_EXPR,
+				      boolean_type_node, tmp,
+				      fold_convert (TREE_TYPE (tmp),
+						    null_pointer_node));
+	    }
+
+	  gfc_trans_runtime_check (true, false, cond, &se->pre, &e->where,
+				   msg);
+	  gfc_free (msg);
+        }
+      end_pointer_check:
+
+      /* Deferred length dummies pass the character length by reference
+	 so that the value can be returned.  */
+      if (parmse.string_length && fsym && fsym->ts.deferred)
+	{
+	  tmp = parmse.string_length;
+	  if (TREE_CODE (tmp) != VAR_DECL)
+	    tmp = gfc_evaluate_now (parmse.string_length, &se->pre);
+	  parmse.string_length = gfc_build_addr_expr (NULL_TREE, tmp);
+	}
+
+      /* Character strings are passed as two parameters, a length and a
+         pointer - except for Bind(c) which only passes the pointer.  */
+      if (parmse.string_length != NULL_TREE && !sym->attr.is_bind_c)
+	VEC_safe_push (tree, gc, stringargs, parmse.string_length);
+
+      VEC_safe_push (tree, gc, arglist, parmse.expr);
+    }
+  gfc_finish_interface_mapping (&mapping, &se->pre, &se->post);
+
+  if (comp)
+    ts = comp->ts;
+  else
+   ts = sym->ts;
+
+  if (ts.type == BT_CHARACTER && sym->attr.is_bind_c)
+    se->string_length = build_int_cst (gfc_charlen_type_node, 1);
+  else if (ts.type == BT_CHARACTER)
+    {
+      if (ts.u.cl->length == NULL)
+	{
+	  /* Assumed character length results are not allowed by 5.1.1.5 of the
+	     standard and are trapped in resolve.c; except in the case of SPREAD
+	     (and other intrinsics?) and dummy functions.  In the case of SPREAD,
+	     we take the character length of the first argument for the result.
+	     For dummies, we have to look through the formal argument list for
+	     this function and use the character length found there.*/
+	  if (ts.deferred && (sym->attr.allocatable || sym->attr.pointer))
+	    cl.backend_decl = gfc_create_var (gfc_charlen_type_node, "slen");
+	  else if (!sym->attr.dummy)
+	    cl.backend_decl = VEC_index (tree, stringargs, 0);
+	  else
+	    {
+	      formal = sym->ns->proc_name->formal;
+	      for (; formal; formal = formal->next)
+		if (strcmp (formal->sym->name, sym->name) == 0)
+		  cl.backend_decl = formal->sym->ts.u.cl->backend_decl;
+	    }
+        }
+      else
+        {
+	  tree tmp;
+
+	  /* Calculate the length of the returned string.  */
+	  gfc_init_se (&parmse, NULL);
+	  if (need_interface_mapping)
+	    gfc_apply_interface_mapping (&mapping, &parmse, ts.u.cl->length);
+	  else
+	    gfc_conv_expr (&parmse, ts.u.cl->length);
+	  gfc_add_block_to_block (&se->pre, &parmse.pre);
+	  gfc_add_block_to_block (&se->post, &parmse.post);
+
+	  tmp = fold_convert (gfc_charlen_type_node, parmse.expr);
+	  tmp = fold_build2_loc (input_location, MAX_EXPR,
+				 gfc_charlen_type_node, tmp,
+				 build_int_cst (gfc_charlen_type_node, 0));
+	  cl.backend_decl = tmp;
+	}
+
+      /* Set up a charlen structure for it.  */
+      cl.next = NULL;
+      cl.length = NULL;
+      ts.u.cl = &cl;
+
+      len = cl.backend_decl;
+    }
+
+  byref = (comp && (comp->attr.dimension || comp->ts.type == BT_CHARACTER))
+	  || (!comp && gfc_return_by_reference (sym));
+  if (byref)
+    {
+      if (se->direct_byref)
+	{
+	  /* Sometimes, too much indirection can be applied; e.g. for
+	     function_result = array_valued_recursive_function.  */
+	  if (TREE_TYPE (TREE_TYPE (se->expr))
+		&& TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr)))
+		&& GFC_DESCRIPTOR_TYPE_P
+			(TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr)))))
+	    se->expr = build_fold_indirect_ref_loc (input_location,
+						se->expr);
+
+	  /* If the lhs of an assignment x = f(..) is allocatable and
+	     f2003 is allowed, we must do the automatic reallocation.
+	     TODO - deal with intrinsics, without using a temporary.  */
+	  if (gfc_option.flag_realloc_lhs
+		&& se->ss && se->ss->loop_chain
+		&& se->ss->loop_chain->is_alloc_lhs
+		&& !expr->value.function.isym
+		&& sym->result->as != NULL)
+	    {
+	      /* Evaluate the bounds of the result, if known.  */
+	      gfc_set_loop_bounds_from_array_spec (&mapping, se,
+						   sym->result->as);
+
+	      /* Perform the automatic reallocation.  */
+	      tmp = gfc_alloc_allocatable_for_assignment (se->loop,
+							  expr, NULL);
+	      gfc_add_expr_to_block (&se->pre, tmp);
+
+	      /* Pass the temporary as the first argument.  */
+	      result = info->descriptor;
+	    }
+	  else
+	    result = build_fold_indirect_ref_loc (input_location,
+						  se->expr);
+	  VEC_safe_push (tree, gc, retargs, se->expr);
+	}
+      else if (comp && comp->attr.dimension)
+	{
+	  gcc_assert (se->loop && info);
+
+	  /* Set the type of the array.  */
+	  tmp = gfc_typenode_for_spec (&comp->ts);
+	  info->dimen = se->loop->dimen;
+
+	  /* Evaluate the bounds of the result, if known.  */
+	  gfc_set_loop_bounds_from_array_spec (&mapping, se, comp->as);
+
+	  /* If the lhs of an assignment x = f(..) is allocatable and
+	     f2003 is allowed, we must not generate the function call
+	     here but should just send back the results of the mapping.
+	     This is signalled by the function ss being flagged.  */
+	  if (gfc_option.flag_realloc_lhs
+		&& se->ss && se->ss->is_alloc_lhs)
+	    {
+	      gfc_free_interface_mapping (&mapping);
+	      return has_alternate_specifier;
+	    }
+
+	  /* Create a temporary to store the result.  In case the function
+	     returns a pointer, the temporary will be a shallow copy and
+	     mustn't be deallocated.  */
+	  callee_alloc = comp->attr.allocatable || comp->attr.pointer;
+	  gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp,
+				       NULL_TREE, false, !comp->attr.pointer,
+				       callee_alloc, &se->ss->expr->where);
+
+	  /* Pass the temporary as the first argument.  */
+	  result = info->descriptor;
+	  tmp = gfc_build_addr_expr (NULL_TREE, result);
+	  VEC_safe_push (tree, gc, retargs, tmp);
+	}
+      else if (!comp && sym->result->attr.dimension)
+	{
+	  gcc_assert (se->loop && info);
+
+	  /* Set the type of the array.  */
+	  tmp = gfc_typenode_for_spec (&ts);
+	  info->dimen = se->loop->dimen;
+
+	  /* Evaluate the bounds of the result, if known.  */
+	  gfc_set_loop_bounds_from_array_spec (&mapping, se, sym->result->as);
+
+	  /* If the lhs of an assignment x = f(..) is allocatable and
+	     f2003 is allowed, we must not generate the function call
+	     here but should just send back the results of the mapping.
+	     This is signalled by the function ss being flagged.  */
+	  if (gfc_option.flag_realloc_lhs
+		&& se->ss && se->ss->is_alloc_lhs)
+	    {
+	      gfc_free_interface_mapping (&mapping);
+	      return has_alternate_specifier;
+	    }
+
+	  /* Create a temporary to store the result.  In case the function
+	     returns a pointer, the temporary will be a shallow copy and
+	     mustn't be deallocated.  */
+	  callee_alloc = sym->attr.allocatable || sym->attr.pointer;
+	  gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp,
+				       NULL_TREE, false, !sym->attr.pointer,
+				       callee_alloc, &se->ss->expr->where);
+
+	  /* Pass the temporary as the first argument.  */
+	  result = info->descriptor;
+	  tmp = gfc_build_addr_expr (NULL_TREE, result);
+	  VEC_safe_push (tree, gc, retargs, tmp);
+	}
+      else if (ts.type == BT_CHARACTER)
+	{
+	  /* Pass the string length.  */
+	  type = gfc_get_character_type (ts.kind, ts.u.cl);
+	  type = build_pointer_type (type);
+
+	  /* Return an address to a char[0:len-1]* temporary for
+	     character pointers.  */
+	  if ((!comp && (sym->attr.pointer || sym->attr.allocatable))
+	       || (comp && (comp->attr.pointer || comp->attr.allocatable)))
+	    {
+	      var = gfc_create_var (type, "pstr");
+
+	      if ((!comp && sym->attr.allocatable)
+		  || (comp && comp->attr.allocatable))
+		gfc_add_modify (&se->pre, var,
+				fold_convert (TREE_TYPE (var),
+					      null_pointer_node));
+
+	      /* Provide an address expression for the function arguments.  */
+	      var = gfc_build_addr_expr (NULL_TREE, var);
+	    }
+	  else
+	    var = gfc_conv_string_tmp (se, type, len);
+
+	  VEC_safe_push (tree, gc, retargs, var);
+	}
+      else
+	{
+	  gcc_assert (gfc_option.flag_f2c && ts.type == BT_COMPLEX);
+
+	  type = gfc_get_complex_type (ts.kind);
+	  var = gfc_build_addr_expr (NULL_TREE, gfc_create_var (type, "cmplx"));
+	  VEC_safe_push (tree, gc, retargs, var);
+	}
+
+      if (ts.type == BT_CHARACTER && ts.deferred
+	    && (sym->attr.allocatable || sym->attr.pointer))
+	{
+	  tmp = len;
+	  if (TREE_CODE (tmp) != VAR_DECL)
+	    tmp = gfc_evaluate_now (len, &se->pre);
+	  len = gfc_build_addr_expr (NULL_TREE, tmp);
+	}
+
+      /* Add the string length to the argument list.  */
+      if (ts.type == BT_CHARACTER)
+	VEC_safe_push (tree, gc, retargs, len);
+    }
+  gfc_free_interface_mapping (&mapping);
+
+  /* We need to glom RETARGS + ARGLIST + STRINGARGS + APPEND_ARGS.  */
+  arglen = (VEC_length (tree, arglist)
+	    + VEC_length (tree, stringargs) + VEC_length (tree, append_args));
+  VEC_reserve_exact (tree, gc, retargs, arglen);
+
+  /* Add the return arguments.  */
+  VEC_splice (tree, retargs, arglist);
+
+  /* Add the hidden string length parameters to the arguments.  */
+  VEC_splice (tree, retargs, stringargs);
+
+  /* We may want to append extra arguments here.  This is used e.g. for
+     calls to libgfortran_matmul_??, which need extra information.  */
+  if (!VEC_empty (tree, append_args))
+    VEC_splice (tree, retargs, append_args);
+  arglist = retargs;
+
+  /* Generate the actual call.  */
+  conv_function_val (se, sym, expr);
+
+  /* If there are alternate return labels, function type should be
+     integer.  Can't modify the type in place though, since it can be shared
+     with other functions.  For dummy arguments, the typing is done to
+     to this result, even if it has to be repeated for each call.  */
+  if (has_alternate_specifier
+      && TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) != integer_type_node)
+    {
+      if (!sym->attr.dummy)
+	{
+	  TREE_TYPE (sym->backend_decl)
+		= build_function_type (integer_type_node,
+		      TYPE_ARG_TYPES (TREE_TYPE (sym->backend_decl)));
+	  se->expr = gfc_build_addr_expr (NULL_TREE, sym->backend_decl);
+	}
+      else
+	TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) = integer_type_node;
+    }
+
+  fntype = TREE_TYPE (TREE_TYPE (se->expr));
+  se->expr = build_call_vec (TREE_TYPE (fntype), se->expr, arglist);
+
+  /* If we have a pointer function, but we don't want a pointer, e.g.
+     something like
+        x = f()
+     where f is pointer valued, we have to dereference the result.  */
+  if (!se->want_pointer && !byref
+      && ((!comp && (sym->attr.pointer || sym->attr.allocatable))
+	  || (comp && (comp->attr.pointer || comp->attr.allocatable))))
+    se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
+
+  /* f2c calling conventions require a scalar default real function to
+     return a double precision result.  Convert this back to default
+     real.  We only care about the cases that can happen in Fortran 77.
+  */
+  if (gfc_option.flag_f2c && sym->ts.type == BT_REAL
+      && sym->ts.kind == gfc_default_real_kind
+      && !sym->attr.always_explicit)
+    se->expr = fold_convert (gfc_get_real_type (sym->ts.kind), se->expr);
+
+  /* A pure function may still have side-effects - it may modify its
+     parameters.  */
+  TREE_SIDE_EFFECTS (se->expr) = 1;
+#if 0
+  if (!sym->attr.pure)
+    TREE_SIDE_EFFECTS (se->expr) = 1;
+#endif
+
+  if (byref)
+    {
+      /* Add the function call to the pre chain.  There is no expression.  */
+      gfc_add_expr_to_block (&se->pre, se->expr);
+      se->expr = NULL_TREE;
+
+      if (!se->direct_byref)
+	{
+	  if ((sym->attr.dimension && !comp) || (comp && comp->attr.dimension))
+	    {
+	      if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+		{
+		  /* Check the data pointer hasn't been modified.  This would
+		     happen in a function returning a pointer.  */
+		  tmp = gfc_conv_descriptor_data_get (info->descriptor);
+		  tmp = fold_build2_loc (input_location, NE_EXPR,
+					 boolean_type_node,
+					 tmp, info->data);
+		  gfc_trans_runtime_check (true, false, tmp, &se->pre, NULL,
+					   gfc_msg_fault);
+		}
+	      se->expr = info->descriptor;
+	      /* Bundle in the string length.  */
+	      se->string_length = len;
+	    }
+	  else if (ts.type == BT_CHARACTER)
+	    {
+	      /* Dereference for character pointer results.  */
+	      if ((!comp && (sym->attr.pointer || sym->attr.allocatable))
+		  || (comp && (comp->attr.pointer || comp->attr.allocatable)))
+		se->expr = build_fold_indirect_ref_loc (input_location, var);
+	      else
+	        se->expr = var;
+
+	      if (!ts.deferred)
+		se->string_length = len;
+	      else if (sym->attr.allocatable || sym->attr.pointer)
+		se->string_length = cl.backend_decl;
+	    }
+	  else
+	    {
+	      gcc_assert (ts.type == BT_COMPLEX && gfc_option.flag_f2c);
+	      se->expr = build_fold_indirect_ref_loc (input_location, var);
+	    }
+	}
+    }
+
+  /* Follow the function call with the argument post block.  */
+  if (byref)
+    {
+      gfc_add_block_to_block (&se->pre, &post);
+
+      /* Transformational functions of derived types with allocatable
+         components must have the result allocatable components copied.  */
+      arg = expr->value.function.actual;
+      if (result && arg && expr->rank
+	    && expr->value.function.isym
+	    && expr->value.function.isym->transformational
+	    && arg->expr->ts.type == BT_DERIVED
+	    && arg->expr->ts.u.derived->attr.alloc_comp)
+	{
+	  tree tmp2;
+	  /* Copy the allocatable components.  We have to use a
+	     temporary here to prevent source allocatable components
+	     from being corrupted.  */
+	  tmp2 = gfc_evaluate_now (result, &se->pre);
+	  tmp = gfc_copy_alloc_comp (arg->expr->ts.u.derived,
+				     result, tmp2, expr->rank);
+	  gfc_add_expr_to_block (&se->pre, tmp);
+	  tmp = gfc_copy_allocatable_data (result, tmp2, TREE_TYPE(tmp2),
+				           expr->rank);
+	  gfc_add_expr_to_block (&se->pre, tmp);
+
+	  /* Finally free the temporary's data field.  */
+	  tmp = gfc_conv_descriptor_data_get (tmp2);
+	  tmp = gfc_deallocate_with_status (tmp, NULL_TREE, true, NULL);
+	  gfc_add_expr_to_block (&se->pre, tmp);
+	}
+    }
+  else
+    gfc_add_block_to_block (&se->post, &post);
+
+  return has_alternate_specifier;
+}
+
+
+/* Fill a character string with spaces.  */
+
+static tree
+fill_with_spaces (tree start, tree type, tree size)
+{
+  stmtblock_t block, loop;
+  tree i, el, exit_label, cond, tmp;
+
+  /* For a simple char type, we can call memset().  */
+  if (compare_tree_int (TYPE_SIZE_UNIT (type), 1) == 0)
+    return build_call_expr_loc (input_location,
+			    built_in_decls[BUILT_IN_MEMSET], 3, start,
+			    build_int_cst (gfc_get_int_type (gfc_c_int_kind),
+					   lang_hooks.to_target_charset (' ')),
+			    size);
+
+  /* Otherwise, we use a loop:
+	for (el = start, i = size; i > 0; el--, i+= TYPE_SIZE_UNIT (type))
+	  *el = (type) ' ';
+   */
+
+  /* Initialize variables.  */
+  gfc_init_block (&block);
+  i = gfc_create_var (sizetype, "i");
+  gfc_add_modify (&block, i, fold_convert (sizetype, size));
+  el = gfc_create_var (build_pointer_type (type), "el");
+  gfc_add_modify (&block, el, fold_convert (TREE_TYPE (el), start));
+  exit_label = gfc_build_label_decl (NULL_TREE);
+  TREE_USED (exit_label) = 1;
+
+
+  /* Loop body.  */
+  gfc_init_block (&loop);
+
+  /* Exit condition.  */
+  cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, i,
+			  build_zero_cst (sizetype));
+  tmp = build1_v (GOTO_EXPR, exit_label);
+  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp,
+			 build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&loop, tmp);
+
+  /* Assignment.  */
+  gfc_add_modify (&loop,
+		  fold_build1_loc (input_location, INDIRECT_REF, type, el),
+		  build_int_cst (type, lang_hooks.to_target_charset (' ')));
+
+  /* Increment loop variables.  */
+  gfc_add_modify (&loop, i,
+		  fold_build2_loc (input_location, MINUS_EXPR, sizetype, i,
+				   TYPE_SIZE_UNIT (type)));
+  gfc_add_modify (&loop, el,
+		  fold_build2_loc (input_location, POINTER_PLUS_EXPR,
+				   TREE_TYPE (el), el, TYPE_SIZE_UNIT (type)));
+
+  /* Making the loop... actually loop!  */
+  tmp = gfc_finish_block (&loop);
+  tmp = build1_v (LOOP_EXPR, tmp);
+  gfc_add_expr_to_block (&block, tmp);
+
+  /* The exit label.  */
+  tmp = build1_v (LABEL_EXPR, exit_label);
+  gfc_add_expr_to_block (&block, tmp);
+
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Generate code to copy a string.  */
+
+void
+gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
+		       int dkind, tree slength, tree src, int skind)
+{
+  tree tmp, dlen, slen;
+  tree dsc;
+  tree ssc;
+  tree cond;
+  tree cond2;
+  tree tmp2;
+  tree tmp3;
+  tree tmp4;
+  tree chartype;
+  stmtblock_t tempblock;
+
+  gcc_assert (dkind == skind);
+
+  if (slength != NULL_TREE)
+    {
+      slen = fold_convert (size_type_node, gfc_evaluate_now (slength, block));
+      ssc = gfc_string_to_single_character (slen, src, skind);
+    }
+  else
+    {
+      slen = build_int_cst (size_type_node, 1);
+      ssc =  src;
+    }
+
+  if (dlength != NULL_TREE)
+    {
+      dlen = fold_convert (size_type_node, gfc_evaluate_now (dlength, block));
+      dsc = gfc_string_to_single_character (dlen, dest, dkind);
+    }
+  else
+    {
+      dlen = build_int_cst (size_type_node, 1);
+      dsc =  dest;
+    }
+
+  /* Assign directly if the types are compatible.  */
+  if (dsc != NULL_TREE && ssc != NULL_TREE
+      && TREE_TYPE (dsc) == TREE_TYPE (ssc))
+    {
+      gfc_add_modify (block, dsc, ssc);
+      return;
+    }
+
+  /* Do nothing if the destination length is zero.  */
+  cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, dlen,
+			  build_int_cst (size_type_node, 0));
+
+  /* The following code was previously in _gfortran_copy_string:
+
+       // The two strings may overlap so we use memmove.
+       void
+       copy_string (GFC_INTEGER_4 destlen, char * dest,
+                    GFC_INTEGER_4 srclen, const char * src)
+       {
+         if (srclen >= destlen)
+           {
+             // This will truncate if too long.
+             memmove (dest, src, destlen);
+           }
+         else
+           {
+             memmove (dest, src, srclen);
+             // Pad with spaces.
+             memset (&dest[srclen], ' ', destlen - srclen);
+           }
+       }
+
+     We're now doing it here for better optimization, but the logic
+     is the same.  */
+
+  /* For non-default character kinds, we have to multiply the string
+     length by the base type size.  */
+  chartype = gfc_get_char_type (dkind);
+  slen = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+			  fold_convert (size_type_node, slen),
+			  fold_convert (size_type_node,
+					TYPE_SIZE_UNIT (chartype)));
+  dlen = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+			  fold_convert (size_type_node, dlen),
+			  fold_convert (size_type_node,
+					TYPE_SIZE_UNIT (chartype)));
+
+  if (dlength && POINTER_TYPE_P (TREE_TYPE (dest)))
+    dest = fold_convert (pvoid_type_node, dest);
+  else
+    dest = gfc_build_addr_expr (pvoid_type_node, dest);
+
+  if (slength && POINTER_TYPE_P (TREE_TYPE (src)))
+    src = fold_convert (pvoid_type_node, src);
+  else
+    src = gfc_build_addr_expr (pvoid_type_node, src);
+
+  /* Truncate string if source is too long.  */
+  cond2 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, slen,
+			   dlen);
+  tmp2 = build_call_expr_loc (input_location,
+			  built_in_decls[BUILT_IN_MEMMOVE],
+			  3, dest, src, dlen);
+
+  /* Else copy and pad with spaces.  */
+  tmp3 = build_call_expr_loc (input_location,
+			  built_in_decls[BUILT_IN_MEMMOVE],
+			  3, dest, src, slen);
+
+  tmp4 = fold_build2_loc (input_location, POINTER_PLUS_EXPR, TREE_TYPE (dest),
+			  dest, fold_convert (sizetype, slen));
+  tmp4 = fill_with_spaces (tmp4, chartype,
+			   fold_build2_loc (input_location, MINUS_EXPR,
+					    TREE_TYPE(dlen), dlen, slen));
+
+  gfc_init_block (&tempblock);
+  gfc_add_expr_to_block (&tempblock, tmp3);
+  gfc_add_expr_to_block (&tempblock, tmp4);
+  tmp3 = gfc_finish_block (&tempblock);
+
+  /* The whole copy_string function is there.  */
+  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond2,
+			 tmp2, tmp3);
+  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp,
+			 build_empty_stmt (input_location));
+  gfc_add_expr_to_block (block, tmp);
+}
+
+
+/* Translate a statement function.
+   The value of a statement function reference is obtained by evaluating the
+   expression using the values of the actual arguments for the values of the
+   corresponding dummy arguments.  */
+
+static void
+gfc_conv_statement_function (gfc_se * se, gfc_expr * expr)
+{
+  gfc_symbol *sym;
+  gfc_symbol *fsym;
+  gfc_formal_arglist *fargs;
+  gfc_actual_arglist *args;
+  gfc_se lse;
+  gfc_se rse;
+  gfc_saved_var *saved_vars;
+  tree *temp_vars;
+  tree type;
+  tree tmp;
+  int n;
+
+  sym = expr->symtree->n.sym;
+  args = expr->value.function.actual;
+  gfc_init_se (&lse, NULL);
+  gfc_init_se (&rse, NULL);
+
+  n = 0;
+  for (fargs = sym->formal; fargs; fargs = fargs->next)
+    n++;
+  saved_vars = (gfc_saved_var *)gfc_getmem (n * sizeof (gfc_saved_var));
+  temp_vars = (tree *)gfc_getmem (n * sizeof (tree));
+
+  for (fargs = sym->formal, n = 0; fargs; fargs = fargs->next, n++)
+    {
+      /* Each dummy shall be specified, explicitly or implicitly, to be
+         scalar.  */
+      gcc_assert (fargs->sym->attr.dimension == 0);
+      fsym = fargs->sym;
+
+      if (fsym->ts.type == BT_CHARACTER)
+        {
+	  /* Copy string arguments.  */
+	  tree arglen;
+
+	  gcc_assert (fsym->ts.u.cl && fsym->ts.u.cl->length
+		      && fsym->ts.u.cl->length->expr_type == EXPR_CONSTANT);
+
+	  /* Create a temporary to hold the value.  */
+          if (fsym->ts.u.cl->backend_decl == NULL_TREE)
+	     fsym->ts.u.cl->backend_decl
+		= gfc_conv_constant_to_tree (fsym->ts.u.cl->length);
+
+	  type = gfc_get_character_type (fsym->ts.kind, fsym->ts.u.cl);
+	  temp_vars[n] = gfc_create_var (type, fsym->name);
+
+	  arglen = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
+
+	  gfc_conv_expr (&rse, args->expr);
+	  gfc_conv_string_parameter (&rse);
+	  gfc_add_block_to_block (&se->pre, &lse.pre);
+	  gfc_add_block_to_block (&se->pre, &rse.pre);
+
+	  gfc_trans_string_copy (&se->pre, arglen, temp_vars[n], fsym->ts.kind,
+				 rse.string_length, rse.expr, fsym->ts.kind);
+	  gfc_add_block_to_block (&se->pre, &lse.post);
+	  gfc_add_block_to_block (&se->pre, &rse.post);
+        }
+      else
+        {
+          /* For everything else, just evaluate the expression.  */
+
+	  /* Create a temporary to hold the value.  */
+	  type = gfc_typenode_for_spec (&fsym->ts);
+	  temp_vars[n] = gfc_create_var (type, fsym->name);
+
+          gfc_conv_expr (&lse, args->expr);
+
+          gfc_add_block_to_block (&se->pre, &lse.pre);
+          gfc_add_modify (&se->pre, temp_vars[n], lse.expr);
+          gfc_add_block_to_block (&se->pre, &lse.post);
+        }
+
+      args = args->next;
+    }
+
+  /* Use the temporary variables in place of the real ones.  */
+  for (fargs = sym->formal, n = 0; fargs; fargs = fargs->next, n++)
+    gfc_shadow_sym (fargs->sym, temp_vars[n], &saved_vars[n]);
+
+  gfc_conv_expr (se, sym->value);
+
+  if (sym->ts.type == BT_CHARACTER)
+    {
+      gfc_conv_const_charlen (sym->ts.u.cl);
+
+      /* Force the expression to the correct length.  */
+      if (!INTEGER_CST_P (se->string_length)
+	  || tree_int_cst_lt (se->string_length,
+			      sym->ts.u.cl->backend_decl))
+	{
+	  type = gfc_get_character_type (sym->ts.kind, sym->ts.u.cl);
+	  tmp = gfc_create_var (type, sym->name);
+	  tmp = gfc_build_addr_expr (build_pointer_type (type), tmp);
+	  gfc_trans_string_copy (&se->pre, sym->ts.u.cl->backend_decl, tmp,
+				 sym->ts.kind, se->string_length, se->expr,
+				 sym->ts.kind);
+	  se->expr = tmp;
+	}
+      se->string_length = sym->ts.u.cl->backend_decl;
+    }
+
+  /* Restore the original variables.  */
+  for (fargs = sym->formal, n = 0; fargs; fargs = fargs->next, n++)
+    gfc_restore_sym (fargs->sym, &saved_vars[n]);
+  gfc_free (saved_vars);
+}
+
+
+/* Translate a function expression.  */
+
+static void
+gfc_conv_function_expr (gfc_se * se, gfc_expr * expr)
+{
+  gfc_symbol *sym;
+
+  if (expr->value.function.isym)
+    {
+      gfc_conv_intrinsic_function (se, expr);
+      return;
+    }
+
+  /* expr.value.function.esym is the resolved (specific) function symbol for
+     most functions.  However this isn't set for dummy procedures.  */
+  sym = expr->value.function.esym;
+  if (!sym)
+    sym = expr->symtree->n.sym;
+
+  /* We distinguish statement functions from general functions to improve
+     runtime performance.  */
+  if (sym->attr.proc == PROC_ST_FUNCTION)
+    {
+      gfc_conv_statement_function (se, expr);
+      return;
+    }
+
+  gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr, NULL);
+}
+
+
+/* Determine whether the given EXPR_CONSTANT is a zero initializer.  */
+
+static bool
+is_zero_initializer_p (gfc_expr * expr)
+{
+  if (expr->expr_type != EXPR_CONSTANT)
+    return false;
+
+  /* We ignore constants with prescribed memory representations for now.  */
+  if (expr->representation.string)
+    return false;
+
+  switch (expr->ts.type)
+    {
+    case BT_INTEGER:
+      return mpz_cmp_si (expr->value.integer, 0) == 0;
+
+    case BT_REAL:
+      return mpfr_zero_p (expr->value.real)
+	     && MPFR_SIGN (expr->value.real) >= 0;
+
+    case BT_LOGICAL:
+      return expr->value.logical == 0;
+
+    case BT_COMPLEX:
+      return mpfr_zero_p (mpc_realref (expr->value.complex))
+	     && MPFR_SIGN (mpc_realref (expr->value.complex)) >= 0
+             && mpfr_zero_p (mpc_imagref (expr->value.complex))
+	     && MPFR_SIGN (mpc_imagref (expr->value.complex)) >= 0;
+
+    default:
+      break;
+    }
+  return false;
+}
+
+
+static void
+gfc_conv_array_constructor_expr (gfc_se * se, gfc_expr * expr)
+{
+  gcc_assert (se->ss != NULL && se->ss != gfc_ss_terminator);
+  gcc_assert (se->ss->expr == expr && se->ss->type == GFC_SS_CONSTRUCTOR);
+
+  gfc_conv_tmp_array_ref (se);
+}
+
+
+/* Build a static initializer.  EXPR is the expression for the initial value.
+   The other parameters describe the variable of the component being
+   initialized. EXPR may be null.  */
+
+tree
+gfc_conv_initializer (gfc_expr * expr, gfc_typespec * ts, tree type,
+		      bool array, bool pointer, bool procptr)
+{
+  gfc_se se;
+
+  if (!(expr || pointer || procptr))
+    return NULL_TREE;
+
+  /* Check if we have ISOCBINDING_NULL_PTR or ISOCBINDING_NULL_FUNPTR
+     (these are the only two iso_c_binding derived types that can be
+     used as initialization expressions).  If so, we need to modify
+     the 'expr' to be that for a (void *).  */
+  if (expr != NULL && expr->ts.type == BT_DERIVED
+      && expr->ts.is_iso_c && expr->ts.u.derived)
+    {
+      gfc_symbol *derived = expr->ts.u.derived;
+
+      /* The derived symbol has already been converted to a (void *).  Use
+	 its kind.  */
+      expr = gfc_get_int_expr (derived->ts.kind, NULL, 0);
+      expr->ts.f90_type = derived->ts.f90_type;
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_constant (&se, expr);
+      gcc_assert (TREE_CODE (se.expr) != CONSTRUCTOR);
+      return se.expr;
+    }
+
+  if (array && !procptr)
+    {
+      tree ctor;
+      /* Arrays need special handling.  */
+      if (pointer)
+	ctor = gfc_build_null_descriptor (type);
+      /* Special case assigning an array to zero.  */
+      else if (is_zero_initializer_p (expr))
+        ctor = build_constructor (type, NULL);
+      else
+	ctor = gfc_conv_array_initializer (type, expr);
+      TREE_STATIC (ctor) = 1;
+      return ctor;
+    }
+  else if (pointer || procptr)
+    {
+      if (!expr || expr->expr_type == EXPR_NULL)
+	return fold_convert (type, null_pointer_node);
+      else
+	{
+	  gfc_init_se (&se, NULL);
+	  se.want_pointer = 1;
+	  gfc_conv_expr (&se, expr);
+          gcc_assert (TREE_CODE (se.expr) != CONSTRUCTOR);
+	  return se.expr;
+	}
+    }
+  else
+    {
+      switch (ts->type)
+	{
+	case BT_DERIVED:
+	case BT_CLASS:
+	  gfc_init_se (&se, NULL);
+	  if (ts->type == BT_CLASS && expr->expr_type == EXPR_NULL)
+	    gfc_conv_structure (&se, gfc_class_null_initializer(ts), 1);
+	  else
+	    gfc_conv_structure (&se, expr, 1);
+	  gcc_assert (TREE_CODE (se.expr) == CONSTRUCTOR);
+	  TREE_STATIC (se.expr) = 1;
+	  return se.expr;
+
+	case BT_CHARACTER:
+	  {
+	    tree ctor = gfc_conv_string_init (ts->u.cl->backend_decl,expr);
+	    TREE_STATIC (ctor) = 1;
+	    return ctor;
+	  }
+
+	default:
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_constant (&se, expr);
+	  gcc_assert (TREE_CODE (se.expr) != CONSTRUCTOR);
+	  return se.expr;
+	}
+    }
+}
+
+static tree
+gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr)
+{
+  gfc_se rse;
+  gfc_se lse;
+  gfc_ss *rss;
+  gfc_ss *lss;
+  stmtblock_t body;
+  stmtblock_t block;
+  gfc_loopinfo loop;
+  int n;
+  tree tmp;
+
+  gfc_start_block (&block);
+
+  /* Initialize the scalarizer.  */
+  gfc_init_loopinfo (&loop);
+
+  gfc_init_se (&lse, NULL);
+  gfc_init_se (&rse, NULL);
+
+  /* Walk the rhs.  */
+  rss = gfc_walk_expr (expr);
+  if (rss == gfc_ss_terminator)
+    {
+      /* The rhs is scalar.  Add a ss for the expression.  */
+      rss = gfc_get_ss ();
+      rss->next = gfc_ss_terminator;
+      rss->type = GFC_SS_SCALAR;
+      rss->expr = expr;
+    }
+
+  /* Create a SS for the destination.  */
+  lss = gfc_get_ss ();
+  lss->type = GFC_SS_COMPONENT;
+  lss->expr = NULL;
+  lss->shape = gfc_get_shape (cm->as->rank);
+  lss->next = gfc_ss_terminator;
+  lss->data.info.dimen = cm->as->rank;
+  lss->data.info.descriptor = dest;
+  lss->data.info.data = gfc_conv_array_data (dest);
+  lss->data.info.offset = gfc_conv_array_offset (dest);
+  for (n = 0; n < cm->as->rank; n++)
+    {
+      lss->data.info.dim[n] = n;
+      lss->data.info.start[n] = gfc_conv_array_lbound (dest, n);
+      lss->data.info.stride[n] = gfc_index_one_node;
+
+      mpz_init (lss->shape[n]);
+      mpz_sub (lss->shape[n], cm->as->upper[n]->value.integer,
+	       cm->as->lower[n]->value.integer);
+      mpz_add_ui (lss->shape[n], lss->shape[n], 1);
+    }
+
+  /* Associate the SS with the loop.  */
+  gfc_add_ss_to_loop (&loop, lss);
+  gfc_add_ss_to_loop (&loop, rss);
+
+  /* Calculate the bounds of the scalarization.  */
+  gfc_conv_ss_startstride (&loop);
+
+  /* Setup the scalarizing loops.  */
+  gfc_conv_loop_setup (&loop, &expr->where);
+
+  /* Setup the gfc_se structures.  */
+  gfc_copy_loopinfo_to_se (&lse, &loop);
+  gfc_copy_loopinfo_to_se (&rse, &loop);
+
+  rse.ss = rss;
+  gfc_mark_ss_chain_used (rss, 1);
+  lse.ss = lss;
+  gfc_mark_ss_chain_used (lss, 1);
+
+  /* Start the scalarized loop body.  */
+  gfc_start_scalarized_body (&loop, &body);
+
+  gfc_conv_tmp_array_ref (&lse);
+  if (cm->ts.type == BT_CHARACTER)
+    lse.string_length = cm->ts.u.cl->backend_decl;
+
+  gfc_conv_expr (&rse, expr);
+
+  tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts, true, false, true);
+  gfc_add_expr_to_block (&body, tmp);
+
+  gcc_assert (rse.ss == gfc_ss_terminator);
+
+  /* Generate the copying loops.  */
+  gfc_trans_scalarizing_loops (&loop, &body);
+
+  /* Wrap the whole thing up.  */
+  gfc_add_block_to_block (&block, &loop.pre);
+  gfc_add_block_to_block (&block, &loop.post);
+
+  gcc_assert (lss->shape != NULL);
+  gfc_free_shape (&lss->shape, cm->as->rank);
+  gfc_cleanup_loop (&loop);
+
+  return gfc_finish_block (&block);
+}
+
+
+static tree
+gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
+				 gfc_expr * expr)
+{
+  gfc_se se;
+  gfc_ss *rss;
+  stmtblock_t block;
+  tree offset;
+  int n;
+  tree tmp;
+  tree tmp2;
+  gfc_array_spec *as;
+  gfc_expr *arg = NULL;
+
+  gfc_start_block (&block);
+  gfc_init_se (&se, NULL);
+
+  /* Get the descriptor for the expressions.  */
+  rss = gfc_walk_expr (expr);
+  se.want_pointer = 0;
+  gfc_conv_expr_descriptor (&se, expr, rss);
+  gfc_add_block_to_block (&block, &se.pre);
+  gfc_add_modify (&block, dest, se.expr);
+
+  /* Deal with arrays of derived types with allocatable components.  */
+  if (cm->ts.type == BT_DERIVED
+	&& cm->ts.u.derived->attr.alloc_comp)
+    tmp = gfc_copy_alloc_comp (cm->ts.u.derived,
+			       se.expr, dest,
+			       cm->as->rank);
+  else
+    tmp = gfc_duplicate_allocatable (dest, se.expr,
+				     TREE_TYPE(cm->backend_decl),
+				     cm->as->rank);
+
+  gfc_add_expr_to_block (&block, tmp);
+  gfc_add_block_to_block (&block, &se.post);
+
+  if (expr->expr_type != EXPR_VARIABLE)
+    gfc_conv_descriptor_data_set (&block, se.expr,
+				  null_pointer_node);
+
+  /* We need to know if the argument of a conversion function is a
+     variable, so that the correct lower bound can be used.  */
+  if (expr->expr_type == EXPR_FUNCTION
+	&& expr->value.function.isym
+	&& expr->value.function.isym->conversion
+	&& expr->value.function.actual->expr
+	&& expr->value.function.actual->expr->expr_type == EXPR_VARIABLE)
+    arg = expr->value.function.actual->expr;
+
+  /* Obtain the array spec of full array references.  */
+  if (arg)
+    as = gfc_get_full_arrayspec_from_expr (arg);
+  else
+    as = gfc_get_full_arrayspec_from_expr (expr);
+
+  /* Shift the lbound and ubound of temporaries to being unity,
+     rather than zero, based. Always calculate the offset.  */
+  offset = gfc_conv_descriptor_offset_get (dest);
+  gfc_add_modify (&block, offset, gfc_index_zero_node);
+  tmp2 =gfc_create_var (gfc_array_index_type, NULL);
+
+  for (n = 0; n < expr->rank; n++)
+    {
+      tree span;
+      tree lbound;
+
+      /* Obtain the correct lbound - ISO/IEC TR 15581:2001 page 9.
+	 TODO It looks as if gfc_conv_expr_descriptor should return
+	 the correct bounds and that the following should not be
+	 necessary.  This would simplify gfc_conv_intrinsic_bound
+	 as well.  */
+      if (as && as->lower[n])
+	{
+	  gfc_se lbse;
+	  gfc_init_se (&lbse, NULL);
+	  gfc_conv_expr (&lbse, as->lower[n]);
+	  gfc_add_block_to_block (&block, &lbse.pre);
+	  lbound = gfc_evaluate_now (lbse.expr, &block);
+	}
+      else if (as && arg)
+	{
+	  tmp = gfc_get_symbol_decl (arg->symtree->n.sym);
+	  lbound = gfc_conv_descriptor_lbound_get (tmp,
+					gfc_rank_cst[n]);
+	}
+      else if (as)
+	lbound = gfc_conv_descriptor_lbound_get (dest,
+						gfc_rank_cst[n]);
+      else
+	lbound = gfc_index_one_node;
+
+      lbound = fold_convert (gfc_array_index_type, lbound);
+
+      /* Shift the bounds and set the offset accordingly.  */
+      tmp = gfc_conv_descriptor_ubound_get (dest, gfc_rank_cst[n]);
+      span = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+		tmp, gfc_conv_descriptor_lbound_get (dest, gfc_rank_cst[n]));
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     span, lbound);
+      gfc_conv_descriptor_ubound_set (&block, dest,
+				      gfc_rank_cst[n], tmp);
+      gfc_conv_descriptor_lbound_set (&block, dest,
+				      gfc_rank_cst[n], lbound);
+
+      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			 gfc_conv_descriptor_lbound_get (dest,
+							 gfc_rank_cst[n]),
+			 gfc_conv_descriptor_stride_get (dest,
+							 gfc_rank_cst[n]));
+      gfc_add_modify (&block, tmp2, tmp);
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     offset, tmp2);
+      gfc_conv_descriptor_offset_set (&block, dest, tmp);
+    }
+
+  if (arg)
+    {
+      /* If a conversion expression has a null data pointer
+	 argument, nullify the allocatable component.  */
+      tree non_null_expr;
+      tree null_expr;
+
+      if (arg->symtree->n.sym->attr.allocatable
+	    || arg->symtree->n.sym->attr.pointer)
+	{
+	  non_null_expr = gfc_finish_block (&block);
+	  gfc_start_block (&block);
+	  gfc_conv_descriptor_data_set (&block, dest,
+					null_pointer_node);
+	  null_expr = gfc_finish_block (&block);
+	  tmp = gfc_conv_descriptor_data_get (arg->symtree->n.sym->backend_decl);
+	  tmp = build2_loc (input_location, EQ_EXPR, boolean_type_node, tmp,
+			    fold_convert (TREE_TYPE (tmp), null_pointer_node));
+	  return build3_v (COND_EXPR, tmp,
+			   null_expr, non_null_expr);
+	}
+    }
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Assign a single component of a derived type constructor.  */
+
+static tree
+gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr)
+{
+  gfc_se se;
+  gfc_se lse;
+  gfc_ss *rss;
+  stmtblock_t block;
+  tree tmp;
+
+  gfc_start_block (&block);
+
+  if (cm->attr.pointer)
+    {
+      gfc_init_se (&se, NULL);
+      /* Pointer component.  */
+      if (cm->attr.dimension)
+	{
+	  /* Array pointer.  */
+	  if (expr->expr_type == EXPR_NULL)
+	    gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
+	  else
+	    {
+	      rss = gfc_walk_expr (expr);
+	      se.direct_byref = 1;
+	      se.expr = dest;
+	      gfc_conv_expr_descriptor (&se, expr, rss);
+	      gfc_add_block_to_block (&block, &se.pre);
+	      gfc_add_block_to_block (&block, &se.post);
+	    }
+	}
+      else
+	{
+	  /* Scalar pointers.  */
+	  se.want_pointer = 1;
+	  gfc_conv_expr (&se, expr);
+	  gfc_add_block_to_block (&block, &se.pre);
+	  gfc_add_modify (&block, dest,
+			       fold_convert (TREE_TYPE (dest), se.expr));
+	  gfc_add_block_to_block (&block, &se.post);
+	}
+    }
+  else if (cm->ts.type == BT_CLASS && expr->expr_type == EXPR_NULL)
+    {
+      /* NULL initialization for CLASS components.  */
+      tmp = gfc_trans_structure_assign (dest,
+					gfc_class_null_initializer (&cm->ts));
+      gfc_add_expr_to_block (&block, tmp);
+    }
+  else if (cm->attr.dimension && !cm->attr.proc_pointer)
+    {
+      if (cm->attr.allocatable && expr->expr_type == EXPR_NULL)
+ 	gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
+      else if (cm->attr.allocatable)
+	{
+	  tmp = gfc_trans_alloc_subarray_assign (dest, cm, expr);
+	  gfc_add_expr_to_block (&block, tmp);
+	}
+      else
+	{
+	  tmp = gfc_trans_subarray_assign (dest, cm, expr);
+	  gfc_add_expr_to_block (&block, tmp);
+	}
+    }
+  else if (expr->ts.type == BT_DERIVED)
+    {
+      if (expr->expr_type != EXPR_STRUCTURE)
+	{
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr (&se, expr);
+	  gfc_add_block_to_block (&block, &se.pre);
+	  gfc_add_modify (&block, dest,
+			       fold_convert (TREE_TYPE (dest), se.expr));
+	  gfc_add_block_to_block (&block, &se.post);
+	}
+      else
+	{
+	  /* Nested constructors.  */
+	  tmp = gfc_trans_structure_assign (dest, expr);
+	  gfc_add_expr_to_block (&block, tmp);
+	}
+    }
+  else
+    {
+      /* Scalar component.  */
+      gfc_init_se (&se, NULL);
+      gfc_init_se (&lse, NULL);
+
+      gfc_conv_expr (&se, expr);
+      if (cm->ts.type == BT_CHARACTER)
+	lse.string_length = cm->ts.u.cl->backend_decl;
+      lse.expr = dest;
+      tmp = gfc_trans_scalar_assign (&lse, &se, cm->ts, true, false, true);
+      gfc_add_expr_to_block (&block, tmp);
+    }
+  return gfc_finish_block (&block);
+}
+
+/* Assign a derived type constructor to a variable.  */
+
+static tree
+gfc_trans_structure_assign (tree dest, gfc_expr * expr)
+{
+  gfc_constructor *c;
+  gfc_component *cm;
+  stmtblock_t block;
+  tree field;
+  tree tmp;
+
+  gfc_start_block (&block);
+  cm = expr->ts.u.derived->components;
+
+  if (expr->ts.u.derived->from_intmod == INTMOD_ISO_C_BINDING
+      && (expr->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR
+          || expr->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR))
+    {
+      gfc_se se, lse;
+
+      gcc_assert (cm->backend_decl == NULL);
+      gfc_init_se (&se, NULL);
+      gfc_init_se (&lse, NULL);
+      gfc_conv_expr (&se, gfc_constructor_first (expr->value.constructor)->expr);
+      lse.expr = dest;
+      gfc_add_modify (&block, lse.expr,
+		      fold_convert (TREE_TYPE (lse.expr), se.expr));
+
+      return gfc_finish_block (&block);
+    }
+
+  for (c = gfc_constructor_first (expr->value.constructor);
+       c; c = gfc_constructor_next (c), cm = cm->next)
+    {
+      /* Skip absent members in default initializers.  */
+      if (!c->expr)
+	continue;
+
+      field = cm->backend_decl;
+      tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
+			     dest, field, NULL_TREE);
+      tmp = gfc_trans_subcomponent_assign (tmp, cm, c->expr);
+      gfc_add_expr_to_block (&block, tmp);
+    }
+  return gfc_finish_block (&block);
+}
+
+/* Build an expression for a constructor. If init is nonzero then
+   this is part of a static variable initializer.  */
+
+void
+gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init)
+{
+  gfc_constructor *c;
+  gfc_component *cm;
+  tree val;
+  tree type;
+  tree tmp;
+  VEC(constructor_elt,gc) *v = NULL;
+
+  gcc_assert (se->ss == NULL);
+  gcc_assert (expr->expr_type == EXPR_STRUCTURE);
+  type = gfc_typenode_for_spec (&expr->ts);
+
+  if (!init)
+    {
+      /* Create a temporary variable and fill it in.  */
+      se->expr = gfc_create_var (type, expr->ts.u.derived->name);
+      tmp = gfc_trans_structure_assign (se->expr, expr);
+      gfc_add_expr_to_block (&se->pre, tmp);
+      return;
+    }
+
+  cm = expr->ts.u.derived->components;
+
+  for (c = gfc_constructor_first (expr->value.constructor);
+       c; c = gfc_constructor_next (c), cm = cm->next)
+    {
+      /* Skip absent members in default initializers and allocatable
+	 components.  Although the latter have a default initializer
+	 of EXPR_NULL,... by default, the static nullify is not needed
+	 since this is done every time we come into scope.  */
+      if (!c->expr || (cm->attr.allocatable && cm->attr.flavor != FL_PROCEDURE))
+        continue;
+
+      if (strcmp (cm->name, "_size") == 0)
+	{
+	  val = TYPE_SIZE_UNIT (gfc_get_derived_type (cm->ts.u.derived));
+	  CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val);
+	}
+      else if (cm->initializer && cm->initializer->expr_type != EXPR_NULL
+	       && strcmp (cm->name, "_extends") == 0)
+	{
+	  tree vtab;
+	  gfc_symbol *vtabs;
+	  vtabs = cm->initializer->symtree->n.sym;
+	  vtab = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtabs));
+	  CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, vtab);
+	}
+      else
+	{
+	  val = gfc_conv_initializer (c->expr, &cm->ts,
+				      TREE_TYPE (cm->backend_decl),
+				      cm->attr.dimension, cm->attr.pointer,
+				      cm->attr.proc_pointer);
+
+	  /* Append it to the constructor list.  */
+	  CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val);
+	}
+    }
+  se->expr = build_constructor (type, v);
+  if (init)
+    TREE_CONSTANT (se->expr) = 1;
+}
+
+
+/* Translate a substring expression.  */
+
+static void
+gfc_conv_substring_expr (gfc_se * se, gfc_expr * expr)
+{
+  gfc_ref *ref;
+
+  ref = expr->ref;
+
+  gcc_assert (ref == NULL || ref->type == REF_SUBSTRING);
+
+  se->expr = gfc_build_wide_string_const (expr->ts.kind,
+					  expr->value.character.length,
+					  expr->value.character.string);
+
+  se->string_length = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (se->expr)));
+  TYPE_STRING_FLAG (TREE_TYPE (se->expr)) = 1;
+
+  if (ref)
+    gfc_conv_substring (se, ref, expr->ts.kind, NULL, &expr->where);
+}
+
+
+/* Entry point for expression translation.  Evaluates a scalar quantity.
+   EXPR is the expression to be translated, and SE is the state structure if
+   called from within the scalarized.  */
+
+void
+gfc_conv_expr (gfc_se * se, gfc_expr * expr)
+{
+  if (se->ss && se->ss->expr == expr
+      && (se->ss->type == GFC_SS_SCALAR || se->ss->type == GFC_SS_REFERENCE))
+    {
+      /* Substitute a scalar expression evaluated outside the scalarization
+         loop.  */
+      se->expr = se->ss->data.scalar.expr;
+      if (se->ss->type == GFC_SS_REFERENCE)
+	se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
+      se->string_length = se->ss->string_length;
+      gfc_advance_se_ss_chain (se);
+      return;
+    }
+
+  /* We need to convert the expressions for the iso_c_binding derived types.
+     C_NULL_PTR and C_NULL_FUNPTR will be made EXPR_NULL, which evaluates to
+     null_pointer_node.  C_PTR and C_FUNPTR are converted to match the
+     typespec for the C_PTR and C_FUNPTR symbols, which has already been
+     updated to be an integer with a kind equal to the size of a (void *).  */
+  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived
+      && expr->ts.u.derived->attr.is_iso_c)
+    {
+      if (expr->expr_type == EXPR_VARIABLE
+	  && (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR
+	      || expr->symtree->n.sym->intmod_sym_id
+		 == ISOCBINDING_NULL_FUNPTR))
+        {
+	  /* Set expr_type to EXPR_NULL, which will result in
+	     null_pointer_node being used below.  */
+          expr->expr_type = EXPR_NULL;
+        }
+      else
+        {
+          /* Update the type/kind of the expression to be what the new
+             type/kind are for the updated symbols of C_PTR/C_FUNPTR.  */
+          expr->ts.type = expr->ts.u.derived->ts.type;
+          expr->ts.f90_type = expr->ts.u.derived->ts.f90_type;
+          expr->ts.kind = expr->ts.u.derived->ts.kind;
+        }
+    }
+
+  switch (expr->expr_type)
+    {
+    case EXPR_OP:
+      gfc_conv_expr_op (se, expr);
+      break;
+
+    case EXPR_FUNCTION:
+      gfc_conv_function_expr (se, expr);
+      break;
+
+    case EXPR_CONSTANT:
+      gfc_conv_constant (se, expr);
+      break;
+
+    case EXPR_VARIABLE:
+      gfc_conv_variable (se, expr);
+      break;
+
+    case EXPR_NULL:
+      se->expr = null_pointer_node;
+      break;
+
+    case EXPR_SUBSTRING:
+      gfc_conv_substring_expr (se, expr);
+      break;
+
+    case EXPR_STRUCTURE:
+      gfc_conv_structure (se, expr, 0);
+      break;
+
+    case EXPR_ARRAY:
+      gfc_conv_array_constructor_expr (se, expr);
+      break;
+
+    default:
+      gcc_unreachable ();
+      break;
+    }
+}
+
+/* Like gfc_conv_expr_val, but the value is also suitable for use in the lhs
+   of an assignment.  */
+void
+gfc_conv_expr_lhs (gfc_se * se, gfc_expr * expr)
+{
+  gfc_conv_expr (se, expr);
+  /* All numeric lvalues should have empty post chains.  If not we need to
+     figure out a way of rewriting an lvalue so that it has no post chain.  */
+  gcc_assert (expr->ts.type == BT_CHARACTER || !se->post.head);
+}
+
+/* Like gfc_conv_expr, but the POST block is guaranteed to be empty for
+   numeric expressions.  Used for scalar values where inserting cleanup code
+   is inconvenient.  */
+void
+gfc_conv_expr_val (gfc_se * se, gfc_expr * expr)
+{
+  tree val;
+
+  gcc_assert (expr->ts.type != BT_CHARACTER);
+  gfc_conv_expr (se, expr);
+  if (se->post.head)
+    {
+      val = gfc_create_var (TREE_TYPE (se->expr), NULL);
+      gfc_add_modify (&se->pre, val, se->expr);
+      se->expr = val;
+      gfc_add_block_to_block (&se->pre, &se->post);
+    }
+}
+
+/* Helper to translate an expression and convert it to a particular type.  */
+void
+gfc_conv_expr_type (gfc_se * se, gfc_expr * expr, tree type)
+{
+  gfc_conv_expr_val (se, expr);
+  se->expr = convert (type, se->expr);
+}
+
+
+/* Converts an expression so that it can be passed by reference.  Scalar
+   values only.  */
+
+void
+gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
+{
+  tree var;
+
+  if (se->ss && se->ss->expr == expr
+      && se->ss->type == GFC_SS_REFERENCE)
+    {
+      /* Returns a reference to the scalar evaluated outside the loop
+	 for this case.  */
+      gfc_conv_expr (se, expr);
+      return;
+    }
+
+  if (expr->ts.type == BT_CHARACTER)
+    {
+      gfc_conv_expr (se, expr);
+      gfc_conv_string_parameter (se);
+      return;
+    }
+
+  if (expr->expr_type == EXPR_VARIABLE)
+    {
+      se->want_pointer = 1;
+      gfc_conv_expr (se, expr);
+      if (se->post.head)
+	{
+	  var = gfc_create_var (TREE_TYPE (se->expr), NULL);
+	  gfc_add_modify (&se->pre, var, se->expr);
+	  gfc_add_block_to_block (&se->pre, &se->post);
+	  se->expr = var;
+	}
+      return;
+    }
+
+  if (expr->expr_type == EXPR_FUNCTION
+      && ((expr->value.function.esym
+	   && expr->value.function.esym->result->attr.pointer
+	   && !expr->value.function.esym->result->attr.dimension)
+	  || (!expr->value.function.esym
+	      && expr->symtree->n.sym->attr.pointer
+	      && !expr->symtree->n.sym->attr.dimension)))
+    {
+      se->want_pointer = 1;
+      gfc_conv_expr (se, expr);
+      var = gfc_create_var (TREE_TYPE (se->expr), NULL);
+      gfc_add_modify (&se->pre, var, se->expr);
+      se->expr = var;
+      return;
+    }
+
+
+  gfc_conv_expr (se, expr);
+
+  /* Create a temporary var to hold the value.  */
+  if (TREE_CONSTANT (se->expr))
+    {
+      tree tmp = se->expr;
+      STRIP_TYPE_NOPS (tmp);
+      var = build_decl (input_location,
+			CONST_DECL, NULL, TREE_TYPE (tmp));
+      DECL_INITIAL (var) = tmp;
+      TREE_STATIC (var) = 1;
+      pushdecl (var);
+    }
+  else
+    {
+      var = gfc_create_var (TREE_TYPE (se->expr), NULL);
+      gfc_add_modify (&se->pre, var, se->expr);
+    }
+  gfc_add_block_to_block (&se->pre, &se->post);
+
+  /* Take the address of that value.  */
+  se->expr = gfc_build_addr_expr (NULL_TREE, var);
+}
+
+
+tree
+gfc_trans_pointer_assign (gfc_code * code)
+{
+  return gfc_trans_pointer_assignment (code->expr1, code->expr2);
+}
+
+
+/* Generate code for a pointer assignment.  */
+
+tree
+gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
+{
+  gfc_se lse;
+  gfc_se rse;
+  gfc_ss *lss;
+  gfc_ss *rss;
+  stmtblock_t block;
+  tree desc;
+  tree tmp;
+  tree decl;
+
+  gfc_start_block (&block);
+
+  gfc_init_se (&lse, NULL);
+
+  lss = gfc_walk_expr (expr1);
+  rss = gfc_walk_expr (expr2);
+  if (lss == gfc_ss_terminator)
+    {
+      /* Scalar pointers.  */
+      lse.want_pointer = 1;
+      gfc_conv_expr (&lse, expr1);
+      gcc_assert (rss == gfc_ss_terminator);
+      gfc_init_se (&rse, NULL);
+      rse.want_pointer = 1;
+      gfc_conv_expr (&rse, expr2);
+
+      if (expr1->symtree->n.sym->attr.proc_pointer
+	  && expr1->symtree->n.sym->attr.dummy)
+	lse.expr = build_fold_indirect_ref_loc (input_location,
+					    lse.expr);
+
+      if (expr2->symtree && expr2->symtree->n.sym->attr.proc_pointer
+	  && expr2->symtree->n.sym->attr.dummy)
+	rse.expr = build_fold_indirect_ref_loc (input_location,
+					    rse.expr);
+
+      gfc_add_block_to_block (&block, &lse.pre);
+      gfc_add_block_to_block (&block, &rse.pre);
+
+      /* Check character lengths if character expression.  The test is only
+	 really added if -fbounds-check is enabled.  Exclude deferred
+	 character length lefthand sides.  */
+      if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL
+	  && !(expr1->ts.deferred
+			&& (TREE_CODE (lse.string_length) == VAR_DECL))
+	  && !expr1->symtree->n.sym->attr.proc_pointer
+	  && !gfc_is_proc_ptr_comp (expr1, NULL))
+	{
+	  gcc_assert (expr2->ts.type == BT_CHARACTER);
+	  gcc_assert (lse.string_length && rse.string_length);
+	  gfc_trans_same_strlen_check ("pointer assignment", &expr1->where,
+				       lse.string_length, rse.string_length,
+				       &block);
+	}
+
+      /* The assignment to an deferred character length sets the string
+	 length to that of the rhs.  */
+      if (expr1->ts.deferred && (TREE_CODE (lse.string_length) == VAR_DECL))
+	{
+	  if (expr2->expr_type != EXPR_NULL)
+	    gfc_add_modify (&block, lse.string_length, rse.string_length);
+	  else
+	    gfc_add_modify (&block, lse.string_length,
+			    build_int_cst (gfc_charlen_type_node, 0));
+	}
+
+      gfc_add_modify (&block, lse.expr,
+			   fold_convert (TREE_TYPE (lse.expr), rse.expr));
+
+      gfc_add_block_to_block (&block, &rse.post);
+      gfc_add_block_to_block (&block, &lse.post);
+    }
+  else
+    {
+      gfc_ref* remap;
+      bool rank_remap;
+      tree strlen_lhs;
+      tree strlen_rhs = NULL_TREE;
+
+      /* Array pointer.  Find the last reference on the LHS and if it is an
+	 array section ref, we're dealing with bounds remapping.  In this case,
+	 set it to AR_FULL so that gfc_conv_expr_descriptor does
+	 not see it and process the bounds remapping afterwards explicitely.  */
+      for (remap = expr1->ref; remap; remap = remap->next)
+	if (!remap->next && remap->type == REF_ARRAY
+	    && remap->u.ar.type == AR_SECTION)
+	  {
+	    remap->u.ar.type = AR_FULL;
+	    break;
+	  }
+      rank_remap = (remap && remap->u.ar.end[0]);
+
+      gfc_conv_expr_descriptor (&lse, expr1, lss);
+      strlen_lhs = lse.string_length;
+      desc = lse.expr;
+
+      if (expr2->expr_type == EXPR_NULL)
+	{
+	  /* Just set the data pointer to null.  */
+	  gfc_conv_descriptor_data_set (&lse.pre, lse.expr, null_pointer_node);
+	}
+      else if (rank_remap)
+	{
+	  /* If we are rank-remapping, just get the RHS's descriptor and
+	     process this later on.  */
+	  gfc_init_se (&rse, NULL);
+	  rse.direct_byref = 1;
+	  rse.byref_noassign = 1;
+	  gfc_conv_expr_descriptor (&rse, expr2, rss);
+	  strlen_rhs = rse.string_length;
+	}
+      else if (expr2->expr_type == EXPR_VARIABLE)
+	{
+	  /* Assign directly to the LHS's descriptor.  */
+	  lse.direct_byref = 1;
+	  gfc_conv_expr_descriptor (&lse, expr2, rss);
+	  strlen_rhs = lse.string_length;
+
+	  /* If this is a subreference array pointer assignment, use the rhs
+	     descriptor element size for the lhs span.  */
+	  if (expr1->symtree->n.sym->attr.subref_array_pointer)
+	    {
+	      decl = expr1->symtree->n.sym->backend_decl;
+	      gfc_init_se (&rse, NULL);
+	      rse.descriptor_only = 1;
+	      gfc_conv_expr (&rse, expr2);
+	      tmp = gfc_get_element_type (TREE_TYPE (rse.expr));
+	      tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp));
+	      if (!INTEGER_CST_P (tmp))
+		gfc_add_block_to_block (&lse.post, &rse.pre);
+	      gfc_add_modify (&lse.post, GFC_DECL_SPAN(decl), tmp);
+	    }
+	}
+      else
+	{
+	  /* Assign to a temporary descriptor and then copy that
+	     temporary to the pointer.  */
+	  tmp = gfc_create_var (TREE_TYPE (desc), "ptrtemp");
+
+	  lse.expr = tmp;
+	  lse.direct_byref = 1;
+	  gfc_conv_expr_descriptor (&lse, expr2, rss);
+	  strlen_rhs = lse.string_length;
+	  gfc_add_modify (&lse.pre, desc, tmp);
+	}
+
+      gfc_add_block_to_block (&block, &lse.pre);
+      if (rank_remap)
+	gfc_add_block_to_block (&block, &rse.pre);
+
+      /* If we do bounds remapping, update LHS descriptor accordingly.  */
+      if (remap)
+	{
+	  int dim;
+	  gcc_assert (remap->u.ar.dimen == expr1->rank);
+
+	  if (rank_remap)
+	    {
+	      /* Do rank remapping.  We already have the RHS's descriptor
+		 converted in rse and now have to build the correct LHS
+		 descriptor for it.  */
+
+	      tree dtype, data;
+	      tree offs, stride;
+	      tree lbound, ubound;
+
+	      /* Set dtype.  */
+	      dtype = gfc_conv_descriptor_dtype (desc);
+	      tmp = gfc_get_dtype (TREE_TYPE (desc));
+	      gfc_add_modify (&block, dtype, tmp);
+
+	      /* Copy data pointer.  */
+	      data = gfc_conv_descriptor_data_get (rse.expr);
+	      gfc_conv_descriptor_data_set (&block, desc, data);
+
+	      /* Copy offset but adjust it such that it would correspond
+		 to a lbound of zero.  */
+	      offs = gfc_conv_descriptor_offset_get (rse.expr);
+	      for (dim = 0; dim < expr2->rank; ++dim)
+		{
+		  stride = gfc_conv_descriptor_stride_get (rse.expr,
+							   gfc_rank_cst[dim]);
+		  lbound = gfc_conv_descriptor_lbound_get (rse.expr,
+							   gfc_rank_cst[dim]);
+		  tmp = fold_build2_loc (input_location, MULT_EXPR,
+					 gfc_array_index_type, stride, lbound);
+		  offs = fold_build2_loc (input_location, PLUS_EXPR,
+					  gfc_array_index_type, offs, tmp);
+		}
+	      gfc_conv_descriptor_offset_set (&block, desc, offs);
+
+	      /* Set the bounds as declared for the LHS and calculate strides as
+		 well as another offset update accordingly.  */
+	      stride = gfc_conv_descriptor_stride_get (rse.expr,
+						       gfc_rank_cst[0]);
+	      for (dim = 0; dim < expr1->rank; ++dim)
+		{
+		  gfc_se lower_se;
+		  gfc_se upper_se;
+
+		  gcc_assert (remap->u.ar.start[dim] && remap->u.ar.end[dim]);
+
+		  /* Convert declared bounds.  */
+		  gfc_init_se (&lower_se, NULL);
+		  gfc_init_se (&upper_se, NULL);
+		  gfc_conv_expr (&lower_se, remap->u.ar.start[dim]);
+		  gfc_conv_expr (&upper_se, remap->u.ar.end[dim]);
+
+		  gfc_add_block_to_block (&block, &lower_se.pre);
+		  gfc_add_block_to_block (&block, &upper_se.pre);
+
+		  lbound = fold_convert (gfc_array_index_type, lower_se.expr);
+		  ubound = fold_convert (gfc_array_index_type, upper_se.expr);
+
+		  lbound = gfc_evaluate_now (lbound, &block);
+		  ubound = gfc_evaluate_now (ubound, &block);
+
+		  gfc_add_block_to_block (&block, &lower_se.post);
+		  gfc_add_block_to_block (&block, &upper_se.post);
+
+		  /* Set bounds in descriptor.  */
+		  gfc_conv_descriptor_lbound_set (&block, desc,
+						  gfc_rank_cst[dim], lbound);
+		  gfc_conv_descriptor_ubound_set (&block, desc,
+						  gfc_rank_cst[dim], ubound);
+
+		  /* Set stride.  */
+		  stride = gfc_evaluate_now (stride, &block);
+		  gfc_conv_descriptor_stride_set (&block, desc,
+						  gfc_rank_cst[dim], stride);
+
+		  /* Update offset.  */
+		  offs = gfc_conv_descriptor_offset_get (desc);
+		  tmp = fold_build2_loc (input_location, MULT_EXPR,
+					 gfc_array_index_type, lbound, stride);
+		  offs = fold_build2_loc (input_location, MINUS_EXPR,
+					  gfc_array_index_type, offs, tmp);
+		  offs = gfc_evaluate_now (offs, &block);
+		  gfc_conv_descriptor_offset_set (&block, desc, offs);
+
+		  /* Update stride.  */
+		  tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
+		  stride = fold_build2_loc (input_location, MULT_EXPR,
+					    gfc_array_index_type, stride, tmp);
+		}
+	    }
+	  else
+	    {
+	      /* Bounds remapping.  Just shift the lower bounds.  */
+
+	      gcc_assert (expr1->rank == expr2->rank);
+
+	      for (dim = 0; dim < remap->u.ar.dimen; ++dim)
+		{
+		  gfc_se lbound_se;
+
+		  gcc_assert (remap->u.ar.start[dim]);
+		  gcc_assert (!remap->u.ar.end[dim]);
+		  gfc_init_se (&lbound_se, NULL);
+		  gfc_conv_expr (&lbound_se, remap->u.ar.start[dim]);
+
+		  gfc_add_block_to_block (&block, &lbound_se.pre);
+		  gfc_conv_shift_descriptor_lbound (&block, desc,
+						    dim, lbound_se.expr);
+		  gfc_add_block_to_block (&block, &lbound_se.post);
+		}
+	    }
+	}
+
+      /* Check string lengths if applicable.  The check is only really added
+	 to the output code if -fbounds-check is enabled.  */
+      if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL)
+	{
+	  gcc_assert (expr2->ts.type == BT_CHARACTER);
+	  gcc_assert (strlen_lhs && strlen_rhs);
+	  gfc_trans_same_strlen_check ("pointer assignment", &expr1->where,
+				       strlen_lhs, strlen_rhs, &block);
+	}
+
+      /* If rank remapping was done, check with -fcheck=bounds that
+	 the target is at least as large as the pointer.  */
+      if (rank_remap && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS))
+	{
+	  tree lsize, rsize;
+	  tree fault;
+	  const char* msg;
+
+	  lsize = gfc_conv_descriptor_size (lse.expr, expr1->rank);
+	  rsize = gfc_conv_descriptor_size (rse.expr, expr2->rank);
+
+	  lsize = gfc_evaluate_now (lsize, &block);
+	  rsize = gfc_evaluate_now (rsize, &block);
+	  fault = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+				   rsize, lsize);
+
+	  msg = _("Target of rank remapping is too small (%ld < %ld)");
+	  gfc_trans_runtime_check (true, false, fault, &block, &expr2->where,
+				   msg, rsize, lsize);
+	}
+
+      gfc_add_block_to_block (&block, &lse.post);
+      if (rank_remap)
+	gfc_add_block_to_block (&block, &rse.post);
+    }
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Makes sure se is suitable for passing as a function string parameter.  */
+/* TODO: Need to check all callers of this function.  It may be abused.  */
+
+void
+gfc_conv_string_parameter (gfc_se * se)
+{
+  tree type;
+
+  if (TREE_CODE (se->expr) == STRING_CST)
+    {
+      type = TREE_TYPE (TREE_TYPE (se->expr));
+      se->expr = gfc_build_addr_expr (build_pointer_type (type), se->expr);
+      return;
+    }
+
+  if (TYPE_STRING_FLAG (TREE_TYPE (se->expr)))
+    {
+      if (TREE_CODE (se->expr) != INDIRECT_REF)
+	{
+	  type = TREE_TYPE (se->expr);
+          se->expr = gfc_build_addr_expr (build_pointer_type (type), se->expr);
+	}
+      else
+	{
+	  type = gfc_get_character_type_len (gfc_default_character_kind,
+					     se->string_length);
+	  type = build_pointer_type (type);
+	  se->expr = gfc_build_addr_expr (type, se->expr);
+	}
+    }
+
+  gcc_assert (POINTER_TYPE_P (TREE_TYPE (se->expr)));
+}
+
+
+/* Generate code for assignment of scalar variables.  Includes character
+   strings and derived types with allocatable components.
+   If you know that the LHS has no allocations, set dealloc to false.  */
+
+tree
+gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
+			 bool l_is_temp, bool r_is_var, bool dealloc)
+{
+  stmtblock_t block;
+  tree tmp;
+  tree cond;
+
+  gfc_init_block (&block);
+
+  if (ts.type == BT_CHARACTER)
+    {
+      tree rlen = NULL;
+      tree llen = NULL;
+
+      if (lse->string_length != NULL_TREE)
+	{
+	  gfc_conv_string_parameter (lse);
+	  gfc_add_block_to_block (&block, &lse->pre);
+	  llen = lse->string_length;
+	}
+
+      if (rse->string_length != NULL_TREE)
+	{
+	  gcc_assert (rse->string_length != NULL_TREE);
+	  gfc_conv_string_parameter (rse);
+	  gfc_add_block_to_block (&block, &rse->pre);
+	  rlen = rse->string_length;
+	}
+
+      gfc_trans_string_copy (&block, llen, lse->expr, ts.kind, rlen,
+			     rse->expr, ts.kind);
+    }
+  else if (ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp)
+    {
+      cond = NULL_TREE;
+
+      /* Are the rhs and the lhs the same?  */
+      if (r_is_var)
+	{
+	  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				  gfc_build_addr_expr (NULL_TREE, lse->expr),
+				  gfc_build_addr_expr (NULL_TREE, rse->expr));
+	  cond = gfc_evaluate_now (cond, &lse->pre);
+	}
+
+      /* Deallocate the lhs allocated components as long as it is not
+	 the same as the rhs.  This must be done following the assignment
+	 to prevent deallocating data that could be used in the rhs
+	 expression.  */
+      if (!l_is_temp && dealloc)
+	{
+	  tmp = gfc_evaluate_now (lse->expr, &lse->pre);
+	  tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0);
+	  if (r_is_var)
+	    tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
+			    tmp);
+	  gfc_add_expr_to_block (&lse->post, tmp);
+	}
+
+      gfc_add_block_to_block (&block, &rse->pre);
+      gfc_add_block_to_block (&block, &lse->pre);
+
+      gfc_add_modify (&block, lse->expr,
+			   fold_convert (TREE_TYPE (lse->expr), rse->expr));
+
+      /* Do a deep copy if the rhs is a variable, if it is not the
+	 same as the lhs.  */
+      if (r_is_var)
+	{
+	  tmp = gfc_copy_alloc_comp (ts.u.derived, rse->expr, lse->expr, 0);
+	  tmp = build3_v (COND_EXPR, cond, build_empty_stmt (input_location),
+			  tmp);
+	  gfc_add_expr_to_block (&block, tmp);
+	}
+    }
+  else if (ts.type == BT_DERIVED || ts.type == BT_CLASS)
+    {
+      gfc_add_block_to_block (&block, &lse->pre);
+      gfc_add_block_to_block (&block, &rse->pre);
+      tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+			     TREE_TYPE (lse->expr), rse->expr);
+      gfc_add_modify (&block, lse->expr, tmp);
+    }
+  else
+    {
+      gfc_add_block_to_block (&block, &lse->pre);
+      gfc_add_block_to_block (&block, &rse->pre);
+
+      gfc_add_modify (&block, lse->expr,
+		      fold_convert (TREE_TYPE (lse->expr), rse->expr));
+    }
+
+  gfc_add_block_to_block (&block, &lse->post);
+  gfc_add_block_to_block (&block, &rse->post);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* There are quite a lot of restrictions on the optimisation in using an
+   array function assign without a temporary.  */
+
+static bool
+arrayfunc_assign_needs_temporary (gfc_expr * expr1, gfc_expr * expr2)
+{
+  gfc_ref * ref;
+  bool seen_array_ref;
+  bool c = false;
+  gfc_symbol *sym = expr1->symtree->n.sym;
+
+  /* The caller has already checked rank>0 and expr_type == EXPR_FUNCTION.  */
+  if (expr2->value.function.isym && !gfc_is_intrinsic_libcall (expr2))
+    return true;
+
+  /* Elemental functions are scalarized so that they don't need a
+     temporary in gfc_trans_assignment_1, so return a true.  Otherwise,
+     they would need special treatment in gfc_trans_arrayfunc_assign.  */
+  if (expr2->value.function.esym != NULL
+      && expr2->value.function.esym->attr.elemental)
+    return true;
+
+  /* Need a temporary if rhs is not FULL or a contiguous section.  */
+  if (expr1->ref && !(gfc_full_array_ref_p (expr1->ref, &c) || c))
+    return true;
+
+  /* Need a temporary if EXPR1 can't be expressed as a descriptor.  */
+  if (gfc_ref_needs_temporary_p (expr1->ref))
+    return true;
+
+  /* Functions returning pointers or allocatables need temporaries.  */
+  c = expr2->value.function.esym
+      ? (expr2->value.function.esym->attr.pointer
+	 || expr2->value.function.esym->attr.allocatable)
+      : (expr2->symtree->n.sym->attr.pointer
+	 || expr2->symtree->n.sym->attr.allocatable);
+  if (c)
+    return true;
+
+  /* Character array functions need temporaries unless the
+     character lengths are the same.  */
+  if (expr2->ts.type == BT_CHARACTER && expr2->rank > 0)
+    {
+      if (expr1->ts.u.cl->length == NULL
+	    || expr1->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+	return true;
+
+      if (expr2->ts.u.cl->length == NULL
+	    || expr2->ts.u.cl->length->expr_type != EXPR_CONSTANT)
+	return true;
+
+      if (mpz_cmp (expr1->ts.u.cl->length->value.integer,
+		     expr2->ts.u.cl->length->value.integer) != 0)
+	return true;
+    }
+
+  /* Check that no LHS component references appear during an array
+     reference. This is needed because we do not have the means to
+     span any arbitrary stride with an array descriptor. This check
+     is not needed for the rhs because the function result has to be
+     a complete type.  */
+  seen_array_ref = false;
+  for (ref = expr1->ref; ref; ref = ref->next)
+    {
+      if (ref->type == REF_ARRAY)
+	seen_array_ref= true;
+      else if (ref->type == REF_COMPONENT && seen_array_ref)
+	return true;
+    }
+
+  /* Check for a dependency.  */
+  if (gfc_check_fncall_dependency (expr1, INTENT_OUT,
+				   expr2->value.function.esym,
+				   expr2->value.function.actual,
+				   NOT_ELEMENTAL))
+    return true;
+
+  /* If we have reached here with an intrinsic function, we do not
+     need a temporary except in the particular case that reallocation
+     on assignment is active and the lhs is allocatable and a target.  */
+  if (expr2->value.function.isym)
+    return (gfc_option.flag_realloc_lhs
+	      && sym->attr.allocatable
+	      && sym->attr.target);
+
+  /* If the LHS is a dummy, we need a temporary if it is not
+     INTENT(OUT).  */
+  if (sym->attr.dummy && sym->attr.intent != INTENT_OUT)
+    return true;
+
+  /* If the lhs has been host_associated, is in common, a pointer or is
+     a target and the function is not using a RESULT variable, aliasing
+     can occur and a temporary is needed.  */
+  if ((sym->attr.host_assoc
+	   || sym->attr.in_common
+	   || sym->attr.pointer
+	   || sym->attr.cray_pointee
+	   || sym->attr.target)
+	&& expr2->symtree != NULL
+	&& expr2->symtree->n.sym == expr2->symtree->n.sym->result)
+    return true;
+
+  /* A PURE function can unconditionally be called without a temporary.  */
+  if (expr2->value.function.esym != NULL
+      && expr2->value.function.esym->attr.pure)
+    return false;
+
+  /* Implicit_pure functions are those which could legally be declared
+     to be PURE.  */
+  if (expr2->value.function.esym != NULL
+      && expr2->value.function.esym->attr.implicit_pure)
+    return false;
+
+  if (!sym->attr.use_assoc
+	&& !sym->attr.in_common
+	&& !sym->attr.pointer
+	&& !sym->attr.target
+	&& !sym->attr.cray_pointee
+	&& expr2->value.function.esym)
+    {
+      /* A temporary is not needed if the function is not contained and
+	 the variable is local or host associated and not a pointer or
+	 a target. */
+      if (!expr2->value.function.esym->attr.contained)
+	return false;
+
+      /* A temporary is not needed if the lhs has never been host
+	 associated and the procedure is contained.  */
+      else if (!sym->attr.host_assoc)
+	return false;
+
+      /* A temporary is not needed if the variable is local and not
+	 a pointer, a target or a result.  */
+      if (sym->ns->parent
+	    && expr2->value.function.esym->ns == sym->ns->parent)
+	return false;
+    }
+
+  /* Default to temporary use.  */
+  return true;
+}
+
+
+/* Provide the loop info so that the lhs descriptor can be built for
+   reallocatable assignments from extrinsic function calls.  */
+
+static void
+realloc_lhs_loop_for_fcn_call (gfc_se *se, locus *where, gfc_ss **ss)
+{
+  gfc_loopinfo loop;
+  /* Signal that the function call should not be made by
+     gfc_conv_loop_setup. */
+  se->ss->is_alloc_lhs = 1;
+  gfc_init_loopinfo (&loop);
+  gfc_add_ss_to_loop (&loop, *ss);
+  gfc_add_ss_to_loop (&loop, se->ss);
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop, where);
+  gfc_copy_loopinfo_to_se (se, &loop);
+  gfc_add_block_to_block (&se->pre, &loop.pre);
+  gfc_add_block_to_block (&se->pre, &loop.post);
+  se->ss->is_alloc_lhs = 0;
+}
+
+
+/* For assignment to a reallocatable lhs from intrinsic functions,
+   replace the se.expr (ie. the result) with a temporary descriptor.
+   Null the data field so that the library allocates space for the
+   result. Free the data of the original descriptor after the function,
+   in case it appears in an argument expression and transfer the
+   result to the original descriptor.  */
+
+static void
+fcncall_realloc_result (gfc_se *se, int rank)
+{
+  tree desc;
+  tree res_desc;
+  tree tmp;
+  tree offset;
+  tree zero_cond;
+  int n;
+
+  /* Use the allocation done by the library.  Substitute the lhs
+     descriptor with a copy, whose data field is nulled.*/
+  desc = build_fold_indirect_ref_loc (input_location, se->expr);
+  if (POINTER_TYPE_P (TREE_TYPE (desc)))
+    desc = build_fold_indirect_ref_loc (input_location, desc);
+
+  /* Unallocated, the descriptor does not have a dtype.  */
+  tmp = gfc_conv_descriptor_dtype (desc);
+  gfc_add_modify (&se->pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+
+  res_desc = gfc_evaluate_now (desc, &se->pre);
+  gfc_conv_descriptor_data_set (&se->pre, res_desc, null_pointer_node);
+  se->expr = gfc_build_addr_expr (TREE_TYPE (se->expr), res_desc);
+
+  /* Free the lhs after the function call and copy the result data to
+     the lhs descriptor.  */
+  tmp = gfc_conv_descriptor_data_get (desc);
+  zero_cond = fold_build2_loc (input_location, EQ_EXPR,
+			       boolean_type_node, tmp,
+			       build_int_cst (TREE_TYPE (tmp), 0));
+  zero_cond = gfc_evaluate_now (zero_cond, &se->post);
+  tmp = gfc_call_free (fold_convert (pvoid_type_node, tmp));
+  gfc_add_expr_to_block (&se->post, tmp);
+
+  tmp = gfc_conv_descriptor_data_get (res_desc);
+  gfc_conv_descriptor_data_set (&se->post, desc, tmp);
+
+  /* Check that the shapes are the same between lhs and expression.  */
+  for (n = 0 ; n < rank; n++)
+    {
+      tree tmp1;
+      tmp = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]);
+      tmp1 = gfc_conv_descriptor_lbound_get (res_desc, gfc_rank_cst[n]);
+      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+			     gfc_array_index_type, tmp, tmp1);
+      tmp1 = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[n]);
+      tmp = fold_build2_loc (input_location, MINUS_EXPR,
+			     gfc_array_index_type, tmp, tmp1);
+      tmp1 = gfc_conv_descriptor_ubound_get (res_desc, gfc_rank_cst[n]);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR,
+			     gfc_array_index_type, tmp, tmp1);
+      tmp = fold_build2_loc (input_location, NE_EXPR,
+			     boolean_type_node, tmp,
+			     gfc_index_zero_node);
+      tmp = gfc_evaluate_now (tmp, &se->post);
+      zero_cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+				   boolean_type_node, tmp,
+				   zero_cond);
+    }
+
+  /* 'zero_cond' being true is equal to lhs not being allocated or the
+     shapes being different.  */
+  zero_cond = gfc_evaluate_now (zero_cond, &se->post);
+
+  /* Now reset the bounds returned from the function call to bounds based
+     on the lhs lbounds, except where the lhs is not allocated or the shapes
+     of 'variable and 'expr' are different. Set the offset accordingly.  */
+  offset = gfc_index_zero_node;
+  for (n = 0 ; n < rank; n++)
+    {
+      tree lbound;
+
+      lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]);
+      lbound = fold_build3_loc (input_location, COND_EXPR,
+				gfc_array_index_type, zero_cond,
+				gfc_index_one_node, lbound);
+      lbound = gfc_evaluate_now (lbound, &se->post);
+
+      tmp = gfc_conv_descriptor_ubound_get (res_desc, gfc_rank_cst[n]);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR,
+			     gfc_array_index_type, tmp, lbound);
+      gfc_conv_descriptor_lbound_set (&se->post, desc,
+				      gfc_rank_cst[n], lbound);
+      gfc_conv_descriptor_ubound_set (&se->post, desc,
+				      gfc_rank_cst[n], tmp);
+
+      /* Set stride and accumulate the offset.  */
+      tmp = gfc_conv_descriptor_stride_get (res_desc, gfc_rank_cst[n]);
+      gfc_conv_descriptor_stride_set (&se->post, desc,
+				      gfc_rank_cst[n], tmp);
+      tmp = fold_build2_loc (input_location, MULT_EXPR,
+			     gfc_array_index_type, lbound, tmp);
+      offset = fold_build2_loc (input_location, MINUS_EXPR,
+				gfc_array_index_type, offset, tmp);
+      offset = gfc_evaluate_now (offset, &se->post);
+    }
+
+  gfc_conv_descriptor_offset_set (&se->post, desc, offset);
+}
+
+
+/* Try to translate array(:) = func (...), where func is a transformational
+   array function, without using a temporary.  Returns NULL if this isn't the
+   case.  */
+
+static tree
+gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
+{
+  gfc_se se;
+  gfc_ss *ss;
+  gfc_component *comp = NULL;
+
+  if (arrayfunc_assign_needs_temporary (expr1, expr2))
+    return NULL;
+
+  /* The frontend doesn't seem to bother filling in expr->symtree for intrinsic
+     functions.  */
+  gcc_assert (expr2->value.function.isym
+	      || (gfc_is_proc_ptr_comp (expr2, &comp)
+		  && comp && comp->attr.dimension)
+	      || (!comp && gfc_return_by_reference (expr2->value.function.esym)
+		  && expr2->value.function.esym->result->attr.dimension));
+
+  ss = gfc_walk_expr (expr1);
+  gcc_assert (ss != gfc_ss_terminator);
+  gfc_init_se (&se, NULL);
+  gfc_start_block (&se.pre);
+  se.want_pointer = 1;
+
+  gfc_conv_array_parameter (&se, expr1, ss, false, NULL, NULL, NULL);
+
+  if (expr1->ts.type == BT_DERIVED
+	&& expr1->ts.u.derived->attr.alloc_comp)
+    {
+      tree tmp;
+      tmp = gfc_deallocate_alloc_comp (expr1->ts.u.derived, se.expr,
+				       expr1->rank);
+      gfc_add_expr_to_block (&se.pre, tmp);
+    }
+
+  se.direct_byref = 1;
+  se.ss = gfc_walk_expr (expr2);
+  gcc_assert (se.ss != gfc_ss_terminator);
+
+  /* Reallocate on assignment needs the loopinfo for extrinsic functions.
+     This is signalled to gfc_conv_procedure_call by setting is_alloc_lhs.
+     Clearly, this cannot be done for an allocatable function result, since
+     the shape of the result is unknown and, in any case, the function must
+     correctly take care of the reallocation internally. For intrinsic
+     calls, the array data is freed and the library takes care of allocation.
+     TODO: Add logic of trans-array.c: gfc_alloc_allocatable_for_assignment
+     to the library.  */
+  if (gfc_option.flag_realloc_lhs
+	&& gfc_is_reallocatable_lhs (expr1)
+	&& !gfc_expr_attr (expr1).codimension
+	&& !gfc_is_coindexed (expr1)
+	&& !(expr2->value.function.esym
+	    && expr2->value.function.esym->result->attr.allocatable))
+    {
+      if (!expr2->value.function.isym)
+	{
+	  realloc_lhs_loop_for_fcn_call (&se, &expr1->where, &ss);
+	  ss->is_alloc_lhs = 1;
+	}
+      else
+	fcncall_realloc_result (&se, expr1->rank);
+    }
+
+  gfc_conv_function_expr (&se, expr2);
+  gfc_add_block_to_block (&se.pre, &se.post);
+
+  return gfc_finish_block (&se.pre);
+}
+
+
+/* Try to efficiently translate array(:) = 0.  Return NULL if this
+   can't be done.  */
+
+static tree
+gfc_trans_zero_assign (gfc_expr * expr)
+{
+  tree dest, len, type;
+  tree tmp;
+  gfc_symbol *sym;
+
+  sym = expr->symtree->n.sym;
+  dest = gfc_get_symbol_decl (sym);
+
+  type = TREE_TYPE (dest);
+  if (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+  if (!GFC_ARRAY_TYPE_P (type))
+    return NULL_TREE;
+
+  /* Determine the length of the array.  */
+  len = GFC_TYPE_ARRAY_SIZE (type);
+  if (!len || TREE_CODE (len) != INTEGER_CST)
+    return NULL_TREE;
+
+  tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+  len = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, len,
+			 fold_convert (gfc_array_index_type, tmp));
+
+  /* If we are zeroing a local array avoid taking its address by emitting
+     a = {} instead.  */
+  if (!POINTER_TYPE_P (TREE_TYPE (dest)))
+    return build2_loc (input_location, MODIFY_EXPR, void_type_node,
+		       dest, build_constructor (TREE_TYPE (dest), NULL));
+
+  /* Convert arguments to the correct types.  */
+  dest = fold_convert (pvoid_type_node, dest);
+  len = fold_convert (size_type_node, len);
+
+  /* Construct call to __builtin_memset.  */
+  tmp = build_call_expr_loc (input_location,
+			 built_in_decls[BUILT_IN_MEMSET],
+			 3, dest, integer_zero_node, len);
+  return fold_convert (void_type_node, tmp);
+}
+
+
+/* Helper for gfc_trans_array_copy and gfc_trans_array_constructor_copy
+   that constructs the call to __builtin_memcpy.  */
+
+tree
+gfc_build_memcpy_call (tree dst, tree src, tree len)
+{
+  tree tmp;
+
+  /* Convert arguments to the correct types.  */
+  if (!POINTER_TYPE_P (TREE_TYPE (dst)))
+    dst = gfc_build_addr_expr (pvoid_type_node, dst);
+  else
+    dst = fold_convert (pvoid_type_node, dst);
+
+  if (!POINTER_TYPE_P (TREE_TYPE (src)))
+    src = gfc_build_addr_expr (pvoid_type_node, src);
+  else
+    src = fold_convert (pvoid_type_node, src);
+
+  len = fold_convert (size_type_node, len);
+
+  /* Construct call to __builtin_memcpy.  */
+  tmp = build_call_expr_loc (input_location,
+			 built_in_decls[BUILT_IN_MEMCPY], 3, dst, src, len);
+  return fold_convert (void_type_node, tmp);
+}
+
+
+/* Try to efficiently translate dst(:) = src(:).  Return NULL if this
+   can't be done.  EXPR1 is the destination/lhs and EXPR2 is the
+   source/rhs, both are gfc_full_array_ref_p which have been checked for
+   dependencies.  */
+
+static tree
+gfc_trans_array_copy (gfc_expr * expr1, gfc_expr * expr2)
+{
+  tree dst, dlen, dtype;
+  tree src, slen, stype;
+  tree tmp;
+
+  dst = gfc_get_symbol_decl (expr1->symtree->n.sym);
+  src = gfc_get_symbol_decl (expr2->symtree->n.sym);
+
+  dtype = TREE_TYPE (dst);
+  if (POINTER_TYPE_P (dtype))
+    dtype = TREE_TYPE (dtype);
+  stype = TREE_TYPE (src);
+  if (POINTER_TYPE_P (stype))
+    stype = TREE_TYPE (stype);
+
+  if (!GFC_ARRAY_TYPE_P (dtype) || !GFC_ARRAY_TYPE_P (stype))
+    return NULL_TREE;
+
+  /* Determine the lengths of the arrays.  */
+  dlen = GFC_TYPE_ARRAY_SIZE (dtype);
+  if (!dlen || TREE_CODE (dlen) != INTEGER_CST)
+    return NULL_TREE;
+  tmp = TYPE_SIZE_UNIT (gfc_get_element_type (dtype));
+  dlen = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			  dlen, fold_convert (gfc_array_index_type, tmp));
+
+  slen = GFC_TYPE_ARRAY_SIZE (stype);
+  if (!slen || TREE_CODE (slen) != INTEGER_CST)
+    return NULL_TREE;
+  tmp = TYPE_SIZE_UNIT (gfc_get_element_type (stype));
+  slen = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			  slen, fold_convert (gfc_array_index_type, tmp));
+
+  /* Sanity check that they are the same.  This should always be
+     the case, as we should already have checked for conformance.  */
+  if (!tree_int_cst_equal (slen, dlen))
+    return NULL_TREE;
+
+  return gfc_build_memcpy_call (dst, src, dlen);
+}
+
+
+/* Try to efficiently translate array(:) = (/ ... /).  Return NULL if
+   this can't be done.  EXPR1 is the destination/lhs for which
+   gfc_full_array_ref_p is true, and EXPR2 is the source/rhs.  */
+
+static tree
+gfc_trans_array_constructor_copy (gfc_expr * expr1, gfc_expr * expr2)
+{
+  unsigned HOST_WIDE_INT nelem;
+  tree dst, dtype;
+  tree src, stype;
+  tree len;
+  tree tmp;
+
+  nelem = gfc_constant_array_constructor_p (expr2->value.constructor);
+  if (nelem == 0)
+    return NULL_TREE;
+
+  dst = gfc_get_symbol_decl (expr1->symtree->n.sym);
+  dtype = TREE_TYPE (dst);
+  if (POINTER_TYPE_P (dtype))
+    dtype = TREE_TYPE (dtype);
+  if (!GFC_ARRAY_TYPE_P (dtype))
+    return NULL_TREE;
+
+  /* Determine the lengths of the array.  */
+  len = GFC_TYPE_ARRAY_SIZE (dtype);
+  if (!len || TREE_CODE (len) != INTEGER_CST)
+    return NULL_TREE;
+
+  /* Confirm that the constructor is the same size.  */
+  if (compare_tree_int (len, nelem) != 0)
+    return NULL_TREE;
+
+  tmp = TYPE_SIZE_UNIT (gfc_get_element_type (dtype));
+  len = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, len,
+			 fold_convert (gfc_array_index_type, tmp));
+
+  stype = gfc_typenode_for_spec (&expr2->ts);
+  src = gfc_build_constant_array_constructor (expr2, stype);
+
+  stype = TREE_TYPE (src);
+  if (POINTER_TYPE_P (stype))
+    stype = TREE_TYPE (stype);
+
+  return gfc_build_memcpy_call (dst, src, len);
+}
+
+
+/* Tells whether the expression is to be treated as a variable reference.  */
+
+static bool
+expr_is_variable (gfc_expr *expr)
+{
+  gfc_expr *arg;
+
+  if (expr->expr_type == EXPR_VARIABLE)
+    return true;
+
+  arg = gfc_get_noncopying_intrinsic_argument (expr);
+  if (arg)
+    {
+      gcc_assert (expr->value.function.isym->id == GFC_ISYM_TRANSPOSE);
+      return expr_is_variable (arg);
+    }
+
+  return false;
+}
+
+
+/* Is the lhs OK for automatic reallocation?  */
+
+static bool
+is_scalar_reallocatable_lhs (gfc_expr *expr)
+{
+  gfc_ref * ref;
+
+  /* An allocatable variable with no reference.  */
+  if (expr->symtree->n.sym->attr.allocatable
+	&& !expr->ref)
+    return true;
+
+  /* All that can be left are allocatable components.  */
+  if ((expr->symtree->n.sym->ts.type != BT_DERIVED
+	&& expr->symtree->n.sym->ts.type != BT_CLASS)
+	|| !expr->symtree->n.sym->ts.u.derived->attr.alloc_comp)
+    return false;
+
+  /* Find an allocatable component ref last.  */
+  for (ref = expr->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT
+	  && !ref->next
+	  && ref->u.c.component->attr.allocatable)
+      return true;
+
+  return false;
+}
+
+
+/* Allocate or reallocate scalar lhs, as necessary.  */
+
+static void
+alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
+					 tree string_length,
+					 gfc_expr *expr1,
+					 gfc_expr *expr2)
+
+{
+  tree cond;
+  tree tmp;
+  tree size;
+  tree size_in_bytes;
+  tree jump_label1;
+  tree jump_label2;
+  gfc_se lse;
+
+  if (!expr1 || expr1->rank)
+    return;
+
+  if (!expr2 || expr2->rank)
+    return;
+
+  /* Since this is a scalar lhs, we can afford to do this.  That is,
+     there is no risk of side effects being repeated.  */
+  gfc_init_se (&lse, NULL);
+  lse.want_pointer = 1;
+  gfc_conv_expr (&lse, expr1);
+
+  jump_label1 = gfc_build_label_decl (NULL_TREE);
+  jump_label2 = gfc_build_label_decl (NULL_TREE);
+
+  /* Do the allocation if the lhs is NULL. Otherwise go to label 1.  */
+  tmp = build_int_cst (TREE_TYPE (lse.expr), 0);
+  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			  lse.expr, tmp);
+  tmp = build3_v (COND_EXPR, cond,
+		  build1_v (GOTO_EXPR, jump_label1),
+		  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (block, tmp);
+
+  if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
+    {
+      /* Use the rhs string length and the lhs element size.  */
+      size = string_length;
+      tmp = TREE_TYPE (gfc_typenode_for_spec (&expr1->ts));
+      tmp = TYPE_SIZE_UNIT (tmp);
+      size_in_bytes = fold_build2_loc (input_location, MULT_EXPR,
+				       TREE_TYPE (tmp), tmp,
+				       fold_convert (TREE_TYPE (tmp), size));
+    }
+  else
+    {
+      /* Otherwise use the length in bytes of the rhs.  */
+      size = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&expr1->ts));
+      size_in_bytes = size;
+    }
+
+  tmp = build_call_expr_loc (input_location,
+			     built_in_decls[BUILT_IN_MALLOC], 1,
+			     size_in_bytes);
+  tmp = fold_convert (TREE_TYPE (lse.expr), tmp);
+  gfc_add_modify (block, lse.expr, tmp);
+  if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
+    {
+      /* Deferred characters need checking for lhs and rhs string
+	 length.  Other deferred parameter variables will have to
+	 come here too.  */
+      tmp = build1_v (GOTO_EXPR, jump_label2);
+      gfc_add_expr_to_block (block, tmp);
+    }
+  tmp = build1_v (LABEL_EXPR, jump_label1);
+  gfc_add_expr_to_block (block, tmp);
+
+  /* For a deferred length character, reallocate if lengths of lhs and
+     rhs are different.  */
+  if (expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
+    {
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			      expr1->ts.u.cl->backend_decl, size);
+      /* Jump past the realloc if the lengths are the same.  */
+      tmp = build3_v (COND_EXPR, cond,
+		      build1_v (GOTO_EXPR, jump_label2),
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (block, tmp);
+      tmp = build_call_expr_loc (input_location,
+				 built_in_decls[BUILT_IN_REALLOC], 2,
+				 fold_convert (pvoid_type_node, lse.expr),
+				 size_in_bytes);
+      tmp = fold_convert (TREE_TYPE (lse.expr), tmp);
+      gfc_add_modify (block, lse.expr, tmp);
+      tmp = build1_v (LABEL_EXPR, jump_label2);
+      gfc_add_expr_to_block (block, tmp);
+
+      /* Update the lhs character length.  */
+      size = string_length;
+      gfc_add_modify (block, expr1->ts.u.cl->backend_decl, size);
+    }
+}
+
+
+/* Subroutine of gfc_trans_assignment that actually scalarizes the
+   assignment.  EXPR1 is the destination/LHS and EXPR2 is the source/RHS.
+   init_flag indicates initialization expressions and dealloc that no
+   deallocate prior assignment is needed (if in doubt, set true).  */
+
+static tree
+gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
+			bool dealloc)
+{
+  gfc_se lse;
+  gfc_se rse;
+  gfc_ss *lss;
+  gfc_ss *lss_section;
+  gfc_ss *rss;
+  gfc_loopinfo loop;
+  tree tmp;
+  stmtblock_t block;
+  stmtblock_t body;
+  bool l_is_temp;
+  bool scalar_to_array;
+  bool def_clen_func;
+  tree string_length;
+  int n;
+
+  /* Assignment of the form lhs = rhs.  */
+  gfc_start_block (&block);
+
+  gfc_init_se (&lse, NULL);
+  gfc_init_se (&rse, NULL);
+
+  /* Walk the lhs.  */
+  lss = gfc_walk_expr (expr1);
+  if (gfc_is_reallocatable_lhs (expr1)
+	&& !(expr2->expr_type == EXPR_FUNCTION
+	     && expr2->value.function.isym != NULL))
+    lss->is_alloc_lhs = 1;
+  rss = NULL;
+  if (lss != gfc_ss_terminator)
+    {
+      /* The assignment needs scalarization.  */
+      lss_section = lss;
+
+      /* Find a non-scalar SS from the lhs.  */
+      while (lss_section != gfc_ss_terminator
+	     && lss_section->type != GFC_SS_SECTION)
+	lss_section = lss_section->next;
+
+      gcc_assert (lss_section != gfc_ss_terminator);
+
+      /* Initialize the scalarizer.  */
+      gfc_init_loopinfo (&loop);
+
+      /* Walk the rhs.  */
+      rss = gfc_walk_expr (expr2);
+      if (rss == gfc_ss_terminator)
+	{
+	  /* The rhs is scalar.  Add a ss for the expression.  */
+	  rss = gfc_get_ss ();
+	  rss->next = gfc_ss_terminator;
+	  rss->type = GFC_SS_SCALAR;
+	  rss->expr = expr2;
+	}
+      /* Associate the SS with the loop.  */
+      gfc_add_ss_to_loop (&loop, lss);
+      gfc_add_ss_to_loop (&loop, rss);
+
+      /* Calculate the bounds of the scalarization.  */
+      gfc_conv_ss_startstride (&loop);
+      /* Enable loop reversal.  */
+      for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
+	loop.reverse[n] = GFC_ENABLE_REVERSE;
+      /* Resolve any data dependencies in the statement.  */
+      gfc_conv_resolve_dependencies (&loop, lss, rss);
+      /* Setup the scalarizing loops.  */
+      gfc_conv_loop_setup (&loop, &expr2->where);
+
+      /* Setup the gfc_se structures.  */
+      gfc_copy_loopinfo_to_se (&lse, &loop);
+      gfc_copy_loopinfo_to_se (&rse, &loop);
+
+      rse.ss = rss;
+      gfc_mark_ss_chain_used (rss, 1);
+      if (loop.temp_ss == NULL)
+	{
+	  lse.ss = lss;
+	  gfc_mark_ss_chain_used (lss, 1);
+	}
+      else
+	{
+	  lse.ss = loop.temp_ss;
+	  gfc_mark_ss_chain_used (lss, 3);
+	  gfc_mark_ss_chain_used (loop.temp_ss, 3);
+	}
+
+      /* Allow the scalarizer to workshare array assignments.  */
+      if ((ompws_flags & OMPWS_WORKSHARE_FLAG) && loop.temp_ss == NULL)
+	ompws_flags |= OMPWS_SCALARIZER_WS;
+
+      /* Start the scalarized loop body.  */
+      gfc_start_scalarized_body (&loop, &body);
+    }
+  else
+    gfc_init_block (&body);
+
+  l_is_temp = (lss != gfc_ss_terminator && loop.temp_ss != NULL);
+
+  /* Translate the expression.  */
+  gfc_conv_expr (&rse, expr2);
+
+  /* Stabilize a string length for temporaries.  */
+  if (expr2->ts.type == BT_CHARACTER)
+    string_length = gfc_evaluate_now (rse.string_length, &rse.pre);
+  else
+    string_length = NULL_TREE;
+
+  if (l_is_temp)
+    {
+      gfc_conv_tmp_array_ref (&lse);
+      if (expr2->ts.type == BT_CHARACTER)
+	lse.string_length = string_length;
+    }
+  else
+    gfc_conv_expr (&lse, expr1);
+
+  /* Assignments of scalar derived types with allocatable components
+     to arrays must be done with a deep copy and the rhs temporary
+     must have its components deallocated afterwards.  */
+  scalar_to_array = (expr2->ts.type == BT_DERIVED
+		       && expr2->ts.u.derived->attr.alloc_comp
+		       && !expr_is_variable (expr2)
+		       && !gfc_is_constant_expr (expr2)
+		       && expr1->rank && !expr2->rank);
+  if (scalar_to_array && dealloc)
+    {
+      tmp = gfc_deallocate_alloc_comp (expr2->ts.u.derived, rse.expr, 0);
+      gfc_add_expr_to_block (&loop.post, tmp);
+    }
+
+  /* For a deferred character length function, the function call must
+     happen before the (re)allocation of the lhs, otherwise the character
+     length of the result is not known.  */
+  def_clen_func = (((expr2->expr_type == EXPR_FUNCTION)
+			   || (expr2->expr_type == EXPR_COMPCALL)
+			   || (expr2->expr_type == EXPR_PPC))
+		       && expr2->ts.deferred);
+  if (gfc_option.flag_realloc_lhs
+	&& expr2->ts.type == BT_CHARACTER
+	&& (def_clen_func || expr2->expr_type == EXPR_OP)
+	&& expr1->ts.deferred)
+    gfc_add_block_to_block (&block, &rse.pre);
+
+  tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
+				 l_is_temp || init_flag,
+				 expr_is_variable (expr2) || scalar_to_array
+				 || expr2->expr_type == EXPR_ARRAY, dealloc);
+  gfc_add_expr_to_block (&body, tmp);
+
+  if (lss == gfc_ss_terminator)
+    {
+      /* F2003: Add the code for reallocation on assignment.  */
+      if (gfc_option.flag_realloc_lhs
+	    && is_scalar_reallocatable_lhs (expr1))
+	alloc_scalar_allocatable_for_assignment (&block, rse.string_length,
+						 expr1, expr2);
+
+      /* Use the scalar assignment as is.  */
+      gfc_add_block_to_block (&block, &body);
+    }
+  else
+    {
+      gcc_assert (lse.ss == gfc_ss_terminator
+		  && rse.ss == gfc_ss_terminator);
+
+      if (l_is_temp)
+	{
+	  gfc_trans_scalarized_loop_boundary (&loop, &body);
+
+	  /* We need to copy the temporary to the actual lhs.  */
+	  gfc_init_se (&lse, NULL);
+	  gfc_init_se (&rse, NULL);
+	  gfc_copy_loopinfo_to_se (&lse, &loop);
+	  gfc_copy_loopinfo_to_se (&rse, &loop);
+
+	  rse.ss = loop.temp_ss;
+	  lse.ss = lss;
+
+	  gfc_conv_tmp_array_ref (&rse);
+	  gfc_conv_expr (&lse, expr1);
+
+	  gcc_assert (lse.ss == gfc_ss_terminator
+		      && rse.ss == gfc_ss_terminator);
+
+	  if (expr2->ts.type == BT_CHARACTER)
+	    rse.string_length = string_length;
+
+	  tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
+					 false, false, dealloc);
+	  gfc_add_expr_to_block (&body, tmp);
+	}
+
+      /* F2003: Allocate or reallocate lhs of allocatable array.  */
+      if (gfc_option.flag_realloc_lhs
+	    && gfc_is_reallocatable_lhs (expr1)
+	    && !gfc_expr_attr (expr1).codimension
+	    && !gfc_is_coindexed (expr1))
+	{
+	  ompws_flags &= ~OMPWS_SCALARIZER_WS;
+	  tmp = gfc_alloc_allocatable_for_assignment (&loop, expr1, expr2);
+	  if (tmp != NULL_TREE)
+	    gfc_add_expr_to_block (&loop.code[expr1->rank - 1], tmp);
+	}
+
+      /* Generate the copying loops.  */
+      gfc_trans_scalarizing_loops (&loop, &body);
+
+      /* Wrap the whole thing up.  */
+      gfc_add_block_to_block (&block, &loop.pre);
+      gfc_add_block_to_block (&block, &loop.post);
+
+      gfc_cleanup_loop (&loop);
+    }
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Check whether EXPR is a copyable array.  */
+
+static bool
+copyable_array_p (gfc_expr * expr)
+{
+  if (expr->expr_type != EXPR_VARIABLE)
+    return false;
+
+  /* First check it's an array.  */
+  if (expr->rank < 1 || !expr->ref || expr->ref->next)
+    return false;
+
+  if (!gfc_full_array_ref_p (expr->ref, NULL))
+    return false;
+
+  /* Next check that it's of a simple enough type.  */
+  switch (expr->ts.type)
+    {
+    case BT_INTEGER:
+    case BT_REAL:
+    case BT_COMPLEX:
+    case BT_LOGICAL:
+      return true;
+
+    case BT_CHARACTER:
+      return false;
+
+    case BT_DERIVED:
+      return !expr->ts.u.derived->attr.alloc_comp;
+
+    default:
+      break;
+    }
+
+  return false;
+}
+
+/* Translate an assignment.  */
+
+tree
+gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
+		      bool dealloc)
+{
+  tree tmp;
+
+  /* Special case a single function returning an array.  */
+  if (expr2->expr_type == EXPR_FUNCTION && expr2->rank > 0)
+    {
+      tmp = gfc_trans_arrayfunc_assign (expr1, expr2);
+      if (tmp)
+	return tmp;
+    }
+
+  /* Special case assigning an array to zero.  */
+  if (copyable_array_p (expr1)
+      && is_zero_initializer_p (expr2))
+    {
+      tmp = gfc_trans_zero_assign (expr1);
+      if (tmp)
+        return tmp;
+    }
+
+  /* Special case copying one array to another.  */
+  if (copyable_array_p (expr1)
+      && copyable_array_p (expr2)
+      && gfc_compare_types (&expr1->ts, &expr2->ts)
+      && !gfc_check_dependency (expr1, expr2, 0))
+    {
+      tmp = gfc_trans_array_copy (expr1, expr2);
+      if (tmp)
+        return tmp;
+    }
+
+  /* Special case initializing an array from a constant array constructor.  */
+  if (copyable_array_p (expr1)
+      && expr2->expr_type == EXPR_ARRAY
+      && gfc_compare_types (&expr1->ts, &expr2->ts))
+    {
+      tmp = gfc_trans_array_constructor_copy (expr1, expr2);
+      if (tmp)
+	return tmp;
+    }
+
+  /* Fallback to the scalarizer to generate explicit loops.  */
+  return gfc_trans_assignment_1 (expr1, expr2, init_flag, dealloc);
+}
+
+tree
+gfc_trans_init_assign (gfc_code * code)
+{
+  return gfc_trans_assignment (code->expr1, code->expr2, true, false);
+}
+
+tree
+gfc_trans_assign (gfc_code * code)
+{
+  return gfc_trans_assignment (code->expr1, code->expr2, false, true);
+}
+
+
+/* Special case for initializing a polymorphic dummy with INTENT(OUT).
+   A MEMCPY is needed to copy the full data from the default initializer
+   of the dynamic type.  */
+
+tree
+gfc_trans_class_init_assign (gfc_code *code)
+{
+  stmtblock_t block;
+  tree tmp;
+  gfc_se dst,src,memsz;
+  gfc_expr *lhs,*rhs,*sz;
+
+  gfc_start_block (&block);
+
+  lhs = gfc_copy_expr (code->expr1);
+  gfc_add_data_component (lhs);
+
+  rhs = gfc_copy_expr (code->expr1);
+  gfc_add_vptr_component (rhs);
+
+  /* Make sure that the component backend_decls have been built, which
+     will not have happened if the derived types concerned have not
+     been referenced.  */
+  gfc_get_derived_type (rhs->ts.u.derived);
+  gfc_add_def_init_component (rhs);
+
+  sz = gfc_copy_expr (code->expr1);
+  gfc_add_vptr_component (sz);
+  gfc_add_size_component (sz);
+
+  gfc_init_se (&dst, NULL);
+  gfc_init_se (&src, NULL);
+  gfc_init_se (&memsz, NULL);
+  gfc_conv_expr (&dst, lhs);
+  gfc_conv_expr (&src, rhs);
+  gfc_conv_expr (&memsz, sz);
+  gfc_add_block_to_block (&block, &src.pre);
+  tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz.expr);
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Translate an assignment to a CLASS object
+   (pointer or ordinary assignment).  */
+
+tree
+gfc_trans_class_assign (gfc_expr *expr1, gfc_expr *expr2, gfc_exec_op op)
+{
+  stmtblock_t block;
+  tree tmp;
+  gfc_expr *lhs;
+  gfc_expr *rhs;
+
+  gfc_start_block (&block);
+
+  if (expr2->ts.type != BT_CLASS)
+    {
+      /* Insert an additional assignment which sets the '_vptr' field.  */
+      gfc_symbol *vtab = NULL;
+      gfc_symtree *st;
+
+      lhs = gfc_copy_expr (expr1);
+      gfc_add_vptr_component (lhs);
+
+      if (expr2->ts.type == BT_DERIVED)
+	vtab = gfc_find_derived_vtab (expr2->ts.u.derived);
+      else if (expr2->expr_type == EXPR_NULL)
+	vtab = gfc_find_derived_vtab (expr1->ts.u.derived);
+      gcc_assert (vtab);
+
+      rhs = gfc_get_expr ();
+      rhs->expr_type = EXPR_VARIABLE;
+      gfc_find_sym_tree (vtab->name, vtab->ns, 1, &st);
+      rhs->symtree = st;
+      rhs->ts = vtab->ts;
+
+      tmp = gfc_trans_pointer_assignment (lhs, rhs);
+      gfc_add_expr_to_block (&block, tmp);
+
+      gfc_free_expr (lhs);
+      gfc_free_expr (rhs);
+    }
+
+  /* Do the actual CLASS assignment.  */
+  if (expr2->ts.type == BT_CLASS)
+    op = EXEC_ASSIGN;
+  else
+    gfc_add_data_component (expr1);
+
+  if (op == EXEC_ASSIGN)
+    tmp = gfc_trans_assignment (expr1, expr2, false, true);
+  else if (op == EXEC_POINTER_ASSIGN)
+    tmp = gfc_trans_pointer_assignment (expr1, expr2);
+  else
+    gcc_unreachable();
+
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
new file mode 100644
index 000000000..1d55fbe76
--- /dev/null
+++ b/gcc/fortran/trans-intrinsic.c
@@ -0,0 +1,6439 @@
+/* Intrinsic translation
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+   and Steven Bosscher <s.bosscher@student.tudelft.nl>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* trans-intrinsic.c-- generate GENERIC trees for calls to intrinsics.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tm.h"		/* For UNITS_PER_WORD.  */
+#include "tree.h"
+#include "ggc.h"
+#include "diagnostic-core.h"	/* For internal_error.  */
+#include "toplev.h"	/* For rest_of_decl_compilation.  */
+#include "flags.h"
+#include "gfortran.h"
+#include "arith.h"
+#include "intrinsic.h"
+#include "trans.h"
+#include "trans-const.h"
+#include "trans-types.h"
+#include "trans-array.h"
+#include "defaults.h"
+/* Only for gfc_trans_assign and gfc_trans_pointer_assign.  */
+#include "trans-stmt.h"
+
+/* This maps fortran intrinsic math functions to external library or GCC
+   builtin functions.  */
+typedef struct GTY(()) gfc_intrinsic_map_t {
+  /* The explicit enum is required to work around inadequacies in the
+     garbage collection/gengtype parsing mechanism.  */
+  enum gfc_isym_id id;
+
+  /* Enum value from the "language-independent", aka C-centric, part
+     of gcc, or END_BUILTINS of no such value set.  */
+  enum built_in_function float_built_in;
+  enum built_in_function double_built_in;
+  enum built_in_function long_double_built_in;
+  enum built_in_function complex_float_built_in;
+  enum built_in_function complex_double_built_in;
+  enum built_in_function complex_long_double_built_in;
+
+  /* True if the naming pattern is to prepend "c" for complex and
+     append "f" for kind=4.  False if the naming pattern is to
+     prepend "_gfortran_" and append "[rc](4|8|10|16)".  */
+  bool libm_name;
+
+  /* True if a complex version of the function exists.  */
+  bool complex_available;
+
+  /* True if the function should be marked const.  */
+  bool is_constant;
+
+  /* The base library name of this function.  */
+  const char *name;
+
+  /* Cache decls created for the various operand types.  */
+  tree real4_decl;
+  tree real8_decl;
+  tree real10_decl;
+  tree real16_decl;
+  tree complex4_decl;
+  tree complex8_decl;
+  tree complex10_decl;
+  tree complex16_decl;
+}
+gfc_intrinsic_map_t;
+
+/* ??? The NARGS==1 hack here is based on the fact that (c99 at least)
+   defines complex variants of all of the entries in mathbuiltins.def
+   except for atan2.  */
+#define DEFINE_MATH_BUILTIN(ID, NAME, ARGTYPE) \
+  { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
+    BUILT_IN_ ## ID ## L, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+    true, false, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, \
+    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
+
+#define DEFINE_MATH_BUILTIN_C(ID, NAME, ARGTYPE) \
+  { GFC_ISYM_ ## ID, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
+    BUILT_IN_ ## ID ## L, BUILT_IN_C ## ID ## F, BUILT_IN_C ## ID, \
+    BUILT_IN_C ## ID ## L, true, true, true, NAME, NULL_TREE, NULL_TREE, \
+    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
+
+#define LIB_FUNCTION(ID, NAME, HAVE_COMPLEX) \
+  { GFC_ISYM_ ## ID, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+    END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+    false, HAVE_COMPLEX, true, NAME, NULL_TREE, NULL_TREE, NULL_TREE, \
+    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE }
+
+#define OTHER_BUILTIN(ID, NAME, TYPE, CONST) \
+  { GFC_ISYM_NONE, BUILT_IN_ ## ID ## F, BUILT_IN_ ## ID, \
+    BUILT_IN_ ## ID ## L, END_BUILTINS, END_BUILTINS, END_BUILTINS, \
+    true, false, CONST, NAME, NULL_TREE, NULL_TREE, \
+    NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE, NULL_TREE},
+
+static GTY(()) gfc_intrinsic_map_t gfc_intrinsic_map[] =
+{
+  /* Functions built into gcc itself (DEFINE_MATH_BUILTIN and
+     DEFINE_MATH_BUILTIN_C), then the built-ins that don't correspond
+     to any GFC_ISYM id directly, which use the OTHER_BUILTIN macro.  */
+#include "mathbuiltins.def"
+
+  /* Functions in libgfortran.  */
+  LIB_FUNCTION (ERFC_SCALED, "erfc_scaled", false),
+
+  /* End the list.  */
+  LIB_FUNCTION (NONE, NULL, false)
+
+};
+#undef OTHER_BUILTIN
+#undef LIB_FUNCTION
+#undef DEFINE_MATH_BUILTIN
+#undef DEFINE_MATH_BUILTIN_C
+
+
+enum rounding_mode { RND_ROUND, RND_TRUNC, RND_CEIL, RND_FLOOR };
+
+
+/* Find the correct variant of a given builtin from its argument.  */
+static tree
+builtin_decl_for_precision (enum built_in_function base_built_in,
+			    int precision)
+{
+  int i = END_BUILTINS;
+
+  gfc_intrinsic_map_t *m;
+  for (m = gfc_intrinsic_map; m->double_built_in != base_built_in ; m++)
+    ;
+
+  if (precision == TYPE_PRECISION (float_type_node))
+    i = m->float_built_in;
+  else if (precision == TYPE_PRECISION (double_type_node))
+    i = m->double_built_in;
+  else if (precision == TYPE_PRECISION (long_double_type_node))
+    i = m->long_double_built_in;
+  else if (precision == TYPE_PRECISION (float128_type_node))
+    {
+      /* Special treatment, because it is not exactly a built-in, but
+	 a library function.  */
+      return m->real16_decl;
+    }
+
+  return (i == END_BUILTINS ? NULL_TREE : built_in_decls[i]);
+}
+
+
+tree
+gfc_builtin_decl_for_float_kind (enum built_in_function double_built_in,
+				 int kind)
+{
+  int i = gfc_validate_kind (BT_REAL, kind, false);
+
+  if (gfc_real_kinds[i].c_float128)
+    {
+      /* For __float128, the story is a bit different, because we return
+	 a decl to a library function rather than a built-in.  */
+      gfc_intrinsic_map_t *m; 
+      for (m = gfc_intrinsic_map; m->double_built_in != double_built_in ; m++)
+	;
+
+      return m->real16_decl;
+    }
+
+  return builtin_decl_for_precision (double_built_in,
+				     gfc_real_kinds[i].mode_precision);
+}
+
+
+/* Evaluate the arguments to an intrinsic function.  The value
+   of NARGS may be less than the actual number of arguments in EXPR
+   to allow optional "KIND" arguments that are not included in the
+   generated code to be ignored.  */
+
+static void
+gfc_conv_intrinsic_function_args (gfc_se *se, gfc_expr *expr,
+				  tree *argarray, int nargs)
+{
+  gfc_actual_arglist *actual;
+  gfc_expr *e;
+  gfc_intrinsic_arg  *formal;
+  gfc_se argse;
+  int curr_arg;
+
+  formal = expr->value.function.isym->formal;
+  actual = expr->value.function.actual;
+
+   for (curr_arg = 0; curr_arg < nargs; curr_arg++,
+	actual = actual->next,
+	formal = formal ? formal->next : NULL)
+    {
+      gcc_assert (actual);
+      e = actual->expr;
+      /* Skip omitted optional arguments.  */
+      if (!e)
+	{
+	  --curr_arg;
+	  continue;
+	}
+
+      /* Evaluate the parameter.  This will substitute scalarized
+         references automatically.  */
+      gfc_init_se (&argse, se);
+
+      if (e->ts.type == BT_CHARACTER)
+	{
+	  gfc_conv_expr (&argse, e);
+	  gfc_conv_string_parameter (&argse);
+          argarray[curr_arg++] = argse.string_length;
+	  gcc_assert (curr_arg < nargs);
+	}
+      else
+        gfc_conv_expr_val (&argse, e);
+
+      /* If an optional argument is itself an optional dummy argument,
+	 check its presence and substitute a null if absent.  */
+      if (e->expr_type == EXPR_VARIABLE
+	    && e->symtree->n.sym->attr.optional
+	    && formal
+	    && formal->optional)
+	gfc_conv_missing_dummy (&argse, e, formal->ts, 0);
+
+      gfc_add_block_to_block (&se->pre, &argse.pre);
+      gfc_add_block_to_block (&se->post, &argse.post);
+      argarray[curr_arg] = argse.expr;
+    }
+}
+
+/* Count the number of actual arguments to the intrinsic function EXPR
+   including any "hidden" string length arguments.  */
+
+static unsigned int
+gfc_intrinsic_argument_list_length (gfc_expr *expr)
+{
+  int n = 0;
+  gfc_actual_arglist *actual;
+
+  for (actual = expr->value.function.actual; actual; actual = actual->next)
+    {
+      if (!actual->expr)
+	continue;
+
+      if (actual->expr->ts.type == BT_CHARACTER)
+	n += 2;
+      else
+	n++;
+    }
+
+  return n;
+}
+
+
+/* Conversions between different types are output by the frontend as
+   intrinsic functions.  We implement these directly with inline code.  */
+
+static void
+gfc_conv_intrinsic_conversion (gfc_se * se, gfc_expr * expr)
+{
+  tree type;
+  tree *args;
+  int nargs;
+
+  nargs = gfc_intrinsic_argument_list_length (expr);
+  args = XALLOCAVEC (tree, nargs);
+
+  /* Evaluate all the arguments passed. Whilst we're only interested in the 
+     first one here, there are other parts of the front-end that assume this 
+     and will trigger an ICE if it's not the case.  */
+  type = gfc_typenode_for_spec (&expr->ts);
+  gcc_assert (expr->value.function.actual->expr);
+  gfc_conv_intrinsic_function_args (se, expr, args, nargs);
+
+  /* Conversion between character kinds involves a call to a library
+     function.  */
+  if (expr->ts.type == BT_CHARACTER)
+    {
+      tree fndecl, var, addr, tmp;
+
+      if (expr->ts.kind == 1
+	  && expr->value.function.actual->expr->ts.kind == 4)
+	fndecl = gfor_fndecl_convert_char4_to_char1;
+      else if (expr->ts.kind == 4
+	       && expr->value.function.actual->expr->ts.kind == 1)
+	fndecl = gfor_fndecl_convert_char1_to_char4;
+      else
+	gcc_unreachable ();
+
+      /* Create the variable storing the converted value.  */
+      type = gfc_get_pchar_type (expr->ts.kind);
+      var = gfc_create_var (type, "str");
+      addr = gfc_build_addr_expr (build_pointer_type (type), var);
+
+      /* Call the library function that will perform the conversion.  */
+      gcc_assert (nargs >= 2);
+      tmp = build_call_expr_loc (input_location,
+			     fndecl, 3, addr, args[0], args[1]);
+      gfc_add_expr_to_block (&se->pre, tmp);
+
+      /* Free the temporary afterwards.  */
+      tmp = gfc_call_free (var);
+      gfc_add_expr_to_block (&se->post, tmp);
+
+      se->expr = var;
+      se->string_length = args[0];
+
+      return;
+    }
+
+  /* Conversion from complex to non-complex involves taking the real
+     component of the value.  */
+  if (TREE_CODE (TREE_TYPE (args[0])) == COMPLEX_TYPE
+      && expr->ts.type != BT_COMPLEX)
+    {
+      tree artype;
+
+      artype = TREE_TYPE (TREE_TYPE (args[0]));
+      args[0] = fold_build1_loc (input_location, REALPART_EXPR, artype,
+				 args[0]);
+    }
+
+  se->expr = convert (type, args[0]);
+}
+
+/* This is needed because the gcc backend only implements
+   FIX_TRUNC_EXPR, which is the same as INT() in Fortran.
+   FLOOR(x) = INT(x) <= x ? INT(x) : INT(x) - 1
+   Similarly for CEILING.  */
+
+static tree
+build_fixbound_expr (stmtblock_t * pblock, tree arg, tree type, int up)
+{
+  tree tmp;
+  tree cond;
+  tree argtype;
+  tree intval;
+
+  argtype = TREE_TYPE (arg);
+  arg = gfc_evaluate_now (arg, pblock);
+
+  intval = convert (type, arg);
+  intval = gfc_evaluate_now (intval, pblock);
+
+  tmp = convert (argtype, intval);
+  cond = fold_build2_loc (input_location, up ? GE_EXPR : LE_EXPR,
+			  boolean_type_node, tmp, arg);
+
+  tmp = fold_build2_loc (input_location, up ? PLUS_EXPR : MINUS_EXPR, type,
+			 intval, build_int_cst (type, 1));
+  tmp = fold_build3_loc (input_location, COND_EXPR, type, cond, intval, tmp);
+  return tmp;
+}
+
+
+/* Round to nearest integer, away from zero.  */
+
+static tree
+build_round_expr (tree arg, tree restype)
+{
+  tree argtype;
+  tree fn;
+  bool longlong;
+  int argprec, resprec;
+
+  argtype = TREE_TYPE (arg);
+  argprec = TYPE_PRECISION (argtype);
+  resprec = TYPE_PRECISION (restype);
+
+  /* Depending on the type of the result, choose the long int intrinsic
+     (lround family) or long long intrinsic (llround).  We might also
+     need to convert the result afterwards.  */
+  if (resprec <= LONG_TYPE_SIZE)
+    longlong = false;
+  else if (resprec <= LONG_LONG_TYPE_SIZE)
+    longlong = true;
+  else
+    gcc_unreachable ();
+
+  /* Now, depending on the argument type, we choose between intrinsics.  */
+  if (longlong)
+    fn = builtin_decl_for_precision (BUILT_IN_LLROUND, argprec);
+  else
+    fn = builtin_decl_for_precision (BUILT_IN_LROUND, argprec);
+
+  return fold_convert (restype, build_call_expr_loc (input_location,
+						 fn, 1, arg));
+}
+
+
+/* Convert a real to an integer using a specific rounding mode.
+   Ideally we would just build the corresponding GENERIC node,
+   however the RTL expander only actually supports FIX_TRUNC_EXPR.  */
+
+static tree
+build_fix_expr (stmtblock_t * pblock, tree arg, tree type,
+               enum rounding_mode op)
+{
+  switch (op)
+    {
+    case RND_FLOOR:
+      return build_fixbound_expr (pblock, arg, type, 0);
+      break;
+
+    case RND_CEIL:
+      return build_fixbound_expr (pblock, arg, type, 1);
+      break;
+
+    case RND_ROUND:
+      return build_round_expr (arg, type);
+      break;
+
+    case RND_TRUNC:
+      return fold_build1_loc (input_location, FIX_TRUNC_EXPR, type, arg);
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+}
+
+
+/* Round a real value using the specified rounding mode.
+   We use a temporary integer of that same kind size as the result.
+   Values larger than those that can be represented by this kind are
+   unchanged, as they will not be accurate enough to represent the
+   rounding.
+    huge = HUGE (KIND (a))
+    aint (a) = ((a > huge) || (a < -huge)) ? a : (real)(int)a
+   */
+
+static void
+gfc_conv_intrinsic_aint (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
+{
+  tree type;
+  tree itype;
+  tree arg[2];
+  tree tmp;
+  tree cond;
+  tree decl;
+  mpfr_t huge;
+  int n, nargs;
+  int kind;
+
+  kind = expr->ts.kind;
+  nargs = gfc_intrinsic_argument_list_length (expr);
+
+  decl = NULL_TREE;
+  /* We have builtin functions for some cases.  */
+  switch (op)
+    {
+    case RND_ROUND:
+      decl = gfc_builtin_decl_for_float_kind (BUILT_IN_ROUND, kind);
+      break;
+
+    case RND_TRUNC:
+      decl = gfc_builtin_decl_for_float_kind (BUILT_IN_TRUNC, kind);
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+
+  /* Evaluate the argument.  */
+  gcc_assert (expr->value.function.actual->expr);
+  gfc_conv_intrinsic_function_args (se, expr, arg, nargs);
+
+  /* Use a builtin function if one exists.  */
+  if (decl != NULL_TREE)
+    {
+      se->expr = build_call_expr_loc (input_location, decl, 1, arg[0]);
+      return;
+    }
+
+  /* This code is probably redundant, but we'll keep it lying around just
+     in case.  */
+  type = gfc_typenode_for_spec (&expr->ts);
+  arg[0] = gfc_evaluate_now (arg[0], &se->pre);
+
+  /* Test if the value is too large to handle sensibly.  */
+  gfc_set_model_kind (kind);
+  mpfr_init (huge);
+  n = gfc_validate_kind (BT_INTEGER, kind, false);
+  mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE);
+  tmp = gfc_conv_mpfr_to_tree (huge, kind, 0);
+  cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, arg[0],
+			  tmp);
+
+  mpfr_neg (huge, huge, GFC_RND_MODE);
+  tmp = gfc_conv_mpfr_to_tree (huge, kind, 0);
+  tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, arg[0],
+			 tmp);
+  cond = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node,
+			  cond, tmp);
+  itype = gfc_get_int_type (kind);
+
+  tmp = build_fix_expr (&se->pre, arg[0], itype, op);
+  tmp = convert (type, tmp);
+  se->expr = fold_build3_loc (input_location, COND_EXPR, type, cond, tmp,
+			      arg[0]);
+  mpfr_clear (huge);
+}
+
+
+/* Convert to an integer using the specified rounding mode.  */
+
+static void
+gfc_conv_intrinsic_int (gfc_se * se, gfc_expr * expr, enum rounding_mode op)
+{
+  tree type;
+  tree *args;
+  int nargs;
+
+  nargs = gfc_intrinsic_argument_list_length (expr);
+  args = XALLOCAVEC (tree, nargs);
+
+  /* Evaluate the argument, we process all arguments even though we only 
+     use the first one for code generation purposes.  */
+  type = gfc_typenode_for_spec (&expr->ts);
+  gcc_assert (expr->value.function.actual->expr);
+  gfc_conv_intrinsic_function_args (se, expr, args, nargs);
+
+  if (TREE_CODE (TREE_TYPE (args[0])) == INTEGER_TYPE)
+    {
+      /* Conversion to a different integer kind.  */
+      se->expr = convert (type, args[0]);
+    }
+  else
+    {
+      /* Conversion from complex to non-complex involves taking the real
+         component of the value.  */
+      if (TREE_CODE (TREE_TYPE (args[0])) == COMPLEX_TYPE
+	  && expr->ts.type != BT_COMPLEX)
+	{
+	  tree artype;
+
+	  artype = TREE_TYPE (TREE_TYPE (args[0]));
+	  args[0] = fold_build1_loc (input_location, REALPART_EXPR, artype,
+				     args[0]);
+	}
+
+      se->expr = build_fix_expr (&se->pre, args[0], type, op);
+    }
+}
+
+
+/* Get the imaginary component of a value.  */
+
+static void
+gfc_conv_intrinsic_imagpart (gfc_se * se, gfc_expr * expr)
+{
+  tree arg;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  se->expr = fold_build1_loc (input_location, IMAGPART_EXPR,
+			      TREE_TYPE (TREE_TYPE (arg)), arg);
+}
+
+
+/* Get the complex conjugate of a value.  */
+
+static void
+gfc_conv_intrinsic_conjg (gfc_se * se, gfc_expr * expr)
+{
+  tree arg;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  se->expr = fold_build1_loc (input_location, CONJ_EXPR, TREE_TYPE (arg), arg);
+}
+
+
+
+static tree
+define_quad_builtin (const char *name, tree type, bool is_const)
+{
+  tree fndecl;
+  fndecl = build_decl (input_location, FUNCTION_DECL, get_identifier (name),
+		       type);
+
+  /* Mark the decl as external.  */
+  DECL_EXTERNAL (fndecl) = 1;
+  TREE_PUBLIC (fndecl) = 1;
+
+  /* Mark it __attribute__((const)).  */
+  TREE_READONLY (fndecl) = is_const;
+
+  rest_of_decl_compilation (fndecl, 1, 0);
+
+  return fndecl;
+}
+
+
+
+/* Initialize function decls for library functions.  The external functions
+   are created as required.  Builtin functions are added here.  */
+
+void
+gfc_build_intrinsic_lib_fndecls (void)
+{
+  gfc_intrinsic_map_t *m;
+  tree quad_decls[END_BUILTINS + 1];
+
+  if (gfc_real16_is_float128)
+  {
+    /* If we have soft-float types, we create the decls for their
+       C99-like library functions.  For now, we only handle __float128
+       q-suffixed functions.  */
+
+    tree tmp, func_1, func_2, func_cabs, func_frexp;
+    tree func_lround, func_llround, func_scalbn, func_cpow;
+
+    memset (quad_decls, 0, sizeof(tree) * (END_BUILTINS + 1));
+
+    /* type (*) (type) */
+    tmp = tree_cons (NULL_TREE, float128_type_node, void_list_node);
+    func_1 = build_function_type (float128_type_node, tmp);
+    /* long (*) (type) */
+    func_lround = build_function_type (long_integer_type_node, tmp);
+    /* long long (*) (type) */
+    func_llround = build_function_type (long_long_integer_type_node, tmp);
+    /* type (*) (type, type) */
+    tmp = tree_cons (NULL_TREE, float128_type_node, tmp);
+    func_2 = build_function_type (float128_type_node, tmp);
+    /* type (*) (type, &int) */
+    tmp = tree_cons (NULL_TREE, float128_type_node, void_list_node);
+    tmp = tree_cons (NULL_TREE, build_pointer_type (integer_type_node), tmp);
+    func_frexp = build_function_type (float128_type_node, tmp);
+    /* type (*) (type, int) */
+    tmp = tree_cons (NULL_TREE, float128_type_node, void_list_node);
+    tmp = tree_cons (NULL_TREE, integer_type_node, tmp);
+    func_scalbn = build_function_type (float128_type_node, tmp);
+    /* type (*) (complex type) */
+    tmp = tree_cons (NULL_TREE, complex_float128_type_node, void_list_node);
+    func_cabs = build_function_type (float128_type_node, tmp);
+    /* complex type (*) (complex type, complex type) */
+    tmp = tree_cons (NULL_TREE, complex_float128_type_node, tmp);
+    func_cpow = build_function_type (complex_float128_type_node, tmp);
+
+#define DEFINE_MATH_BUILTIN(ID, NAME, ARGTYPE)
+#define DEFINE_MATH_BUILTIN_C(ID, NAME, ARGTYPE)
+#define LIB_FUNCTION(ID, NAME, HAVE_COMPLEX)
+
+    /* Only these built-ins are actually needed here. These are used directly
+       from the code, when calling builtin_decl_for_precision() or
+       builtin_decl_for_float_type(). The others are all constructed by
+       gfc_get_intrinsic_lib_fndecl().  */
+#define OTHER_BUILTIN(ID, NAME, TYPE, CONST) \
+  quad_decls[BUILT_IN_ ## ID] = define_quad_builtin (NAME "q", func_ ## TYPE, CONST);
+
+#include "mathbuiltins.def"
+
+#undef OTHER_BUILTIN
+#undef LIB_FUNCTION
+#undef DEFINE_MATH_BUILTIN
+#undef DEFINE_MATH_BUILTIN_C
+
+  }
+
+  /* Add GCC builtin functions.  */
+  for (m = gfc_intrinsic_map;
+       m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++)
+    {
+      if (m->float_built_in != END_BUILTINS)
+	m->real4_decl = built_in_decls[m->float_built_in];
+      if (m->complex_float_built_in != END_BUILTINS)
+	m->complex4_decl = built_in_decls[m->complex_float_built_in];
+      if (m->double_built_in != END_BUILTINS)
+	m->real8_decl = built_in_decls[m->double_built_in];
+      if (m->complex_double_built_in != END_BUILTINS)
+	m->complex8_decl = built_in_decls[m->complex_double_built_in];
+
+      /* If real(kind=10) exists, it is always long double.  */
+      if (m->long_double_built_in != END_BUILTINS)
+	m->real10_decl = built_in_decls[m->long_double_built_in];
+      if (m->complex_long_double_built_in != END_BUILTINS)
+	m->complex10_decl = built_in_decls[m->complex_long_double_built_in];
+
+      if (!gfc_real16_is_float128)
+	{
+	  if (m->long_double_built_in != END_BUILTINS)
+	    m->real16_decl = built_in_decls[m->long_double_built_in];
+	  if (m->complex_long_double_built_in != END_BUILTINS)
+	    m->complex16_decl = built_in_decls[m->complex_long_double_built_in];
+	}
+      else if (quad_decls[m->double_built_in] != NULL_TREE)
+        {
+	  /* Quad-precision function calls are constructed when first
+	     needed by builtin_decl_for_precision(), except for those
+	     that will be used directly (define by OTHER_BUILTIN).  */
+	  m->real16_decl = quad_decls[m->double_built_in];
+	}
+      else if (quad_decls[m->complex_double_built_in] != NULL_TREE)
+        {
+	  /* Same thing for the complex ones.  */
+	  m->complex16_decl = quad_decls[m->double_built_in];
+	}
+    }
+}
+
+
+/* Create a fndecl for a simple intrinsic library function.  */
+
+static tree
+gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr)
+{
+  tree type;
+  tree argtypes;
+  tree fndecl;
+  gfc_actual_arglist *actual;
+  tree *pdecl;
+  gfc_typespec *ts;
+  char name[GFC_MAX_SYMBOL_LEN + 3];
+
+  ts = &expr->ts;
+  if (ts->type == BT_REAL)
+    {
+      switch (ts->kind)
+	{
+	case 4:
+	  pdecl = &m->real4_decl;
+	  break;
+	case 8:
+	  pdecl = &m->real8_decl;
+	  break;
+	case 10:
+	  pdecl = &m->real10_decl;
+	  break;
+	case 16:
+	  pdecl = &m->real16_decl;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+    }
+  else if (ts->type == BT_COMPLEX)
+    {
+      gcc_assert (m->complex_available);
+
+      switch (ts->kind)
+	{
+	case 4:
+	  pdecl = &m->complex4_decl;
+	  break;
+	case 8:
+	  pdecl = &m->complex8_decl;
+	  break;
+	case 10:
+	  pdecl = &m->complex10_decl;
+	  break;
+	case 16:
+	  pdecl = &m->complex16_decl;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+    }
+  else
+    gcc_unreachable ();
+
+  if (*pdecl)
+    return *pdecl;
+
+  if (m->libm_name)
+    {
+      int n = gfc_validate_kind (BT_REAL, ts->kind, false);
+      if (gfc_real_kinds[n].c_float)
+	snprintf (name, sizeof (name), "%s%s%s",
+		  ts->type == BT_COMPLEX ? "c" : "", m->name, "f");
+      else if (gfc_real_kinds[n].c_double)
+	snprintf (name, sizeof (name), "%s%s",
+		  ts->type == BT_COMPLEX ? "c" : "", m->name);
+      else if (gfc_real_kinds[n].c_long_double)
+	snprintf (name, sizeof (name), "%s%s%s",
+		  ts->type == BT_COMPLEX ? "c" : "", m->name, "l");
+      else if (gfc_real_kinds[n].c_float128)
+	snprintf (name, sizeof (name), "%s%s%s",
+		  ts->type == BT_COMPLEX ? "c" : "", m->name, "q");
+      else
+	gcc_unreachable ();
+    }
+  else
+    {
+      snprintf (name, sizeof (name), PREFIX ("%s_%c%d"), m->name,
+		ts->type == BT_COMPLEX ? 'c' : 'r',
+		ts->kind);
+    }
+
+  argtypes = NULL_TREE;
+  for (actual = expr->value.function.actual; actual; actual = actual->next)
+    {
+      type = gfc_typenode_for_spec (&actual->expr->ts);
+      argtypes = gfc_chainon_list (argtypes, type);
+    }
+  argtypes = chainon (argtypes, void_list_node);
+  type = build_function_type (gfc_typenode_for_spec (ts), argtypes);
+  fndecl = build_decl (input_location,
+		       FUNCTION_DECL, get_identifier (name), type);
+
+  /* Mark the decl as external.  */
+  DECL_EXTERNAL (fndecl) = 1;
+  TREE_PUBLIC (fndecl) = 1;
+
+  /* Mark it __attribute__((const)), if possible.  */
+  TREE_READONLY (fndecl) = m->is_constant;
+
+  rest_of_decl_compilation (fndecl, 1, 0);
+
+  (*pdecl) = fndecl;
+  return fndecl;
+}
+
+
+/* Convert an intrinsic function into an external or builtin call.  */
+
+static void
+gfc_conv_intrinsic_lib_function (gfc_se * se, gfc_expr * expr)
+{
+  gfc_intrinsic_map_t *m;
+  tree fndecl;
+  tree rettype;
+  tree *args;
+  unsigned int num_args;
+  gfc_isym_id id;
+
+  id = expr->value.function.isym->id;
+  /* Find the entry for this function.  */
+  for (m = gfc_intrinsic_map;
+       m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++)
+    {
+      if (id == m->id)
+	break;
+    }
+
+  if (m->id == GFC_ISYM_NONE)
+    {
+      internal_error ("Intrinsic function %s(%d) not recognized",
+		      expr->value.function.name, id);
+    }
+
+  /* Get the decl and generate the call.  */
+  num_args = gfc_intrinsic_argument_list_length (expr);
+  args = XALLOCAVEC (tree, num_args);
+
+  gfc_conv_intrinsic_function_args (se, expr, args, num_args);
+  fndecl = gfc_get_intrinsic_lib_fndecl (m, expr);
+  rettype = TREE_TYPE (TREE_TYPE (fndecl));
+
+  fndecl = build_addr (fndecl, current_function_decl);
+  se->expr = build_call_array_loc (input_location, rettype, fndecl, num_args, args);
+}
+
+
+/* If bounds-checking is enabled, create code to verify at runtime that the
+   string lengths for both expressions are the same (needed for e.g. MERGE).
+   If bounds-checking is not enabled, does nothing.  */
+
+void
+gfc_trans_same_strlen_check (const char* intr_name, locus* where,
+			     tree a, tree b, stmtblock_t* target)
+{
+  tree cond;
+  tree name;
+
+  /* If bounds-checking is disabled, do nothing.  */
+  if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS))
+    return;
+
+  /* Compare the two string lengths.  */
+  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, a, b);
+
+  /* Output the runtime-check.  */
+  name = gfc_build_cstring_const (intr_name);
+  name = gfc_build_addr_expr (pchar_type_node, name);
+  gfc_trans_runtime_check (true, false, cond, target, where,
+			   "Unequal character lengths (%ld/%ld) in %s",
+			   fold_convert (long_integer_type_node, a),
+			   fold_convert (long_integer_type_node, b), name);
+}
+
+
+/* The EXPONENT(s) intrinsic function is translated into
+       int ret;
+       frexp (s, &ret);
+       return ret;
+ */
+
+static void
+gfc_conv_intrinsic_exponent (gfc_se *se, gfc_expr *expr)
+{
+  tree arg, type, res, tmp, frexp;
+
+  frexp = gfc_builtin_decl_for_float_kind (BUILT_IN_FREXP,
+				       expr->value.function.actual->expr->ts.kind);
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+
+  res = gfc_create_var (integer_type_node, NULL);
+  tmp = build_call_expr_loc (input_location, frexp, 2, arg,
+			     gfc_build_addr_expr (NULL_TREE, res));
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  se->expr = fold_convert (type, res);
+}
+
+/* Evaluate a single upper or lower bound.  */
+/* TODO: bound intrinsic generates way too much unnecessary code.  */
+
+static void
+gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
+{
+  gfc_actual_arglist *arg;
+  gfc_actual_arglist *arg2;
+  tree desc;
+  tree type;
+  tree bound;
+  tree tmp;
+  tree cond, cond1, cond3, cond4, size;
+  tree ubound;
+  tree lbound;
+  gfc_se argse;
+  gfc_ss *ss;
+  gfc_array_spec * as;
+
+  arg = expr->value.function.actual;
+  arg2 = arg->next;
+
+  if (se->ss)
+    {
+      /* Create an implicit second parameter from the loop variable.  */
+      gcc_assert (!arg2->expr);
+      gcc_assert (se->loop->dimen == 1);
+      gcc_assert (se->ss->expr == expr);
+      gfc_advance_se_ss_chain (se);
+      bound = se->loop->loopvar[0];
+      bound = fold_build2_loc (input_location, MINUS_EXPR,
+			       gfc_array_index_type, bound,
+			       se->loop->from[0]);
+    }
+  else
+    {
+      /* use the passed argument.  */
+      gcc_assert (arg->next->expr);
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_type (&argse, arg->next->expr, gfc_array_index_type);
+      gfc_add_block_to_block (&se->pre, &argse.pre);
+      bound = argse.expr;
+      /* Convert from one based to zero based.  */
+      bound = fold_build2_loc (input_location, MINUS_EXPR,
+			       gfc_array_index_type, bound,
+			       gfc_index_one_node);
+    }
+
+  /* TODO: don't re-evaluate the descriptor on each iteration.  */
+  /* Get a descriptor for the first parameter.  */
+  ss = gfc_walk_expr (arg->expr);
+  gcc_assert (ss != gfc_ss_terminator);
+  gfc_init_se (&argse, NULL);
+  gfc_conv_expr_descriptor (&argse, arg->expr, ss);
+  gfc_add_block_to_block (&se->pre, &argse.pre);
+  gfc_add_block_to_block (&se->post, &argse.post);
+
+  desc = argse.expr;
+
+  if (INTEGER_CST_P (bound))
+    {
+      int hi, low;
+
+      hi = TREE_INT_CST_HIGH (bound);
+      low = TREE_INT_CST_LOW (bound);
+      if (hi || low < 0 || low >= GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc)))
+	gfc_error ("'dim' argument of %s intrinsic at %L is not a valid "
+		   "dimension index", upper ? "UBOUND" : "LBOUND",
+		   &expr->where);
+    }
+  else
+    {
+      if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+        {
+          bound = gfc_evaluate_now (bound, &se->pre);
+          cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+				  bound, build_int_cst (TREE_TYPE (bound), 0));
+          tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
+          tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
+				 bound, tmp);
+          cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
+				  boolean_type_node, cond, tmp);
+          gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
+				   gfc_msg_fault);
+        }
+    }
+
+  ubound = gfc_conv_descriptor_ubound_get (desc, bound);
+  lbound = gfc_conv_descriptor_lbound_get (desc, bound);
+  
+  as = gfc_get_full_arrayspec_from_expr (arg->expr);
+
+  /* 13.14.53: Result value for LBOUND
+
+     Case (i): For an array section or for an array expression other than a
+               whole array or array structure component, LBOUND(ARRAY, DIM)
+               has the value 1.  For a whole array or array structure
+               component, LBOUND(ARRAY, DIM) has the value:
+                 (a) equal to the lower bound for subscript DIM of ARRAY if
+                     dimension DIM of ARRAY does not have extent zero
+                     or if ARRAY is an assumed-size array of rank DIM,
+              or (b) 1 otherwise.
+
+     13.14.113: Result value for UBOUND
+
+     Case (i): For an array section or for an array expression other than a
+               whole array or array structure component, UBOUND(ARRAY, DIM)
+               has the value equal to the number of elements in the given
+               dimension; otherwise, it has a value equal to the upper bound
+               for subscript DIM of ARRAY if dimension DIM of ARRAY does
+               not have size zero and has value zero if dimension DIM has
+               size zero.  */
+
+  if (as)
+    {
+      tree stride = gfc_conv_descriptor_stride_get (desc, bound);
+
+      cond1 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
+			       ubound, lbound);
+      cond3 = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
+			       stride, gfc_index_zero_node);
+      cond3 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+			       boolean_type_node, cond3, cond1);
+      cond4 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+			       stride, gfc_index_zero_node);
+
+      if (upper)
+	{
+	  tree cond5;
+	  cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+				  boolean_type_node, cond3, cond4);
+	  cond5 = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				   gfc_index_one_node, lbound);
+	  cond5 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+				   boolean_type_node, cond4, cond5);
+
+	  cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+				  boolean_type_node, cond, cond5);
+
+	  se->expr = fold_build3_loc (input_location, COND_EXPR,
+				      gfc_array_index_type, cond,
+				      ubound, gfc_index_zero_node);
+	}
+      else
+	{
+	  if (as->type == AS_ASSUMED_SIZE)
+	    cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				    bound, build_int_cst (TREE_TYPE (bound),
+							  arg->expr->rank - 1));
+	  else
+	    cond = boolean_false_node;
+
+	  cond1 = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+				   boolean_type_node, cond3, cond4);
+	  cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+				  boolean_type_node, cond, cond1);
+
+	  se->expr = fold_build3_loc (input_location, COND_EXPR,
+				      gfc_array_index_type, cond,
+				      lbound, gfc_index_one_node);
+	}
+    }
+  else
+    {
+      if (upper)
+        {
+	  size = fold_build2_loc (input_location, MINUS_EXPR,
+				  gfc_array_index_type, ubound, lbound);
+	  se->expr = fold_build2_loc (input_location, PLUS_EXPR,
+				      gfc_array_index_type, size,
+				  gfc_index_one_node);
+	  se->expr = fold_build2_loc (input_location, MAX_EXPR,
+				      gfc_array_index_type, se->expr,
+				      gfc_index_zero_node);
+	}
+      else
+	se->expr = gfc_index_one_node;
+    }
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  se->expr = convert (type, se->expr);
+}
+
+
+static void
+gfc_conv_intrinsic_abs (gfc_se * se, gfc_expr * expr)
+{
+  tree arg, cabs;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+
+  switch (expr->value.function.actual->expr->ts.type)
+    {
+    case BT_INTEGER:
+    case BT_REAL:
+      se->expr = fold_build1_loc (input_location, ABS_EXPR, TREE_TYPE (arg),
+				  arg);
+      break;
+
+    case BT_COMPLEX:
+      cabs = gfc_builtin_decl_for_float_kind (BUILT_IN_CABS, expr->ts.kind);
+      se->expr = build_call_expr_loc (input_location, cabs, 1, arg);
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+}
+
+
+/* Create a complex value from one or two real components.  */
+
+static void
+gfc_conv_intrinsic_cmplx (gfc_se * se, gfc_expr * expr, int both)
+{
+  tree real;
+  tree imag;
+  tree type;
+  tree *args;
+  unsigned int num_args;
+
+  num_args = gfc_intrinsic_argument_list_length (expr);
+  args = XALLOCAVEC (tree, num_args);
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  gfc_conv_intrinsic_function_args (se, expr, args, num_args);
+  real = convert (TREE_TYPE (type), args[0]);
+  if (both)
+    imag = convert (TREE_TYPE (type), args[1]);
+  else if (TREE_CODE (TREE_TYPE (args[0])) == COMPLEX_TYPE)
+    {
+      imag = fold_build1_loc (input_location, IMAGPART_EXPR,
+			      TREE_TYPE (TREE_TYPE (args[0])), args[0]);
+      imag = convert (TREE_TYPE (type), imag);
+    }
+  else
+    imag = build_real_from_int_cst (TREE_TYPE (type), integer_zero_node);
+
+  se->expr = fold_build2_loc (input_location, COMPLEX_EXPR, type, real, imag);
+}
+
+/* Remainder function MOD(A, P) = A - INT(A / P) * P
+                      MODULO(A, P) = A - FLOOR (A / P) * P  */
+/* TODO: MOD(x, 0)  */
+
+static void
+gfc_conv_intrinsic_mod (gfc_se * se, gfc_expr * expr, int modulo)
+{
+  tree type;
+  tree itype;
+  tree tmp;
+  tree test;
+  tree test2;
+  tree fmod;
+  mpfr_t huge;
+  int n, ikind;
+  tree args[2];
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+
+  switch (expr->ts.type)
+    {
+    case BT_INTEGER:
+      /* Integer case is easy, we've got a builtin op.  */
+      type = TREE_TYPE (args[0]);
+
+      if (modulo)
+       se->expr = fold_build2_loc (input_location, FLOOR_MOD_EXPR, type,
+				   args[0], args[1]);
+      else
+       se->expr = fold_build2_loc (input_location, TRUNC_MOD_EXPR, type,
+				   args[0], args[1]);
+      break;
+
+    case BT_REAL:
+      fmod = NULL_TREE;
+      /* Check if we have a builtin fmod.  */
+      fmod = gfc_builtin_decl_for_float_kind (BUILT_IN_FMOD, expr->ts.kind);
+
+      /* Use it if it exists.  */
+      if (fmod != NULL_TREE)
+	{
+  	  tmp = build_addr (fmod, current_function_decl);
+	  se->expr = build_call_array_loc (input_location,
+				       TREE_TYPE (TREE_TYPE (fmod)),
+                                       tmp, 2, args);
+	  if (modulo == 0)
+	    return;
+	}
+
+      type = TREE_TYPE (args[0]);
+
+      args[0] = gfc_evaluate_now (args[0], &se->pre);
+      args[1] = gfc_evaluate_now (args[1], &se->pre);
+
+      /* Definition:
+	 modulo = arg - floor (arg/arg2) * arg2, so
+		= test ? fmod (arg, arg2) : fmod (arg, arg2) + arg2, 
+	 where
+	  test  = (fmod (arg, arg2) != 0) && ((arg < 0) xor (arg2 < 0))
+	 thereby avoiding another division and retaining the accuracy
+	 of the builtin function.  */
+      if (fmod != NULL_TREE && modulo)
+	{
+	  tree zero = gfc_build_const (type, integer_zero_node);
+	  tmp = gfc_evaluate_now (se->expr, &se->pre);
+	  test = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+				  args[0], zero);
+	  test2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+				   args[1], zero);
+	  test2 = fold_build2_loc (input_location, TRUTH_XOR_EXPR,
+				   boolean_type_node, test, test2);
+	  test = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				  tmp, zero);
+	  test = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+				  boolean_type_node, test, test2);
+	  test = gfc_evaluate_now (test, &se->pre);
+	  se->expr = fold_build3_loc (input_location, COND_EXPR, type, test,
+				  fold_build2_loc (input_location, PLUS_EXPR,
+						   type, tmp, args[1]), tmp);
+	  return;
+	}
+
+      /* If we do not have a built_in fmod, the calculation is going to
+	 have to be done longhand.  */
+      tmp = fold_build2_loc (input_location, RDIV_EXPR, type, args[0], args[1]);
+
+      /* Test if the value is too large to handle sensibly.  */
+      gfc_set_model_kind (expr->ts.kind);
+      mpfr_init (huge);
+      n = gfc_validate_kind (BT_INTEGER, expr->ts.kind, true);
+      ikind = expr->ts.kind;
+      if (n < 0)
+	{
+	  n = gfc_validate_kind (BT_INTEGER, gfc_max_integer_kind, false);
+	  ikind = gfc_max_integer_kind;
+	}
+      mpfr_set_z (huge, gfc_integer_kinds[n].huge, GFC_RND_MODE);
+      test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind, 0);
+      test2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+			       tmp, test);
+
+      mpfr_neg (huge, huge, GFC_RND_MODE);
+      test = gfc_conv_mpfr_to_tree (huge, expr->ts.kind, 0);
+      test = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, tmp,
+			      test);
+      test2 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+			       boolean_type_node, test, test2);
+
+      itype = gfc_get_int_type (ikind);
+      if (modulo)
+       tmp = build_fix_expr (&se->pre, tmp, itype, RND_FLOOR);
+      else
+       tmp = build_fix_expr (&se->pre, tmp, itype, RND_TRUNC);
+      tmp = convert (type, tmp);
+      tmp = fold_build3_loc (input_location, COND_EXPR, type, test2, tmp,
+			     args[0]);
+      tmp = fold_build2_loc (input_location, MULT_EXPR, type, tmp, args[1]);
+      se->expr = fold_build2_loc (input_location, MINUS_EXPR, type, args[0],
+				  tmp);
+      mpfr_clear (huge);
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+}
+
+/* DSHIFTL(I,J,S) = (I << S) | (J >> (BITSIZE(J) - S))
+   DSHIFTR(I,J,S) = (I << (BITSIZE(I) - S)) | (J >> S)
+   where the right shifts are logical (i.e. 0's are shifted in).
+   Because SHIFT_EXPR's want shifts strictly smaller than the integral
+   type width, we have to special-case both S == 0 and S == BITSIZE(J):
+     DSHIFTL(I,J,0) = I
+     DSHIFTL(I,J,BITSIZE) = J
+     DSHIFTR(I,J,0) = J
+     DSHIFTR(I,J,BITSIZE) = I.  */
+
+static void
+gfc_conv_intrinsic_dshift (gfc_se * se, gfc_expr * expr, bool dshiftl)
+{
+  tree type, utype, stype, arg1, arg2, shift, res, left, right;
+  tree args[3], cond, tmp;
+  int bitsize;
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 3);
+
+  gcc_assert (TREE_TYPE (args[0]) == TREE_TYPE (args[1]));
+  type = TREE_TYPE (args[0]);
+  bitsize = TYPE_PRECISION (type);
+  utype = unsigned_type_for (type);
+  stype = TREE_TYPE (args[2]);
+
+  arg1 = gfc_evaluate_now (args[0], &se->pre);
+  arg2 = gfc_evaluate_now (args[1], &se->pre);
+  shift = gfc_evaluate_now (args[2], &se->pre);
+
+  /* The generic case.  */
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, stype,
+			 build_int_cst (stype, bitsize), shift);
+  left = fold_build2_loc (input_location, LSHIFT_EXPR, type,
+			  arg1, dshiftl ? shift : tmp);
+
+  right = fold_build2_loc (input_location, RSHIFT_EXPR, utype,
+			   fold_convert (utype, arg2), dshiftl ? tmp : shift);
+  right = fold_convert (type, right);
+
+  res = fold_build2_loc (input_location, BIT_IOR_EXPR, type, left, right);
+
+  /* Special cases.  */
+  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, shift,
+			  build_int_cst (stype, 0));
+  res = fold_build3_loc (input_location, COND_EXPR, type, cond,
+			 dshiftl ? arg1 : arg2, res);
+
+  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, shift,
+			  build_int_cst (stype, bitsize));
+  res = fold_build3_loc (input_location, COND_EXPR, type, cond,
+			 dshiftl ? arg2 : arg1, res);
+
+  se->expr = res;
+}
+
+
+/* Positive difference DIM (x, y) = ((x - y) < 0) ? 0 : x - y.  */
+
+static void
+gfc_conv_intrinsic_dim (gfc_se * se, gfc_expr * expr)
+{
+  tree val;
+  tree tmp;
+  tree type;
+  tree zero;
+  tree args[2];
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+  type = TREE_TYPE (args[0]);
+
+  val = fold_build2_loc (input_location, MINUS_EXPR, type, args[0], args[1]);
+  val = gfc_evaluate_now (val, &se->pre);
+
+  zero = gfc_build_const (type, integer_zero_node);
+  tmp = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, val, zero);
+  se->expr = fold_build3_loc (input_location, COND_EXPR, type, tmp, zero, val);
+}
+
+
+/* SIGN(A, B) is absolute value of A times sign of B.
+   The real value versions use library functions to ensure the correct
+   handling of negative zero.  Integer case implemented as:
+   SIGN(A, B) = { tmp = (A ^ B) >> C; (A + tmp) ^ tmp }
+  */
+
+static void
+gfc_conv_intrinsic_sign (gfc_se * se, gfc_expr * expr)
+{
+  tree tmp;
+  tree type;
+  tree args[2];
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+  if (expr->ts.type == BT_REAL)
+    {
+      tree abs;
+
+      tmp = gfc_builtin_decl_for_float_kind (BUILT_IN_COPYSIGN, expr->ts.kind);
+      abs = gfc_builtin_decl_for_float_kind (BUILT_IN_FABS, expr->ts.kind);
+
+      /* We explicitly have to ignore the minus sign. We do so by using
+	 result = (arg1 == 0) ? abs(arg0) : copysign(arg0, arg1).  */
+      if (!gfc_option.flag_sign_zero
+	  && MODE_HAS_SIGNED_ZEROS (TYPE_MODE (TREE_TYPE (args[1]))))
+	{
+	  tree cond, zero;
+	  zero = build_real_from_int_cst (TREE_TYPE (args[1]), integer_zero_node);
+	  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				  args[1], zero);
+	  se->expr = fold_build3_loc (input_location, COND_EXPR,
+				  TREE_TYPE (args[0]), cond,
+				  build_call_expr_loc (input_location, abs, 1,
+						       args[0]),
+				  build_call_expr_loc (input_location, tmp, 2,
+						       args[0], args[1]));
+	}
+      else
+        se->expr = build_call_expr_loc (input_location, tmp, 2,
+					args[0], args[1]);
+      return;
+    }
+
+  /* Having excluded floating point types, we know we are now dealing
+     with signed integer types.  */
+  type = TREE_TYPE (args[0]);
+
+  /* Args[0] is used multiple times below.  */
+  args[0] = gfc_evaluate_now (args[0], &se->pre);
+
+  /* Construct (A ^ B) >> 31, which generates a bit mask of all zeros if
+     the signs of A and B are the same, and of all ones if they differ.  */
+  tmp = fold_build2_loc (input_location, BIT_XOR_EXPR, type, args[0], args[1]);
+  tmp = fold_build2_loc (input_location, RSHIFT_EXPR, type, tmp,
+			 build_int_cst (type, TYPE_PRECISION (type) - 1));
+  tmp = gfc_evaluate_now (tmp, &se->pre);
+
+  /* Construct (A + tmp) ^ tmp, which is A if tmp is zero, and -A if tmp]
+     is all ones (i.e. -1).  */
+  se->expr = fold_build2_loc (input_location, BIT_XOR_EXPR, type,
+			      fold_build2_loc (input_location, PLUS_EXPR,
+					       type, args[0], tmp), tmp);
+}
+
+
+/* Test for the presence of an optional argument.  */
+
+static void
+gfc_conv_intrinsic_present (gfc_se * se, gfc_expr * expr)
+{
+  gfc_expr *arg;
+
+  arg = expr->value.function.actual->expr;
+  gcc_assert (arg->expr_type == EXPR_VARIABLE);
+  se->expr = gfc_conv_expr_present (arg->symtree->n.sym);
+  se->expr = convert (gfc_typenode_for_spec (&expr->ts), se->expr);
+}
+
+
+/* Calculate the double precision product of two single precision values.  */
+
+static void
+gfc_conv_intrinsic_dprod (gfc_se * se, gfc_expr * expr)
+{
+  tree type;
+  tree args[2];
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+
+  /* Convert the args to double precision before multiplying.  */
+  type = gfc_typenode_for_spec (&expr->ts);
+  args[0] = convert (type, args[0]);
+  args[1] = convert (type, args[1]);
+  se->expr = fold_build2_loc (input_location, MULT_EXPR, type, args[0],
+			      args[1]);
+}
+
+
+/* Return a length one character string containing an ascii character.  */
+
+static void
+gfc_conv_intrinsic_char (gfc_se * se, gfc_expr * expr)
+{
+  tree arg[2];
+  tree var;
+  tree type;
+  unsigned int num_args;
+
+  num_args = gfc_intrinsic_argument_list_length (expr);
+  gfc_conv_intrinsic_function_args (se, expr, arg, num_args);
+
+  type = gfc_get_char_type (expr->ts.kind);
+  var = gfc_create_var (type, "char");
+
+  arg[0] = fold_build1_loc (input_location, NOP_EXPR, type, arg[0]);
+  gfc_add_modify (&se->pre, var, arg[0]);
+  se->expr = gfc_build_addr_expr (build_pointer_type (type), var);
+  se->string_length = build_int_cst (gfc_charlen_type_node, 1);
+}
+
+
+static void
+gfc_conv_intrinsic_ctime (gfc_se * se, gfc_expr * expr)
+{
+  tree var;
+  tree len;
+  tree tmp;
+  tree cond;
+  tree fndecl;
+  tree *args;
+  unsigned int num_args;
+
+  num_args = gfc_intrinsic_argument_list_length (expr) + 2;
+  args = XALLOCAVEC (tree, num_args);
+
+  var = gfc_create_var (pchar_type_node, "pstr");
+  len = gfc_create_var (gfc_charlen_type_node, "len");
+
+  gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2);
+  args[0] = gfc_build_addr_expr (NULL_TREE, var);
+  args[1] = gfc_build_addr_expr (NULL_TREE, len);
+
+  fndecl = build_addr (gfor_fndecl_ctime, current_function_decl);
+  tmp = build_call_array_loc (input_location,
+			  TREE_TYPE (TREE_TYPE (gfor_fndecl_ctime)),
+			  fndecl, num_args, args);
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  /* Free the temporary afterwards, if necessary.  */
+  cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+			  len, build_int_cst (TREE_TYPE (len), 0));
+  tmp = gfc_call_free (var);
+  tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&se->post, tmp);
+
+  se->expr = var;
+  se->string_length = len;
+}
+
+
+static void
+gfc_conv_intrinsic_fdate (gfc_se * se, gfc_expr * expr)
+{
+  tree var;
+  tree len;
+  tree tmp;
+  tree cond;
+  tree fndecl;
+  tree *args;
+  unsigned int num_args;
+
+  num_args = gfc_intrinsic_argument_list_length (expr) + 2;
+  args = XALLOCAVEC (tree, num_args);
+
+  var = gfc_create_var (pchar_type_node, "pstr");
+  len = gfc_create_var (gfc_charlen_type_node, "len");
+
+  gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2);
+  args[0] = gfc_build_addr_expr (NULL_TREE, var);
+  args[1] = gfc_build_addr_expr (NULL_TREE, len);
+
+  fndecl = build_addr (gfor_fndecl_fdate, current_function_decl);
+  tmp = build_call_array_loc (input_location,
+			  TREE_TYPE (TREE_TYPE (gfor_fndecl_fdate)),
+			  fndecl, num_args, args);
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  /* Free the temporary afterwards, if necessary.  */
+  cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+			  len, build_int_cst (TREE_TYPE (len), 0));
+  tmp = gfc_call_free (var);
+  tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&se->post, tmp);
+
+  se->expr = var;
+  se->string_length = len;
+}
+
+
+/* Return a character string containing the tty name.  */
+
+static void
+gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr)
+{
+  tree var;
+  tree len;
+  tree tmp;
+  tree cond;
+  tree fndecl;
+  tree *args;
+  unsigned int num_args;
+
+  num_args = gfc_intrinsic_argument_list_length (expr) + 2;
+  args = XALLOCAVEC (tree, num_args);
+
+  var = gfc_create_var (pchar_type_node, "pstr");
+  len = gfc_create_var (gfc_charlen_type_node, "len");
+
+  gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2);
+  args[0] = gfc_build_addr_expr (NULL_TREE, var);
+  args[1] = gfc_build_addr_expr (NULL_TREE, len);
+
+  fndecl = build_addr (gfor_fndecl_ttynam, current_function_decl);
+  tmp = build_call_array_loc (input_location,
+			  TREE_TYPE (TREE_TYPE (gfor_fndecl_ttynam)),
+			  fndecl, num_args, args);
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  /* Free the temporary afterwards, if necessary.  */
+  cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+			  len, build_int_cst (TREE_TYPE (len), 0));
+  tmp = gfc_call_free (var);
+  tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&se->post, tmp);
+
+  se->expr = var;
+  se->string_length = len;
+}
+
+
+/* Get the minimum/maximum value of all the parameters.
+    minmax (a1, a2, a3, ...)
+    {
+      mvar = a1;
+      if (a2 .op. mvar || isnan(mvar))
+        mvar = a2;
+      if (a3 .op. mvar || isnan(mvar))
+        mvar = a3;
+      ...
+      return mvar
+    }
+ */
+
+/* TODO: Mismatching types can occur when specific names are used.
+   These should be handled during resolution.  */
+static void
+gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op)
+{
+  tree tmp;
+  tree mvar;
+  tree val;
+  tree thencase;
+  tree *args;
+  tree type;
+  gfc_actual_arglist *argexpr;
+  unsigned int i, nargs;
+
+  nargs = gfc_intrinsic_argument_list_length (expr);
+  args = XALLOCAVEC (tree, nargs);
+
+  gfc_conv_intrinsic_function_args (se, expr, args, nargs);
+  type = gfc_typenode_for_spec (&expr->ts);
+
+  argexpr = expr->value.function.actual;
+  if (TREE_TYPE (args[0]) != type)
+    args[0] = convert (type, args[0]);
+  /* Only evaluate the argument once.  */
+  if (TREE_CODE (args[0]) != VAR_DECL && !TREE_CONSTANT (args[0]))
+    args[0] = gfc_evaluate_now (args[0], &se->pre);
+
+  mvar = gfc_create_var (type, "M");
+  gfc_add_modify (&se->pre, mvar, args[0]);
+  for (i = 1, argexpr = argexpr->next; i < nargs; i++)
+    {
+      tree cond, isnan;
+
+      val = args[i]; 
+
+      /* Handle absent optional arguments by ignoring the comparison.  */
+      if (argexpr->expr->expr_type == EXPR_VARIABLE
+	  && argexpr->expr->symtree->n.sym->attr.optional
+	  && TREE_CODE (val) == INDIRECT_REF)
+	cond = fold_build2_loc (input_location,
+				NE_EXPR, boolean_type_node,
+				TREE_OPERAND (val, 0), 
+			build_int_cst (TREE_TYPE (TREE_OPERAND (val, 0)), 0));
+      else
+      {
+	cond = NULL_TREE;
+
+	/* Only evaluate the argument once.  */
+	if (TREE_CODE (val) != VAR_DECL && !TREE_CONSTANT (val))
+	  val = gfc_evaluate_now (val, &se->pre);
+      }
+
+      thencase = build2_v (MODIFY_EXPR, mvar, convert (type, val));
+
+      tmp = fold_build2_loc (input_location, op, boolean_type_node,
+			     convert (type, val), mvar);
+
+      /* FIXME: When the IEEE_ARITHMETIC module is implemented, the call to
+	 __builtin_isnan might be made dependent on that module being loaded,
+	 to help performance of programs that don't rely on IEEE semantics.  */
+      if (FLOAT_TYPE_P (TREE_TYPE (mvar)))
+	{
+	  isnan = build_call_expr_loc (input_location,
+				   built_in_decls[BUILT_IN_ISNAN], 1, mvar);
+	  tmp = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+				 boolean_type_node, tmp,
+				 fold_convert (boolean_type_node, isnan));
+	}
+      tmp = build3_v (COND_EXPR, tmp, thencase,
+		      build_empty_stmt (input_location));
+
+      if (cond != NULL_TREE)
+	tmp = build3_v (COND_EXPR, cond, tmp,
+			build_empty_stmt (input_location));
+
+      gfc_add_expr_to_block (&se->pre, tmp);
+      argexpr = argexpr->next;
+    }
+  se->expr = mvar;
+}
+
+
+/* Generate library calls for MIN and MAX intrinsics for character
+   variables.  */
+static void
+gfc_conv_intrinsic_minmax_char (gfc_se * se, gfc_expr * expr, int op)
+{
+  tree *args;
+  tree var, len, fndecl, tmp, cond, function;
+  unsigned int nargs;
+
+  nargs = gfc_intrinsic_argument_list_length (expr);
+  args = XALLOCAVEC (tree, nargs + 4);
+  gfc_conv_intrinsic_function_args (se, expr, &args[4], nargs);
+
+  /* Create the result variables.  */
+  len = gfc_create_var (gfc_charlen_type_node, "len");
+  args[0] = gfc_build_addr_expr (NULL_TREE, len);
+  var = gfc_create_var (gfc_get_pchar_type (expr->ts.kind), "pstr");
+  args[1] = gfc_build_addr_expr (ppvoid_type_node, var);
+  args[2] = build_int_cst (NULL_TREE, op);
+  args[3] = build_int_cst (NULL_TREE, nargs / 2);
+
+  if (expr->ts.kind == 1)
+    function = gfor_fndecl_string_minmax;
+  else if (expr->ts.kind == 4)
+    function = gfor_fndecl_string_minmax_char4;
+  else
+    gcc_unreachable ();
+
+  /* Make the function call.  */
+  fndecl = build_addr (function, current_function_decl);
+  tmp = build_call_array_loc (input_location,
+			  TREE_TYPE (TREE_TYPE (function)), fndecl,
+			  nargs + 4, args);
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  /* Free the temporary afterwards, if necessary.  */
+  cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+			  len, build_int_cst (TREE_TYPE (len), 0));
+  tmp = gfc_call_free (var);
+  tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&se->post, tmp);
+
+  se->expr = var;
+  se->string_length = len;
+}
+
+
+/* Create a symbol node for this intrinsic.  The symbol from the frontend
+   has the generic name.  */
+
+static gfc_symbol *
+gfc_get_symbol_for_expr (gfc_expr * expr)
+{
+  gfc_symbol *sym;
+
+  /* TODO: Add symbols for intrinsic function to the global namespace.  */
+  gcc_assert (strlen (expr->value.function.name) <= GFC_MAX_SYMBOL_LEN - 5);
+  sym = gfc_new_symbol (expr->value.function.name, NULL);
+
+  sym->ts = expr->ts;
+  sym->attr.external = 1;
+  sym->attr.function = 1;
+  sym->attr.always_explicit = 1;
+  sym->attr.proc = PROC_INTRINSIC;
+  sym->attr.flavor = FL_PROCEDURE;
+  sym->result = sym;
+  if (expr->rank > 0)
+    {
+      sym->attr.dimension = 1;
+      sym->as = gfc_get_array_spec ();
+      sym->as->type = AS_ASSUMED_SHAPE;
+      sym->as->rank = expr->rank;
+    }
+
+  gfc_copy_formal_args_intr (sym, expr->value.function.isym);
+
+  return sym;
+}
+
+/* Generate a call to an external intrinsic function.  */
+static void
+gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr)
+{
+  gfc_symbol *sym;
+  VEC(tree,gc) *append_args;
+
+  gcc_assert (!se->ss || se->ss->expr == expr);
+
+  if (se->ss)
+    gcc_assert (expr->rank > 0);
+  else
+    gcc_assert (expr->rank == 0);
+
+  sym = gfc_get_symbol_for_expr (expr);
+
+  /* Calls to libgfortran_matmul need to be appended special arguments,
+     to be able to call the BLAS ?gemm functions if required and possible.  */
+  append_args = NULL;
+  if (expr->value.function.isym->id == GFC_ISYM_MATMUL
+      && sym->ts.type != BT_LOGICAL)
+    {
+      tree cint = gfc_get_int_type (gfc_c_int_kind);
+
+      if (gfc_option.flag_external_blas
+	  && (sym->ts.type == BT_REAL || sym->ts.type == BT_COMPLEX)
+	  && (sym->ts.kind == gfc_default_real_kind
+	      || sym->ts.kind == gfc_default_double_kind))
+	{
+	  tree gemm_fndecl;
+
+	  if (sym->ts.type == BT_REAL)
+	    {
+	      if (sym->ts.kind == gfc_default_real_kind)
+		gemm_fndecl = gfor_fndecl_sgemm;
+	      else
+		gemm_fndecl = gfor_fndecl_dgemm;
+	    }
+	  else
+	    {
+	      if (sym->ts.kind == gfc_default_real_kind)
+		gemm_fndecl = gfor_fndecl_cgemm;
+	      else
+		gemm_fndecl = gfor_fndecl_zgemm;
+	    }
+
+	  append_args = VEC_alloc (tree, gc, 3);
+	  VEC_quick_push (tree, append_args, build_int_cst (cint, 1));
+	  VEC_quick_push (tree, append_args,
+			  build_int_cst (cint, gfc_option.blas_matmul_limit));
+	  VEC_quick_push (tree, append_args,
+			  gfc_build_addr_expr (NULL_TREE, gemm_fndecl));
+	}
+      else
+	{
+	  append_args = VEC_alloc (tree, gc, 3);
+	  VEC_quick_push (tree, append_args, build_int_cst (cint, 0));
+	  VEC_quick_push (tree, append_args, build_int_cst (cint, 0));
+	  VEC_quick_push (tree, append_args, null_pointer_node);
+	}
+    }
+
+  gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr,
+			  append_args);
+  gfc_free_symbol (sym);
+}
+
+/* ANY and ALL intrinsics. ANY->op == NE_EXPR, ALL->op == EQ_EXPR.
+   Implemented as
+    any(a)
+    {
+      forall (i=...)
+        if (a[i] != 0)
+          return 1
+      end forall
+      return 0
+    }
+    all(a)
+    {
+      forall (i=...)
+        if (a[i] == 0)
+          return 0
+      end forall
+      return 1
+    }
+ */
+static void
+gfc_conv_intrinsic_anyall (gfc_se * se, gfc_expr * expr, enum tree_code op)
+{
+  tree resvar;
+  stmtblock_t block;
+  stmtblock_t body;
+  tree type;
+  tree tmp;
+  tree found;
+  gfc_loopinfo loop;
+  gfc_actual_arglist *actual;
+  gfc_ss *arrayss;
+  gfc_se arrayse;
+  tree exit_label;
+
+  if (se->ss)
+    {
+      gfc_conv_intrinsic_funcall (se, expr);
+      return;
+    }
+
+  actual = expr->value.function.actual;
+  type = gfc_typenode_for_spec (&expr->ts);
+  /* Initialize the result.  */
+  resvar = gfc_create_var (type, "test");
+  if (op == EQ_EXPR)
+    tmp = convert (type, boolean_true_node);
+  else
+    tmp = convert (type, boolean_false_node);
+  gfc_add_modify (&se->pre, resvar, tmp);
+
+  /* Walk the arguments.  */
+  arrayss = gfc_walk_expr (actual->expr);
+  gcc_assert (arrayss != gfc_ss_terminator);
+
+  /* Initialize the scalarizer.  */
+  gfc_init_loopinfo (&loop);
+  exit_label = gfc_build_label_decl (NULL_TREE);
+  TREE_USED (exit_label) = 1;
+  gfc_add_ss_to_loop (&loop, arrayss);
+
+  /* Initialize the loop.  */
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop, &expr->where);
+
+  gfc_mark_ss_chain_used (arrayss, 1);
+  /* Generate the loop body.  */
+  gfc_start_scalarized_body (&loop, &body);
+
+  /* If the condition matches then set the return value.  */
+  gfc_start_block (&block);
+  if (op == EQ_EXPR)
+    tmp = convert (type, boolean_false_node);
+  else
+    tmp = convert (type, boolean_true_node);
+  gfc_add_modify (&block, resvar, tmp);
+
+  /* And break out of the loop.  */
+  tmp = build1_v (GOTO_EXPR, exit_label);
+  gfc_add_expr_to_block (&block, tmp);
+
+  found = gfc_finish_block (&block);
+
+  /* Check this element.  */
+  gfc_init_se (&arrayse, NULL);
+  gfc_copy_loopinfo_to_se (&arrayse, &loop);
+  arrayse.ss = arrayss;
+  gfc_conv_expr_val (&arrayse, actual->expr);
+
+  gfc_add_block_to_block (&body, &arrayse.pre);
+  tmp = fold_build2_loc (input_location, op, boolean_type_node, arrayse.expr,
+			 build_int_cst (TREE_TYPE (arrayse.expr), 0));
+  tmp = build3_v (COND_EXPR, tmp, found, build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&body, tmp);
+  gfc_add_block_to_block (&body, &arrayse.post);
+
+  gfc_trans_scalarizing_loops (&loop, &body);
+
+  /* Add the exit label.  */
+  tmp = build1_v (LABEL_EXPR, exit_label);
+  gfc_add_expr_to_block (&loop.pre, tmp);
+
+  gfc_add_block_to_block (&se->pre, &loop.pre);
+  gfc_add_block_to_block (&se->pre, &loop.post);
+  gfc_cleanup_loop (&loop);
+
+  se->expr = resvar;
+}
+
+/* COUNT(A) = Number of true elements in A.  */
+static void
+gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr)
+{
+  tree resvar;
+  tree type;
+  stmtblock_t body;
+  tree tmp;
+  gfc_loopinfo loop;
+  gfc_actual_arglist *actual;
+  gfc_ss *arrayss;
+  gfc_se arrayse;
+
+  if (se->ss)
+    {
+      gfc_conv_intrinsic_funcall (se, expr);
+      return;
+    }
+
+  actual = expr->value.function.actual;
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  /* Initialize the result.  */
+  resvar = gfc_create_var (type, "count");
+  gfc_add_modify (&se->pre, resvar, build_int_cst (type, 0));
+
+  /* Walk the arguments.  */
+  arrayss = gfc_walk_expr (actual->expr);
+  gcc_assert (arrayss != gfc_ss_terminator);
+
+  /* Initialize the scalarizer.  */
+  gfc_init_loopinfo (&loop);
+  gfc_add_ss_to_loop (&loop, arrayss);
+
+  /* Initialize the loop.  */
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop, &expr->where);
+
+  gfc_mark_ss_chain_used (arrayss, 1);
+  /* Generate the loop body.  */
+  gfc_start_scalarized_body (&loop, &body);
+
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (resvar),
+			 resvar, build_int_cst (TREE_TYPE (resvar), 1));
+  tmp = build2_v (MODIFY_EXPR, resvar, tmp);
+
+  gfc_init_se (&arrayse, NULL);
+  gfc_copy_loopinfo_to_se (&arrayse, &loop);
+  arrayse.ss = arrayss;
+  gfc_conv_expr_val (&arrayse, actual->expr);
+  tmp = build3_v (COND_EXPR, arrayse.expr, tmp,
+		  build_empty_stmt (input_location));
+
+  gfc_add_block_to_block (&body, &arrayse.pre);
+  gfc_add_expr_to_block (&body, tmp);
+  gfc_add_block_to_block (&body, &arrayse.post);
+
+  gfc_trans_scalarizing_loops (&loop, &body);
+
+  gfc_add_block_to_block (&se->pre, &loop.pre);
+  gfc_add_block_to_block (&se->pre, &loop.post);
+  gfc_cleanup_loop (&loop);
+
+  se->expr = resvar;
+}
+
+/* Inline implementation of the sum and product intrinsics.  */
+static void
+gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op,
+			  bool norm2)
+{
+  tree resvar;
+  tree scale = NULL_TREE;
+  tree type;
+  stmtblock_t body;
+  stmtblock_t block;
+  tree tmp;
+  gfc_loopinfo loop;
+  gfc_actual_arglist *actual;
+  gfc_ss *arrayss;
+  gfc_ss *maskss;
+  gfc_se arrayse;
+  gfc_se maskse;
+  gfc_expr *arrayexpr;
+  gfc_expr *maskexpr;
+
+  if (se->ss)
+    {
+      gfc_conv_intrinsic_funcall (se, expr);
+      return;
+    }
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  /* Initialize the result.  */
+  resvar = gfc_create_var (type, "val");
+  if (norm2)
+    {
+      /* result = 0.0;
+	 scale = 1.0.  */
+      scale = gfc_create_var (type, "scale");
+      gfc_add_modify (&se->pre, scale,
+		      gfc_build_const (type, integer_one_node));
+      tmp = gfc_build_const (type, integer_zero_node);
+    }
+  else if (op == PLUS_EXPR || op == BIT_IOR_EXPR || op == BIT_XOR_EXPR)
+    tmp = gfc_build_const (type, integer_zero_node);
+  else if (op == NE_EXPR)
+    /* PARITY.  */
+    tmp = convert (type, boolean_false_node);
+  else if (op == BIT_AND_EXPR)
+    tmp = gfc_build_const (type, fold_build1_loc (input_location, NEGATE_EXPR,
+						  type, integer_one_node));
+  else
+    tmp = gfc_build_const (type, integer_one_node);
+
+  gfc_add_modify (&se->pre, resvar, tmp);
+
+  /* Walk the arguments.  */
+  actual = expr->value.function.actual;
+  arrayexpr = actual->expr;
+  arrayss = gfc_walk_expr (arrayexpr);
+  gcc_assert (arrayss != gfc_ss_terminator);
+
+  if (op == NE_EXPR || norm2)
+    /* PARITY and NORM2.  */
+    maskexpr = NULL;
+  else
+    {
+      actual = actual->next->next;
+      gcc_assert (actual);
+      maskexpr = actual->expr;
+    }
+
+  if (maskexpr && maskexpr->rank != 0)
+    {
+      maskss = gfc_walk_expr (maskexpr);
+      gcc_assert (maskss != gfc_ss_terminator);
+    }
+  else
+    maskss = NULL;
+
+  /* Initialize the scalarizer.  */
+  gfc_init_loopinfo (&loop);
+  gfc_add_ss_to_loop (&loop, arrayss);
+  if (maskss)
+    gfc_add_ss_to_loop (&loop, maskss);
+
+  /* Initialize the loop.  */
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop, &expr->where);
+
+  gfc_mark_ss_chain_used (arrayss, 1);
+  if (maskss)
+    gfc_mark_ss_chain_used (maskss, 1);
+  /* Generate the loop body.  */
+  gfc_start_scalarized_body (&loop, &body);
+
+  /* If we have a mask, only add this element if the mask is set.  */
+  if (maskss)
+    {
+      gfc_init_se (&maskse, NULL);
+      gfc_copy_loopinfo_to_se (&maskse, &loop);
+      maskse.ss = maskss;
+      gfc_conv_expr_val (&maskse, maskexpr);
+      gfc_add_block_to_block (&body, &maskse.pre);
+
+      gfc_start_block (&block);
+    }
+  else
+    gfc_init_block (&block);
+
+  /* Do the actual summation/product.  */
+  gfc_init_se (&arrayse, NULL);
+  gfc_copy_loopinfo_to_se (&arrayse, &loop);
+  arrayse.ss = arrayss;
+  gfc_conv_expr_val (&arrayse, arrayexpr);
+  gfc_add_block_to_block (&block, &arrayse.pre);
+
+  if (norm2)
+    {
+      /* if (x(i) != 0.0)
+	   {
+	     absX = abs(x(i))
+	     if (absX > scale)
+	       {
+                 val = scale/absX;
+		 result = 1.0 + result * val * val;
+		 scale = absX;
+	       }
+	     else
+	       {
+                 val = absX/scale;
+	         result += val * val;
+	       }
+	   }  */
+      tree res1, res2, cond, absX, val;
+      stmtblock_t ifblock1, ifblock2, ifblock3;
+
+      gfc_init_block (&ifblock1);
+
+      absX = gfc_create_var (type, "absX");
+      gfc_add_modify (&ifblock1, absX,
+		      fold_build1_loc (input_location, ABS_EXPR, type,
+				       arrayse.expr));
+      val = gfc_create_var (type, "val");
+      gfc_add_expr_to_block (&ifblock1, val);
+
+      gfc_init_block (&ifblock2);
+      gfc_add_modify (&ifblock2, val,
+		      fold_build2_loc (input_location, RDIV_EXPR, type, scale,
+				       absX));
+      res1 = fold_build2_loc (input_location, MULT_EXPR, type, val, val); 
+      res1 = fold_build2_loc (input_location, MULT_EXPR, type, resvar, res1);
+      res1 = fold_build2_loc (input_location, PLUS_EXPR, type, res1,
+			      gfc_build_const (type, integer_one_node));
+      gfc_add_modify (&ifblock2, resvar, res1);
+      gfc_add_modify (&ifblock2, scale, absX);
+      res1 = gfc_finish_block (&ifblock2); 
+
+      gfc_init_block (&ifblock3);
+      gfc_add_modify (&ifblock3, val,
+		      fold_build2_loc (input_location, RDIV_EXPR, type, absX,
+				       scale));
+      res2 = fold_build2_loc (input_location, MULT_EXPR, type, val, val); 
+      res2 = fold_build2_loc (input_location, PLUS_EXPR, type, resvar, res2);
+      gfc_add_modify (&ifblock3, resvar, res2);
+      res2 = gfc_finish_block (&ifblock3);
+
+      cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+			      absX, scale);
+      tmp = build3_v (COND_EXPR, cond, res1, res2);
+      gfc_add_expr_to_block (&ifblock1, tmp);  
+      tmp = gfc_finish_block (&ifblock1);
+
+      cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			      arrayse.expr,
+			      gfc_build_const (type, integer_zero_node));
+
+      tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block, tmp);  
+    }
+  else
+    {
+      tmp = fold_build2_loc (input_location, op, type, resvar, arrayse.expr);
+      gfc_add_modify (&block, resvar, tmp);
+    }
+
+  gfc_add_block_to_block (&block, &arrayse.post);
+
+  if (maskss)
+    {
+      /* We enclose the above in if (mask) {...} .  */
+
+      tmp = gfc_finish_block (&block);
+      tmp = build3_v (COND_EXPR, maskse.expr, tmp,
+		      build_empty_stmt (input_location));
+    }
+  else
+    tmp = gfc_finish_block (&block);
+  gfc_add_expr_to_block (&body, tmp);
+
+  gfc_trans_scalarizing_loops (&loop, &body);
+
+  /* For a scalar mask, enclose the loop in an if statement.  */
+  if (maskexpr && maskss == NULL)
+    {
+      gfc_init_se (&maskse, NULL);
+      gfc_conv_expr_val (&maskse, maskexpr);
+      gfc_init_block (&block);
+      gfc_add_block_to_block (&block, &loop.pre);
+      gfc_add_block_to_block (&block, &loop.post);
+      tmp = gfc_finish_block (&block);
+
+      tmp = build3_v (COND_EXPR, maskse.expr, tmp,
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block, tmp);
+      gfc_add_block_to_block (&se->pre, &block);
+    }
+  else
+    {
+      gfc_add_block_to_block (&se->pre, &loop.pre);
+      gfc_add_block_to_block (&se->pre, &loop.post);
+    }
+
+  gfc_cleanup_loop (&loop);
+
+  if (norm2)
+    {
+      /* result = scale * sqrt(result).  */
+      tree sqrt;
+      sqrt = gfc_builtin_decl_for_float_kind (BUILT_IN_SQRT, expr->ts.kind);
+      resvar = build_call_expr_loc (input_location,
+				    sqrt, 1, resvar);
+      resvar = fold_build2_loc (input_location, MULT_EXPR, type, scale, resvar);
+    }
+
+  se->expr = resvar;
+}
+
+
+/* Inline implementation of the dot_product intrinsic. This function
+   is based on gfc_conv_intrinsic_arith (the previous function).  */
+static void
+gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr * expr)
+{
+  tree resvar;
+  tree type;
+  stmtblock_t body;
+  stmtblock_t block;
+  tree tmp;
+  gfc_loopinfo loop;
+  gfc_actual_arglist *actual;
+  gfc_ss *arrayss1, *arrayss2;
+  gfc_se arrayse1, arrayse2;
+  gfc_expr *arrayexpr1, *arrayexpr2;
+
+  type = gfc_typenode_for_spec (&expr->ts);
+
+  /* Initialize the result.  */
+  resvar = gfc_create_var (type, "val");
+  if (expr->ts.type == BT_LOGICAL)
+    tmp = build_int_cst (type, 0);
+  else
+    tmp = gfc_build_const (type, integer_zero_node);
+
+  gfc_add_modify (&se->pre, resvar, tmp);
+
+  /* Walk argument #1.  */
+  actual = expr->value.function.actual;
+  arrayexpr1 = actual->expr;
+  arrayss1 = gfc_walk_expr (arrayexpr1);
+  gcc_assert (arrayss1 != gfc_ss_terminator);
+
+  /* Walk argument #2.  */
+  actual = actual->next;
+  arrayexpr2 = actual->expr;
+  arrayss2 = gfc_walk_expr (arrayexpr2);
+  gcc_assert (arrayss2 != gfc_ss_terminator);
+
+  /* Initialize the scalarizer.  */
+  gfc_init_loopinfo (&loop);
+  gfc_add_ss_to_loop (&loop, arrayss1);
+  gfc_add_ss_to_loop (&loop, arrayss2);
+
+  /* Initialize the loop.  */
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop, &expr->where);
+
+  gfc_mark_ss_chain_used (arrayss1, 1);
+  gfc_mark_ss_chain_used (arrayss2, 1);
+
+  /* Generate the loop body.  */
+  gfc_start_scalarized_body (&loop, &body);
+  gfc_init_block (&block);
+
+  /* Make the tree expression for [conjg(]array1[)].  */
+  gfc_init_se (&arrayse1, NULL);
+  gfc_copy_loopinfo_to_se (&arrayse1, &loop);
+  arrayse1.ss = arrayss1;
+  gfc_conv_expr_val (&arrayse1, arrayexpr1);
+  if (expr->ts.type == BT_COMPLEX)
+    arrayse1.expr = fold_build1_loc (input_location, CONJ_EXPR, type,
+				     arrayse1.expr);
+  gfc_add_block_to_block (&block, &arrayse1.pre);
+
+  /* Make the tree expression for array2.  */
+  gfc_init_se (&arrayse2, NULL);
+  gfc_copy_loopinfo_to_se (&arrayse2, &loop);
+  arrayse2.ss = arrayss2;
+  gfc_conv_expr_val (&arrayse2, arrayexpr2);
+  gfc_add_block_to_block (&block, &arrayse2.pre);
+
+  /* Do the actual product and sum.  */
+  if (expr->ts.type == BT_LOGICAL)
+    {
+      tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, type,
+			     arrayse1.expr, arrayse2.expr);
+      tmp = fold_build2_loc (input_location, TRUTH_OR_EXPR, type, resvar, tmp);
+    }
+  else
+    {
+      tmp = fold_build2_loc (input_location, MULT_EXPR, type, arrayse1.expr,
+			     arrayse2.expr);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, type, resvar, tmp);
+    }
+  gfc_add_modify (&block, resvar, tmp);
+
+  /* Finish up the loop block and the loop.  */
+  tmp = gfc_finish_block (&block);
+  gfc_add_expr_to_block (&body, tmp);
+
+  gfc_trans_scalarizing_loops (&loop, &body);
+  gfc_add_block_to_block (&se->pre, &loop.pre);
+  gfc_add_block_to_block (&se->pre, &loop.post);
+  gfc_cleanup_loop (&loop);
+
+  se->expr = resvar;
+}
+
+
+/* Emit code for minloc or maxloc intrinsic.  There are many different cases
+   we need to handle.  For performance reasons we sometimes create two
+   loops instead of one, where the second one is much simpler.
+   Examples for minloc intrinsic:
+   1) Result is an array, a call is generated
+   2) Array mask is used and NaNs need to be supported:
+      limit = Infinity;
+      pos = 0;
+      S = from;
+      while (S <= to) {
+	if (mask[S]) {
+	  if (pos == 0) pos = S + (1 - from);
+	  if (a[S] <= limit) { limit = a[S]; pos = S + (1 - from); goto lab1; }
+	}
+	S++;
+      }
+      goto lab2;
+      lab1:;
+      while (S <= to) {
+	if (mask[S]) if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
+	S++;
+      }
+      lab2:;
+   3) NaNs need to be supported, but it is known at compile time or cheaply
+      at runtime whether array is nonempty or not:
+      limit = Infinity;
+      pos = 0;
+      S = from;
+      while (S <= to) {
+	if (a[S] <= limit) { limit = a[S]; pos = S + (1 - from); goto lab1; }
+	S++;
+      }
+      if (from <= to) pos = 1;
+      goto lab2;
+      lab1:;
+      while (S <= to) {
+	if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
+	S++;
+      }
+      lab2:;
+   4) NaNs aren't supported, array mask is used:
+      limit = infinities_supported ? Infinity : huge (limit);
+      pos = 0;
+      S = from;
+      while (S <= to) {
+	if (mask[S]) { limit = a[S]; pos = S + (1 - from); goto lab1; }
+	S++;
+      }
+      goto lab2;
+      lab1:;
+      while (S <= to) {
+	if (mask[S]) if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
+	S++;
+      }
+      lab2:;
+   5) Same without array mask:
+      limit = infinities_supported ? Infinity : huge (limit);
+      pos = (from <= to) ? 1 : 0;
+      S = from;
+      while (S <= to) {
+	if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
+	S++;
+      }
+   For 3) and 5), if mask is scalar, this all goes into a conditional,
+   setting pos = 0; in the else branch.  */
+
+static void
+gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op)
+{
+  stmtblock_t body;
+  stmtblock_t block;
+  stmtblock_t ifblock;
+  stmtblock_t elseblock;
+  tree limit;
+  tree type;
+  tree tmp;
+  tree cond;
+  tree elsetmp;
+  tree ifbody;
+  tree offset;
+  tree nonempty;
+  tree lab1, lab2;
+  gfc_loopinfo loop;
+  gfc_actual_arglist *actual;
+  gfc_ss *arrayss;
+  gfc_ss *maskss;
+  gfc_se arrayse;
+  gfc_se maskse;
+  gfc_expr *arrayexpr;
+  gfc_expr *maskexpr;
+  tree pos;
+  int n;
+
+  if (se->ss)
+    {
+      gfc_conv_intrinsic_funcall (se, expr);
+      return;
+    }
+
+  /* Initialize the result.  */
+  pos = gfc_create_var (gfc_array_index_type, "pos");
+  offset = gfc_create_var (gfc_array_index_type, "offset");
+  type = gfc_typenode_for_spec (&expr->ts);
+
+  /* Walk the arguments.  */
+  actual = expr->value.function.actual;
+  arrayexpr = actual->expr;
+  arrayss = gfc_walk_expr (arrayexpr);
+  gcc_assert (arrayss != gfc_ss_terminator);
+
+  actual = actual->next->next;
+  gcc_assert (actual);
+  maskexpr = actual->expr;
+  nonempty = NULL;
+  if (maskexpr && maskexpr->rank != 0)
+    {
+      maskss = gfc_walk_expr (maskexpr);
+      gcc_assert (maskss != gfc_ss_terminator);
+    }
+  else
+    {
+      mpz_t asize;
+      if (gfc_array_size (arrayexpr, &asize) == SUCCESS)
+	{
+	  nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind);
+	  mpz_clear (asize);
+	  nonempty = fold_build2_loc (input_location, GT_EXPR,
+				      boolean_type_node, nonempty,
+				      gfc_index_zero_node);
+	}
+      maskss = NULL;
+    }
+
+  limit = gfc_create_var (gfc_typenode_for_spec (&arrayexpr->ts), "limit");
+  switch (arrayexpr->ts.type)
+    {
+    case BT_REAL:
+      tmp = gfc_build_inf_or_huge (TREE_TYPE (limit), arrayexpr->ts.kind);
+      break;
+
+    case BT_INTEGER:
+      n = gfc_validate_kind (arrayexpr->ts.type, arrayexpr->ts.kind, false);
+      tmp = gfc_conv_mpz_to_tree (gfc_integer_kinds[n].huge,
+				  arrayexpr->ts.kind);
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+
+  /* We start with the most negative possible value for MAXLOC, and the most
+     positive possible value for MINLOC. The most negative possible value is
+     -HUGE for BT_REAL and (-HUGE - 1) for BT_INTEGER; the most positive
+     possible value is HUGE in both cases.  */
+  if (op == GT_EXPR)
+    tmp = fold_build1_loc (input_location, NEGATE_EXPR, TREE_TYPE (tmp), tmp);
+  if (op == GT_EXPR && expr->ts.type == BT_INTEGER)
+    tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (tmp), tmp,
+			   build_int_cst (type, 1));
+
+  gfc_add_modify (&se->pre, limit, tmp);
+
+  /* Initialize the scalarizer.  */
+  gfc_init_loopinfo (&loop);
+  gfc_add_ss_to_loop (&loop, arrayss);
+  if (maskss)
+    gfc_add_ss_to_loop (&loop, maskss);
+
+  /* Initialize the loop.  */
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop, &expr->where);
+
+  gcc_assert (loop.dimen == 1);
+  if (nonempty == NULL && maskss == NULL && loop.from[0] && loop.to[0])
+    nonempty = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
+				loop.from[0], loop.to[0]);
+
+  lab1 = NULL;
+  lab2 = NULL;
+  /* Initialize the position to zero, following Fortran 2003.  We are free
+     to do this because Fortran 95 allows the result of an entirely false
+     mask to be processor dependent.  If we know at compile time the array
+     is non-empty and no MASK is used, we can initialize to 1 to simplify
+     the inner loop.  */
+  if (nonempty != NULL && !HONOR_NANS (DECL_MODE (limit)))
+    gfc_add_modify (&loop.pre, pos,
+		    fold_build3_loc (input_location, COND_EXPR,
+				     gfc_array_index_type,
+				     nonempty, gfc_index_one_node,
+				     gfc_index_zero_node));
+  else
+    {
+      gfc_add_modify (&loop.pre, pos, gfc_index_zero_node);
+      lab1 = gfc_build_label_decl (NULL_TREE);
+      TREE_USED (lab1) = 1;
+      lab2 = gfc_build_label_decl (NULL_TREE);
+      TREE_USED (lab2) = 1;
+    }
+
+  gfc_mark_ss_chain_used (arrayss, 1);
+  if (maskss)
+    gfc_mark_ss_chain_used (maskss, 1);
+  /* Generate the loop body.  */
+  gfc_start_scalarized_body (&loop, &body);
+
+  /* If we have a mask, only check this element if the mask is set.  */
+  if (maskss)
+    {
+      gfc_init_se (&maskse, NULL);
+      gfc_copy_loopinfo_to_se (&maskse, &loop);
+      maskse.ss = maskss;
+      gfc_conv_expr_val (&maskse, maskexpr);
+      gfc_add_block_to_block (&body, &maskse.pre);
+
+      gfc_start_block (&block);
+    }
+  else
+    gfc_init_block (&block);
+
+  /* Compare with the current limit.  */
+  gfc_init_se (&arrayse, NULL);
+  gfc_copy_loopinfo_to_se (&arrayse, &loop);
+  arrayse.ss = arrayss;
+  gfc_conv_expr_val (&arrayse, arrayexpr);
+  gfc_add_block_to_block (&block, &arrayse.pre);
+
+  /* We do the following if this is a more extreme value.  */
+  gfc_start_block (&ifblock);
+
+  /* Assign the value to the limit...  */
+  gfc_add_modify (&ifblock, limit, arrayse.expr);
+
+  /* Remember where we are.  An offset must be added to the loop
+     counter to obtain the required position.  */
+  if (loop.from[0])
+    tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			   gfc_index_one_node, loop.from[0]);
+  else
+    tmp = gfc_index_one_node;
+
+  gfc_add_modify (&block, offset, tmp);
+
+  if (nonempty == NULL && HONOR_NANS (DECL_MODE (limit)))
+    {
+      stmtblock_t ifblock2;
+      tree ifbody2;
+
+      gfc_start_block (&ifblock2);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (pos),
+			     loop.loopvar[0], offset);
+      gfc_add_modify (&ifblock2, pos, tmp);
+      ifbody2 = gfc_finish_block (&ifblock2);
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pos,
+			      gfc_index_zero_node);
+      tmp = build3_v (COND_EXPR, cond, ifbody2,
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block, tmp);
+    }
+
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (pos),
+			 loop.loopvar[0], offset);
+  gfc_add_modify (&ifblock, pos, tmp);
+
+  if (lab1)
+    gfc_add_expr_to_block (&ifblock, build1_v (GOTO_EXPR, lab1));
+
+  ifbody = gfc_finish_block (&ifblock);
+
+  if (!lab1 || HONOR_NANS (DECL_MODE (limit)))
+    {
+      if (lab1)
+	cond = fold_build2_loc (input_location,
+				op == GT_EXPR ? GE_EXPR : LE_EXPR,
+				boolean_type_node, arrayse.expr, limit);
+      else
+	cond = fold_build2_loc (input_location, op, boolean_type_node,
+				arrayse.expr, limit);
+
+      ifbody = build3_v (COND_EXPR, cond, ifbody,
+			 build_empty_stmt (input_location));
+    }
+  gfc_add_expr_to_block (&block, ifbody);
+
+  if (maskss)
+    {
+      /* We enclose the above in if (mask) {...}.  */
+      tmp = gfc_finish_block (&block);
+
+      tmp = build3_v (COND_EXPR, maskse.expr, tmp,
+		      build_empty_stmt (input_location));
+    }
+  else
+    tmp = gfc_finish_block (&block);
+  gfc_add_expr_to_block (&body, tmp);
+
+  if (lab1)
+    {
+      gfc_trans_scalarized_loop_end (&loop, 0, &body);
+
+      if (HONOR_NANS (DECL_MODE (limit)))
+	{
+	  if (nonempty != NULL)
+	    {
+	      ifbody = build2_v (MODIFY_EXPR, pos, gfc_index_one_node);
+	      tmp = build3_v (COND_EXPR, nonempty, ifbody,
+			      build_empty_stmt (input_location));
+	      gfc_add_expr_to_block (&loop.code[0], tmp);
+	    }
+	}
+
+      gfc_add_expr_to_block (&loop.code[0], build1_v (GOTO_EXPR, lab2));
+      gfc_add_expr_to_block (&loop.code[0], build1_v (LABEL_EXPR, lab1));
+      gfc_start_block (&body);
+
+      /* If we have a mask, only check this element if the mask is set.  */
+      if (maskss)
+	{
+	  gfc_init_se (&maskse, NULL);
+	  gfc_copy_loopinfo_to_se (&maskse, &loop);
+	  maskse.ss = maskss;
+	  gfc_conv_expr_val (&maskse, maskexpr);
+	  gfc_add_block_to_block (&body, &maskse.pre);
+
+	  gfc_start_block (&block);
+	}
+      else
+	gfc_init_block (&block);
+
+      /* Compare with the current limit.  */
+      gfc_init_se (&arrayse, NULL);
+      gfc_copy_loopinfo_to_se (&arrayse, &loop);
+      arrayse.ss = arrayss;
+      gfc_conv_expr_val (&arrayse, arrayexpr);
+      gfc_add_block_to_block (&block, &arrayse.pre);
+
+      /* We do the following if this is a more extreme value.  */
+      gfc_start_block (&ifblock);
+
+      /* Assign the value to the limit...  */
+      gfc_add_modify (&ifblock, limit, arrayse.expr);
+
+      /* Remember where we are.  An offset must be added to the loop
+	 counter to obtain the required position.  */
+      if (loop.from[0])
+	tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			       gfc_index_one_node, loop.from[0]);
+      else
+	tmp = gfc_index_one_node;
+
+      gfc_add_modify (&block, offset, tmp);
+
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (pos),
+			     loop.loopvar[0], offset);
+      gfc_add_modify (&ifblock, pos, tmp);
+
+      ifbody = gfc_finish_block (&ifblock);
+
+      cond = fold_build2_loc (input_location, op, boolean_type_node,
+			      arrayse.expr, limit);
+
+      tmp = build3_v (COND_EXPR, cond, ifbody,
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block, tmp);
+
+      if (maskss)
+	{
+	  /* We enclose the above in if (mask) {...}.  */
+	  tmp = gfc_finish_block (&block);
+
+	  tmp = build3_v (COND_EXPR, maskse.expr, tmp,
+			  build_empty_stmt (input_location));
+	}
+      else
+	tmp = gfc_finish_block (&block);
+      gfc_add_expr_to_block (&body, tmp);
+      /* Avoid initializing loopvar[0] again, it should be left where
+	 it finished by the first loop.  */
+      loop.from[0] = loop.loopvar[0];
+    }
+
+  gfc_trans_scalarizing_loops (&loop, &body);
+
+  if (lab2)
+    gfc_add_expr_to_block (&loop.pre, build1_v (LABEL_EXPR, lab2));
+
+  /* For a scalar mask, enclose the loop in an if statement.  */
+  if (maskexpr && maskss == NULL)
+    {
+      gfc_init_se (&maskse, NULL);
+      gfc_conv_expr_val (&maskse, maskexpr);
+      gfc_init_block (&block);
+      gfc_add_block_to_block (&block, &loop.pre);
+      gfc_add_block_to_block (&block, &loop.post);
+      tmp = gfc_finish_block (&block);
+
+      /* For the else part of the scalar mask, just initialize
+	 the pos variable the same way as above.  */
+
+      gfc_init_block (&elseblock);
+      gfc_add_modify (&elseblock, pos, gfc_index_zero_node);
+      elsetmp = gfc_finish_block (&elseblock);
+
+      tmp = build3_v (COND_EXPR, maskse.expr, tmp, elsetmp);
+      gfc_add_expr_to_block (&block, tmp);
+      gfc_add_block_to_block (&se->pre, &block);
+    }
+  else
+    {
+      gfc_add_block_to_block (&se->pre, &loop.pre);
+      gfc_add_block_to_block (&se->pre, &loop.post);
+    }
+  gfc_cleanup_loop (&loop);
+
+  se->expr = convert (type, pos);
+}
+
+/* Emit code for minval or maxval intrinsic.  There are many different cases
+   we need to handle.  For performance reasons we sometimes create two
+   loops instead of one, where the second one is much simpler.
+   Examples for minval intrinsic:
+   1) Result is an array, a call is generated
+   2) Array mask is used and NaNs need to be supported, rank 1:
+      limit = Infinity;
+      nonempty = false;
+      S = from;
+      while (S <= to) {
+	if (mask[S]) { nonempty = true; if (a[S] <= limit) goto lab; }
+	S++;
+      }
+      limit = nonempty ? NaN : huge (limit);
+      lab:
+      while (S <= to) { if(mask[S]) limit = min (a[S], limit); S++; }
+   3) NaNs need to be supported, but it is known at compile time or cheaply
+      at runtime whether array is nonempty or not, rank 1:
+      limit = Infinity;
+      S = from;
+      while (S <= to) { if (a[S] <= limit) goto lab; S++; }
+      limit = (from <= to) ? NaN : huge (limit);
+      lab:
+      while (S <= to) { limit = min (a[S], limit); S++; }
+   4) Array mask is used and NaNs need to be supported, rank > 1:
+      limit = Infinity;
+      nonempty = false;
+      fast = false;
+      S1 = from1;
+      while (S1 <= to1) {
+	S2 = from2;
+	while (S2 <= to2) {
+	  if (mask[S1][S2]) {
+	    if (fast) limit = min (a[S1][S2], limit);
+	    else {
+	      nonempty = true;
+	      if (a[S1][S2] <= limit) {
+		limit = a[S1][S2];
+		fast = true;
+	      }
+	    }
+	  }
+	  S2++;
+	}
+	S1++;
+      }
+      if (!fast)
+	limit = nonempty ? NaN : huge (limit);
+   5) NaNs need to be supported, but it is known at compile time or cheaply
+      at runtime whether array is nonempty or not, rank > 1:
+      limit = Infinity;
+      fast = false;
+      S1 = from1;
+      while (S1 <= to1) {
+	S2 = from2;
+	while (S2 <= to2) {
+	  if (fast) limit = min (a[S1][S2], limit);
+	  else {
+	    if (a[S1][S2] <= limit) {
+	      limit = a[S1][S2];
+	      fast = true;
+	    }
+	  }
+	  S2++;
+	}
+	S1++;
+      }
+      if (!fast)
+	limit = (nonempty_array) ? NaN : huge (limit);
+   6) NaNs aren't supported, but infinities are.  Array mask is used:
+      limit = Infinity;
+      nonempty = false;
+      S = from;
+      while (S <= to) {
+	if (mask[S]) { nonempty = true; limit = min (a[S], limit); }
+	S++;
+      }
+      limit = nonempty ? limit : huge (limit);
+   7) Same without array mask:
+      limit = Infinity;
+      S = from;
+      while (S <= to) { limit = min (a[S], limit); S++; }
+      limit = (from <= to) ? limit : huge (limit);
+   8) Neither NaNs nor infinities are supported (-ffast-math or BT_INTEGER):
+      limit = huge (limit);
+      S = from;
+      while (S <= to) { limit = min (a[S], limit); S++); }
+      (or
+      while (S <= to) { if (mask[S]) limit = min (a[S], limit); S++; }
+      with array mask instead).
+   For 3), 5), 7) and 8), if mask is scalar, this all goes into a conditional,
+   setting limit = huge (limit); in the else branch.  */
+
+static void
+gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op)
+{
+  tree limit;
+  tree type;
+  tree tmp;
+  tree ifbody;
+  tree nonempty;
+  tree nonempty_var;
+  tree lab;
+  tree fast;
+  tree huge_cst = NULL, nan_cst = NULL;
+  stmtblock_t body;
+  stmtblock_t block, block2;
+  gfc_loopinfo loop;
+  gfc_actual_arglist *actual;
+  gfc_ss *arrayss;
+  gfc_ss *maskss;
+  gfc_se arrayse;
+  gfc_se maskse;
+  gfc_expr *arrayexpr;
+  gfc_expr *maskexpr;
+  int n;
+
+  if (se->ss)
+    {
+      gfc_conv_intrinsic_funcall (se, expr);
+      return;
+    }
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  /* Initialize the result.  */
+  limit = gfc_create_var (type, "limit");
+  n = gfc_validate_kind (expr->ts.type, expr->ts.kind, false);
+  switch (expr->ts.type)
+    {
+    case BT_REAL:
+      huge_cst = gfc_conv_mpfr_to_tree (gfc_real_kinds[n].huge,
+					expr->ts.kind, 0);
+      if (HONOR_INFINITIES (DECL_MODE (limit)))
+	{
+	  REAL_VALUE_TYPE real;
+	  real_inf (&real);
+	  tmp = build_real (type, real);
+	}
+      else
+	tmp = huge_cst;
+      if (HONOR_NANS (DECL_MODE (limit)))
+	{
+	  REAL_VALUE_TYPE real;
+	  real_nan (&real, "", 1, DECL_MODE (limit));
+	  nan_cst = build_real (type, real);
+	}
+      break;
+
+    case BT_INTEGER:
+      tmp = gfc_conv_mpz_to_tree (gfc_integer_kinds[n].huge, expr->ts.kind);
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+
+  /* We start with the most negative possible value for MAXVAL, and the most
+     positive possible value for MINVAL. The most negative possible value is
+     -HUGE for BT_REAL and (-HUGE - 1) for BT_INTEGER; the most positive
+     possible value is HUGE in both cases.  */
+  if (op == GT_EXPR)
+    {
+      tmp = fold_build1_loc (input_location, NEGATE_EXPR, TREE_TYPE (tmp), tmp);
+      if (huge_cst)
+	huge_cst = fold_build1_loc (input_location, NEGATE_EXPR,
+				    TREE_TYPE (huge_cst), huge_cst);
+    }
+
+  if (op == GT_EXPR && expr->ts.type == BT_INTEGER)
+    tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (tmp),
+			   tmp, build_int_cst (type, 1));
+
+  gfc_add_modify (&se->pre, limit, tmp);
+
+  /* Walk the arguments.  */
+  actual = expr->value.function.actual;
+  arrayexpr = actual->expr;
+  arrayss = gfc_walk_expr (arrayexpr);
+  gcc_assert (arrayss != gfc_ss_terminator);
+
+  actual = actual->next->next;
+  gcc_assert (actual);
+  maskexpr = actual->expr;
+  nonempty = NULL;
+  if (maskexpr && maskexpr->rank != 0)
+    {
+      maskss = gfc_walk_expr (maskexpr);
+      gcc_assert (maskss != gfc_ss_terminator);
+    }
+  else
+    {
+      mpz_t asize;
+      if (gfc_array_size (arrayexpr, &asize) == SUCCESS)
+	{
+	  nonempty = gfc_conv_mpz_to_tree (asize, gfc_index_integer_kind);
+	  mpz_clear (asize);
+	  nonempty = fold_build2_loc (input_location, GT_EXPR,
+				      boolean_type_node, nonempty,
+				      gfc_index_zero_node);
+	}
+      maskss = NULL;
+    }
+
+  /* Initialize the scalarizer.  */
+  gfc_init_loopinfo (&loop);
+  gfc_add_ss_to_loop (&loop, arrayss);
+  if (maskss)
+    gfc_add_ss_to_loop (&loop, maskss);
+
+  /* Initialize the loop.  */
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop, &expr->where);
+
+  if (nonempty == NULL && maskss == NULL
+      && loop.dimen == 1 && loop.from[0] && loop.to[0])
+    nonempty = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
+				loop.from[0], loop.to[0]);
+  nonempty_var = NULL;
+  if (nonempty == NULL
+      && (HONOR_INFINITIES (DECL_MODE (limit))
+	  || HONOR_NANS (DECL_MODE (limit))))
+    {
+      nonempty_var = gfc_create_var (boolean_type_node, "nonempty");
+      gfc_add_modify (&se->pre, nonempty_var, boolean_false_node);
+      nonempty = nonempty_var;
+    }
+  lab = NULL;
+  fast = NULL;
+  if (HONOR_NANS (DECL_MODE (limit)))
+    {
+      if (loop.dimen == 1)
+	{
+	  lab = gfc_build_label_decl (NULL_TREE);
+	  TREE_USED (lab) = 1;
+	}
+      else
+	{
+	  fast = gfc_create_var (boolean_type_node, "fast");
+	  gfc_add_modify (&se->pre, fast, boolean_false_node);
+	}
+    }
+
+  gfc_mark_ss_chain_used (arrayss, 1);
+  if (maskss)
+    gfc_mark_ss_chain_used (maskss, 1);
+  /* Generate the loop body.  */
+  gfc_start_scalarized_body (&loop, &body);
+
+  /* If we have a mask, only add this element if the mask is set.  */
+  if (maskss)
+    {
+      gfc_init_se (&maskse, NULL);
+      gfc_copy_loopinfo_to_se (&maskse, &loop);
+      maskse.ss = maskss;
+      gfc_conv_expr_val (&maskse, maskexpr);
+      gfc_add_block_to_block (&body, &maskse.pre);
+
+      gfc_start_block (&block);
+    }
+  else
+    gfc_init_block (&block);
+
+  /* Compare with the current limit.  */
+  gfc_init_se (&arrayse, NULL);
+  gfc_copy_loopinfo_to_se (&arrayse, &loop);
+  arrayse.ss = arrayss;
+  gfc_conv_expr_val (&arrayse, arrayexpr);
+  gfc_add_block_to_block (&block, &arrayse.pre);
+
+  gfc_init_block (&block2);
+
+  if (nonempty_var)
+    gfc_add_modify (&block2, nonempty_var, boolean_true_node);
+
+  if (HONOR_NANS (DECL_MODE (limit)))
+    {
+      tmp = fold_build2_loc (input_location, op == GT_EXPR ? GE_EXPR : LE_EXPR,
+			     boolean_type_node, arrayse.expr, limit);
+      if (lab)
+	ifbody = build1_v (GOTO_EXPR, lab);
+      else
+	{
+	  stmtblock_t ifblock;
+
+	  gfc_init_block (&ifblock);
+	  gfc_add_modify (&ifblock, limit, arrayse.expr);
+	  gfc_add_modify (&ifblock, fast, boolean_true_node);
+	  ifbody = gfc_finish_block (&ifblock);
+	}
+      tmp = build3_v (COND_EXPR, tmp, ifbody,
+		      build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block2, tmp);
+    }
+  else
+    {
+      /* MIN_EXPR/MAX_EXPR has unspecified behavior with NaNs or
+	 signed zeros.  */
+      if (HONOR_SIGNED_ZEROS (DECL_MODE (limit)))
+	{
+	  tmp = fold_build2_loc (input_location, op, boolean_type_node,
+				 arrayse.expr, limit);
+	  ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr);
+	  tmp = build3_v (COND_EXPR, tmp, ifbody,
+			  build_empty_stmt (input_location));
+	  gfc_add_expr_to_block (&block2, tmp);
+	}
+      else
+	{
+	  tmp = fold_build2_loc (input_location,
+				 op == GT_EXPR ? MAX_EXPR : MIN_EXPR,
+				 type, arrayse.expr, limit);
+	  gfc_add_modify (&block2, limit, tmp);
+	}
+    }
+
+  if (fast)
+    {
+      tree elsebody = gfc_finish_block (&block2);
+
+      /* MIN_EXPR/MAX_EXPR has unspecified behavior with NaNs or
+	 signed zeros.  */
+      if (HONOR_NANS (DECL_MODE (limit))
+	  || HONOR_SIGNED_ZEROS (DECL_MODE (limit)))
+	{
+	  tmp = fold_build2_loc (input_location, op, boolean_type_node,
+				 arrayse.expr, limit);
+	  ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr);
+	  ifbody = build3_v (COND_EXPR, tmp, ifbody,
+			     build_empty_stmt (input_location));
+	}
+      else
+	{
+	  tmp = fold_build2_loc (input_location,
+				 op == GT_EXPR ? MAX_EXPR : MIN_EXPR,
+				 type, arrayse.expr, limit);
+	  ifbody = build2_v (MODIFY_EXPR, limit, tmp);
+	}
+      tmp = build3_v (COND_EXPR, fast, ifbody, elsebody);
+      gfc_add_expr_to_block (&block, tmp);
+    }
+  else
+    gfc_add_block_to_block (&block, &block2);
+
+  gfc_add_block_to_block (&block, &arrayse.post);
+
+  tmp = gfc_finish_block (&block);
+  if (maskss)
+    /* We enclose the above in if (mask) {...}.  */
+    tmp = build3_v (COND_EXPR, maskse.expr, tmp,
+		    build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&body, tmp);
+
+  if (lab)
+    {
+      gfc_trans_scalarized_loop_end (&loop, 0, &body);
+
+      tmp = fold_build3_loc (input_location, COND_EXPR, type, nonempty,
+			     nan_cst, huge_cst);
+      gfc_add_modify (&loop.code[0], limit, tmp);
+      gfc_add_expr_to_block (&loop.code[0], build1_v (LABEL_EXPR, lab));
+
+      gfc_start_block (&body);
+
+      /* If we have a mask, only add this element if the mask is set.  */
+      if (maskss)
+	{
+	  gfc_init_se (&maskse, NULL);
+	  gfc_copy_loopinfo_to_se (&maskse, &loop);
+	  maskse.ss = maskss;
+	  gfc_conv_expr_val (&maskse, maskexpr);
+	  gfc_add_block_to_block (&body, &maskse.pre);
+
+	  gfc_start_block (&block);
+	}
+      else
+	gfc_init_block (&block);
+
+      /* Compare with the current limit.  */
+      gfc_init_se (&arrayse, NULL);
+      gfc_copy_loopinfo_to_se (&arrayse, &loop);
+      arrayse.ss = arrayss;
+      gfc_conv_expr_val (&arrayse, arrayexpr);
+      gfc_add_block_to_block (&block, &arrayse.pre);
+
+      /* MIN_EXPR/MAX_EXPR has unspecified behavior with NaNs or
+	 signed zeros.  */
+      if (HONOR_NANS (DECL_MODE (limit))
+	  || HONOR_SIGNED_ZEROS (DECL_MODE (limit)))
+	{
+	  tmp = fold_build2_loc (input_location, op, boolean_type_node,
+				 arrayse.expr, limit);
+	  ifbody = build2_v (MODIFY_EXPR, limit, arrayse.expr);
+	  tmp = build3_v (COND_EXPR, tmp, ifbody,
+			  build_empty_stmt (input_location));
+	  gfc_add_expr_to_block (&block, tmp);
+	}
+      else
+	{
+	  tmp = fold_build2_loc (input_location,
+				 op == GT_EXPR ? MAX_EXPR : MIN_EXPR,
+				 type, arrayse.expr, limit);
+	  gfc_add_modify (&block, limit, tmp);
+	}
+
+      gfc_add_block_to_block (&block, &arrayse.post);
+
+      tmp = gfc_finish_block (&block);
+      if (maskss)
+	/* We enclose the above in if (mask) {...}.  */
+	tmp = build3_v (COND_EXPR, maskse.expr, tmp,
+			build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&body, tmp);
+      /* Avoid initializing loopvar[0] again, it should be left where
+	 it finished by the first loop.  */
+      loop.from[0] = loop.loopvar[0];
+    }
+  gfc_trans_scalarizing_loops (&loop, &body);
+
+  if (fast)
+    {
+      tmp = fold_build3_loc (input_location, COND_EXPR, type, nonempty,
+			     nan_cst, huge_cst);
+      ifbody = build2_v (MODIFY_EXPR, limit, tmp);
+      tmp = build3_v (COND_EXPR, fast, build_empty_stmt (input_location),
+		      ifbody);
+      gfc_add_expr_to_block (&loop.pre, tmp);
+    }
+  else if (HONOR_INFINITIES (DECL_MODE (limit)) && !lab)
+    {
+      tmp = fold_build3_loc (input_location, COND_EXPR, type, nonempty, limit,
+			     huge_cst);
+      gfc_add_modify (&loop.pre, limit, tmp);
+    }
+
+  /* For a scalar mask, enclose the loop in an if statement.  */
+  if (maskexpr && maskss == NULL)
+    {
+      tree else_stmt;
+
+      gfc_init_se (&maskse, NULL);
+      gfc_conv_expr_val (&maskse, maskexpr);
+      gfc_init_block (&block);
+      gfc_add_block_to_block (&block, &loop.pre);
+      gfc_add_block_to_block (&block, &loop.post);
+      tmp = gfc_finish_block (&block);
+
+      if (HONOR_INFINITIES (DECL_MODE (limit)))
+	else_stmt = build2_v (MODIFY_EXPR, limit, huge_cst);
+      else
+	else_stmt = build_empty_stmt (input_location);
+      tmp = build3_v (COND_EXPR, maskse.expr, tmp, else_stmt);
+      gfc_add_expr_to_block (&block, tmp);
+      gfc_add_block_to_block (&se->pre, &block);
+    }
+  else
+    {
+      gfc_add_block_to_block (&se->pre, &loop.pre);
+      gfc_add_block_to_block (&se->pre, &loop.post);
+    }
+
+  gfc_cleanup_loop (&loop);
+
+  se->expr = limit;
+}
+
+/* BTEST (i, pos) = (i & (1 << pos)) != 0.  */
+static void
+gfc_conv_intrinsic_btest (gfc_se * se, gfc_expr * expr)
+{
+  tree args[2];
+  tree type;
+  tree tmp;
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+  type = TREE_TYPE (args[0]);
+
+  tmp = fold_build2_loc (input_location, LSHIFT_EXPR, type,
+			 build_int_cst (type, 1), args[1]);
+  tmp = fold_build2_loc (input_location, BIT_AND_EXPR, type, args[0], tmp);
+  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp,
+			 build_int_cst (type, 0));
+  type = gfc_typenode_for_spec (&expr->ts);
+  se->expr = convert (type, tmp);
+}
+
+
+/* Generate code for BGE, BGT, BLE and BLT intrinsics.  */
+static void
+gfc_conv_intrinsic_bitcomp (gfc_se * se, gfc_expr * expr, enum tree_code op)
+{
+  tree args[2];
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+
+  /* Convert both arguments to the unsigned type of the same size.  */
+  args[0] = fold_convert (unsigned_type_for (TREE_TYPE (args[0])), args[0]);
+  args[1] = fold_convert (unsigned_type_for (TREE_TYPE (args[1])), args[1]);
+
+  /* If they have unequal type size, convert to the larger one.  */
+  if (TYPE_PRECISION (TREE_TYPE (args[0]))
+      > TYPE_PRECISION (TREE_TYPE (args[1])))
+    args[1] = fold_convert (TREE_TYPE (args[0]), args[1]);
+  else if (TYPE_PRECISION (TREE_TYPE (args[1]))
+	   > TYPE_PRECISION (TREE_TYPE (args[0])))
+    args[0] = fold_convert (TREE_TYPE (args[1]), args[0]);
+
+  /* Now, we compare them.  */
+  se->expr = fold_build2_loc (input_location, op, boolean_type_node,
+			      args[0], args[1]);
+}
+
+
+/* Generate code to perform the specified operation.  */
+static void
+gfc_conv_intrinsic_bitop (gfc_se * se, gfc_expr * expr, enum tree_code op)
+{
+  tree args[2];
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+  se->expr = fold_build2_loc (input_location, op, TREE_TYPE (args[0]),
+			      args[0], args[1]);
+}
+
+/* Bitwise not.  */
+static void
+gfc_conv_intrinsic_not (gfc_se * se, gfc_expr * expr)
+{
+  tree arg;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  se->expr = fold_build1_loc (input_location, BIT_NOT_EXPR,
+			      TREE_TYPE (arg), arg);
+}
+
+/* Set or clear a single bit.  */
+static void
+gfc_conv_intrinsic_singlebitop (gfc_se * se, gfc_expr * expr, int set)
+{
+  tree args[2];
+  tree type;
+  tree tmp;
+  enum tree_code op;
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+  type = TREE_TYPE (args[0]);
+
+  tmp = fold_build2_loc (input_location, LSHIFT_EXPR, type,
+			 build_int_cst (type, 1), args[1]);
+  if (set)
+    op = BIT_IOR_EXPR;
+  else
+    {
+      op = BIT_AND_EXPR;
+      tmp = fold_build1_loc (input_location, BIT_NOT_EXPR, type, tmp);
+    }
+  se->expr = fold_build2_loc (input_location, op, type, args[0], tmp);
+}
+
+/* Extract a sequence of bits.
+    IBITS(I, POS, LEN) = (I >> POS) & ~((~0) << LEN).  */
+static void
+gfc_conv_intrinsic_ibits (gfc_se * se, gfc_expr * expr)
+{
+  tree args[3];
+  tree type;
+  tree tmp;
+  tree mask;
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 3);
+  type = TREE_TYPE (args[0]);
+
+  mask = build_int_cst (type, -1);
+  mask = fold_build2_loc (input_location, LSHIFT_EXPR, type, mask, args[2]);
+  mask = fold_build1_loc (input_location, BIT_NOT_EXPR, type, mask);
+
+  tmp = fold_build2_loc (input_location, RSHIFT_EXPR, type, args[0], args[1]);
+
+  se->expr = fold_build2_loc (input_location, BIT_AND_EXPR, type, tmp, mask);
+}
+
+static void
+gfc_conv_intrinsic_shift (gfc_se * se, gfc_expr * expr, bool right_shift,
+			  bool arithmetic)
+{
+  tree args[2], type, num_bits, cond;
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+
+  args[0] = gfc_evaluate_now (args[0], &se->pre);
+  args[1] = gfc_evaluate_now (args[1], &se->pre);
+  type = TREE_TYPE (args[0]);
+
+  if (!arithmetic)
+    args[0] = fold_convert (unsigned_type_for (type), args[0]);
+  else
+    gcc_assert (right_shift);
+
+  se->expr = fold_build2_loc (input_location,
+			      right_shift ? RSHIFT_EXPR : LSHIFT_EXPR,
+			      TREE_TYPE (args[0]), args[0], args[1]);
+
+  if (!arithmetic)
+    se->expr = fold_convert (type, se->expr);
+
+  /* The Fortran standard allows shift widths <= BIT_SIZE(I), whereas
+     gcc requires a shift width < BIT_SIZE(I), so we have to catch this
+     special case.  */
+  num_bits = build_int_cst (TREE_TYPE (args[1]), TYPE_PRECISION (type));
+  cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
+			  args[1], num_bits);
+
+  se->expr = fold_build3_loc (input_location, COND_EXPR, type, cond,
+			      build_int_cst (type, 0), se->expr);
+}
+
+/* ISHFT (I, SHIFT) = (abs (shift) >= BIT_SIZE (i))
+                        ? 0
+	 	        : ((shift >= 0) ? i << shift : i >> -shift)
+   where all shifts are logical shifts.  */
+static void
+gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr)
+{
+  tree args[2];
+  tree type;
+  tree utype;
+  tree tmp;
+  tree width;
+  tree num_bits;
+  tree cond;
+  tree lshift;
+  tree rshift;
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+
+  args[0] = gfc_evaluate_now (args[0], &se->pre);
+  args[1] = gfc_evaluate_now (args[1], &se->pre);
+
+  type = TREE_TYPE (args[0]);
+  utype = unsigned_type_for (type);
+
+  width = fold_build1_loc (input_location, ABS_EXPR, TREE_TYPE (args[1]),
+			   args[1]);
+
+  /* Left shift if positive.  */
+  lshift = fold_build2_loc (input_location, LSHIFT_EXPR, type, args[0], width);
+
+  /* Right shift if negative.
+     We convert to an unsigned type because we want a logical shift.
+     The standard doesn't define the case of shifting negative
+     numbers, and we try to be compatible with other compilers, most
+     notably g77, here.  */
+  rshift = fold_convert (type, fold_build2_loc (input_location, RSHIFT_EXPR,
+				    utype, convert (utype, args[0]), width));
+
+  tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, args[1],
+			 build_int_cst (TREE_TYPE (args[1]), 0));
+  tmp = fold_build3_loc (input_location, COND_EXPR, type, tmp, lshift, rshift);
+
+  /* The Fortran standard allows shift widths <= BIT_SIZE(I), whereas
+     gcc requires a shift width < BIT_SIZE(I), so we have to catch this
+     special case.  */
+  num_bits = build_int_cst (TREE_TYPE (args[1]), TYPE_PRECISION (type));
+  cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, width,
+			  num_bits);
+  se->expr = fold_build3_loc (input_location, COND_EXPR, type, cond,
+			      build_int_cst (type, 0), tmp);
+}
+
+
+/* Circular shift.  AKA rotate or barrel shift.  */
+
+static void
+gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
+{
+  tree *args;
+  tree type;
+  tree tmp;
+  tree lrot;
+  tree rrot;
+  tree zero;
+  unsigned int num_args;
+
+  num_args = gfc_intrinsic_argument_list_length (expr);
+  args = XALLOCAVEC (tree, num_args);
+
+  gfc_conv_intrinsic_function_args (se, expr, args, num_args);
+
+  if (num_args == 3)
+    {
+      /* Use a library function for the 3 parameter version.  */
+      tree int4type = gfc_get_int_type (4);
+
+      type = TREE_TYPE (args[0]);
+      /* We convert the first argument to at least 4 bytes, and
+	 convert back afterwards.  This removes the need for library
+	 functions for all argument sizes, and function will be
+	 aligned to at least 32 bits, so there's no loss.  */
+      if (expr->ts.kind < 4)
+	args[0] = convert (int4type, args[0]);
+
+      /* Convert the SHIFT and SIZE args to INTEGER*4 otherwise we would
+         need loads of library  functions.  They cannot have values >
+	 BIT_SIZE (I) so the conversion is safe.  */
+      args[1] = convert (int4type, args[1]);
+      args[2] = convert (int4type, args[2]);
+
+      switch (expr->ts.kind)
+	{
+	case 1:
+	case 2:
+	case 4:
+	  tmp = gfor_fndecl_math_ishftc4;
+	  break;
+	case 8:
+	  tmp = gfor_fndecl_math_ishftc8;
+	  break;
+	case 16:
+	  tmp = gfor_fndecl_math_ishftc16;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+      se->expr = build_call_expr_loc (input_location,
+				      tmp, 3, args[0], args[1], args[2]);
+      /* Convert the result back to the original type, if we extended
+	 the first argument's width above.  */
+      if (expr->ts.kind < 4)
+	se->expr = convert (type, se->expr);
+
+      return;
+    }
+  type = TREE_TYPE (args[0]);
+
+  /* Evaluate arguments only once.  */
+  args[0] = gfc_evaluate_now (args[0], &se->pre);
+  args[1] = gfc_evaluate_now (args[1], &se->pre);
+
+  /* Rotate left if positive.  */
+  lrot = fold_build2_loc (input_location, LROTATE_EXPR, type, args[0], args[1]);
+
+  /* Rotate right if negative.  */
+  tmp = fold_build1_loc (input_location, NEGATE_EXPR, TREE_TYPE (args[1]),
+			 args[1]);
+  rrot = fold_build2_loc (input_location,RROTATE_EXPR, type, args[0], tmp);
+
+  zero = build_int_cst (TREE_TYPE (args[1]), 0);
+  tmp = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, args[1],
+			 zero);
+  rrot = fold_build3_loc (input_location, COND_EXPR, type, tmp, lrot, rrot);
+
+  /* Do nothing if shift == 0.  */
+  tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, args[1],
+			 zero);
+  se->expr = fold_build3_loc (input_location, COND_EXPR, type, tmp, args[0],
+			      rrot);
+}
+
+
+/* LEADZ (i) = (i == 0) ? BIT_SIZE (i)
+			: __builtin_clz(i) - (BIT_SIZE('int') - BIT_SIZE(i))
+
+   The conditional expression is necessary because the result of LEADZ(0)
+   is defined, but the result of __builtin_clz(0) is undefined for most
+   targets.
+
+   For INTEGER kinds smaller than the C 'int' type, we have to subtract the
+   difference in bit size between the argument of LEADZ and the C int.  */
+ 
+static void
+gfc_conv_intrinsic_leadz (gfc_se * se, gfc_expr * expr)
+{
+  tree arg;
+  tree arg_type;
+  tree cond;
+  tree result_type;
+  tree leadz;
+  tree bit_size;
+  tree tmp;
+  tree func;
+  int s, argsize;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  argsize = TYPE_PRECISION (TREE_TYPE (arg));
+
+  /* Which variant of __builtin_clz* should we call?  */
+  if (argsize <= INT_TYPE_SIZE)
+    {
+      arg_type = unsigned_type_node;
+      func = built_in_decls[BUILT_IN_CLZ];
+    }
+  else if (argsize <= LONG_TYPE_SIZE)
+    {
+      arg_type = long_unsigned_type_node;
+      func = built_in_decls[BUILT_IN_CLZL];
+    }
+  else if (argsize <= LONG_LONG_TYPE_SIZE)
+    {
+      arg_type = long_long_unsigned_type_node;
+      func = built_in_decls[BUILT_IN_CLZLL];
+    }
+  else
+    {
+      gcc_assert (argsize == 2 * LONG_LONG_TYPE_SIZE);
+      arg_type = gfc_build_uint_type (argsize);
+      func = NULL_TREE;
+    }
+
+  /* Convert the actual argument twice: first, to the unsigned type of the
+     same size; then, to the proper argument type for the built-in
+     function.  But the return type is of the default INTEGER kind.  */
+  arg = fold_convert (gfc_build_uint_type (argsize), arg);
+  arg = fold_convert (arg_type, arg);
+  arg = gfc_evaluate_now (arg, &se->pre);
+  result_type = gfc_get_int_type (gfc_default_integer_kind);
+
+  /* Compute LEADZ for the case i .ne. 0.  */
+  if (func)
+    {
+      s = TYPE_PRECISION (arg_type) - argsize;
+      tmp = fold_convert (result_type,
+			  build_call_expr_loc (input_location, func,
+					       1, arg));
+      leadz = fold_build2_loc (input_location, MINUS_EXPR, result_type,
+			       tmp, build_int_cst (result_type, s));
+    }
+  else
+    {
+      /* We end up here if the argument type is larger than 'long long'.
+	 We generate this code:
+  
+	    if (x & (ULL_MAX << ULL_SIZE) != 0)
+	      return clzll ((unsigned long long) (x >> ULLSIZE));
+	    else
+	      return ULL_SIZE + clzll ((unsigned long long) x);
+	 where ULL_MAX is the largest value that a ULL_MAX can hold
+	 (0xFFFFFFFFFFFFFFFF for a 64-bit long long type), and ULLSIZE
+	 is the bit-size of the long long type (64 in this example).  */
+      tree ullsize, ullmax, tmp1, tmp2;
+
+      ullsize = build_int_cst (result_type, LONG_LONG_TYPE_SIZE);
+      ullmax = fold_build1_loc (input_location, BIT_NOT_EXPR,
+				long_long_unsigned_type_node,
+				build_int_cst (long_long_unsigned_type_node,
+					       0));
+
+      cond = fold_build2_loc (input_location, LSHIFT_EXPR, arg_type,
+			      fold_convert (arg_type, ullmax), ullsize);
+      cond = fold_build2_loc (input_location, BIT_AND_EXPR, arg_type,
+			      arg, cond);
+      cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			      cond, build_int_cst (arg_type, 0));
+
+      tmp1 = fold_build2_loc (input_location, RSHIFT_EXPR, arg_type,
+			      arg, ullsize);
+      tmp1 = fold_convert (long_long_unsigned_type_node, tmp1);
+      tmp1 = fold_convert (result_type,
+			   build_call_expr_loc (input_location,	
+						built_in_decls[BUILT_IN_CLZLL],
+						1, tmp1));
+
+      tmp2 = fold_convert (long_long_unsigned_type_node, arg);
+      tmp2 = fold_convert (result_type,
+			   build_call_expr_loc (input_location,
+						built_in_decls[BUILT_IN_CLZLL],
+						1, tmp2));
+      tmp2 = fold_build2_loc (input_location, PLUS_EXPR, result_type,
+			      tmp2, ullsize);
+
+      leadz = fold_build3_loc (input_location, COND_EXPR, result_type,
+			       cond, tmp1, tmp2);
+    }
+
+  /* Build BIT_SIZE.  */
+  bit_size = build_int_cst (result_type, argsize);
+
+  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			  arg, build_int_cst (arg_type, 0));
+  se->expr = fold_build3_loc (input_location, COND_EXPR, result_type, cond,
+			      bit_size, leadz);
+}
+
+
+/* TRAILZ(i) = (i == 0) ? BIT_SIZE (i) : __builtin_ctz(i)
+
+   The conditional expression is necessary because the result of TRAILZ(0)
+   is defined, but the result of __builtin_ctz(0) is undefined for most
+   targets.  */
+ 
+static void
+gfc_conv_intrinsic_trailz (gfc_se * se, gfc_expr *expr)
+{
+  tree arg;
+  tree arg_type;
+  tree cond;
+  tree result_type;
+  tree trailz;
+  tree bit_size;
+  tree func;
+  int argsize;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  argsize = TYPE_PRECISION (TREE_TYPE (arg));
+
+  /* Which variant of __builtin_ctz* should we call?  */
+  if (argsize <= INT_TYPE_SIZE)
+    {
+      arg_type = unsigned_type_node;
+      func = built_in_decls[BUILT_IN_CTZ];
+    }
+  else if (argsize <= LONG_TYPE_SIZE)
+    {
+      arg_type = long_unsigned_type_node;
+      func = built_in_decls[BUILT_IN_CTZL];
+    }
+  else if (argsize <= LONG_LONG_TYPE_SIZE)
+    {
+      arg_type = long_long_unsigned_type_node;
+      func = built_in_decls[BUILT_IN_CTZLL];
+    }
+  else
+    {
+      gcc_assert (argsize == 2 * LONG_LONG_TYPE_SIZE);
+      arg_type = gfc_build_uint_type (argsize);
+      func = NULL_TREE;
+    }
+
+  /* Convert the actual argument twice: first, to the unsigned type of the
+     same size; then, to the proper argument type for the built-in
+     function.  But the return type is of the default INTEGER kind.  */
+  arg = fold_convert (gfc_build_uint_type (argsize), arg);
+  arg = fold_convert (arg_type, arg);
+  arg = gfc_evaluate_now (arg, &se->pre);
+  result_type = gfc_get_int_type (gfc_default_integer_kind);
+
+  /* Compute TRAILZ for the case i .ne. 0.  */
+  if (func)
+    trailz = fold_convert (result_type, build_call_expr_loc (input_location,
+							     func, 1, arg));
+  else
+    {
+      /* We end up here if the argument type is larger than 'long long'.
+	 We generate this code:
+  
+	    if ((x & ULL_MAX) == 0)
+	      return ULL_SIZE + ctzll ((unsigned long long) (x >> ULLSIZE));
+	    else
+	      return ctzll ((unsigned long long) x);
+
+	 where ULL_MAX is the largest value that a ULL_MAX can hold
+	 (0xFFFFFFFFFFFFFFFF for a 64-bit long long type), and ULLSIZE
+	 is the bit-size of the long long type (64 in this example).  */
+      tree ullsize, ullmax, tmp1, tmp2;
+
+      ullsize = build_int_cst (result_type, LONG_LONG_TYPE_SIZE);
+      ullmax = fold_build1_loc (input_location, BIT_NOT_EXPR,
+				long_long_unsigned_type_node,
+				build_int_cst (long_long_unsigned_type_node, 0));
+
+      cond = fold_build2_loc (input_location, BIT_AND_EXPR, arg_type, arg,
+			      fold_convert (arg_type, ullmax));
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, cond,
+			      build_int_cst (arg_type, 0));
+
+      tmp1 = fold_build2_loc (input_location, RSHIFT_EXPR, arg_type,
+			      arg, ullsize);
+      tmp1 = fold_convert (long_long_unsigned_type_node, tmp1);
+      tmp1 = fold_convert (result_type,
+			   build_call_expr_loc (input_location,	
+						built_in_decls[BUILT_IN_CTZLL],
+						1, tmp1));
+      tmp1 = fold_build2_loc (input_location, PLUS_EXPR, result_type,
+			      tmp1, ullsize);
+
+      tmp2 = fold_convert (long_long_unsigned_type_node, arg);
+      tmp2 = fold_convert (result_type,
+			   build_call_expr_loc (input_location,
+						built_in_decls[BUILT_IN_CTZLL],
+						1, tmp2));
+
+      trailz = fold_build3_loc (input_location, COND_EXPR, result_type,
+				cond, tmp1, tmp2);
+    }
+
+  /* Build BIT_SIZE.  */
+  bit_size = build_int_cst (result_type, argsize);
+
+  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			  arg, build_int_cst (arg_type, 0));
+  se->expr = fold_build3_loc (input_location, COND_EXPR, result_type, cond,
+			      bit_size, trailz);
+}
+
+/* Using __builtin_popcount for POPCNT and __builtin_parity for POPPAR;
+   for types larger than "long long", we call the long long built-in for
+   the lower and higher bits and combine the result.  */
+ 
+static void
+gfc_conv_intrinsic_popcnt_poppar (gfc_se * se, gfc_expr *expr, int parity)
+{
+  tree arg;
+  tree arg_type;
+  tree result_type;
+  tree func;
+  int argsize;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  argsize = TYPE_PRECISION (TREE_TYPE (arg));
+  result_type = gfc_get_int_type (gfc_default_integer_kind);
+
+  /* Which variant of the builtin should we call?  */
+  if (argsize <= INT_TYPE_SIZE)
+    {
+      arg_type = unsigned_type_node;
+      func = built_in_decls[parity ? BUILT_IN_PARITY : BUILT_IN_POPCOUNT];
+    }
+  else if (argsize <= LONG_TYPE_SIZE)
+    {
+      arg_type = long_unsigned_type_node;
+      func = built_in_decls[parity ? BUILT_IN_PARITYL : BUILT_IN_POPCOUNTL];
+    }
+  else if (argsize <= LONG_LONG_TYPE_SIZE)
+    {
+      arg_type = long_long_unsigned_type_node;
+      func = built_in_decls[parity ? BUILT_IN_PARITYLL : BUILT_IN_POPCOUNTLL];
+    }
+  else
+    {
+      /* Our argument type is larger than 'long long', which mean none
+	 of the POPCOUNT builtins covers it.  We thus call the 'long long'
+	 variant multiple times, and add the results.  */
+      tree utype, arg2, call1, call2;
+
+      /* For now, we only cover the case where argsize is twice as large
+	 as 'long long'.  */
+      gcc_assert (argsize == 2 * LONG_LONG_TYPE_SIZE);
+
+      func = built_in_decls[parity ? BUILT_IN_PARITYLL : BUILT_IN_POPCOUNTLL];
+
+      /* Convert it to an integer, and store into a variable.  */
+      utype = gfc_build_uint_type (argsize);
+      arg = fold_convert (utype, arg);
+      arg = gfc_evaluate_now (arg, &se->pre);
+
+      /* Call the builtin twice.  */
+      call1 = build_call_expr_loc (input_location, func, 1,
+				   fold_convert (long_long_unsigned_type_node,
+						 arg));
+
+      arg2 = fold_build2_loc (input_location, RSHIFT_EXPR, utype, arg,
+			      build_int_cst (utype, LONG_LONG_TYPE_SIZE));
+      call2 = build_call_expr_loc (input_location, func, 1,
+				   fold_convert (long_long_unsigned_type_node,
+						 arg2));
+			  
+      /* Combine the results.  */
+      if (parity)
+	se->expr = fold_build2_loc (input_location, BIT_XOR_EXPR, result_type,
+				    call1, call2);
+      else
+	se->expr = fold_build2_loc (input_location, PLUS_EXPR, result_type,
+				    call1, call2);
+
+      return;
+    }
+
+  /* Convert the actual argument twice: first, to the unsigned type of the
+     same size; then, to the proper argument type for the built-in
+     function.  */
+  arg = fold_convert (gfc_build_uint_type (argsize), arg);
+  arg = fold_convert (arg_type, arg);
+
+  se->expr = fold_convert (result_type,
+			   build_call_expr_loc (input_location, func, 1, arg));
+}
+
+
+/* Process an intrinsic with unspecified argument-types that has an optional
+   argument (which could be of type character), e.g. EOSHIFT.  For those, we
+   need to append the string length of the optional argument if it is not
+   present and the type is really character.
+   primary specifies the position (starting at 1) of the non-optional argument
+   specifying the type and optional gives the position of the optional
+   argument in the arglist.  */
+
+static void
+conv_generic_with_optional_char_arg (gfc_se* se, gfc_expr* expr,
+				     unsigned primary, unsigned optional)
+{
+  gfc_actual_arglist* prim_arg;
+  gfc_actual_arglist* opt_arg;
+  unsigned cur_pos;
+  gfc_actual_arglist* arg;
+  gfc_symbol* sym;
+  VEC(tree,gc) *append_args;
+
+  /* Find the two arguments given as position.  */
+  cur_pos = 0;
+  prim_arg = NULL;
+  opt_arg = NULL;
+  for (arg = expr->value.function.actual; arg; arg = arg->next)
+    {
+      ++cur_pos;
+
+      if (cur_pos == primary)
+	prim_arg = arg;
+      if (cur_pos == optional)
+	opt_arg = arg;
+
+      if (cur_pos >= primary && cur_pos >= optional)
+	break;
+    }
+  gcc_assert (prim_arg);
+  gcc_assert (prim_arg->expr);
+  gcc_assert (opt_arg);
+
+  /* If we do have type CHARACTER and the optional argument is really absent,
+     append a dummy 0 as string length.  */
+  append_args = NULL;
+  if (prim_arg->expr->ts.type == BT_CHARACTER && !opt_arg->expr)
+    {
+      tree dummy;
+
+      dummy = build_int_cst (gfc_charlen_type_node, 0);
+      append_args = VEC_alloc (tree, gc, 1);
+      VEC_quick_push (tree, append_args, dummy);
+    }
+
+  /* Build the call itself.  */
+  sym = gfc_get_symbol_for_expr (expr);
+  gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr,
+			  append_args);
+  gfc_free (sym);
+}
+
+
+/* The length of a character string.  */
+static void
+gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr)
+{
+  tree len;
+  tree type;
+  tree decl;
+  gfc_symbol *sym;
+  gfc_se argse;
+  gfc_expr *arg;
+  gfc_ss *ss;
+
+  gcc_assert (!se->ss);
+
+  arg = expr->value.function.actual->expr;
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  switch (arg->expr_type)
+    {
+    case EXPR_CONSTANT:
+      len = build_int_cst (NULL_TREE, arg->value.character.length);
+      break;
+
+    case EXPR_ARRAY:
+      /* Obtain the string length from the function used by
+         trans-array.c(gfc_trans_array_constructor).  */
+      len = NULL_TREE;
+      get_array_ctor_strlen (&se->pre, arg->value.constructor, &len);
+      break;
+
+    case EXPR_VARIABLE:
+      if (arg->ref == NULL
+	    || (arg->ref->next == NULL && arg->ref->type == REF_ARRAY))
+	{
+	  /* This doesn't catch all cases.
+	     See http://gcc.gnu.org/ml/fortran/2004-06/msg00165.html
+	     and the surrounding thread.  */
+	  sym = arg->symtree->n.sym;
+	  decl = gfc_get_symbol_decl (sym);
+	  if (decl == current_function_decl && sym->attr.function
+		&& (sym->result == sym))
+	    decl = gfc_get_fake_result_decl (sym, 0);
+
+	  len = sym->ts.u.cl->backend_decl;
+	  gcc_assert (len);
+	  break;
+	}
+
+      /* Otherwise fall through.  */
+
+    default:
+      /* Anybody stupid enough to do this deserves inefficient code.  */
+      ss = gfc_walk_expr (arg);
+      gfc_init_se (&argse, se);
+      if (ss == gfc_ss_terminator)
+	gfc_conv_expr (&argse, arg);
+      else
+	gfc_conv_expr_descriptor (&argse, arg, ss);
+      gfc_add_block_to_block (&se->pre, &argse.pre);
+      gfc_add_block_to_block (&se->post, &argse.post);
+      len = argse.string_length;
+      break;
+    }
+  se->expr = convert (type, len);
+}
+
+/* The length of a character string not including trailing blanks.  */
+static void
+gfc_conv_intrinsic_len_trim (gfc_se * se, gfc_expr * expr)
+{
+  int kind = expr->value.function.actual->expr->ts.kind;
+  tree args[2], type, fndecl;
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+  type = gfc_typenode_for_spec (&expr->ts);
+
+  if (kind == 1)
+    fndecl = gfor_fndecl_string_len_trim;
+  else if (kind == 4)
+    fndecl = gfor_fndecl_string_len_trim_char4;
+  else
+    gcc_unreachable ();
+
+  se->expr = build_call_expr_loc (input_location,
+			      fndecl, 2, args[0], args[1]);
+  se->expr = convert (type, se->expr);
+}
+
+
+/* Returns the starting position of a substring within a string.  */
+
+static void
+gfc_conv_intrinsic_index_scan_verify (gfc_se * se, gfc_expr * expr,
+				      tree function)
+{
+  tree logical4_type_node = gfc_get_logical_type (4);
+  tree type;
+  tree fndecl;
+  tree *args;
+  unsigned int num_args;
+
+  args = XALLOCAVEC (tree, 5);
+
+  /* Get number of arguments; characters count double due to the
+     string length argument. Kind= is not passed to the library
+     and thus ignored.  */
+  if (expr->value.function.actual->next->next->expr == NULL)
+    num_args = 4;
+  else
+    num_args = 5;
+
+  gfc_conv_intrinsic_function_args (se, expr, args, num_args);
+  type = gfc_typenode_for_spec (&expr->ts);
+
+  if (num_args == 4)
+    args[4] = build_int_cst (logical4_type_node, 0);
+  else
+    args[4] = convert (logical4_type_node, args[4]);
+
+  fndecl = build_addr (function, current_function_decl);
+  se->expr = build_call_array_loc (input_location,
+			       TREE_TYPE (TREE_TYPE (function)), fndecl,
+			       5, args);
+  se->expr = convert (type, se->expr);
+
+}
+
+/* The ascii value for a single character.  */
+static void
+gfc_conv_intrinsic_ichar (gfc_se * se, gfc_expr * expr)
+{
+  tree args[2], type, pchartype;
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+  gcc_assert (POINTER_TYPE_P (TREE_TYPE (args[1])));
+  pchartype = gfc_get_pchar_type (expr->value.function.actual->expr->ts.kind);
+  args[1] = fold_build1_loc (input_location, NOP_EXPR, pchartype, args[1]);
+  type = gfc_typenode_for_spec (&expr->ts);
+
+  se->expr = build_fold_indirect_ref_loc (input_location,
+				      args[1]);
+  se->expr = convert (type, se->expr);
+}
+
+
+/* Intrinsic ISNAN calls __builtin_isnan.  */
+
+static void
+gfc_conv_intrinsic_isnan (gfc_se * se, gfc_expr * expr)
+{
+  tree arg;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  se->expr = build_call_expr_loc (input_location,
+			      built_in_decls[BUILT_IN_ISNAN], 1, arg);
+  STRIP_TYPE_NOPS (se->expr);
+  se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), se->expr);
+}
+
+
+/* Intrinsics IS_IOSTAT_END and IS_IOSTAT_EOR just need to compare
+   their argument against a constant integer value.  */
+
+static void
+gfc_conv_has_intvalue (gfc_se * se, gfc_expr * expr, const int value)
+{
+  tree arg;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  se->expr = fold_build2_loc (input_location, EQ_EXPR,
+			      gfc_typenode_for_spec (&expr->ts),
+			      arg, build_int_cst (TREE_TYPE (arg), value));
+}
+
+
+
+/* MERGE (tsource, fsource, mask) = mask ? tsource : fsource.  */
+
+static void
+gfc_conv_intrinsic_merge (gfc_se * se, gfc_expr * expr)
+{
+  tree tsource;
+  tree fsource;
+  tree mask;
+  tree type;
+  tree len, len2;
+  tree *args;
+  unsigned int num_args;
+
+  num_args = gfc_intrinsic_argument_list_length (expr);
+  args = XALLOCAVEC (tree, num_args);
+
+  gfc_conv_intrinsic_function_args (se, expr, args, num_args);
+  if (expr->ts.type != BT_CHARACTER)
+    {
+      tsource = args[0];
+      fsource = args[1];
+      mask = args[2];
+    }
+  else
+    {
+      /* We do the same as in the non-character case, but the argument
+	 list is different because of the string length arguments. We
+	 also have to set the string length for the result.  */
+      len = args[0];
+      tsource = args[1];
+      len2 = args[2];
+      fsource = args[3];
+      mask = args[4];
+
+      gfc_trans_same_strlen_check ("MERGE intrinsic", &expr->where, len, len2,
+				   &se->pre);
+      se->string_length = len;
+    }
+  type = TREE_TYPE (tsource);
+  se->expr = fold_build3_loc (input_location, COND_EXPR, type, mask, tsource,
+			      fold_convert (type, fsource));
+}
+
+
+/* MERGE_BITS (I, J, MASK) = (I & MASK) | (I & (~MASK)).  */
+
+static void
+gfc_conv_intrinsic_merge_bits (gfc_se * se, gfc_expr * expr)
+{
+  tree args[3], mask, type;
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 3);
+  mask = gfc_evaluate_now (args[2], &se->pre);
+
+  type = TREE_TYPE (args[0]);
+  gcc_assert (TREE_TYPE (args[1]) == type);
+  gcc_assert (TREE_TYPE (mask) == type);
+
+  args[0] = fold_build2_loc (input_location, BIT_AND_EXPR, type, args[0], mask);
+  args[1] = fold_build2_loc (input_location, BIT_AND_EXPR, type, args[1],
+			     fold_build1_loc (input_location, BIT_NOT_EXPR,
+					      type, mask));
+  se->expr = fold_build2_loc (input_location, BIT_IOR_EXPR, type,
+			      args[0], args[1]);
+}
+
+
+/* MASKL(n)  =  n == 0 ? 0 : (~0) << (BIT_SIZE - n)
+   MASKR(n)  =  n == BIT_SIZE ? ~0 : ~((~0) << n)  */
+
+static void
+gfc_conv_intrinsic_mask (gfc_se * se, gfc_expr * expr, int left)
+{
+  tree arg, allones, type, utype, res, cond, bitsize;
+  int i;
+ 
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  arg = gfc_evaluate_now (arg, &se->pre);
+
+  type = gfc_get_int_type (expr->ts.kind);
+  utype = unsigned_type_for (type);
+
+  i = gfc_validate_kind (BT_INTEGER, expr->ts.kind, false);
+  bitsize = build_int_cst (TREE_TYPE (arg), gfc_integer_kinds[i].bit_size);
+
+  allones = fold_build1_loc (input_location, BIT_NOT_EXPR, utype,
+			     build_int_cst (utype, 0));
+
+  if (left)
+    {
+      /* Left-justified mask.  */
+      res = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (arg),
+			     bitsize, arg);
+      res = fold_build2_loc (input_location, LSHIFT_EXPR, utype, allones,
+			     fold_convert (utype, res));
+
+      /* Special case arg == 0, because SHIFT_EXPR wants a shift strictly
+	 smaller than type width.  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, arg,
+			      build_int_cst (TREE_TYPE (arg), 0));
+      res = fold_build3_loc (input_location, COND_EXPR, utype, cond,
+			     build_int_cst (utype, 0), res);
+    }
+  else
+    {
+      /* Right-justified mask.  */
+      res = fold_build2_loc (input_location, LSHIFT_EXPR, utype, allones,
+			     fold_convert (utype, arg));
+      res = fold_build1_loc (input_location, BIT_NOT_EXPR, utype, res);
+
+      /* Special case agr == bit_size, because SHIFT_EXPR wants a shift
+	 strictly smaller than type width.  */
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			      arg, bitsize);
+      res = fold_build3_loc (input_location, COND_EXPR, utype,
+			     cond, allones, res);
+    }
+
+  se->expr = fold_convert (type, res);
+}
+
+
+/* FRACTION (s) is translated into frexp (s, &dummy_int).  */
+static void
+gfc_conv_intrinsic_fraction (gfc_se * se, gfc_expr * expr)
+{
+  tree arg, type, tmp, frexp;
+
+  frexp = gfc_builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  tmp = gfc_create_var (integer_type_node, NULL);
+  se->expr = build_call_expr_loc (input_location, frexp, 2,
+				  fold_convert (type, arg),
+				  gfc_build_addr_expr (NULL_TREE, tmp));
+  se->expr = fold_convert (type, se->expr);
+}
+
+
+/* NEAREST (s, dir) is translated into
+     tmp = copysign (HUGE_VAL, dir);
+     return nextafter (s, tmp);
+ */
+static void
+gfc_conv_intrinsic_nearest (gfc_se * se, gfc_expr * expr)
+{
+  tree args[2], type, tmp, nextafter, copysign, huge_val;
+
+  nextafter = gfc_builtin_decl_for_float_kind (BUILT_IN_NEXTAFTER, expr->ts.kind);
+  copysign = gfc_builtin_decl_for_float_kind (BUILT_IN_COPYSIGN, expr->ts.kind);
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+
+  huge_val = gfc_build_inf_or_huge (type, expr->ts.kind);
+  tmp = build_call_expr_loc (input_location, copysign, 2, huge_val,
+			     fold_convert (type, args[1]));
+  se->expr = build_call_expr_loc (input_location, nextafter, 2,
+				  fold_convert (type, args[0]), tmp);
+  se->expr = fold_convert (type, se->expr);
+}
+
+
+/* SPACING (s) is translated into
+    int e;
+    if (s == 0)
+      res = tiny;
+    else
+    {
+      frexp (s, &e);
+      e = e - prec;
+      e = MAX_EXPR (e, emin);
+      res = scalbn (1., e);
+    }
+    return res;
+
+ where prec is the precision of s, gfc_real_kinds[k].digits,
+       emin is min_exponent - 1, gfc_real_kinds[k].min_exponent - 1,
+   and tiny is tiny(s), gfc_real_kinds[k].tiny.  */
+
+static void
+gfc_conv_intrinsic_spacing (gfc_se * se, gfc_expr * expr)
+{
+  tree arg, type, prec, emin, tiny, res, e;
+  tree cond, tmp, frexp, scalbn;
+  int k;
+  stmtblock_t block;
+
+  k = gfc_validate_kind (BT_REAL, expr->ts.kind, false);
+  prec = build_int_cst (NULL_TREE, gfc_real_kinds[k].digits);
+  emin = build_int_cst (NULL_TREE, gfc_real_kinds[k].min_exponent - 1);
+  tiny = gfc_conv_mpfr_to_tree (gfc_real_kinds[k].tiny, expr->ts.kind, 0);
+
+  frexp = gfc_builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
+  scalbn = gfc_builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  arg = gfc_evaluate_now (arg, &se->pre);
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  e = gfc_create_var (integer_type_node, NULL);
+  res = gfc_create_var (type, NULL);
+
+
+  /* Build the block for s /= 0.  */
+  gfc_start_block (&block);
+  tmp = build_call_expr_loc (input_location, frexp, 2, arg,
+			     gfc_build_addr_expr (NULL_TREE, e));
+  gfc_add_expr_to_block (&block, tmp);
+
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, integer_type_node, e,
+			 prec);
+  gfc_add_modify (&block, e, fold_build2_loc (input_location, MAX_EXPR,
+					      integer_type_node, tmp, emin));
+
+  tmp = build_call_expr_loc (input_location, scalbn, 2,
+			 build_real_from_int_cst (type, integer_one_node), e);
+  gfc_add_modify (&block, res, tmp);
+
+  /* Finish by building the IF statement.  */
+  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, arg,
+			  build_real_from_int_cst (type, integer_zero_node));
+  tmp = build3_v (COND_EXPR, cond, build2_v (MODIFY_EXPR, res, tiny),
+		  gfc_finish_block (&block));
+
+  gfc_add_expr_to_block (&se->pre, tmp);
+  se->expr = res;
+}
+
+
+/* RRSPACING (s) is translated into
+      int e;
+      real x;
+      x = fabs (s);
+      if (x != 0)
+      {
+	frexp (s, &e);
+	x = scalbn (x, precision - e);
+      }
+      return x;
+
+ where precision is gfc_real_kinds[k].digits.  */
+
+static void
+gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
+{
+  tree arg, type, e, x, cond, stmt, tmp, frexp, scalbn, fabs;
+  int prec, k;
+  stmtblock_t block;
+
+  k = gfc_validate_kind (BT_REAL, expr->ts.kind, false);
+  prec = gfc_real_kinds[k].digits;
+
+  frexp = gfc_builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
+  scalbn = gfc_builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
+  fabs = gfc_builtin_decl_for_float_kind (BUILT_IN_FABS, expr->ts.kind);
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+  arg = gfc_evaluate_now (arg, &se->pre);
+
+  e = gfc_create_var (integer_type_node, NULL);
+  x = gfc_create_var (type, NULL);
+  gfc_add_modify (&se->pre, x,
+		  build_call_expr_loc (input_location, fabs, 1, arg));
+
+
+  gfc_start_block (&block);
+  tmp = build_call_expr_loc (input_location, frexp, 2, arg,
+			     gfc_build_addr_expr (NULL_TREE, e));
+  gfc_add_expr_to_block (&block, tmp);
+
+  tmp = fold_build2_loc (input_location, MINUS_EXPR, integer_type_node,
+			 build_int_cst (NULL_TREE, prec), e);
+  tmp = build_call_expr_loc (input_location, scalbn, 2, x, tmp);
+  gfc_add_modify (&block, x, tmp);
+  stmt = gfc_finish_block (&block);
+
+  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, x,
+			  build_real_from_int_cst (type, integer_zero_node));
+  tmp = build3_v (COND_EXPR, cond, stmt, build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  se->expr = fold_convert (type, x);
+}
+
+
+/* SCALE (s, i) is translated into scalbn (s, i).  */
+static void
+gfc_conv_intrinsic_scale (gfc_se * se, gfc_expr * expr)
+{
+  tree args[2], type, scalbn;
+
+  scalbn = gfc_builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+  se->expr = build_call_expr_loc (input_location, scalbn, 2,
+				  fold_convert (type, args[0]),
+				  fold_convert (integer_type_node, args[1]));
+  se->expr = fold_convert (type, se->expr);
+}
+
+
+/* SET_EXPONENT (s, i) is translated into
+   scalbn (frexp (s, &dummy_int), i).  */
+static void
+gfc_conv_intrinsic_set_exponent (gfc_se * se, gfc_expr * expr)
+{
+  tree args[2], type, tmp, frexp, scalbn;
+
+  frexp = gfc_builtin_decl_for_float_kind (BUILT_IN_FREXP, expr->ts.kind);
+  scalbn = gfc_builtin_decl_for_float_kind (BUILT_IN_SCALBN, expr->ts.kind);
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+
+  tmp = gfc_create_var (integer_type_node, NULL);
+  tmp = build_call_expr_loc (input_location, frexp, 2,
+			     fold_convert (type, args[0]),
+			     gfc_build_addr_expr (NULL_TREE, tmp));
+  se->expr = build_call_expr_loc (input_location, scalbn, 2, tmp,
+				  fold_convert (integer_type_node, args[1]));
+  se->expr = fold_convert (type, se->expr);
+}
+
+
+static void
+gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
+{
+  gfc_actual_arglist *actual;
+  tree arg1;
+  tree type;
+  tree fncall0;
+  tree fncall1;
+  gfc_se argse;
+  gfc_ss *ss;
+
+  gfc_init_se (&argse, NULL);
+  actual = expr->value.function.actual;
+
+  ss = gfc_walk_expr (actual->expr);
+  gcc_assert (ss != gfc_ss_terminator);
+  argse.want_pointer = 1;
+  argse.data_not_needed = 1;
+  gfc_conv_expr_descriptor (&argse, actual->expr, ss);
+  gfc_add_block_to_block (&se->pre, &argse.pre);
+  gfc_add_block_to_block (&se->post, &argse.post);
+  arg1 = gfc_evaluate_now (argse.expr, &se->pre);
+
+  /* Build the call to size0.  */
+  fncall0 = build_call_expr_loc (input_location,
+			     gfor_fndecl_size0, 1, arg1);
+
+  actual = actual->next;
+
+  if (actual->expr)
+    {
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_type (&argse, actual->expr,
+			  gfc_array_index_type);
+      gfc_add_block_to_block (&se->pre, &argse.pre);
+
+      /* Unusually, for an intrinsic, size does not exclude
+	 an optional arg2, so we must test for it.  */  
+      if (actual->expr->expr_type == EXPR_VARIABLE
+	    && actual->expr->symtree->n.sym->attr.dummy
+	    && actual->expr->symtree->n.sym->attr.optional)
+	{
+	  tree tmp;
+	  /* Build the call to size1.  */
+	  fncall1 = build_call_expr_loc (input_location,
+				     gfor_fndecl_size1, 2,
+				     arg1, argse.expr);
+
+	  gfc_init_se (&argse, NULL);
+	  argse.want_pointer = 1;
+	  argse.data_not_needed = 1;
+	  gfc_conv_expr (&argse, actual->expr);
+	  gfc_add_block_to_block (&se->pre, &argse.pre);
+	  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				 argse.expr, null_pointer_node);
+	  tmp = gfc_evaluate_now (tmp, &se->pre);
+	  se->expr = fold_build3_loc (input_location, COND_EXPR,
+				      pvoid_type_node, tmp, fncall1, fncall0);
+	}
+      else
+	{
+	  se->expr = NULL_TREE;
+	  argse.expr = fold_build2_loc (input_location, MINUS_EXPR,
+					gfc_array_index_type,
+					argse.expr, gfc_index_one_node);
+	}
+    }
+  else if (expr->value.function.actual->expr->rank == 1)
+    {
+      argse.expr = gfc_index_zero_node;
+      se->expr = NULL_TREE;
+    }
+  else
+    se->expr = fncall0;
+
+  if (se->expr == NULL_TREE)
+    {
+      tree ubound, lbound;
+
+      arg1 = build_fold_indirect_ref_loc (input_location,
+				      arg1);
+      ubound = gfc_conv_descriptor_ubound_get (arg1, argse.expr);
+      lbound = gfc_conv_descriptor_lbound_get (arg1, argse.expr);
+      se->expr = fold_build2_loc (input_location, MINUS_EXPR,
+				  gfc_array_index_type, ubound, lbound);
+      se->expr = fold_build2_loc (input_location, PLUS_EXPR,
+				  gfc_array_index_type,
+				  se->expr, gfc_index_one_node);
+      se->expr = fold_build2_loc (input_location, MAX_EXPR,
+				  gfc_array_index_type, se->expr,
+				  gfc_index_zero_node);
+    }
+
+  type = gfc_typenode_for_spec (&expr->ts);
+  se->expr = convert (type, se->expr);
+}
+
+
+/* Helper function to compute the size of a character variable,
+   excluding the terminating null characters.  The result has
+   gfc_array_index_type type.  */
+
+static tree
+size_of_string_in_bytes (int kind, tree string_length)
+{
+  tree bytesize;
+  int i = gfc_validate_kind (BT_CHARACTER, kind, false);
+ 
+  bytesize = build_int_cst (gfc_array_index_type,
+			    gfc_character_kinds[i].bit_size / 8);
+
+  return fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			  bytesize,
+			  fold_convert (gfc_array_index_type, string_length));
+}
+
+
+static void
+gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
+{
+  gfc_expr *arg;
+  gfc_ss *ss;
+  gfc_se argse;
+  tree source_bytes;
+  tree type;
+  tree tmp;
+  tree lower;
+  tree upper;
+  int n;
+
+  arg = expr->value.function.actual->expr;
+
+  gfc_init_se (&argse, NULL);
+  ss = gfc_walk_expr (arg);
+
+  if (ss == gfc_ss_terminator)
+    {
+      if (arg->ts.type == BT_CLASS)
+	gfc_add_data_component (arg);
+
+      gfc_conv_expr_reference (&argse, arg);
+
+      type = TREE_TYPE (build_fold_indirect_ref_loc (input_location,
+						 argse.expr));
+
+      /* Obtain the source word length.  */
+      if (arg->ts.type == BT_CHARACTER)
+	se->expr = size_of_string_in_bytes (arg->ts.kind,
+					    argse.string_length);
+      else
+	se->expr = fold_convert (gfc_array_index_type, size_in_bytes (type)); 
+    }
+  else
+    {
+      source_bytes = gfc_create_var (gfc_array_index_type, "bytes");
+      argse.want_pointer = 0;
+      gfc_conv_expr_descriptor (&argse, arg, ss);
+      type = gfc_get_element_type (TREE_TYPE (argse.expr));
+
+      /* Obtain the argument's word length.  */
+      if (arg->ts.type == BT_CHARACTER)
+	tmp = size_of_string_in_bytes (arg->ts.kind, argse.string_length);
+      else
+	tmp = fold_convert (gfc_array_index_type,
+			    size_in_bytes (type)); 
+      gfc_add_modify (&argse.pre, source_bytes, tmp);
+
+      /* Obtain the size of the array in bytes.  */
+      for (n = 0; n < arg->rank; n++)
+	{
+	  tree idx;
+	  idx = gfc_rank_cst[n];
+	  lower = gfc_conv_descriptor_lbound_get (argse.expr, idx);
+	  upper = gfc_conv_descriptor_ubound_get (argse.expr, idx);
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type, upper, lower);
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, tmp, gfc_index_one_node);
+	  tmp = fold_build2_loc (input_location, MULT_EXPR,
+				 gfc_array_index_type, tmp, source_bytes);
+	  gfc_add_modify (&argse.pre, source_bytes, tmp);
+	}
+      se->expr = source_bytes;
+    }
+
+  gfc_add_block_to_block (&se->pre, &argse.pre);
+}
+
+
+static void
+gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr)
+{
+  gfc_expr *arg;
+  gfc_ss *ss;
+  gfc_se argse,eight;
+  tree type, result_type, tmp;
+
+  arg = expr->value.function.actual->expr;
+  gfc_init_se (&eight, NULL);
+  gfc_conv_expr (&eight, gfc_get_int_expr (expr->ts.kind, NULL, 8));
+  
+  gfc_init_se (&argse, NULL);
+  ss = gfc_walk_expr (arg);
+  result_type = gfc_get_int_type (expr->ts.kind);
+
+  if (ss == gfc_ss_terminator)
+    {
+      if (arg->ts.type == BT_CLASS)
+      {
+	gfc_add_vptr_component (arg);
+	gfc_add_size_component (arg);
+	gfc_conv_expr (&argse, arg);
+	tmp = fold_convert (result_type, argse.expr);
+	goto done;
+      }
+
+      gfc_conv_expr_reference (&argse, arg);
+      type = TREE_TYPE (build_fold_indirect_ref_loc (input_location, 
+						     argse.expr));
+    }
+  else
+    {
+      argse.want_pointer = 0;
+      gfc_conv_expr_descriptor (&argse, arg, ss);
+      type = gfc_get_element_type (TREE_TYPE (argse.expr));
+    }
+    
+  /* Obtain the argument's word length.  */
+  if (arg->ts.type == BT_CHARACTER)
+    tmp = size_of_string_in_bytes (arg->ts.kind, argse.string_length);
+  else
+    tmp = fold_convert (result_type, size_in_bytes (type)); 
+
+done:
+  se->expr = fold_build2_loc (input_location, MULT_EXPR, result_type, tmp,
+			      eight.expr);
+  gfc_add_block_to_block (&se->pre, &argse.pre);
+}
+
+
+/* Intrinsic string comparison functions.  */
+
+static void
+gfc_conv_intrinsic_strcmp (gfc_se * se, gfc_expr * expr, enum tree_code op)
+{
+  tree args[4];
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 4);
+
+  se->expr
+    = gfc_build_compare_string (args[0], args[1], args[2], args[3],
+				expr->value.function.actual->expr->ts.kind,
+				op);
+  se->expr = fold_build2_loc (input_location, op,
+			      gfc_typenode_for_spec (&expr->ts), se->expr,
+			      build_int_cst (TREE_TYPE (se->expr), 0));
+}
+
+/* Generate a call to the adjustl/adjustr library function.  */
+static void
+gfc_conv_intrinsic_adjust (gfc_se * se, gfc_expr * expr, tree fndecl)
+{
+  tree args[3];
+  tree len;
+  tree type;
+  tree var;
+  tree tmp;
+
+  gfc_conv_intrinsic_function_args (se, expr, &args[1], 2);
+  len = args[1];
+
+  type = TREE_TYPE (args[2]);
+  var = gfc_conv_string_tmp (se, type, len);
+  args[0] = var;
+
+  tmp = build_call_expr_loc (input_location,
+			 fndecl, 3, args[0], args[1], args[2]);
+  gfc_add_expr_to_block (&se->pre, tmp);
+  se->expr = var;
+  se->string_length = len;
+}
+
+
+/* Generate code for the TRANSFER intrinsic:
+	For scalar results:
+	  DEST = TRANSFER (SOURCE, MOLD)
+	where:
+	  typeof<DEST> = typeof<MOLD>
+	and:
+	  MOLD is scalar.
+
+	For array results:
+	  DEST(1:N) = TRANSFER (SOURCE, MOLD[, SIZE])
+	where:
+	  typeof<DEST> = typeof<MOLD>
+	and:
+	  N = min (sizeof (SOURCE(:)), sizeof (DEST(:)),
+	      sizeof (DEST(0) * SIZE).  */
+static void
+gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
+{
+  tree tmp;
+  tree tmpdecl;
+  tree ptr;
+  tree extent;
+  tree source;
+  tree source_type;
+  tree source_bytes;
+  tree mold_type;
+  tree dest_word_len;
+  tree size_words;
+  tree size_bytes;
+  tree upper;
+  tree lower;
+  tree stmt;
+  gfc_actual_arglist *arg;
+  gfc_se argse;
+  gfc_ss *ss;
+  gfc_ss_info *info;
+  stmtblock_t block;
+  int n;
+  bool scalar_mold;
+
+  info = NULL;
+  if (se->loop)
+    info = &se->ss->data.info;
+
+  /* Convert SOURCE.  The output from this stage is:-
+	source_bytes = length of the source in bytes
+	source = pointer to the source data.  */
+  arg = expr->value.function.actual;
+
+  /* Ensure double transfer through LOGICAL preserves all
+     the needed bits.  */
+  if (arg->expr->expr_type == EXPR_FUNCTION
+	&& arg->expr->value.function.esym == NULL
+	&& arg->expr->value.function.isym != NULL
+	&& arg->expr->value.function.isym->id == GFC_ISYM_TRANSFER
+	&& arg->expr->ts.type == BT_LOGICAL
+	&& expr->ts.type != arg->expr->ts.type)
+    arg->expr->value.function.name = "__transfer_in_transfer";
+
+  gfc_init_se (&argse, NULL);
+  ss = gfc_walk_expr (arg->expr);
+
+  source_bytes = gfc_create_var (gfc_array_index_type, NULL);
+
+  /* Obtain the pointer to source and the length of source in bytes.  */
+  if (ss == gfc_ss_terminator)
+    {
+      gfc_conv_expr_reference (&argse, arg->expr);
+      source = argse.expr;
+
+      source_type = TREE_TYPE (build_fold_indirect_ref_loc (input_location,
+							argse.expr));
+
+      /* Obtain the source word length.  */
+      if (arg->expr->ts.type == BT_CHARACTER)
+	tmp = size_of_string_in_bytes (arg->expr->ts.kind,
+				       argse.string_length);
+      else
+	tmp = fold_convert (gfc_array_index_type,
+			    size_in_bytes (source_type)); 
+    }
+  else
+    {
+      argse.want_pointer = 0;
+      gfc_conv_expr_descriptor (&argse, arg->expr, ss);
+      source = gfc_conv_descriptor_data_get (argse.expr);
+      source_type = gfc_get_element_type (TREE_TYPE (argse.expr));
+
+      /* Repack the source if not simply contiguous.  */
+      if (!gfc_is_simply_contiguous (arg->expr, false))
+	{
+	  tmp = gfc_build_addr_expr (NULL_TREE, argse.expr);
+
+	  if (gfc_option.warn_array_temp)
+	    gfc_warning ("Creating array temporary at %L", &expr->where);
+
+	  source = build_call_expr_loc (input_location,
+				    gfor_fndecl_in_pack, 1, tmp);
+	  source = gfc_evaluate_now (source, &argse.pre);
+
+	  /* Free the temporary.  */
+	  gfc_start_block (&block);
+	  tmp = gfc_call_free (convert (pvoid_type_node, source));
+	  gfc_add_expr_to_block (&block, tmp);
+	  stmt = gfc_finish_block (&block);
+
+	  /* Clean up if it was repacked.  */
+	  gfc_init_block (&block);
+	  tmp = gfc_conv_array_data (argse.expr);
+	  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				 source, tmp);
+	  tmp = build3_v (COND_EXPR, tmp, stmt,
+			  build_empty_stmt (input_location));
+	  gfc_add_expr_to_block (&block, tmp);
+	  gfc_add_block_to_block (&block, &se->post);
+	  gfc_init_block (&se->post);
+	  gfc_add_block_to_block (&se->post, &block);
+	}
+
+      /* Obtain the source word length.  */
+      if (arg->expr->ts.type == BT_CHARACTER)
+	tmp = size_of_string_in_bytes (arg->expr->ts.kind,
+				       argse.string_length);
+      else
+	tmp = fold_convert (gfc_array_index_type,
+			    size_in_bytes (source_type)); 
+
+      /* Obtain the size of the array in bytes.  */
+      extent = gfc_create_var (gfc_array_index_type, NULL);
+      for (n = 0; n < arg->expr->rank; n++)
+	{
+	  tree idx;
+	  idx = gfc_rank_cst[n];
+	  gfc_add_modify (&argse.pre, source_bytes, tmp);
+	  lower = gfc_conv_descriptor_lbound_get (argse.expr, idx);
+	  upper = gfc_conv_descriptor_ubound_get (argse.expr, idx);
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type, upper, lower);
+	  gfc_add_modify (&argse.pre, extent, tmp);
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, extent,
+				 gfc_index_one_node);
+	  tmp = fold_build2_loc (input_location, MULT_EXPR,
+				 gfc_array_index_type, tmp, source_bytes);
+	}
+    }
+
+  gfc_add_modify (&argse.pre, source_bytes, tmp);
+  gfc_add_block_to_block (&se->pre, &argse.pre);
+  gfc_add_block_to_block (&se->post, &argse.post);
+
+  /* Now convert MOLD.  The outputs are:
+	mold_type = the TREE type of MOLD
+	dest_word_len = destination word length in bytes.  */
+  arg = arg->next;
+
+  gfc_init_se (&argse, NULL);
+  ss = gfc_walk_expr (arg->expr);
+
+  scalar_mold = arg->expr->rank == 0;
+
+  if (ss == gfc_ss_terminator)
+    {
+      gfc_conv_expr_reference (&argse, arg->expr);
+      mold_type = TREE_TYPE (build_fold_indirect_ref_loc (input_location,
+						      argse.expr));
+    }
+  else
+    {
+      gfc_init_se (&argse, NULL);
+      argse.want_pointer = 0;
+      gfc_conv_expr_descriptor (&argse, arg->expr, ss);
+      mold_type = gfc_get_element_type (TREE_TYPE (argse.expr));
+    }
+
+  gfc_add_block_to_block (&se->pre, &argse.pre);
+  gfc_add_block_to_block (&se->post, &argse.post);
+
+  if (strcmp (expr->value.function.name, "__transfer_in_transfer") == 0)
+    {
+      /* If this TRANSFER is nested in another TRANSFER, use a type
+	 that preserves all bits.  */
+      if (arg->expr->ts.type == BT_LOGICAL)
+	mold_type = gfc_get_int_type (arg->expr->ts.kind);
+    }
+
+  if (arg->expr->ts.type == BT_CHARACTER)
+    {
+      tmp = size_of_string_in_bytes (arg->expr->ts.kind, argse.string_length);
+      mold_type = gfc_get_character_type_len (arg->expr->ts.kind, tmp);
+    }
+  else
+    tmp = fold_convert (gfc_array_index_type,
+			size_in_bytes (mold_type)); 
+ 
+  dest_word_len = gfc_create_var (gfc_array_index_type, NULL);
+  gfc_add_modify (&se->pre, dest_word_len, tmp);
+
+  /* Finally convert SIZE, if it is present.  */
+  arg = arg->next;
+  size_words = gfc_create_var (gfc_array_index_type, NULL);
+
+  if (arg->expr)
+    {
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_reference (&argse, arg->expr);
+      tmp = convert (gfc_array_index_type,
+		     build_fold_indirect_ref_loc (input_location,
+					      argse.expr));
+      gfc_add_block_to_block (&se->pre, &argse.pre);
+      gfc_add_block_to_block (&se->post, &argse.post);
+    }
+  else
+    tmp = NULL_TREE;
+
+  /* Separate array and scalar results.  */
+  if (scalar_mold && tmp == NULL_TREE)
+    goto scalar_transfer;
+
+  size_bytes = gfc_create_var (gfc_array_index_type, NULL);
+  if (tmp != NULL_TREE)
+    tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			   tmp, dest_word_len);
+  else
+    tmp = source_bytes;
+
+  gfc_add_modify (&se->pre, size_bytes, tmp);
+  gfc_add_modify (&se->pre, size_words,
+		       fold_build2_loc (input_location, CEIL_DIV_EXPR,
+					gfc_array_index_type,
+					size_bytes, dest_word_len));
+
+  /* Evaluate the bounds of the result.  If the loop range exists, we have
+     to check if it is too large.  If so, we modify loop->to be consistent
+     with min(size, size(source)).  Otherwise, size is made consistent with
+     the loop range, so that the right number of bytes is transferred.*/
+  n = se->loop->order[0];
+  if (se->loop->to[n] != NULL_TREE)
+    {
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     se->loop->to[n], se->loop->from[n]);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     tmp, gfc_index_one_node);
+      tmp = fold_build2_loc (input_location, MIN_EXPR, gfc_array_index_type,
+			 tmp, size_words);
+      gfc_add_modify (&se->pre, size_words, tmp);
+      gfc_add_modify (&se->pre, size_bytes,
+			   fold_build2_loc (input_location, MULT_EXPR,
+					    gfc_array_index_type,
+					    size_words, dest_word_len));
+      upper = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			       size_words, se->loop->from[n]);
+      upper = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			       upper, gfc_index_one_node);
+    }
+  else
+    {
+      upper = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			       size_words, gfc_index_one_node);
+      se->loop->from[n] = gfc_index_zero_node;
+    }
+
+  se->loop->to[n] = upper;
+
+  /* Build a destination descriptor, using the pointer, source, as the
+     data field.  */
+  gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
+			       info, mold_type, NULL_TREE, false, true, false,
+			       &expr->where);
+
+  /* Cast the pointer to the result.  */
+  tmp = gfc_conv_descriptor_data_get (info->descriptor);
+  tmp = fold_convert (pvoid_type_node, tmp);
+
+  /* Use memcpy to do the transfer.  */
+  tmp = build_call_expr_loc (input_location,
+			 built_in_decls[BUILT_IN_MEMCPY],
+			 3,
+			 tmp,
+			 fold_convert (pvoid_type_node, source),
+			 fold_build2_loc (input_location, MIN_EXPR,
+					  gfc_array_index_type,
+					  size_bytes, source_bytes));
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  se->expr = info->descriptor;
+  if (expr->ts.type == BT_CHARACTER)
+    se->string_length = fold_convert (gfc_charlen_type_node, dest_word_len);
+
+  return;
+
+/* Deal with scalar results.  */
+scalar_transfer:
+  extent = fold_build2_loc (input_location, MIN_EXPR, gfc_array_index_type,
+			    dest_word_len, source_bytes);
+  extent = fold_build2_loc (input_location, MAX_EXPR, gfc_array_index_type,
+			    extent, gfc_index_zero_node);
+
+  if (expr->ts.type == BT_CHARACTER)
+    {
+      tree direct;
+      tree indirect;
+
+      ptr = convert (gfc_get_pchar_type (expr->ts.kind), source);
+      tmpdecl = gfc_create_var (gfc_get_pchar_type (expr->ts.kind),
+				"transfer");
+
+      /* If source is longer than the destination, use a pointer to
+	 the source directly.  */
+      gfc_init_block (&block);
+      gfc_add_modify (&block, tmpdecl, ptr);
+      direct = gfc_finish_block (&block);
+
+      /* Otherwise, allocate a string with the length of the destination
+	 and copy the source into it.  */
+      gfc_init_block (&block);
+      tmp = gfc_get_pchar_type (expr->ts.kind);
+      tmp = gfc_call_malloc (&block, tmp, dest_word_len);
+      gfc_add_modify (&block, tmpdecl,
+		      fold_convert (TREE_TYPE (ptr), tmp));
+      tmp = build_call_expr_loc (input_location,
+			     built_in_decls[BUILT_IN_MEMCPY], 3,
+			     fold_convert (pvoid_type_node, tmpdecl),
+			     fold_convert (pvoid_type_node, ptr),
+			     extent);
+      gfc_add_expr_to_block (&block, tmp);
+      indirect = gfc_finish_block (&block);
+
+      /* Wrap it up with the condition.  */
+      tmp = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
+			     dest_word_len, source_bytes);
+      tmp = build3_v (COND_EXPR, tmp, direct, indirect);
+      gfc_add_expr_to_block (&se->pre, tmp);
+
+      se->expr = tmpdecl;
+      se->string_length = dest_word_len;
+    }
+  else
+    {
+      tmpdecl = gfc_create_var (mold_type, "transfer");
+
+      ptr = convert (build_pointer_type (mold_type), source);
+
+      /* Use memcpy to do the transfer.  */
+      tmp = gfc_build_addr_expr (NULL_TREE, tmpdecl);
+      tmp = build_call_expr_loc (input_location,
+			     built_in_decls[BUILT_IN_MEMCPY], 3,
+			     fold_convert (pvoid_type_node, tmp),
+			     fold_convert (pvoid_type_node, ptr),
+			     extent);
+      gfc_add_expr_to_block (&se->pre, tmp);
+
+      se->expr = tmpdecl;
+    }
+}
+
+
+/* Generate code for the ALLOCATED intrinsic.
+   Generate inline code that directly check the address of the argument.  */
+
+static void
+gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
+{
+  gfc_actual_arglist *arg1;
+  gfc_se arg1se;
+  gfc_ss *ss1;
+  tree tmp;
+
+  gfc_init_se (&arg1se, NULL);
+  arg1 = expr->value.function.actual;
+  ss1 = gfc_walk_expr (arg1->expr);
+
+  if (ss1 == gfc_ss_terminator)
+    {
+      /* Allocatable scalar.  */
+      arg1se.want_pointer = 1;
+      if (arg1->expr->ts.type == BT_CLASS)
+	gfc_add_data_component (arg1->expr);
+      gfc_conv_expr (&arg1se, arg1->expr);
+      tmp = arg1se.expr;
+    }
+  else
+    {
+      /* Allocatable array.  */
+      arg1se.descriptor_only = 1;
+      gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
+      tmp = gfc_conv_descriptor_data_get (arg1se.expr);
+    }
+
+  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp,
+			 fold_convert (TREE_TYPE (tmp), null_pointer_node));
+  se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
+}
+
+
+/* Generate code for the ASSOCIATED intrinsic.
+   If both POINTER and TARGET are arrays, generate a call to library function
+   _gfor_associated, and pass descriptors of POINTER and TARGET to it.
+   In other cases, generate inline code that directly compare the address of
+   POINTER with the address of TARGET.  */
+
+static void
+gfc_conv_associated (gfc_se *se, gfc_expr *expr)
+{
+  gfc_actual_arglist *arg1;
+  gfc_actual_arglist *arg2;
+  gfc_se arg1se;
+  gfc_se arg2se;
+  tree tmp2;
+  tree tmp;
+  tree nonzero_charlen;
+  tree nonzero_arraylen;
+  gfc_ss *ss1, *ss2;
+
+  gfc_init_se (&arg1se, NULL);
+  gfc_init_se (&arg2se, NULL);
+  arg1 = expr->value.function.actual;
+  if (arg1->expr->ts.type == BT_CLASS)
+    gfc_add_data_component (arg1->expr);
+  arg2 = arg1->next;
+  ss1 = gfc_walk_expr (arg1->expr);
+
+  if (!arg2->expr)
+    {
+      /* No optional target.  */
+      if (ss1 == gfc_ss_terminator)
+        {
+          /* A pointer to a scalar.  */
+          arg1se.want_pointer = 1;
+          gfc_conv_expr (&arg1se, arg1->expr);
+          tmp2 = arg1se.expr;
+        }
+      else
+        {
+          /* A pointer to an array.  */
+          gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
+          tmp2 = gfc_conv_descriptor_data_get (arg1se.expr);
+        }
+      gfc_add_block_to_block (&se->pre, &arg1se.pre);
+      gfc_add_block_to_block (&se->post, &arg1se.post);
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp2,
+			     fold_convert (TREE_TYPE (tmp2), null_pointer_node));
+      se->expr = tmp;
+    }
+  else
+    {
+      /* An optional target.  */
+      if (arg2->expr->ts.type == BT_CLASS)
+	gfc_add_data_component (arg2->expr);
+      ss2 = gfc_walk_expr (arg2->expr);
+
+      nonzero_charlen = NULL_TREE;
+      if (arg1->expr->ts.type == BT_CHARACTER)
+	nonzero_charlen = fold_build2_loc (input_location, NE_EXPR,
+					   boolean_type_node,
+					   arg1->expr->ts.u.cl->backend_decl,
+					   integer_zero_node);
+
+      if (ss1 == gfc_ss_terminator)
+        {
+          /* A pointer to a scalar.  */
+          gcc_assert (ss2 == gfc_ss_terminator);
+          arg1se.want_pointer = 1;
+          gfc_conv_expr (&arg1se, arg1->expr);
+          arg2se.want_pointer = 1;
+          gfc_conv_expr (&arg2se, arg2->expr);
+	  gfc_add_block_to_block (&se->pre, &arg1se.pre);
+	  gfc_add_block_to_block (&se->post, &arg1se.post);
+          tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				 arg1se.expr, arg2se.expr);
+          tmp2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				  arg1se.expr, null_pointer_node);
+          se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+				      boolean_type_node, tmp, tmp2);
+        }
+      else
+        {
+	  /* An array pointer of zero length is not associated if target is
+	     present.  */
+	  arg1se.descriptor_only = 1;
+	  gfc_conv_expr_lhs (&arg1se, arg1->expr);
+	  tmp = gfc_conv_descriptor_stride_get (arg1se.expr,
+					    gfc_rank_cst[arg1->expr->rank - 1]);
+	  nonzero_arraylen = fold_build2_loc (input_location, NE_EXPR,
+					      boolean_type_node, tmp,
+					      build_int_cst (TREE_TYPE (tmp), 0));
+
+          /* A pointer to an array, call library function _gfor_associated.  */
+          gcc_assert (ss2 != gfc_ss_terminator);
+          arg1se.want_pointer = 1;
+          gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
+
+          arg2se.want_pointer = 1;
+          gfc_conv_expr_descriptor (&arg2se, arg2->expr, ss2);
+          gfc_add_block_to_block (&se->pre, &arg2se.pre);
+          gfc_add_block_to_block (&se->post, &arg2se.post);
+          se->expr = build_call_expr_loc (input_location,
+				      gfor_fndecl_associated, 2,
+				      arg1se.expr, arg2se.expr);
+	  se->expr = convert (boolean_type_node, se->expr);
+	  se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+				      boolean_type_node, se->expr,
+				      nonzero_arraylen);
+        }
+
+      /* If target is present zero character length pointers cannot
+	 be associated.  */
+      if (nonzero_charlen != NULL_TREE)
+	se->expr = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+				    boolean_type_node,
+				    se->expr, nonzero_charlen);
+    }
+
+  se->expr = convert (gfc_typenode_for_spec (&expr->ts), se->expr);
+}
+
+
+/* Generate code for the SAME_TYPE_AS intrinsic.
+   Generate inline code that directly checks the vindices.  */
+
+static void
+gfc_conv_same_type_as (gfc_se *se, gfc_expr *expr)
+{
+  gfc_expr *a, *b;
+  gfc_se se1, se2;
+  tree tmp;
+
+  gfc_init_se (&se1, NULL);
+  gfc_init_se (&se2, NULL);
+
+  a = expr->value.function.actual->expr;
+  b = expr->value.function.actual->next->expr;
+
+  if (a->ts.type == BT_CLASS)
+    {
+      gfc_add_vptr_component (a);
+      gfc_add_hash_component (a);
+    }
+  else if (a->ts.type == BT_DERIVED)
+    a = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+			  a->ts.u.derived->hash_value);
+
+  if (b->ts.type == BT_CLASS)
+    {
+      gfc_add_vptr_component (b);
+      gfc_add_hash_component (b);
+    }
+  else if (b->ts.type == BT_DERIVED)
+    b = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+			  b->ts.u.derived->hash_value);
+
+  gfc_conv_expr (&se1, a);
+  gfc_conv_expr (&se2, b);
+
+  tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			 se1.expr, fold_convert (TREE_TYPE (se1.expr), se2.expr));
+  se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
+}
+
+
+/* Generate code for SELECTED_CHAR_KIND (NAME) intrinsic function.  */
+
+static void
+gfc_conv_intrinsic_sc_kind (gfc_se *se, gfc_expr *expr)
+{
+  tree args[2];
+
+  gfc_conv_intrinsic_function_args (se, expr, args, 2);
+  se->expr = build_call_expr_loc (input_location,
+			      gfor_fndecl_sc_kind, 2, args[0], args[1]);
+  se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), se->expr);
+}
+
+
+/* Generate code for SELECTED_INT_KIND (R) intrinsic function.  */
+
+static void
+gfc_conv_intrinsic_si_kind (gfc_se *se, gfc_expr *expr)
+{
+  tree arg, type;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+
+  /* The argument to SELECTED_INT_KIND is INTEGER(4).  */
+  type = gfc_get_int_type (4); 
+  arg = gfc_build_addr_expr (NULL_TREE, fold_convert (type, arg));
+
+  /* Convert it to the required type.  */
+  type = gfc_typenode_for_spec (&expr->ts);
+  se->expr = build_call_expr_loc (input_location,
+			      gfor_fndecl_si_kind, 1, arg);
+  se->expr = fold_convert (type, se->expr);
+}
+
+
+/* Generate code for SELECTED_REAL_KIND (P, R) intrinsic function.  */
+
+static void
+gfc_conv_intrinsic_sr_kind (gfc_se *se, gfc_expr *expr)
+{
+  gfc_actual_arglist *actual;
+  tree type;
+  gfc_se argse;
+  VEC(tree,gc) *args = NULL;
+
+  for (actual = expr->value.function.actual; actual; actual = actual->next)
+    {
+      gfc_init_se (&argse, se);
+
+      /* Pass a NULL pointer for an absent arg.  */
+      if (actual->expr == NULL)
+        argse.expr = null_pointer_node;
+      else
+	{
+	  gfc_typespec ts;
+          gfc_clear_ts (&ts);
+
+	  if (actual->expr->ts.kind != gfc_c_int_kind)
+	    {
+  	      /* The arguments to SELECTED_REAL_KIND are INTEGER(4).  */
+	      ts.type = BT_INTEGER;
+	      ts.kind = gfc_c_int_kind;
+	      gfc_convert_type (actual->expr, &ts, 2);
+	    }
+	  gfc_conv_expr_reference (&argse, actual->expr);
+	} 
+
+      gfc_add_block_to_block (&se->pre, &argse.pre);
+      gfc_add_block_to_block (&se->post, &argse.post);
+      VEC_safe_push (tree, gc, args, argse.expr);
+    }
+
+  /* Convert it to the required type.  */
+  type = gfc_typenode_for_spec (&expr->ts);
+  se->expr = build_call_expr_loc_vec (input_location,
+				      gfor_fndecl_sr_kind, args);
+  se->expr = fold_convert (type, se->expr);
+}
+
+
+/* Generate code for TRIM (A) intrinsic function.  */
+
+static void
+gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
+{
+  tree var;
+  tree len;
+  tree addr;
+  tree tmp;
+  tree cond;
+  tree fndecl;
+  tree function;
+  tree *args;
+  unsigned int num_args;
+
+  num_args = gfc_intrinsic_argument_list_length (expr) + 2;
+  args = XALLOCAVEC (tree, num_args);
+
+  var = gfc_create_var (gfc_get_pchar_type (expr->ts.kind), "pstr");
+  addr = gfc_build_addr_expr (ppvoid_type_node, var);
+  len = gfc_create_var (gfc_charlen_type_node, "len");
+
+  gfc_conv_intrinsic_function_args (se, expr, &args[2], num_args - 2);
+  args[0] = gfc_build_addr_expr (NULL_TREE, len);
+  args[1] = addr;
+
+  if (expr->ts.kind == 1)
+    function = gfor_fndecl_string_trim;
+  else if (expr->ts.kind == 4)
+    function = gfor_fndecl_string_trim_char4;
+  else
+    gcc_unreachable ();
+
+  fndecl = build_addr (function, current_function_decl);
+  tmp = build_call_array_loc (input_location,
+			  TREE_TYPE (TREE_TYPE (function)), fndecl,
+			  num_args, args);
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  /* Free the temporary afterwards, if necessary.  */
+  cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+			  len, build_int_cst (TREE_TYPE (len), 0));
+  tmp = gfc_call_free (var);
+  tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&se->post, tmp);
+
+  se->expr = var;
+  se->string_length = len;
+}
+
+
+/* Generate code for REPEAT (STRING, NCOPIES) intrinsic function.  */
+
+static void
+gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr)
+{
+  tree args[3], ncopies, dest, dlen, src, slen, ncopies_type;
+  tree type, cond, tmp, count, exit_label, n, max, largest;
+  tree size;
+  stmtblock_t block, body;
+  int i;
+
+  /* We store in charsize the size of a character.  */
+  i = gfc_validate_kind (BT_CHARACTER, expr->ts.kind, false);
+  size = build_int_cst (size_type_node, gfc_character_kinds[i].bit_size / 8);
+
+  /* Get the arguments.  */
+  gfc_conv_intrinsic_function_args (se, expr, args, 3);
+  slen = fold_convert (size_type_node, gfc_evaluate_now (args[0], &se->pre));
+  src = args[1];
+  ncopies = gfc_evaluate_now (args[2], &se->pre);
+  ncopies_type = TREE_TYPE (ncopies);
+
+  /* Check that NCOPIES is not negative.  */
+  cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, ncopies,
+			  build_int_cst (ncopies_type, 0));
+  gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
+			   "Argument NCOPIES of REPEAT intrinsic is negative "
+			   "(its value is %lld)",
+			   fold_convert (long_integer_type_node, ncopies));
+
+  /* If the source length is zero, any non negative value of NCOPIES
+     is valid, and nothing happens.  */
+  n = gfc_create_var (ncopies_type, "ncopies");
+  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, slen,
+			  build_int_cst (size_type_node, 0));
+  tmp = fold_build3_loc (input_location, COND_EXPR, ncopies_type, cond,
+			 build_int_cst (ncopies_type, 0), ncopies);
+  gfc_add_modify (&se->pre, n, tmp);
+  ncopies = n;
+
+  /* Check that ncopies is not too large: ncopies should be less than
+     (or equal to) MAX / slen, where MAX is the maximal integer of
+     the gfc_charlen_type_node type.  If slen == 0, we need a special
+     case to avoid the division by zero.  */
+  i = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+  max = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, gfc_charlen_int_kind);
+  max = fold_build2_loc (input_location, TRUNC_DIV_EXPR, size_type_node,
+			  fold_convert (size_type_node, max), slen);
+  largest = TYPE_PRECISION (size_type_node) > TYPE_PRECISION (ncopies_type)
+	      ? size_type_node : ncopies_type;
+  cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+			  fold_convert (largest, ncopies),
+			  fold_convert (largest, max));
+  tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, slen,
+			 build_int_cst (size_type_node, 0));
+  cond = fold_build3_loc (input_location, COND_EXPR, boolean_type_node, tmp,
+			  boolean_false_node, cond);
+  gfc_trans_runtime_check (true, false, cond, &se->pre, &expr->where,
+			   "Argument NCOPIES of REPEAT intrinsic is too large");
+
+  /* Compute the destination length.  */
+  dlen = fold_build2_loc (input_location, MULT_EXPR, gfc_charlen_type_node,
+			  fold_convert (gfc_charlen_type_node, slen),
+			  fold_convert (gfc_charlen_type_node, ncopies));
+  type = gfc_get_character_type (expr->ts.kind, expr->ts.u.cl);
+  dest = gfc_conv_string_tmp (se, build_pointer_type (type), dlen);
+
+  /* Generate the code to do the repeat operation:
+       for (i = 0; i < ncopies; i++)
+         memmove (dest + (i * slen * size), src, slen*size);  */
+  gfc_start_block (&block);
+  count = gfc_create_var (ncopies_type, "count");
+  gfc_add_modify (&block, count, build_int_cst (ncopies_type, 0));
+  exit_label = gfc_build_label_decl (NULL_TREE);
+
+  /* Start the loop body.  */
+  gfc_start_block (&body);
+
+  /* Exit the loop if count >= ncopies.  */
+  cond = fold_build2_loc (input_location, GE_EXPR, boolean_type_node, count,
+			  ncopies);
+  tmp = build1_v (GOTO_EXPR, exit_label);
+  TREE_USED (exit_label) = 1;
+  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, tmp,
+			 build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Call memmove (dest + (i*slen*size), src, slen*size).  */
+  tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_charlen_type_node,
+			 fold_convert (gfc_charlen_type_node, slen),
+			 fold_convert (gfc_charlen_type_node, count));
+  tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_charlen_type_node,
+			 tmp, fold_convert (gfc_charlen_type_node, size));
+  tmp = fold_build2_loc (input_location, POINTER_PLUS_EXPR, pvoid_type_node,
+			 fold_convert (pvoid_type_node, dest),
+			 fold_convert (sizetype, tmp));
+  tmp = build_call_expr_loc (input_location,
+			     built_in_decls[BUILT_IN_MEMMOVE], 3, tmp, src,
+			     fold_build2_loc (input_location, MULT_EXPR,
+					      size_type_node, slen,
+					      fold_convert (size_type_node,
+							    size)));
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Increment count.  */
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, ncopies_type,
+			 count, build_int_cst (TREE_TYPE (count), 1));
+  gfc_add_modify (&body, count, tmp);
+
+  /* Build the loop.  */
+  tmp = build1_v (LOOP_EXPR, gfc_finish_block (&body));
+  gfc_add_expr_to_block (&block, tmp);
+
+  /* Add the exit label.  */
+  tmp = build1_v (LABEL_EXPR, exit_label);
+  gfc_add_expr_to_block (&block, tmp);
+
+  /* Finish the block.  */
+  tmp = gfc_finish_block (&block);
+  gfc_add_expr_to_block (&se->pre, tmp);
+
+  /* Set the result value.  */
+  se->expr = dest;
+  se->string_length = dlen;
+}
+
+
+/* Generate code for the IARGC intrinsic.  */
+
+static void
+gfc_conv_intrinsic_iargc (gfc_se * se, gfc_expr * expr)
+{
+  tree tmp;
+  tree fndecl;
+  tree type;
+
+  /* Call the library function.  This always returns an INTEGER(4).  */
+  fndecl = gfor_fndecl_iargc;
+  tmp = build_call_expr_loc (input_location,
+			 fndecl, 0);
+
+  /* Convert it to the required type.  */
+  type = gfc_typenode_for_spec (&expr->ts);
+  tmp = fold_convert (type, tmp);
+
+  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, true, NULL, NULL, NULL);
+  se->expr= convert (gfc_get_int_type (gfc_index_integer_kind), 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_get_int_type (gfc_index_integer_kind), NULL);
+  gfc_add_modify (&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.  */
+
+void
+gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
+{
+  const char *name;
+  int lib, kind;
+  tree fndecl;
+
+  name = &expr->value.function.name[2];
+
+  if (expr->rank > 0)
+    {
+      lib = gfc_is_intrinsic_libcall (expr);
+      if (lib != 0)
+	{
+	  if (lib == 1)
+	    se->ignore_optional = 1;
+
+	  switch (expr->value.function.isym->id)
+	    {
+	    case GFC_ISYM_EOSHIFT:
+	    case GFC_ISYM_PACK:
+	    case GFC_ISYM_RESHAPE:
+	      /* For all of those the first argument specifies the type and the
+		 third is optional.  */
+	      conv_generic_with_optional_char_arg (se, expr, 1, 3);
+	      break;
+
+	    default:
+	      gfc_conv_intrinsic_funcall (se, expr);
+	      break;
+	    }
+
+	  return;
+	}
+    }
+
+  switch (expr->value.function.isym->id)
+    {
+    case GFC_ISYM_NONE:
+      gcc_unreachable ();
+
+    case GFC_ISYM_REPEAT:
+      gfc_conv_intrinsic_repeat (se, expr);
+      break;
+
+    case GFC_ISYM_TRIM:
+      gfc_conv_intrinsic_trim (se, expr);
+      break;
+
+    case GFC_ISYM_SC_KIND:
+      gfc_conv_intrinsic_sc_kind (se, expr);
+      break;
+
+    case GFC_ISYM_SI_KIND:
+      gfc_conv_intrinsic_si_kind (se, expr);
+      break;
+
+    case GFC_ISYM_SR_KIND:
+      gfc_conv_intrinsic_sr_kind (se, expr);
+      break;
+
+    case GFC_ISYM_EXPONENT:
+      gfc_conv_intrinsic_exponent (se, expr);
+      break;
+
+    case GFC_ISYM_SCAN:
+      kind = expr->value.function.actual->expr->ts.kind;
+      if (kind == 1)
+       fndecl = gfor_fndecl_string_scan;
+      else if (kind == 4)
+       fndecl = gfor_fndecl_string_scan_char4;
+      else
+       gcc_unreachable ();
+
+      gfc_conv_intrinsic_index_scan_verify (se, expr, fndecl);
+      break;
+
+    case GFC_ISYM_VERIFY:
+      kind = expr->value.function.actual->expr->ts.kind;
+      if (kind == 1)
+       fndecl = gfor_fndecl_string_verify;
+      else if (kind == 4)
+       fndecl = gfor_fndecl_string_verify_char4;
+      else
+       gcc_unreachable ();
+
+      gfc_conv_intrinsic_index_scan_verify (se, expr, fndecl);
+      break;
+
+    case GFC_ISYM_ALLOCATED:
+      gfc_conv_allocated (se, expr);
+      break;
+
+    case GFC_ISYM_ASSOCIATED:
+      gfc_conv_associated(se, expr);
+      break;
+
+    case GFC_ISYM_SAME_TYPE_AS:
+      gfc_conv_same_type_as (se, expr);
+      break;
+
+    case GFC_ISYM_ABS:
+      gfc_conv_intrinsic_abs (se, expr);
+      break;
+
+    case GFC_ISYM_ADJUSTL:
+      if (expr->ts.kind == 1)
+       fndecl = gfor_fndecl_adjustl;
+      else if (expr->ts.kind == 4)
+       fndecl = gfor_fndecl_adjustl_char4;
+      else
+       gcc_unreachable ();
+
+      gfc_conv_intrinsic_adjust (se, expr, fndecl);
+      break;
+
+    case GFC_ISYM_ADJUSTR:
+      if (expr->ts.kind == 1)
+       fndecl = gfor_fndecl_adjustr;
+      else if (expr->ts.kind == 4)
+       fndecl = gfor_fndecl_adjustr_char4;
+      else
+       gcc_unreachable ();
+
+      gfc_conv_intrinsic_adjust (se, expr, fndecl);
+      break;
+
+    case GFC_ISYM_AIMAG:
+      gfc_conv_intrinsic_imagpart (se, expr);
+      break;
+
+    case GFC_ISYM_AINT:
+      gfc_conv_intrinsic_aint (se, expr, RND_TRUNC);
+      break;
+
+    case GFC_ISYM_ALL:
+      gfc_conv_intrinsic_anyall (se, expr, EQ_EXPR);
+      break;
+
+    case GFC_ISYM_ANINT:
+      gfc_conv_intrinsic_aint (se, expr, RND_ROUND);
+      break;
+
+    case GFC_ISYM_AND:
+      gfc_conv_intrinsic_bitop (se, expr, BIT_AND_EXPR);
+      break;
+
+    case GFC_ISYM_ANY:
+      gfc_conv_intrinsic_anyall (se, expr, NE_EXPR);
+      break;
+
+    case GFC_ISYM_BTEST:
+      gfc_conv_intrinsic_btest (se, expr);
+      break;
+
+    case GFC_ISYM_BGE:
+      gfc_conv_intrinsic_bitcomp (se, expr, GE_EXPR);
+      break;
+
+    case GFC_ISYM_BGT:
+      gfc_conv_intrinsic_bitcomp (se, expr, GT_EXPR);
+      break;
+
+    case GFC_ISYM_BLE:
+      gfc_conv_intrinsic_bitcomp (se, expr, LE_EXPR);
+      break;
+
+    case GFC_ISYM_BLT:
+      gfc_conv_intrinsic_bitcomp (se, expr, LT_EXPR);
+      break;
+
+    case GFC_ISYM_ACHAR:
+    case GFC_ISYM_CHAR:
+      gfc_conv_intrinsic_char (se, expr);
+      break;
+
+    case GFC_ISYM_CONVERSION:
+    case GFC_ISYM_REAL:
+    case GFC_ISYM_LOGICAL:
+    case GFC_ISYM_DBLE:
+      gfc_conv_intrinsic_conversion (se, expr);
+      break;
+
+      /* Integer conversions are handled separately to make sure we get the
+         correct rounding mode.  */
+    case GFC_ISYM_INT:
+    case GFC_ISYM_INT2:
+    case GFC_ISYM_INT8:
+    case GFC_ISYM_LONG:
+      gfc_conv_intrinsic_int (se, expr, RND_TRUNC);
+      break;
+
+    case GFC_ISYM_NINT:
+      gfc_conv_intrinsic_int (se, expr, RND_ROUND);
+      break;
+
+    case GFC_ISYM_CEILING:
+      gfc_conv_intrinsic_int (se, expr, RND_CEIL);
+      break;
+
+    case GFC_ISYM_FLOOR:
+      gfc_conv_intrinsic_int (se, expr, RND_FLOOR);
+      break;
+
+    case GFC_ISYM_MOD:
+      gfc_conv_intrinsic_mod (se, expr, 0);
+      break;
+
+    case GFC_ISYM_MODULO:
+      gfc_conv_intrinsic_mod (se, expr, 1);
+      break;
+
+    case GFC_ISYM_CMPLX:
+      gfc_conv_intrinsic_cmplx (se, expr, name[5] == '1');
+      break;
+
+    case GFC_ISYM_COMMAND_ARGUMENT_COUNT:
+      gfc_conv_intrinsic_iargc (se, expr);
+      break;
+
+    case GFC_ISYM_COMPLEX:
+      gfc_conv_intrinsic_cmplx (se, expr, 1);
+      break;
+
+    case GFC_ISYM_CONJG:
+      gfc_conv_intrinsic_conjg (se, expr);
+      break;
+
+    case GFC_ISYM_COUNT:
+      gfc_conv_intrinsic_count (se, expr);
+      break;
+
+    case GFC_ISYM_CTIME:
+      gfc_conv_intrinsic_ctime (se, expr);
+      break;
+
+    case GFC_ISYM_DIM:
+      gfc_conv_intrinsic_dim (se, expr);
+      break;
+
+    case GFC_ISYM_DOT_PRODUCT:
+      gfc_conv_intrinsic_dot_product (se, expr);
+      break;
+
+    case GFC_ISYM_DPROD:
+      gfc_conv_intrinsic_dprod (se, expr);
+      break;
+
+    case GFC_ISYM_DSHIFTL:
+      gfc_conv_intrinsic_dshift (se, expr, true);
+      break;
+
+    case GFC_ISYM_DSHIFTR:
+      gfc_conv_intrinsic_dshift (se, expr, false);
+      break;
+
+    case GFC_ISYM_FDATE:
+      gfc_conv_intrinsic_fdate (se, expr);
+      break;
+
+    case GFC_ISYM_FRACTION:
+      gfc_conv_intrinsic_fraction (se, expr);
+      break;
+
+    case GFC_ISYM_IALL:
+      gfc_conv_intrinsic_arith (se, expr, BIT_AND_EXPR, false);
+      break;
+
+    case GFC_ISYM_IAND:
+      gfc_conv_intrinsic_bitop (se, expr, BIT_AND_EXPR);
+      break;
+
+    case GFC_ISYM_IANY:
+      gfc_conv_intrinsic_arith (se, expr, BIT_IOR_EXPR, false);
+      break;
+
+    case GFC_ISYM_IBCLR:
+      gfc_conv_intrinsic_singlebitop (se, expr, 0);
+      break;
+
+    case GFC_ISYM_IBITS:
+      gfc_conv_intrinsic_ibits (se, expr);
+      break;
+
+    case GFC_ISYM_IBSET:
+      gfc_conv_intrinsic_singlebitop (se, expr, 1);
+      break;
+
+    case GFC_ISYM_IACHAR:
+    case GFC_ISYM_ICHAR:
+      /* We assume ASCII character sequence.  */
+      gfc_conv_intrinsic_ichar (se, expr);
+      break;
+
+    case GFC_ISYM_IARGC:
+      gfc_conv_intrinsic_iargc (se, expr);
+      break;
+
+    case GFC_ISYM_IEOR:
+      gfc_conv_intrinsic_bitop (se, expr, BIT_XOR_EXPR);
+      break;
+
+    case GFC_ISYM_INDEX:
+      kind = expr->value.function.actual->expr->ts.kind;
+      if (kind == 1)
+       fndecl = gfor_fndecl_string_index;
+      else if (kind == 4)
+       fndecl = gfor_fndecl_string_index_char4;
+      else
+       gcc_unreachable ();
+
+      gfc_conv_intrinsic_index_scan_verify (se, expr, fndecl);
+      break;
+
+    case GFC_ISYM_IOR:
+      gfc_conv_intrinsic_bitop (se, expr, BIT_IOR_EXPR);
+      break;
+
+    case GFC_ISYM_IPARITY:
+      gfc_conv_intrinsic_arith (se, expr, BIT_XOR_EXPR, false);
+      break;
+
+    case GFC_ISYM_IS_IOSTAT_END:
+      gfc_conv_has_intvalue (se, expr, LIBERROR_END);
+      break;
+
+    case GFC_ISYM_IS_IOSTAT_EOR:
+      gfc_conv_has_intvalue (se, expr, LIBERROR_EOR);
+      break;
+
+    case GFC_ISYM_ISNAN:
+      gfc_conv_intrinsic_isnan (se, expr);
+      break;
+
+    case GFC_ISYM_LSHIFT:
+      gfc_conv_intrinsic_shift (se, expr, false, false);
+      break;
+
+    case GFC_ISYM_RSHIFT:
+      gfc_conv_intrinsic_shift (se, expr, true, true);
+      break;
+
+    case GFC_ISYM_SHIFTA:
+      gfc_conv_intrinsic_shift (se, expr, true, true);
+      break;
+
+    case GFC_ISYM_SHIFTL:
+      gfc_conv_intrinsic_shift (se, expr, false, false);
+      break;
+
+    case GFC_ISYM_SHIFTR:
+      gfc_conv_intrinsic_shift (se, expr, true, false);
+      break;
+
+    case GFC_ISYM_ISHFT:
+      gfc_conv_intrinsic_ishft (se, expr);
+      break;
+
+    case GFC_ISYM_ISHFTC:
+      gfc_conv_intrinsic_ishftc (se, expr);
+      break;
+
+    case GFC_ISYM_LEADZ:
+      gfc_conv_intrinsic_leadz (se, expr);
+      break;
+
+    case GFC_ISYM_TRAILZ:
+      gfc_conv_intrinsic_trailz (se, expr);
+      break;
+
+    case GFC_ISYM_POPCNT:
+      gfc_conv_intrinsic_popcnt_poppar (se, expr, 0);
+      break;
+
+    case GFC_ISYM_POPPAR:
+      gfc_conv_intrinsic_popcnt_poppar (se, expr, 1);
+      break;
+
+    case GFC_ISYM_LBOUND:
+      gfc_conv_intrinsic_bound (se, expr, 0);
+      break;
+
+    case GFC_ISYM_TRANSPOSE:
+      /* The scalarizer has already been set up for reversed dimension access
+	 order ; now we just get the argument value normally.  */
+      gfc_conv_expr (se, expr->value.function.actual->expr);
+      break;
+
+    case GFC_ISYM_LEN:
+      gfc_conv_intrinsic_len (se, expr);
+      break;
+
+    case GFC_ISYM_LEN_TRIM:
+      gfc_conv_intrinsic_len_trim (se, expr);
+      break;
+
+    case GFC_ISYM_LGE:
+      gfc_conv_intrinsic_strcmp (se, expr, GE_EXPR);
+      break;
+
+    case GFC_ISYM_LGT:
+      gfc_conv_intrinsic_strcmp (se, expr, GT_EXPR);
+      break;
+
+    case GFC_ISYM_LLE:
+      gfc_conv_intrinsic_strcmp (se, expr, LE_EXPR);
+      break;
+
+    case GFC_ISYM_LLT:
+      gfc_conv_intrinsic_strcmp (se, expr, LT_EXPR);
+      break;
+
+    case GFC_ISYM_MASKL:
+      gfc_conv_intrinsic_mask (se, expr, 1);
+      break;
+
+    case GFC_ISYM_MASKR:
+      gfc_conv_intrinsic_mask (se, expr, 0);
+      break;
+
+    case GFC_ISYM_MAX:
+      if (expr->ts.type == BT_CHARACTER)
+	gfc_conv_intrinsic_minmax_char (se, expr, 1);
+      else
+	gfc_conv_intrinsic_minmax (se, expr, GT_EXPR);
+      break;
+
+    case GFC_ISYM_MAXLOC:
+      gfc_conv_intrinsic_minmaxloc (se, expr, GT_EXPR);
+      break;
+
+    case GFC_ISYM_MAXVAL:
+      gfc_conv_intrinsic_minmaxval (se, expr, GT_EXPR);
+      break;
+
+    case GFC_ISYM_MERGE:
+      gfc_conv_intrinsic_merge (se, expr);
+      break;
+
+    case GFC_ISYM_MERGE_BITS:
+      gfc_conv_intrinsic_merge_bits (se, expr);
+      break;
+
+    case GFC_ISYM_MIN:
+      if (expr->ts.type == BT_CHARACTER)
+	gfc_conv_intrinsic_minmax_char (se, expr, -1);
+      else
+	gfc_conv_intrinsic_minmax (se, expr, LT_EXPR);
+      break;
+
+    case GFC_ISYM_MINLOC:
+      gfc_conv_intrinsic_minmaxloc (se, expr, LT_EXPR);
+      break;
+
+    case GFC_ISYM_MINVAL:
+      gfc_conv_intrinsic_minmaxval (se, expr, LT_EXPR);
+      break;
+
+    case GFC_ISYM_NEAREST:
+      gfc_conv_intrinsic_nearest (se, expr);
+      break;
+
+    case GFC_ISYM_NORM2:
+      gfc_conv_intrinsic_arith (se, expr, PLUS_EXPR, true);
+      break;
+
+    case GFC_ISYM_NOT:
+      gfc_conv_intrinsic_not (se, expr);
+      break;
+
+    case GFC_ISYM_OR:
+      gfc_conv_intrinsic_bitop (se, expr, BIT_IOR_EXPR);
+      break;
+
+    case GFC_ISYM_PARITY:
+      gfc_conv_intrinsic_arith (se, expr, NE_EXPR, false);
+      break;
+
+    case GFC_ISYM_PRESENT:
+      gfc_conv_intrinsic_present (se, expr);
+      break;
+
+    case GFC_ISYM_PRODUCT:
+      gfc_conv_intrinsic_arith (se, expr, MULT_EXPR, false);
+      break;
+
+    case GFC_ISYM_RRSPACING:
+      gfc_conv_intrinsic_rrspacing (se, expr);
+      break;
+
+    case GFC_ISYM_SET_EXPONENT:
+      gfc_conv_intrinsic_set_exponent (se, expr);
+      break;
+
+    case GFC_ISYM_SCALE:
+      gfc_conv_intrinsic_scale (se, expr);
+      break;
+
+    case GFC_ISYM_SIGN:
+      gfc_conv_intrinsic_sign (se, expr);
+      break;
+
+    case GFC_ISYM_SIZE:
+      gfc_conv_intrinsic_size (se, expr);
+      break;
+
+    case GFC_ISYM_SIZEOF:
+    case GFC_ISYM_C_SIZEOF:
+      gfc_conv_intrinsic_sizeof (se, expr);
+      break;
+
+    case GFC_ISYM_STORAGE_SIZE:
+      gfc_conv_intrinsic_storage_size (se, expr);
+      break;
+
+    case GFC_ISYM_SPACING:
+      gfc_conv_intrinsic_spacing (se, expr);
+      break;
+
+    case GFC_ISYM_SUM:
+      gfc_conv_intrinsic_arith (se, expr, PLUS_EXPR, false);
+      break;
+
+    case GFC_ISYM_TRANSFER:
+      if (se->ss && se->ss->useflags)
+	/* Access the previously obtained result.  */
+	gfc_conv_tmp_array_ref (se);
+      else
+	gfc_conv_intrinsic_transfer (se, expr);
+      break;
+
+    case GFC_ISYM_TTYNAM:
+      gfc_conv_intrinsic_ttynam (se, expr);
+      break;
+
+    case GFC_ISYM_UBOUND:
+      gfc_conv_intrinsic_bound (se, expr, 1);
+      break;
+
+    case GFC_ISYM_XOR:
+      gfc_conv_intrinsic_bitop (se, expr, BIT_XOR_EXPR);
+      break;
+
+    case GFC_ISYM_LOC:
+      gfc_conv_intrinsic_loc (se, expr);
+      break;
+
+    case GFC_ISYM_ACCESS:
+    case GFC_ISYM_CHDIR:
+    case GFC_ISYM_CHMOD:
+    case GFC_ISYM_DTIME:
+    case GFC_ISYM_ETIME:
+    case GFC_ISYM_EXTENDS_TYPE_OF:
+    case GFC_ISYM_FGET:
+    case GFC_ISYM_FGETC:
+    case GFC_ISYM_FNUM:
+    case GFC_ISYM_FPUT:
+    case GFC_ISYM_FPUTC:
+    case GFC_ISYM_FSTAT:
+    case GFC_ISYM_FTELL:
+    case GFC_ISYM_GETCWD:
+    case GFC_ISYM_GETGID:
+    case GFC_ISYM_GETPID:
+    case GFC_ISYM_GETUID:
+    case GFC_ISYM_HOSTNM:
+    case GFC_ISYM_KILL:
+    case GFC_ISYM_IERRNO:
+    case GFC_ISYM_IRAND:
+    case GFC_ISYM_ISATTY:
+    case GFC_ISYM_JN2:
+    case GFC_ISYM_LINK:
+    case GFC_ISYM_LSTAT:
+    case GFC_ISYM_MALLOC:
+    case GFC_ISYM_MATMUL:
+    case GFC_ISYM_MCLOCK:
+    case GFC_ISYM_MCLOCK8:
+    case GFC_ISYM_RAND:
+    case GFC_ISYM_RENAME:
+    case GFC_ISYM_SECOND:
+    case GFC_ISYM_SECNDS:
+    case GFC_ISYM_SIGNAL:
+    case GFC_ISYM_STAT:
+    case GFC_ISYM_SYMLNK:
+    case GFC_ISYM_SYSTEM:
+    case GFC_ISYM_TIME:
+    case GFC_ISYM_TIME8:
+    case GFC_ISYM_UMASK:
+    case GFC_ISYM_UNLINK:
+    case GFC_ISYM_YN2:
+      gfc_conv_intrinsic_funcall (se, expr);
+      break;
+
+    case GFC_ISYM_EOSHIFT:
+    case GFC_ISYM_PACK:
+    case GFC_ISYM_RESHAPE:
+      /* For those, expr->rank should always be >0 and thus the if above the
+	 switch should have matched.  */
+      gcc_unreachable ();
+      break;
+
+    default:
+      gfc_conv_intrinsic_lib_function (se, expr);
+      break;
+    }
+}
+
+
+static gfc_ss *
+walk_inline_intrinsic_transpose (gfc_ss *ss, gfc_expr *expr)
+{
+  gfc_ss *arg_ss, *tmp_ss;
+  gfc_actual_arglist *arg;
+
+  arg = expr->value.function.actual;
+
+  gcc_assert (arg->expr);
+
+  arg_ss = gfc_walk_subexpr (gfc_ss_terminator, arg->expr);
+  gcc_assert (arg_ss != gfc_ss_terminator);
+
+  for (tmp_ss = arg_ss; ; tmp_ss = tmp_ss->next)
+    {
+      if (tmp_ss->type != GFC_SS_SCALAR
+	  && tmp_ss->type != GFC_SS_REFERENCE)
+	{
+	  int tmp_dim;
+	  gfc_ss_info *info;
+
+	  info = &tmp_ss->data.info;
+	  gcc_assert (info->dimen == 2);
+
+	  /* We just invert dimensions.  */
+	  tmp_dim = info->dim[0];
+	  info->dim[0] = info->dim[1];
+	  info->dim[1] = tmp_dim;
+	}
+
+      /* Stop when tmp_ss points to the last valid element of the chain...  */
+      if (tmp_ss->next == gfc_ss_terminator)
+	break;
+    }
+
+  /* ... so that we can attach the rest of the chain to it.  */
+  tmp_ss->next = ss;
+
+  return arg_ss;
+}
+
+
+static gfc_ss *
+walk_inline_intrinsic_function (gfc_ss * ss, gfc_expr * expr)
+{
+
+  switch (expr->value.function.isym->id)
+    {
+      case GFC_ISYM_TRANSPOSE:
+	return walk_inline_intrinsic_transpose (ss, expr);
+
+      default:
+	gcc_unreachable ();
+    }
+  gcc_unreachable ();
+}
+
+
+/* This generates code to execute before entering the scalarization loop.
+   Currently does nothing.  */
+
+void
+gfc_add_intrinsic_ss_code (gfc_loopinfo * loop ATTRIBUTE_UNUSED, gfc_ss * ss)
+{
+  switch (ss->expr->value.function.isym->id)
+    {
+    case GFC_ISYM_UBOUND:
+    case GFC_ISYM_LBOUND:
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+}
+
+
+/* UBOUND and LBOUND intrinsics with one parameter are expanded into code
+   inside the scalarization loop.  */
+
+static gfc_ss *
+gfc_walk_intrinsic_bound (gfc_ss * ss, gfc_expr * expr)
+{
+  gfc_ss *newss;
+
+  /* The two argument version returns a scalar.  */
+  if (expr->value.function.actual->next->expr)
+    return ss;
+
+  newss = gfc_get_ss ();
+  newss->type = GFC_SS_INTRINSIC;
+  newss->expr = expr;
+  newss->next = ss;
+  newss->data.info.dimen = 1;
+
+  return newss;
+}
+
+
+/* Walk an intrinsic array libcall.  */
+
+static gfc_ss *
+gfc_walk_intrinsic_libfunc (gfc_ss * ss, gfc_expr * expr)
+{
+  gfc_ss *newss;
+  int n;
+
+  gcc_assert (expr->rank > 0);
+
+  newss = gfc_get_ss ();
+  newss->type = GFC_SS_FUNCTION;
+  newss->expr = expr;
+  newss->next = ss;
+  newss->data.info.dimen = expr->rank;
+  for (n = 0; n < newss->data.info.dimen; n++)
+    newss->data.info.dim[n] = n;
+
+  return newss;
+}
+
+
+/* Return whether the function call expression EXPR will be expanded
+   inline by gfc_conv_intrinsic_function.  */
+
+bool
+gfc_inline_intrinsic_function_p (gfc_expr *expr)
+{
+  if (!expr->value.function.isym)
+    return false;
+
+  switch (expr->value.function.isym->id)
+    {
+    case GFC_ISYM_TRANSPOSE:
+      return true;
+
+    default:
+      return false;
+    }
+}
+
+
+/* Returns nonzero if the specified intrinsic function call maps directly to
+   an external library call.  Should only be used for functions that return
+   arrays.  */
+
+int
+gfc_is_intrinsic_libcall (gfc_expr * expr)
+{
+  gcc_assert (expr->expr_type == EXPR_FUNCTION && expr->value.function.isym);
+  gcc_assert (expr->rank > 0);
+
+  if (gfc_inline_intrinsic_function_p (expr))
+    return 0;
+
+  switch (expr->value.function.isym->id)
+    {
+    case GFC_ISYM_ALL:
+    case GFC_ISYM_ANY:
+    case GFC_ISYM_COUNT:
+    case GFC_ISYM_JN2:
+    case GFC_ISYM_IANY:
+    case GFC_ISYM_IALL:
+    case GFC_ISYM_IPARITY:
+    case GFC_ISYM_MATMUL:
+    case GFC_ISYM_MAXLOC:
+    case GFC_ISYM_MAXVAL:
+    case GFC_ISYM_MINLOC:
+    case GFC_ISYM_MINVAL:
+    case GFC_ISYM_NORM2:
+    case GFC_ISYM_PARITY:
+    case GFC_ISYM_PRODUCT:
+    case GFC_ISYM_SUM:
+    case GFC_ISYM_SHAPE:
+    case GFC_ISYM_SPREAD:
+    case GFC_ISYM_YN2:
+      /* Ignore absent optional parameters.  */
+      return 1;
+
+    case GFC_ISYM_RESHAPE:
+    case GFC_ISYM_CSHIFT:
+    case GFC_ISYM_EOSHIFT:
+    case GFC_ISYM_PACK:
+    case GFC_ISYM_UNPACK:
+      /* Pass absent optional parameters.  */
+      return 2;
+
+    default:
+      return 0;
+    }
+}
+
+/* Walk an intrinsic function.  */
+gfc_ss *
+gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr,
+			     gfc_intrinsic_sym * isym)
+{
+  gcc_assert (isym);
+
+  if (isym->elemental)
+    return gfc_walk_elemental_function_args (ss, expr->value.function.actual,
+					     GFC_SS_SCALAR);
+
+  if (expr->rank == 0)
+    return ss;
+
+  if (gfc_inline_intrinsic_function_p (expr))
+    return walk_inline_intrinsic_function (ss, expr);
+
+  if (gfc_is_intrinsic_libcall (expr))
+    return gfc_walk_intrinsic_libfunc (ss, expr);
+
+  /* Special cases.  */
+  switch (isym->id)
+    {
+    case GFC_ISYM_LBOUND:
+    case GFC_ISYM_UBOUND:
+      return gfc_walk_intrinsic_bound (ss, expr);
+
+    case GFC_ISYM_TRANSFER:
+      return gfc_walk_intrinsic_libfunc (ss, expr);
+
+    default:
+      /* This probably meant someone forgot to add an intrinsic to the above
+         list(s) when they implemented it, or something's gone horribly
+	 wrong.  */
+      gcc_unreachable ();
+    }
+}
+
+
+tree
+gfc_conv_intrinsic_move_alloc (gfc_code *code)
+{
+  if (code->ext.actual->expr->rank == 0)
+    {
+      /* Scalar arguments: Generate pointer assignments.  */
+      gfc_expr *from, *to;
+      stmtblock_t block;
+      tree tmp;
+
+      from = code->ext.actual->expr;
+      to = code->ext.actual->next->expr;
+
+      gfc_start_block (&block);
+
+      if (to->ts.type == BT_CLASS)
+	tmp = gfc_trans_class_assign (to, from, EXEC_POINTER_ASSIGN);
+      else
+	tmp = gfc_trans_pointer_assignment (to, from);
+      gfc_add_expr_to_block (&block, tmp);
+
+      if (from->ts.type == BT_CLASS)
+	tmp = gfc_trans_class_assign (from, gfc_get_null_expr (NULL),
+				      EXEC_POINTER_ASSIGN);
+      else
+	tmp = gfc_trans_pointer_assignment (from,
+					    gfc_get_null_expr (NULL));
+      gfc_add_expr_to_block (&block, tmp);
+
+      return gfc_finish_block (&block);
+    }
+  else
+    /* Array arguments: Generate library code.  */
+    return gfc_trans_call (code, false, NULL_TREE, NULL_TREE, false);
+}
+
+
+#include "gt-fortran-trans-intrinsic.h"
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
new file mode 100644
index 000000000..53ff1f4a4
--- /dev/null
+++ b/gcc/fortran/trans-io.c
@@ -0,0 +1,2340 @@
+/* IO Code translation/library interface
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "ggc.h"
+#include "diagnostic-core.h"	/* For internal_error.  */
+#include "gfortran.h"
+#include "trans.h"
+#include "trans-stmt.h"
+#include "trans-array.h"
+#include "trans-types.h"
+#include "trans-const.h"
+
+/* Members of the ioparm structure.  */
+
+enum ioparam_type
+{
+  IOPARM_ptype_common,
+  IOPARM_ptype_open,
+  IOPARM_ptype_close,
+  IOPARM_ptype_filepos,
+  IOPARM_ptype_inquire,
+  IOPARM_ptype_dt,
+  IOPARM_ptype_wait,
+  IOPARM_ptype_num
+};
+
+enum iofield_type
+{
+  IOPARM_type_int4,
+  IOPARM_type_intio,
+  IOPARM_type_pint4,
+  IOPARM_type_pintio,
+  IOPARM_type_pchar,
+  IOPARM_type_parray,
+  IOPARM_type_pad,
+  IOPARM_type_char1,
+  IOPARM_type_char2,
+  IOPARM_type_common,
+  IOPARM_type_num
+};
+
+typedef struct GTY(()) gfc_st_parameter_field {
+  const char *name;
+  unsigned int mask;
+  enum ioparam_type param_type;
+  enum iofield_type type;
+  tree field;
+  tree field_len;
+}
+gfc_st_parameter_field;
+
+typedef struct GTY(()) gfc_st_parameter {
+  const char *name;
+  tree type;
+}
+gfc_st_parameter;
+
+enum iofield
+{
+#define IOPARM(param_type, name, mask, type) IOPARM_##param_type##_##name,
+#include "ioparm.def"
+#undef IOPARM
+  IOPARM_field_num
+};
+
+static GTY(()) gfc_st_parameter st_parameter[] =
+{
+  { "common", NULL },
+  { "open", NULL },
+  { "close", NULL },
+  { "filepos", NULL },
+  { "inquire", NULL },
+  { "dt", NULL },
+  { "wait", NULL }
+};
+
+static GTY(()) gfc_st_parameter_field st_parameter_field[] =
+{
+#define IOPARM(param_type, name, mask, type) \
+  { #name, mask, IOPARM_ptype_##param_type, IOPARM_type_##type, NULL, NULL },
+#include "ioparm.def"
+#undef IOPARM
+  { NULL, 0, (enum ioparam_type) 0, (enum iofield_type) 0, NULL, NULL }
+};
+
+/* Library I/O subroutines */
+
+enum iocall
+{
+  IOCALL_READ,
+  IOCALL_READ_DONE,
+  IOCALL_WRITE,
+  IOCALL_WRITE_DONE,
+  IOCALL_X_INTEGER,
+  IOCALL_X_INTEGER_WRITE,
+  IOCALL_X_LOGICAL,
+  IOCALL_X_LOGICAL_WRITE,
+  IOCALL_X_CHARACTER,
+  IOCALL_X_CHARACTER_WRITE,
+  IOCALL_X_CHARACTER_WIDE,
+  IOCALL_X_CHARACTER_WIDE_WRITE,
+  IOCALL_X_REAL,
+  IOCALL_X_REAL_WRITE,
+  IOCALL_X_COMPLEX,
+  IOCALL_X_COMPLEX_WRITE,
+  IOCALL_X_REAL128,
+  IOCALL_X_REAL128_WRITE,
+  IOCALL_X_COMPLEX128,
+  IOCALL_X_COMPLEX128_WRITE,
+  IOCALL_X_ARRAY,
+  IOCALL_X_ARRAY_WRITE,
+  IOCALL_OPEN,
+  IOCALL_CLOSE,
+  IOCALL_INQUIRE,
+  IOCALL_IOLENGTH,
+  IOCALL_IOLENGTH_DONE,
+  IOCALL_REWIND,
+  IOCALL_BACKSPACE,
+  IOCALL_ENDFILE,
+  IOCALL_FLUSH,
+  IOCALL_SET_NML_VAL,
+  IOCALL_SET_NML_VAL_DIM,
+  IOCALL_WAIT,
+  IOCALL_NUM
+};
+
+static GTY(()) tree iocall[IOCALL_NUM];
+
+/* Variable for keeping track of what the last data transfer statement
+   was.  Used for deciding which subroutine to call when the data
+   transfer is complete.  */
+static enum { READ, WRITE, IOLENGTH } last_dt;
+
+/* The data transfer parameter block that should be shared by all
+   data transfer calls belonging to the same read/write/iolength.  */
+static GTY(()) tree dt_parm;
+static stmtblock_t *dt_post_end_block;
+
+static void
+gfc_build_st_parameter (enum ioparam_type ptype, tree *types)
+{
+  unsigned int type;
+  gfc_st_parameter_field *p;
+  char name[64];
+  size_t len;
+  tree t = make_node (RECORD_TYPE);
+  tree *chain = NULL;
+
+  len = strlen (st_parameter[ptype].name);
+  gcc_assert (len <= sizeof (name) - sizeof ("__st_parameter_"));
+  memcpy (name, "__st_parameter_", sizeof ("__st_parameter_"));
+  memcpy (name + sizeof ("__st_parameter_") - 1, st_parameter[ptype].name,
+	  len + 1);
+  TYPE_NAME (t) = get_identifier (name);
+
+  for (type = 0, p = st_parameter_field; type < IOPARM_field_num; type++, p++)
+    if (p->param_type == ptype)
+      switch (p->type)
+	{
+	case IOPARM_type_int4:
+	case IOPARM_type_intio:
+	case IOPARM_type_pint4:
+	case IOPARM_type_pintio:
+	case IOPARM_type_parray:
+	case IOPARM_type_pchar:
+	case IOPARM_type_pad:
+	  p->field = gfc_add_field_to_struct (t, get_identifier (p->name),
+					      types[p->type], &chain);
+	  break;
+	case IOPARM_type_char1:
+	  p->field = gfc_add_field_to_struct (t, get_identifier (p->name),
+					      pchar_type_node, &chain);
+	  /* FALLTHROUGH */
+	case IOPARM_type_char2:
+	  len = strlen (p->name);
+	  gcc_assert (len <= sizeof (name) - sizeof ("_len"));
+	  memcpy (name, p->name, len);
+	  memcpy (name + len, "_len", sizeof ("_len"));
+	  p->field_len = gfc_add_field_to_struct (t, get_identifier (name),
+						  gfc_charlen_type_node,
+						  &chain);
+	  if (p->type == IOPARM_type_char2)
+	    p->field = gfc_add_field_to_struct (t, get_identifier (p->name),
+						pchar_type_node, &chain);
+	  break;
+	case IOPARM_type_common:
+	  p->field
+	    = gfc_add_field_to_struct (t,
+				       get_identifier (p->name),
+				       st_parameter[IOPARM_ptype_common].type,
+				       &chain);
+	  break;
+	case IOPARM_type_num:
+	  gcc_unreachable ();
+	}
+
+  gfc_finish_type (t);
+  st_parameter[ptype].type = t;
+}
+
+
+/* Build code to test an error condition and call generate_error if needed.
+   Note: This builds calls to generate_error in the runtime library function.
+   The function generate_error is dependent on certain parameters in the
+   st_parameter_common flags to be set. (See libgfortran/runtime/error.c)
+   Therefore, the code to set these flags must be generated before
+   this function is used.  */
+
+void
+gfc_trans_io_runtime_check (tree cond, tree var, int error_code,
+			 const char * msgid, stmtblock_t * pblock)
+{
+  stmtblock_t block;
+  tree body;
+  tree tmp;
+  tree arg1, arg2, arg3;
+  char *message;
+
+  if (integer_zerop (cond))
+    return;
+
+  /* The code to generate the error.  */
+  gfc_start_block (&block);
+  
+  arg1 = gfc_build_addr_expr (NULL_TREE, var);
+  
+  arg2 = build_int_cst (integer_type_node, error_code),
+  
+  asprintf (&message, "%s", _(msgid));
+  arg3 = gfc_build_addr_expr (pchar_type_node,
+			      gfc_build_localized_cstring_const (message));
+  gfc_free(message);
+  
+  tmp = build_call_expr_loc (input_location,
+			 gfor_fndecl_generate_error, 3, arg1, arg2, arg3);
+
+  gfc_add_expr_to_block (&block, tmp);
+
+  body = gfc_finish_block (&block);
+
+  if (integer_onep (cond))
+    {
+      gfc_add_expr_to_block (pblock, body);
+    }
+  else
+    {
+      /* Tell the compiler that this isn't likely.  */
+      cond = fold_convert (long_integer_type_node, cond);
+      tmp = build_int_cst (long_integer_type_node, 0);
+      cond = build_call_expr_loc (input_location,
+			      built_in_decls[BUILT_IN_EXPECT], 2, cond, tmp);
+      cond = fold_convert (boolean_type_node, cond);
+
+      tmp = build3_v (COND_EXPR, cond, body, build_empty_stmt (input_location));
+      gfc_add_expr_to_block (pblock, tmp);
+    }
+}
+
+
+/* Create function decls for IO library functions.  */
+
+void
+gfc_build_io_library_fndecls (void)
+{
+  tree types[IOPARM_type_num], pad_idx, gfc_int4_type_node;
+  tree gfc_intio_type_node;
+  tree parm_type, dt_parm_type;
+  HOST_WIDE_INT pad_size;
+  unsigned int ptype;
+
+  types[IOPARM_type_int4] = gfc_int4_type_node = gfc_get_int_type (4);
+  types[IOPARM_type_intio] = gfc_intio_type_node
+			    = gfc_get_int_type (gfc_intio_kind);
+  types[IOPARM_type_pint4] = build_pointer_type (gfc_int4_type_node);
+  types[IOPARM_type_pintio]
+			    = build_pointer_type (gfc_intio_type_node);
+  types[IOPARM_type_parray] = pchar_type_node;
+  types[IOPARM_type_pchar] = pchar_type_node;
+  pad_size = 16 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node));
+  pad_size += 32 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (integer_type_node));
+  pad_idx = build_index_type (build_int_cst (NULL_TREE, pad_size - 1));
+  types[IOPARM_type_pad] = build_array_type (char_type_node, pad_idx);
+
+  /* pad actually contains pointers and integers so it needs to have an
+     alignment that is at least as large as the needed alignment for those
+     types.  See the st_parameter_dt structure in libgfortran/io/io.h for
+     what really goes into this space.  */
+  TYPE_ALIGN (types[IOPARM_type_pad]) = MAX (TYPE_ALIGN (pchar_type_node),
+		     TYPE_ALIGN (gfc_get_int_type (gfc_intio_kind)));
+
+  for (ptype = IOPARM_ptype_common; ptype < IOPARM_ptype_num; ptype++)
+    gfc_build_st_parameter ((enum ioparam_type) ptype, types);
+
+  /* Define the transfer functions.  */
+
+  dt_parm_type = build_pointer_type (st_parameter[IOPARM_ptype_dt].type);
+
+  iocall[IOCALL_X_INTEGER] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_integer")), ".wW",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_INTEGER_WRITE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_integer_write")), ".wR",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_LOGICAL] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_logical")), ".wW",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_LOGICAL_WRITE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_logical_write")), ".wR",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_CHARACTER] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_character")), ".wW",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_CHARACTER_WRITE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_character_write")), ".wR",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_CHARACTER_WIDE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_character_wide")), ".wW",
+	void_type_node, 4, dt_parm_type, pvoid_type_node,
+	gfc_charlen_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_CHARACTER_WIDE_WRITE] =
+    gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_character_wide_write")), ".wR",
+	void_type_node, 4, dt_parm_type, pvoid_type_node,
+	gfc_charlen_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_REAL] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_real")), ".wW",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_REAL_WRITE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_real_write")), ".wR",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_COMPLEX] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_complex")), ".wW",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_COMPLEX_WRITE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_complex_write")), ".wR",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  /* Version for __float128.  */
+  iocall[IOCALL_X_REAL128] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_real128")), ".wW",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_REAL128_WRITE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_real128_write")), ".wR",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_COMPLEX128] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_complex128")), ".wW",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_COMPLEX128_WRITE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_complex128_write")), ".wR",
+	void_type_node, 3, dt_parm_type, pvoid_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_X_ARRAY] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_array")), ".ww",
+	void_type_node, 4, dt_parm_type, pvoid_type_node,
+	integer_type_node, gfc_charlen_type_node);
+
+  iocall[IOCALL_X_ARRAY_WRITE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("transfer_array_write")), ".wr",
+	void_type_node, 4, dt_parm_type, pvoid_type_node,
+	integer_type_node, gfc_charlen_type_node);
+
+  /* Library entry points */
+
+  iocall[IOCALL_READ] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_read")), ".w",
+	void_type_node, 1, dt_parm_type);
+
+  iocall[IOCALL_WRITE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_write")), ".w",
+	void_type_node, 1, dt_parm_type);
+
+  parm_type = build_pointer_type (st_parameter[IOPARM_ptype_open].type);
+  iocall[IOCALL_OPEN] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_open")), ".w",
+	void_type_node, 1, parm_type);
+
+  parm_type = build_pointer_type (st_parameter[IOPARM_ptype_close].type);
+  iocall[IOCALL_CLOSE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_close")), ".w",
+	void_type_node, 1, parm_type);
+
+  parm_type = build_pointer_type (st_parameter[IOPARM_ptype_inquire].type);
+  iocall[IOCALL_INQUIRE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_inquire")), ".w",
+	void_type_node, 1, parm_type);
+
+  iocall[IOCALL_IOLENGTH] = gfc_build_library_function_decl_with_spec(
+	get_identifier (PREFIX("st_iolength")), ".w",
+	void_type_node, 1, dt_parm_type);
+
+  /* TODO: Change when asynchronous I/O is implemented.  */
+  parm_type = build_pointer_type (st_parameter[IOPARM_ptype_wait].type);
+  iocall[IOCALL_WAIT] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_wait")), ".X",
+	void_type_node, 1, parm_type);
+
+  parm_type = build_pointer_type (st_parameter[IOPARM_ptype_filepos].type);
+  iocall[IOCALL_REWIND] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_rewind")), ".w",
+	void_type_node, 1, parm_type);
+
+  iocall[IOCALL_BACKSPACE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_backspace")), ".w",
+	void_type_node, 1, parm_type);
+
+  iocall[IOCALL_ENDFILE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_endfile")), ".w",
+	void_type_node, 1, parm_type);
+
+  iocall[IOCALL_FLUSH] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_flush")), ".w",
+	void_type_node, 1, parm_type);
+
+  /* Library helpers */
+
+  iocall[IOCALL_READ_DONE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_read_done")), ".w",
+	void_type_node, 1, dt_parm_type);
+
+  iocall[IOCALL_WRITE_DONE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_write_done")), ".w",
+	void_type_node, 1, dt_parm_type);
+
+  iocall[IOCALL_IOLENGTH_DONE] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_iolength_done")), ".w",
+	void_type_node, 1, dt_parm_type);
+
+  iocall[IOCALL_SET_NML_VAL] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_set_nml_var")), ".w.R",
+	void_type_node, 6, dt_parm_type, pvoid_type_node, pvoid_type_node,
+	void_type_node, gfc_charlen_type_node, gfc_int4_type_node);
+
+  iocall[IOCALL_SET_NML_VAL_DIM] = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("st_set_nml_var_dim")), ".w",
+	void_type_node, 5, dt_parm_type, gfc_int4_type_node,
+	gfc_array_index_type, gfc_array_index_type, gfc_array_index_type);
+}
+
+
+/* Generate code to store an integer constant into the
+   st_parameter_XXX structure.  */
+
+static unsigned int
+set_parameter_const (stmtblock_t *block, tree var, enum iofield type,
+		     unsigned int val)
+{
+  tree tmp;
+  gfc_st_parameter_field *p = &st_parameter_field[type];
+
+  if (p->param_type == IOPARM_ptype_common)
+    var = fold_build3_loc (input_location, COMPONENT_REF,
+			   st_parameter[IOPARM_ptype_common].type,
+			   var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+  tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+			 var, p->field, NULL_TREE);
+  gfc_add_modify (block, tmp, build_int_cst (TREE_TYPE (p->field), val));
+  return p->mask;
+}
+
+
+/* Generate code to store a non-string I/O parameter into the
+   st_parameter_XXX structure.  This is a pass by value.  */
+
+static unsigned int
+set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
+		     gfc_expr *e)
+{
+  gfc_se se;
+  tree tmp;
+  gfc_st_parameter_field *p = &st_parameter_field[type];
+  tree dest_type = TREE_TYPE (p->field);
+
+  gfc_init_se (&se, NULL);
+  gfc_conv_expr_val (&se, e);
+
+  /* If we're storing a UNIT number, we need to check it first.  */
+  if (type == IOPARM_common_unit && e->ts.kind > 4)
+    {
+      tree cond, val;
+      int i;
+
+      /* Don't evaluate the UNIT number multiple times.  */
+      se.expr = gfc_evaluate_now (se.expr, &se.pre);
+
+      /* UNIT numbers should be greater than the min.  */
+      i = gfc_validate_kind (BT_INTEGER, 4, false);
+      val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].pedantic_min_int, 4);
+      cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+			      se.expr,
+			      fold_convert (TREE_TYPE (se.expr), val));
+      gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT,
+			       "Unit number in I/O statement too small",
+			       &se.pre);
+    
+      /* UNIT numbers should be less than the max.  */
+      val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4);
+      cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+			      se.expr,
+			      fold_convert (TREE_TYPE (se.expr), val));
+      gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT,
+			       "Unit number in I/O statement too large",
+			       &se.pre);
+
+    }
+
+  se.expr = convert (dest_type, se.expr);
+  gfc_add_block_to_block (block, &se.pre);
+
+  if (p->param_type == IOPARM_ptype_common)
+    var = fold_build3_loc (input_location, COMPONENT_REF,
+			   st_parameter[IOPARM_ptype_common].type,
+			   var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+
+  tmp = fold_build3_loc (input_location, COMPONENT_REF, dest_type, var,
+			 p->field, NULL_TREE);
+  gfc_add_modify (block, tmp, se.expr);
+  return p->mask;
+}
+
+
+/* Generate code to store a non-string I/O parameter into the
+   st_parameter_XXX structure.  This is pass by reference.  */
+
+static unsigned int
+set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock,
+		   tree var, enum iofield type, gfc_expr *e)
+{
+  gfc_se se;
+  tree tmp, addr;
+  gfc_st_parameter_field *p = &st_parameter_field[type];
+
+  gcc_assert (e->ts.type == BT_INTEGER || e->ts.type == BT_LOGICAL);
+  gfc_init_se (&se, NULL);
+  gfc_conv_expr_lhs (&se, e);
+
+  gfc_add_block_to_block (block, &se.pre);
+
+  if (TYPE_MODE (TREE_TYPE (se.expr))
+      == TYPE_MODE (TREE_TYPE (TREE_TYPE (p->field))))
+    {
+      addr = convert (TREE_TYPE (p->field), gfc_build_addr_expr (NULL_TREE, se.expr));
+
+      /* If this is for the iostat variable initialize the
+	 user variable to LIBERROR_OK which is zero.  */
+      if (type == IOPARM_common_iostat)
+	gfc_add_modify (block, se.expr,
+			     build_int_cst (TREE_TYPE (se.expr), LIBERROR_OK));
+    }
+  else
+    {
+      /* The type used by the library has different size
+	from the type of the variable supplied by the user.
+	Need to use a temporary.  */
+      tree tmpvar = gfc_create_var (TREE_TYPE (TREE_TYPE (p->field)),
+				    st_parameter_field[type].name);
+
+      /* If this is for the iostat variable, initialize the
+	 user variable to LIBERROR_OK which is zero.  */
+      if (type == IOPARM_common_iostat)
+	gfc_add_modify (block, tmpvar,
+			     build_int_cst (TREE_TYPE (tmpvar), LIBERROR_OK));
+
+      addr = gfc_build_addr_expr (NULL_TREE, tmpvar);
+	/* After the I/O operation, we set the variable from the temporary.  */
+      tmp = convert (TREE_TYPE (se.expr), tmpvar);
+      gfc_add_modify (postblock, se.expr, tmp);
+     }
+
+  if (p->param_type == IOPARM_ptype_common)
+    var = fold_build3_loc (input_location, COMPONENT_REF,
+			   st_parameter[IOPARM_ptype_common].type,
+			   var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+  tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+			 var, p->field, NULL_TREE);
+  gfc_add_modify (block, tmp, addr);
+  return p->mask;
+}
+
+/* Given an array expr, find its address and length to get a string. If the
+   array is full, the string's address is the address of array's first element
+   and the length is the size of the whole array.  If it is an element, the
+   string's address is the element's address and the length is the rest size of
+   the array.  */
+
+static void
+gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
+{
+  tree size;
+
+  if (e->rank == 0)
+    {
+      tree type, array, tmp;
+      gfc_symbol *sym;
+      int rank;
+
+      /* If it is an element, we need its address and size of the rest.  */
+      gcc_assert (e->expr_type == EXPR_VARIABLE);
+      gcc_assert (e->ref->u.ar.type == AR_ELEMENT);
+      sym = e->symtree->n.sym;
+      rank = sym->as->rank - 1;
+      gfc_conv_expr (se, e);
+
+      array = sym->backend_decl;
+      type = TREE_TYPE (array);
+
+      if (GFC_ARRAY_TYPE_P (type))
+	size = GFC_TYPE_ARRAY_SIZE (type);
+      else
+	{
+	  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+	  size = gfc_conv_array_stride (array, rank);
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type,
+				 gfc_conv_array_ubound (array, rank),
+				 gfc_conv_array_lbound (array, rank));
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, tmp,
+				 gfc_index_one_node);
+	  size = fold_build2_loc (input_location, MULT_EXPR,
+				  gfc_array_index_type, tmp, size);
+	}
+      gcc_assert (size);
+
+      size = fold_build2_loc (input_location, MINUS_EXPR,
+			      gfc_array_index_type, size,
+			      TREE_OPERAND (se->expr, 1));
+      se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
+      tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+      size = fold_build2_loc (input_location, MULT_EXPR,
+			      gfc_array_index_type, size,
+			      fold_convert (gfc_array_index_type, tmp));
+      se->string_length = fold_convert (gfc_charlen_type_node, size);
+      return;
+    }
+
+  gfc_conv_array_parameter (se, e, gfc_walk_expr (e), true, NULL, NULL, &size);
+  se->string_length = fold_convert (gfc_charlen_type_node, size);
+}
+
+
+/* Generate code to store a string and its length into the
+   st_parameter_XXX structure.  */
+
+static unsigned int
+set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
+	    enum iofield type, gfc_expr * e)
+{
+  gfc_se se;
+  tree tmp;
+  tree io;
+  tree len;
+  gfc_st_parameter_field *p = &st_parameter_field[type];
+
+  gfc_init_se (&se, NULL);
+
+  if (p->param_type == IOPARM_ptype_common)
+    var = fold_build3_loc (input_location, COMPONENT_REF,
+			   st_parameter[IOPARM_ptype_common].type,
+			   var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+  io = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+		    var, p->field, NULL_TREE);
+  len = fold_build3_loc (input_location, COMPONENT_REF,
+			 TREE_TYPE (p->field_len),
+			 var, p->field_len, NULL_TREE);
+
+  /* Integer variable assigned a format label.  */
+  if (e->ts.type == BT_INTEGER
+      && e->rank == 0
+      && e->symtree->n.sym->attr.assign == 1)
+    {
+      char * msg;
+      tree cond;
+
+      gfc_conv_label_variable (&se, e);
+      tmp = GFC_DECL_STRING_LEN (se.expr);
+      cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+			      tmp, build_int_cst (TREE_TYPE (tmp), 0));
+
+      asprintf(&msg, "Label assigned to variable '%s' (%%ld) is not a format "
+	       "label", e->symtree->name);
+      gfc_trans_runtime_check (true, false, cond, &se.pre, &e->where, msg,
+			       fold_convert (long_integer_type_node, tmp));
+      gfc_free (msg);
+
+      gfc_add_modify (&se.pre, io,
+		 fold_convert (TREE_TYPE (io), GFC_DECL_ASSIGN_ADDR (se.expr)));
+      gfc_add_modify (&se.pre, len, GFC_DECL_STRING_LEN (se.expr));
+    }
+  else
+    {
+      /* General character.  */
+      if (e->ts.type == BT_CHARACTER && e->rank == 0)
+	gfc_conv_expr (&se, e);
+      /* Array assigned Hollerith constant or character array.  */
+      else if (e->rank > 0 || (e->symtree && e->symtree->n.sym->as->rank > 0))
+	gfc_convert_array_to_string (&se, e);
+      else
+	gcc_unreachable ();
+
+      gfc_conv_string_parameter (&se);
+      gfc_add_modify (&se.pre, io, fold_convert (TREE_TYPE (io), se.expr));
+      gfc_add_modify (&se.pre, len, se.string_length);
+    }
+
+  gfc_add_block_to_block (block, &se.pre);
+  gfc_add_block_to_block (postblock, &se.post);
+  return p->mask;
+}
+
+
+/* Generate code to store the character (array) and the character length
+   for an internal unit.  */
+
+static unsigned int
+set_internal_unit (stmtblock_t * block, stmtblock_t * post_block,
+		   tree var, gfc_expr * e)
+{
+  gfc_se se;
+  tree io;
+  tree len;
+  tree desc;
+  tree tmp;
+  gfc_st_parameter_field *p;
+  unsigned int mask;
+
+  gfc_init_se (&se, NULL);
+
+  p = &st_parameter_field[IOPARM_dt_internal_unit];
+  mask = p->mask;
+  io = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+			var, p->field, NULL_TREE);
+  len = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field_len),
+			 var, p->field_len,	NULL_TREE);
+  p = &st_parameter_field[IOPARM_dt_internal_unit_desc];
+  desc = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+			  var, p->field, NULL_TREE);
+
+  gcc_assert (e->ts.type == BT_CHARACTER);
+
+  /* Character scalars.  */
+  if (e->rank == 0)
+    {
+      gfc_conv_expr (&se, e);
+      gfc_conv_string_parameter (&se);
+      tmp = se.expr;
+      se.expr = build_int_cst (pchar_type_node, 0);
+    }
+
+  /* Character array.  */
+  else if (e->rank > 0)
+    {
+      se.ss = gfc_walk_expr (e);
+
+      if (is_subref_array (e))
+	{
+	  /* Use a temporary for components of arrays of derived types
+	     or substring array references.  */
+	  gfc_conv_subref_array_arg (&se, e, 0,
+		last_dt == READ ? INTENT_IN : INTENT_OUT, false);
+	  tmp = build_fold_indirect_ref_loc (input_location,
+					 se.expr);
+	  se.expr = gfc_build_addr_expr (pchar_type_node, tmp);
+	  tmp = gfc_conv_descriptor_data_get (tmp);
+	}
+      else
+	{
+	  /* Return the data pointer and rank from the descriptor.  */
+	  gfc_conv_expr_descriptor (&se, e, se.ss);
+	  tmp = gfc_conv_descriptor_data_get (se.expr);
+	  se.expr = gfc_build_addr_expr (pchar_type_node, se.expr);
+	}
+    }
+  else
+    gcc_unreachable ();
+
+  /* The cast is needed for character substrings and the descriptor
+     data.  */
+  gfc_add_modify (&se.pre, io, fold_convert (TREE_TYPE (io), tmp));
+  gfc_add_modify (&se.pre, len,
+		       fold_convert (TREE_TYPE (len), se.string_length));
+  gfc_add_modify (&se.pre, desc, se.expr);
+
+  gfc_add_block_to_block (block, &se.pre);
+  gfc_add_block_to_block (post_block, &se.post);
+  return mask;
+}
+
+/* Add a case to a IO-result switch.  */
+
+static void
+add_case (int label_value, gfc_st_label * label, stmtblock_t * body)
+{
+  tree tmp, value;
+
+  if (label == NULL)
+    return;			/* No label, no case */
+
+  value = build_int_cst (NULL_TREE, label_value);
+
+  /* Make a backend label for this case.  */
+  tmp = gfc_build_label_decl (NULL_TREE);
+
+  /* And the case itself.  */
+  tmp = build3_v (CASE_LABEL_EXPR, value, NULL_TREE, tmp);
+  gfc_add_expr_to_block (body, tmp);
+
+  /* Jump to the label.  */
+  tmp = build1_v (GOTO_EXPR, gfc_get_label_decl (label));
+  gfc_add_expr_to_block (body, tmp);
+}
+
+
+/* Generate a switch statement that branches to the correct I/O
+   result label.  The last statement of an I/O call stores the
+   result into a variable because there is often cleanup that
+   must be done before the switch, so a temporary would have to
+   be created anyway.  */
+
+static void
+io_result (stmtblock_t * block, tree var, gfc_st_label * err_label,
+	   gfc_st_label * end_label, gfc_st_label * eor_label)
+{
+  stmtblock_t body;
+  tree tmp, rc;
+  gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_flags];
+
+  /* If no labels are specified, ignore the result instead
+     of building an empty switch.  */
+  if (err_label == NULL
+      && end_label == NULL
+      && eor_label == NULL)
+    return;
+
+  /* Build a switch statement.  */
+  gfc_start_block (&body);
+
+  /* The label values here must be the same as the values
+     in the library_return enum in the runtime library */
+  add_case (1, err_label, &body);
+  add_case (2, end_label, &body);
+  add_case (3, eor_label, &body);
+
+  tmp = gfc_finish_block (&body);
+
+  var = fold_build3_loc (input_location, COMPONENT_REF,
+			 st_parameter[IOPARM_ptype_common].type,
+			 var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+  rc = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (p->field),
+			var, p->field, NULL_TREE);
+  rc = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (rc),
+			rc, build_int_cst (TREE_TYPE (rc),
+					   IOPARM_common_libreturn_mask));
+
+  tmp = build3_v (SWITCH_EXPR, rc, tmp, NULL_TREE);
+
+  gfc_add_expr_to_block (block, tmp);
+}
+
+
+/* Store the current file and line number to variables so that if a
+   library call goes awry, we can tell the user where the problem is.  */
+
+static void
+set_error_locus (stmtblock_t * block, tree var, locus * where)
+{
+  gfc_file *f;
+  tree str, locus_file;
+  int line;
+  gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_filename];
+
+  locus_file = fold_build3_loc (input_location, COMPONENT_REF,
+				st_parameter[IOPARM_ptype_common].type,
+				var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+  locus_file = fold_build3_loc (input_location, COMPONENT_REF,
+				TREE_TYPE (p->field), locus_file,
+				p->field, NULL_TREE);
+  f = where->lb->file;
+  str = gfc_build_cstring_const (f->filename);
+
+  str = gfc_build_addr_expr (pchar_type_node, str);
+  gfc_add_modify (block, locus_file, str);
+
+  line = LOCATION_LINE (where->lb->location);
+  set_parameter_const (block, var, IOPARM_common_line, line);
+}
+
+
+/* Translate an OPEN statement.  */
+
+tree
+gfc_trans_open (gfc_code * code)
+{
+  stmtblock_t block, post_block;
+  gfc_open *p;
+  tree tmp, var;
+  unsigned int mask = 0;
+
+  gfc_start_block (&block);
+  gfc_init_block (&post_block);
+
+  var = gfc_create_var (st_parameter[IOPARM_ptype_open].type, "open_parm");
+
+  set_error_locus (&block, var, &code->loc);
+  p = code->ext.open;
+
+  if (p->iomsg)
+    mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg,
+			p->iomsg);
+
+  if (p->iostat)
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat,
+			       p->iostat);
+
+  if (p->err)
+    mask |= IOPARM_common_err;
+
+  if (p->file)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_file, p->file);
+
+  if (p->status)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_status,
+			p->status);
+
+  if (p->access)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_access,
+			p->access);
+
+  if (p->form)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_form, p->form);
+
+  if (p->recl)
+    mask |= set_parameter_value (&block, var, IOPARM_open_recl_in, p->recl);
+
+  if (p->blank)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_blank,
+			p->blank);
+
+  if (p->position)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_position,
+			p->position);
+
+  if (p->action)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_action,
+			p->action);
+
+  if (p->delim)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_delim,
+			p->delim);
+
+  if (p->pad)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_pad, p->pad);
+
+  if (p->decimal)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_decimal,
+			p->decimal);
+
+  if (p->encoding)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_encoding,
+			p->encoding);
+
+  if (p->round)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_round, p->round);
+
+  if (p->sign)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_sign, p->sign);
+
+  if (p->asynchronous)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_asynchronous,
+			p->asynchronous);
+
+  if (p->convert)
+    mask |= set_string (&block, &post_block, var, IOPARM_open_convert,
+			p->convert);
+			
+  if (p->newunit)
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_open_newunit,
+			       p->newunit);
+
+  set_parameter_const (&block, var, IOPARM_common_flags, mask);
+
+  if (p->unit)
+    set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+  else
+    set_parameter_const (&block, var, IOPARM_common_unit, 0);
+
+  tmp = gfc_build_addr_expr (NULL_TREE, var);
+  tmp = build_call_expr_loc (input_location,
+			 iocall[IOCALL_OPEN], 1, tmp);
+  gfc_add_expr_to_block (&block, tmp);
+
+  gfc_add_block_to_block (&block, &post_block);
+
+  io_result (&block, var, p->err, NULL, NULL);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Translate a CLOSE statement.  */
+
+tree
+gfc_trans_close (gfc_code * code)
+{
+  stmtblock_t block, post_block;
+  gfc_close *p;
+  tree tmp, var;
+  unsigned int mask = 0;
+
+  gfc_start_block (&block);
+  gfc_init_block (&post_block);
+
+  var = gfc_create_var (st_parameter[IOPARM_ptype_close].type, "close_parm");
+
+  set_error_locus (&block, var, &code->loc);
+  p = code->ext.close;
+
+  if (p->iomsg)
+    mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg,
+			p->iomsg);
+
+  if (p->iostat)
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat,
+			       p->iostat);
+
+  if (p->err)
+    mask |= IOPARM_common_err;
+
+  if (p->status)
+    mask |= set_string (&block, &post_block, var, IOPARM_close_status,
+			p->status);
+
+  set_parameter_const (&block, var, IOPARM_common_flags, mask);
+
+  if (p->unit)
+    set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+  else
+    set_parameter_const (&block, var, IOPARM_common_unit, 0);
+
+  tmp = gfc_build_addr_expr (NULL_TREE, var);
+  tmp = build_call_expr_loc (input_location,
+			 iocall[IOCALL_CLOSE], 1, tmp);
+  gfc_add_expr_to_block (&block, tmp);
+
+  gfc_add_block_to_block (&block, &post_block);
+
+  io_result (&block, var, p->err, NULL, NULL);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Common subroutine for building a file positioning statement.  */
+
+static tree
+build_filepos (tree function, gfc_code * code)
+{
+  stmtblock_t block, post_block;
+  gfc_filepos *p;
+  tree tmp, var;
+  unsigned int mask = 0;
+
+  p = code->ext.filepos;
+
+  gfc_start_block (&block);
+  gfc_init_block (&post_block);
+
+  var = gfc_create_var (st_parameter[IOPARM_ptype_filepos].type,
+			"filepos_parm");
+
+  set_error_locus (&block, var, &code->loc);
+
+  if (p->iomsg)
+    mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg,
+			p->iomsg);
+
+  if (p->iostat)
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat,
+			       p->iostat);
+
+  if (p->err)
+    mask |= IOPARM_common_err;
+
+  set_parameter_const (&block, var, IOPARM_common_flags, mask);
+
+  if (p->unit)
+    set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+  else
+    set_parameter_const (&block, var, IOPARM_common_unit, 0);
+
+  tmp = gfc_build_addr_expr (NULL_TREE, var);
+  tmp = build_call_expr_loc (input_location,
+			 function, 1, tmp);
+  gfc_add_expr_to_block (&block, tmp);
+
+  gfc_add_block_to_block (&block, &post_block);
+
+  io_result (&block, var, p->err, NULL, NULL);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Translate a BACKSPACE statement.  */
+
+tree
+gfc_trans_backspace (gfc_code * code)
+{
+  return build_filepos (iocall[IOCALL_BACKSPACE], code);
+}
+
+
+/* Translate an ENDFILE statement.  */
+
+tree
+gfc_trans_endfile (gfc_code * code)
+{
+  return build_filepos (iocall[IOCALL_ENDFILE], code);
+}
+
+
+/* Translate a REWIND statement.  */
+
+tree
+gfc_trans_rewind (gfc_code * code)
+{
+  return build_filepos (iocall[IOCALL_REWIND], code);
+}
+
+
+/* Translate a FLUSH statement.  */
+
+tree
+gfc_trans_flush (gfc_code * code)
+{
+  return build_filepos (iocall[IOCALL_FLUSH], code);
+}
+
+
+/* Create a dummy iostat variable to catch any error due to bad unit.  */
+
+static gfc_expr *
+create_dummy_iostat (void)
+{
+  gfc_symtree *st;
+  gfc_expr *e;
+
+  gfc_get_ha_sym_tree ("@iostat", &st);
+  st->n.sym->ts.type = BT_INTEGER;
+  st->n.sym->ts.kind = gfc_default_integer_kind;
+  gfc_set_sym_referenced (st->n.sym);
+  gfc_commit_symbol (st->n.sym);
+  st->n.sym->backend_decl
+	= gfc_create_var (gfc_get_int_type (st->n.sym->ts.kind),
+			  st->n.sym->name);
+
+  e = gfc_get_expr ();
+  e->expr_type = EXPR_VARIABLE;
+  e->symtree = st;
+  e->ts.type = BT_INTEGER;
+  e->ts.kind = st->n.sym->ts.kind;
+
+  return e;
+}
+
+
+/* Translate the non-IOLENGTH form of an INQUIRE statement.  */
+
+tree
+gfc_trans_inquire (gfc_code * code)
+{
+  stmtblock_t block, post_block;
+  gfc_inquire *p;
+  tree tmp, var;
+  unsigned int mask = 0, mask2 = 0;
+
+  gfc_start_block (&block);
+  gfc_init_block (&post_block);
+
+  var = gfc_create_var (st_parameter[IOPARM_ptype_inquire].type,
+			"inquire_parm");
+
+  set_error_locus (&block, var, &code->loc);
+  p = code->ext.inquire;
+
+  if (p->iomsg)
+    mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg,
+			p->iomsg);
+
+  if (p->iostat)
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat,
+			       p->iostat);
+
+  if (p->err)
+    mask |= IOPARM_common_err;
+
+  /* Sanity check.  */
+  if (p->unit && p->file)
+    gfc_error ("INQUIRE statement at %L cannot contain both FILE and UNIT specifiers", &code->loc);
+
+  if (p->file)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_file,
+			p->file);
+
+  if (p->exist)
+    {
+      mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_exist,
+				 p->exist);
+    
+      if (p->unit && !p->iostat)
+	{
+	  p->iostat = create_dummy_iostat ();
+	  mask |= set_parameter_ref (&block, &post_block, var,
+				     IOPARM_common_iostat, p->iostat);
+	}
+    }
+
+  if (p->opened)
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_opened,
+			       p->opened);
+
+  if (p->number)
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_number,
+			       p->number);
+
+  if (p->named)
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_named,
+			       p->named);
+
+  if (p->name)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_name,
+			p->name);
+
+  if (p->access)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_access,
+			p->access);
+
+  if (p->sequential)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_sequential,
+			p->sequential);
+
+  if (p->direct)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_direct,
+			p->direct);
+
+  if (p->form)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_form,
+			p->form);
+
+  if (p->formatted)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_formatted,
+			p->formatted);
+
+  if (p->unformatted)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_unformatted,
+			p->unformatted);
+
+  if (p->recl)
+    mask |= set_parameter_ref (&block, &post_block, var,
+			       IOPARM_inquire_recl_out, p->recl);
+
+  if (p->nextrec)
+    mask |= set_parameter_ref (&block, &post_block, var,
+			       IOPARM_inquire_nextrec, p->nextrec);
+
+  if (p->blank)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_blank,
+			p->blank);
+
+  if (p->delim)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_delim,
+			p->delim);
+
+  if (p->position)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_position,
+			p->position);
+
+  if (p->action)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_action,
+			p->action);
+
+  if (p->read)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_read,
+			p->read);
+
+  if (p->write)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_write,
+			p->write);
+
+  if (p->readwrite)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_readwrite,
+			p->readwrite);
+
+  if (p->pad)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_pad,
+			p->pad);
+  
+  if (p->convert)
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_convert,
+			p->convert);
+
+  if (p->strm_pos)
+    mask |= set_parameter_ref (&block, &post_block, var,
+			       IOPARM_inquire_strm_pos_out, p->strm_pos);
+
+  /* The second series of flags.  */
+  if (p->asynchronous)
+    mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_asynchronous,
+			 p->asynchronous);
+
+  if (p->decimal)
+    mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_decimal,
+			 p->decimal);
+
+  if (p->encoding)
+    mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_encoding,
+			 p->encoding);
+
+  if (p->round)
+    mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_round,
+			 p->round);
+
+  if (p->sign)
+    mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_sign,
+			 p->sign);
+
+  if (p->pending)
+    mask2 |= set_parameter_ref (&block, &post_block, var,
+				IOPARM_inquire_pending, p->pending);
+
+  if (p->size)
+    mask2 |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_size,
+				p->size);
+
+  if (p->id)
+    mask2 |= set_parameter_ref (&block, &post_block,var, IOPARM_inquire_id,
+				p->id);
+
+  if (mask2)
+    mask |= set_parameter_const (&block, var, IOPARM_inquire_flags2, mask2);
+
+  set_parameter_const (&block, var, IOPARM_common_flags, mask);
+
+  if (p->unit)
+    set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+  else
+    set_parameter_const (&block, var, IOPARM_common_unit, 0);
+
+  tmp = gfc_build_addr_expr (NULL_TREE, var);
+  tmp = build_call_expr_loc (input_location,
+			 iocall[IOCALL_INQUIRE], 1, tmp);
+  gfc_add_expr_to_block (&block, tmp);
+
+  gfc_add_block_to_block (&block, &post_block);
+
+  io_result (&block, var, p->err, NULL, NULL);
+
+  return gfc_finish_block (&block);
+}
+
+
+tree
+gfc_trans_wait (gfc_code * code)
+{
+  stmtblock_t block, post_block;
+  gfc_wait *p;
+  tree tmp, var;
+  unsigned int mask = 0;
+
+  gfc_start_block (&block);
+  gfc_init_block (&post_block);
+
+  var = gfc_create_var (st_parameter[IOPARM_ptype_wait].type,
+			"wait_parm");
+
+  set_error_locus (&block, var, &code->loc);
+  p = code->ext.wait;
+
+  /* Set parameters here.  */
+  if (p->iomsg)
+    mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg,
+			p->iomsg);
+
+  if (p->iostat)
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat,
+			       p->iostat);
+
+  if (p->err)
+    mask |= IOPARM_common_err;
+
+  if (p->id)
+    mask |= set_parameter_value (&block, var, IOPARM_wait_id, p->id);
+
+  set_parameter_const (&block, var, IOPARM_common_flags, mask);
+
+  if (p->unit)
+    set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+
+  tmp = gfc_build_addr_expr (NULL_TREE, var);
+  tmp = build_call_expr_loc (input_location,
+			 iocall[IOCALL_WAIT], 1, tmp);
+  gfc_add_expr_to_block (&block, tmp);
+
+  gfc_add_block_to_block (&block, &post_block);
+
+  io_result (&block, var, p->err, NULL, NULL);
+
+  return gfc_finish_block (&block);
+
+}
+
+
+/* nml_full_name builds up the fully qualified name of a
+   derived type component.  */
+
+static char*
+nml_full_name (const char* var_name, const char* cmp_name)
+{
+  int full_name_length;
+  char * full_name;
+
+  full_name_length = strlen (var_name) + strlen (cmp_name) + 1;
+  full_name = (char*)gfc_getmem (full_name_length + 1);
+  strcpy (full_name, var_name);
+  full_name = strcat (full_name, "%");
+  full_name = strcat (full_name, cmp_name);
+  return full_name;
+}
+
+
+/* nml_get_addr_expr builds an address expression from the
+   gfc_symbol or gfc_component backend_decl's. An offset is
+   provided so that the address of an element of an array of
+   derived types is returned. This is used in the runtime to
+   determine that span of the derived type.  */
+
+static tree
+nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
+		   tree base_addr)
+{
+  tree decl = NULL_TREE;
+  tree tmp;
+
+  if (sym)
+    {
+      sym->attr.referenced = 1;
+      decl = gfc_get_symbol_decl (sym);
+
+      /* If this is the enclosing function declaration, use
+	 the fake result instead.  */
+      if (decl == current_function_decl)
+	decl = gfc_get_fake_result_decl (sym, 0);
+      else if (decl == DECL_CONTEXT (current_function_decl))
+	decl =  gfc_get_fake_result_decl (sym, 1);
+    }
+  else
+    decl = c->backend_decl;
+
+  gcc_assert (decl && ((TREE_CODE (decl) == FIELD_DECL
+		     || TREE_CODE (decl) == VAR_DECL
+		     || TREE_CODE (decl) == PARM_DECL)
+		     || TREE_CODE (decl) == COMPONENT_REF));
+
+  tmp = decl;
+
+  /* Build indirect reference, if dummy argument.  */
+
+  if (POINTER_TYPE_P (TREE_TYPE(tmp)))
+    tmp = build_fold_indirect_ref_loc (input_location, tmp);
+
+  /* Treat the component of a derived type, using base_addr for
+     the derived type.  */
+
+  if (TREE_CODE (decl) == FIELD_DECL)
+    tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (tmp),
+			   base_addr, tmp, NULL_TREE);
+
+  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+    tmp = gfc_conv_array_data (tmp);
+  else
+    {
+      if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+	tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+
+      if (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
+         tmp = gfc_build_array_ref (tmp, gfc_index_zero_node, NULL);
+
+      if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
+	tmp = build_fold_indirect_ref_loc (input_location,
+				   tmp);
+    }
+
+  gcc_assert (tmp && POINTER_TYPE_P (TREE_TYPE (tmp)));
+
+  return tmp;
+}
+
+
+/* For an object VAR_NAME whose base address is BASE_ADDR, generate a
+   call to iocall[IOCALL_SET_NML_VAL].  For derived type variable, recursively
+   generate calls to iocall[IOCALL_SET_NML_VAL] for each component.  */
+
+#define IARG(i) build_int_cst (gfc_array_index_type, i)
+
+static void
+transfer_namelist_element (stmtblock_t * block, const char * var_name,
+			   gfc_symbol * sym, gfc_component * c,
+			   tree base_addr)
+{
+  gfc_typespec * ts = NULL;
+  gfc_array_spec * as = NULL;
+  tree addr_expr = NULL;
+  tree dt = NULL;
+  tree string;
+  tree tmp;
+  tree dtype;
+  tree dt_parm_addr;
+  tree decl = NULL_TREE;
+  int n_dim; 
+  int itype;
+  int rank = 0;
+
+  gcc_assert (sym || c);
+
+  /* Build the namelist object name.  */
+
+  string = gfc_build_cstring_const (var_name);
+  string = gfc_build_addr_expr (pchar_type_node, string);
+
+  /* Build ts, as and data address using symbol or component.  */
+
+  ts = (sym) ? &sym->ts : &c->ts;
+  as = (sym) ? sym->as : c->as;
+
+  addr_expr = nml_get_addr_expr (sym, c, base_addr);
+
+  if (as)
+    rank = as->rank;
+
+  if (rank)
+    {
+      decl = (sym) ? sym->backend_decl : c->backend_decl;
+      if (sym && sym->attr.dummy)
+        decl = build_fold_indirect_ref_loc (input_location, decl);
+      dt =  TREE_TYPE (decl);
+      dtype = gfc_get_dtype (dt);
+    }
+  else
+    {
+      itype = ts->type;
+      dtype = IARG (itype << GFC_DTYPE_TYPE_SHIFT);
+    }
+
+  /* Build up the arguments for the transfer call.
+     The call for the scalar part transfers:
+     (address, name, type, kind or string_length, dtype)  */
+
+  dt_parm_addr = gfc_build_addr_expr (NULL_TREE, dt_parm);
+
+  if (ts->type == BT_CHARACTER)
+    tmp = ts->u.cl->backend_decl;
+  else
+    tmp = build_int_cst (gfc_charlen_type_node, 0);
+  tmp = build_call_expr_loc (input_location,
+			 iocall[IOCALL_SET_NML_VAL], 6,
+			 dt_parm_addr, addr_expr, string,
+			 IARG (ts->kind), tmp, dtype);
+  gfc_add_expr_to_block (block, tmp);
+
+  /* If the object is an array, transfer rank times:
+     (null pointer, name, stride, lbound, ubound)  */
+
+  for ( n_dim = 0 ; n_dim < rank ; n_dim++ )
+    {
+      tmp = build_call_expr_loc (input_location,
+			     iocall[IOCALL_SET_NML_VAL_DIM], 5,
+			     dt_parm_addr,
+			     IARG (n_dim),
+			     gfc_conv_array_stride (decl, n_dim),
+			     gfc_conv_array_lbound (decl, n_dim),
+			     gfc_conv_array_ubound (decl, n_dim));
+      gfc_add_expr_to_block (block, tmp);
+    }
+
+  if (ts->type == BT_DERIVED)
+    {
+      gfc_component *cmp;
+
+      /* Provide the RECORD_TYPE to build component references.  */
+
+      tree expr = build_fold_indirect_ref_loc (input_location,
+					   addr_expr);
+
+      for (cmp = ts->u.derived->components; cmp; cmp = cmp->next)
+	{
+	  char *full_name = nml_full_name (var_name, cmp->name);
+	  transfer_namelist_element (block,
+				     full_name,
+				     NULL, cmp, expr);
+	  gfc_free (full_name);
+	}
+    }
+}
+
+#undef IARG
+
+/* Create a data transfer statement.  Not all of the fields are valid
+   for both reading and writing, but improper use has been filtered
+   out by now.  */
+
+static tree
+build_dt (tree function, gfc_code * code)
+{
+  stmtblock_t block, post_block, post_end_block, post_iu_block;
+  gfc_dt *dt;
+  tree tmp, var;
+  gfc_expr *nmlname;
+  gfc_namelist *nml;
+  unsigned int mask = 0;
+
+  gfc_start_block (&block);
+  gfc_init_block (&post_block);
+  gfc_init_block (&post_end_block);
+  gfc_init_block (&post_iu_block);
+
+  var = gfc_create_var (st_parameter[IOPARM_ptype_dt].type, "dt_parm");
+
+  set_error_locus (&block, var, &code->loc);
+
+  if (last_dt == IOLENGTH)
+    {
+      gfc_inquire *inq;
+
+      inq = code->ext.inquire;
+
+      /* First check that preconditions are met.  */
+      gcc_assert (inq != NULL);
+      gcc_assert (inq->iolength != NULL);
+
+      /* Connect to the iolength variable.  */
+      mask |= set_parameter_ref (&block, &post_end_block, var,
+				 IOPARM_dt_iolength, inq->iolength);
+      dt = NULL;
+    }
+  else
+    {
+      dt = code->ext.dt;
+      gcc_assert (dt != NULL);
+    }
+
+  if (dt && dt->io_unit)
+    {
+      if (dt->io_unit->ts.type == BT_CHARACTER)
+	{
+	  mask |= set_internal_unit (&block, &post_iu_block,
+				     var, dt->io_unit);
+	  set_parameter_const (&block, var, IOPARM_common_unit,
+			       dt->io_unit->ts.kind == 1 ? 0 : -1);
+	}
+    }
+  else
+    set_parameter_const (&block, var, IOPARM_common_unit, 0);
+
+  if (dt)
+    {
+      if (dt->iomsg)
+	mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg,
+			    dt->iomsg);
+
+      if (dt->iostat)
+	mask |= set_parameter_ref (&block, &post_end_block, var,
+				   IOPARM_common_iostat, dt->iostat);
+
+      if (dt->err)
+	mask |= IOPARM_common_err;
+
+      if (dt->eor)
+	mask |= IOPARM_common_eor;
+
+      if (dt->end)
+	mask |= IOPARM_common_end;
+
+      if (dt->id)
+	mask |= set_parameter_ref (&block, &post_end_block, var,
+				   IOPARM_dt_id, dt->id);
+
+      if (dt->pos)
+	mask |= set_parameter_value (&block, var, IOPARM_dt_pos, dt->pos);
+
+      if (dt->asynchronous)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_asynchronous,
+			    dt->asynchronous);
+
+      if (dt->blank)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_blank,
+			    dt->blank);
+
+      if (dt->decimal)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_decimal,
+			    dt->decimal);
+
+      if (dt->delim)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_delim,
+			    dt->delim);
+
+      if (dt->pad)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_pad,
+			    dt->pad);
+
+      if (dt->round)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_round,
+			    dt->round);
+
+      if (dt->sign)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_sign,
+			    dt->sign);
+
+      if (dt->rec)
+	mask |= set_parameter_value (&block, var, IOPARM_dt_rec, dt->rec);
+
+      if (dt->advance)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_advance,
+			    dt->advance);
+
+      if (dt->format_expr)
+	mask |= set_string (&block, &post_end_block, var, IOPARM_dt_format,
+			    dt->format_expr);
+
+      if (dt->format_label)
+	{
+	  if (dt->format_label == &format_asterisk)
+	    mask |= IOPARM_dt_list_format;
+	  else
+	    mask |= set_string (&block, &post_block, var, IOPARM_dt_format,
+				dt->format_label->format);
+	}
+
+      if (dt->size)
+	mask |= set_parameter_ref (&block, &post_end_block, var,
+				   IOPARM_dt_size, dt->size);
+
+      if (dt->namelist)
+	{
+	  if (dt->format_expr || dt->format_label)
+	    gfc_internal_error ("build_dt: format with namelist");
+
+          nmlname = gfc_get_character_expr (gfc_default_character_kind, NULL,
+					    dt->namelist->name,
+					    strlen (dt->namelist->name));
+
+	  mask |= set_string (&block, &post_block, var, IOPARM_dt_namelist_name,
+			      nmlname);
+
+	  if (last_dt == READ)
+	    mask |= IOPARM_dt_namelist_read_mode;
+
+	  set_parameter_const (&block, var, IOPARM_common_flags, mask);
+
+	  dt_parm = var;
+
+	  for (nml = dt->namelist->namelist; nml; nml = nml->next)
+	    transfer_namelist_element (&block, nml->sym->name, nml->sym,
+				       NULL, NULL_TREE);
+	}
+      else
+	set_parameter_const (&block, var, IOPARM_common_flags, mask);
+
+      if (dt->io_unit && dt->io_unit->ts.type == BT_INTEGER)
+	set_parameter_value (&block, var, IOPARM_common_unit, dt->io_unit);
+    }
+  else
+    set_parameter_const (&block, var, IOPARM_common_flags, mask);
+
+  tmp = gfc_build_addr_expr (NULL_TREE, var);
+  tmp = build_call_expr_loc (UNKNOWN_LOCATION,
+			 function, 1, tmp);
+  gfc_add_expr_to_block (&block, tmp);
+
+  gfc_add_block_to_block (&block, &post_block);
+
+  dt_parm = var;
+  dt_post_end_block = &post_end_block;
+
+  /* Set implied do loop exit condition.  */
+  if (last_dt == READ || last_dt == WRITE)
+    {
+      gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_flags];
+
+      tmp = fold_build3_loc (input_location, COMPONENT_REF,
+			     st_parameter[IOPARM_ptype_common].type,
+			     dt_parm, TYPE_FIELDS (TREE_TYPE (dt_parm)),
+			     NULL_TREE);
+      tmp = fold_build3_loc (input_location, COMPONENT_REF,
+			     TREE_TYPE (p->field), tmp, p->field, NULL_TREE);
+      tmp = fold_build2_loc (input_location, BIT_AND_EXPR, TREE_TYPE (tmp),
+			     tmp, build_int_cst (TREE_TYPE (tmp),
+			     IOPARM_common_libreturn_mask));
+    }
+  else /* IOLENGTH */
+    tmp = NULL_TREE;
+
+  gfc_add_expr_to_block (&block, gfc_trans_code_cond (code->block->next, tmp));
+
+  gfc_add_block_to_block (&block, &post_iu_block);
+
+  dt_parm = NULL;
+  dt_post_end_block = NULL;
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Translate the IOLENGTH form of an INQUIRE statement.  We treat
+   this as a third sort of data transfer statement, except that
+   lengths are summed instead of actually transferring any data.  */
+
+tree
+gfc_trans_iolength (gfc_code * code)
+{
+  last_dt = IOLENGTH;
+  return build_dt (iocall[IOCALL_IOLENGTH], code);
+}
+
+
+/* Translate a READ statement.  */
+
+tree
+gfc_trans_read (gfc_code * code)
+{
+  last_dt = READ;
+  return build_dt (iocall[IOCALL_READ], code);
+}
+
+
+/* Translate a WRITE statement */
+
+tree
+gfc_trans_write (gfc_code * code)
+{
+  last_dt = WRITE;
+  return build_dt (iocall[IOCALL_WRITE], code);
+}
+
+
+/* Finish a data transfer statement.  */
+
+tree
+gfc_trans_dt_end (gfc_code * code)
+{
+  tree function, tmp;
+  stmtblock_t block;
+
+  gfc_init_block (&block);
+
+  switch (last_dt)
+    {
+    case READ:
+      function = iocall[IOCALL_READ_DONE];
+      break;
+
+    case WRITE:
+      function = iocall[IOCALL_WRITE_DONE];
+      break;
+
+    case IOLENGTH:
+      function = iocall[IOCALL_IOLENGTH_DONE];
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+
+  tmp = gfc_build_addr_expr (NULL_TREE, dt_parm);
+  tmp = build_call_expr_loc (input_location,
+			 function, 1, tmp);
+  gfc_add_expr_to_block (&block, tmp);
+  gfc_add_block_to_block (&block, dt_post_end_block);
+  gfc_init_block (dt_post_end_block);
+
+  if (last_dt != IOLENGTH)
+    {
+      gcc_assert (code->ext.dt != NULL);
+      io_result (&block, dt_parm, code->ext.dt->err,
+		 code->ext.dt->end, code->ext.dt->eor);
+    }
+
+  return gfc_finish_block (&block);
+}
+
+static void
+transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code);
+
+/* Given an array field in a derived type variable, generate the code
+   for the loop that iterates over array elements, and the code that
+   accesses those array elements.  Use transfer_expr to generate code
+   for transferring that element.  Because elements may also be
+   derived types, transfer_expr and transfer_array_component are mutually
+   recursive.  */
+
+static tree
+transfer_array_component (tree expr, gfc_component * cm, locus * where)
+{
+  tree tmp;
+  stmtblock_t body;
+  stmtblock_t block;
+  gfc_loopinfo loop;
+  int n;
+  gfc_ss *ss;
+  gfc_se se;
+
+  gfc_start_block (&block);
+  gfc_init_se (&se, NULL);
+
+  /* Create and initialize Scalarization Status.  Unlike in
+     gfc_trans_transfer, we can't simply use gfc_walk_expr to take
+     care of this task, because we don't have a gfc_expr at hand.
+     Build one manually, as in gfc_trans_subarray_assign.  */
+
+  ss = gfc_get_ss ();
+  ss->type = GFC_SS_COMPONENT;
+  ss->expr = NULL;
+  ss->shape = gfc_get_shape (cm->as->rank);
+  ss->next = gfc_ss_terminator;
+  ss->data.info.dimen = cm->as->rank;
+  ss->data.info.descriptor = expr;
+  ss->data.info.data = gfc_conv_array_data (expr);
+  ss->data.info.offset = gfc_conv_array_offset (expr);
+  for (n = 0; n < cm->as->rank; n++)
+    {
+      ss->data.info.dim[n] = n;
+      ss->data.info.start[n] = gfc_conv_array_lbound (expr, n);
+      ss->data.info.stride[n] = gfc_index_one_node;
+
+      mpz_init (ss->shape[n]);
+      mpz_sub (ss->shape[n], cm->as->upper[n]->value.integer,
+               cm->as->lower[n]->value.integer);
+      mpz_add_ui (ss->shape[n], ss->shape[n], 1);
+    }
+
+  /* Once we got ss, we use scalarizer to create the loop.  */
+
+  gfc_init_loopinfo (&loop);
+  gfc_add_ss_to_loop (&loop, ss);
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop, where);
+  gfc_mark_ss_chain_used (ss, 1);
+  gfc_start_scalarized_body (&loop, &body);
+
+  gfc_copy_loopinfo_to_se (&se, &loop);
+  se.ss = ss;
+
+  /* gfc_conv_tmp_array_ref assumes that se.expr contains the array.  */
+  se.expr = expr;
+  gfc_conv_tmp_array_ref (&se);
+
+  /* Now se.expr contains an element of the array.  Take the address and pass
+     it to the IO routines.  */
+  tmp = gfc_build_addr_expr (NULL_TREE, se.expr);
+  transfer_expr (&se, &cm->ts, tmp, NULL);
+
+  /* We are done now with the loop body.  Wrap up the scalarizer and
+     return.  */
+
+  gfc_add_block_to_block (&body, &se.pre);
+  gfc_add_block_to_block (&body, &se.post);
+
+  gfc_trans_scalarizing_loops (&loop, &body);
+
+  gfc_add_block_to_block (&block, &loop.pre);
+  gfc_add_block_to_block (&block, &loop.post);
+
+  gcc_assert (ss->shape != NULL);
+  gfc_free_shape (&ss->shape, cm->as->rank);
+  gfc_cleanup_loop (&loop);
+
+  return gfc_finish_block (&block);
+}
+
+/* Generate the call for a scalar transfer node.  */
+
+static void
+transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
+{
+  tree tmp, function, arg2, arg3, field, expr;
+  gfc_component *c;
+  int kind;
+
+  /* It is possible to get a C_NULL_PTR or C_NULL_FUNPTR expression here if
+     the user says something like: print *, 'c_null_ptr: ', c_null_ptr
+     We need to translate the expression to a constant if it's either
+     C_NULL_PTR or C_NULL_FUNPTR.  We could also get a user variable of
+     type C_PTR or C_FUNPTR, in which case the ts->type may no longer be
+     BT_DERIVED (could have been changed by gfc_conv_expr).  */
+  if ((ts->type == BT_DERIVED || ts->type == BT_INTEGER)
+      && ts->u.derived != NULL
+      && (ts->is_iso_c == 1 || ts->u.derived->ts.is_iso_c == 1))
+    {
+      /* C_PTR and C_FUNPTR have private components which means they can not
+         be printed.  However, if -std=gnu and not -pedantic, allow
+         the component to be printed to help debugging.  */
+      if (gfc_notification_std (GFC_STD_GNU) != SILENT)
+	{
+	  gfc_error_now ("Derived type '%s' at %L has PRIVATE components",
+			 ts->u.derived->name, code != NULL ? &(code->loc) : 
+			 &gfc_current_locus);
+	  return;
+	}
+
+      ts->type = ts->u.derived->ts.type;
+      ts->kind = ts->u.derived->ts.kind;
+      ts->f90_type = ts->u.derived->ts.f90_type;
+    }
+  
+  kind = ts->kind;
+  function = NULL;
+  arg2 = NULL;
+  arg3 = NULL;
+
+  switch (ts->type)
+    {
+    case BT_INTEGER:
+      arg2 = build_int_cst (NULL_TREE, kind);
+      if (last_dt == READ)
+	function = iocall[IOCALL_X_INTEGER];
+      else
+	function = iocall[IOCALL_X_INTEGER_WRITE];
+
+      break;
+
+    case BT_REAL:
+      arg2 = build_int_cst (NULL_TREE, kind);
+      if (last_dt == READ)
+	{
+	  if (gfc_real16_is_float128 && ts->kind == 16)
+	    function = iocall[IOCALL_X_REAL128];
+	  else
+	    function = iocall[IOCALL_X_REAL];
+	}
+      else
+	{
+	  if (gfc_real16_is_float128 && ts->kind == 16)
+	    function = iocall[IOCALL_X_REAL128_WRITE];
+	  else
+	    function = iocall[IOCALL_X_REAL_WRITE];
+	}
+
+      break;
+
+    case BT_COMPLEX:
+      arg2 = build_int_cst (NULL_TREE, kind);
+      if (last_dt == READ)
+	{
+	  if (gfc_real16_is_float128 && ts->kind == 16)
+	    function = iocall[IOCALL_X_COMPLEX128];
+	  else
+	    function = iocall[IOCALL_X_COMPLEX];
+	}
+      else
+	{
+	  if (gfc_real16_is_float128 && ts->kind == 16)
+	    function = iocall[IOCALL_X_COMPLEX128_WRITE];
+	  else
+	    function = iocall[IOCALL_X_COMPLEX_WRITE];
+	}
+
+      break;
+
+    case BT_LOGICAL:
+      arg2 = build_int_cst (NULL_TREE, kind);
+      if (last_dt == READ)
+	function = iocall[IOCALL_X_LOGICAL];
+      else
+	function = iocall[IOCALL_X_LOGICAL_WRITE];
+
+      break;
+
+    case BT_CHARACTER:
+      if (kind == 4)
+	{
+	  if (se->string_length)
+	    arg2 = se->string_length;
+	  else
+	    {
+	      tmp = build_fold_indirect_ref_loc (input_location,
+					     addr_expr);
+	      gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE);
+	      arg2 = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (tmp)));
+	      arg2 = fold_convert (gfc_charlen_type_node, arg2);
+	    }
+	  arg3 = build_int_cst (NULL_TREE, kind);
+	  if (last_dt == READ)
+	    function = iocall[IOCALL_X_CHARACTER_WIDE];
+	  else
+	    function = iocall[IOCALL_X_CHARACTER_WIDE_WRITE];
+	    
+	  tmp = gfc_build_addr_expr (NULL_TREE, dt_parm);
+	  tmp = build_call_expr_loc (input_location,
+				 function, 4, tmp, addr_expr, arg2, arg3);
+	  gfc_add_expr_to_block (&se->pre, tmp);
+	  gfc_add_block_to_block (&se->pre, &se->post);
+	  return;
+	}
+      /* Fall through. */
+    case BT_HOLLERITH:
+      if (se->string_length)
+	arg2 = se->string_length;
+      else
+	{
+	  tmp = build_fold_indirect_ref_loc (input_location,
+					 addr_expr);
+	  gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE);
+	  arg2 = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (tmp)));
+	}
+      if (last_dt == READ)
+	function = iocall[IOCALL_X_CHARACTER];
+      else
+	function = iocall[IOCALL_X_CHARACTER_WRITE];
+
+      break;
+
+    case BT_DERIVED:
+      /* Recurse into the elements of the derived type.  */
+      expr = gfc_evaluate_now (addr_expr, &se->pre);
+      expr = build_fold_indirect_ref_loc (input_location,
+				      expr);
+
+      for (c = ts->u.derived->components; c; c = c->next)
+	{
+	  field = c->backend_decl;
+	  gcc_assert (field && TREE_CODE (field) == FIELD_DECL);
+
+	  tmp = fold_build3_loc (UNKNOWN_LOCATION,
+			     COMPONENT_REF, TREE_TYPE (field),
+			     expr, field, NULL_TREE);
+
+          if (c->attr.dimension)
+            {
+              tmp = transfer_array_component (tmp, c, & code->loc);
+              gfc_add_expr_to_block (&se->pre, tmp);
+            }
+          else
+            {
+              if (!c->attr.pointer)
+                tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+              transfer_expr (se, &c->ts, tmp, code);
+            }
+	}
+      return;
+
+    default:
+      internal_error ("Bad IO basetype (%d)", ts->type);
+    }
+
+  tmp = gfc_build_addr_expr (NULL_TREE, dt_parm);
+  tmp = build_call_expr_loc (input_location,
+			 function, 3, tmp, addr_expr, arg2);
+  gfc_add_expr_to_block (&se->pre, tmp);
+  gfc_add_block_to_block (&se->pre, &se->post);
+
+}
+
+
+/* Generate a call to pass an array descriptor to the IO library. The
+   array should be of one of the intrinsic types.  */
+
+static void
+transfer_array_desc (gfc_se * se, gfc_typespec * ts, tree addr_expr)
+{
+  tree tmp, charlen_arg, kind_arg, io_call;
+
+  if (ts->type == BT_CHARACTER)
+    charlen_arg = se->string_length;
+  else
+    charlen_arg = build_int_cst (NULL_TREE, 0);
+
+  kind_arg = build_int_cst (NULL_TREE, ts->kind);
+
+  tmp = gfc_build_addr_expr (NULL_TREE, dt_parm);
+  if (last_dt == READ)
+    io_call = iocall[IOCALL_X_ARRAY];
+  else
+    io_call = iocall[IOCALL_X_ARRAY_WRITE];
+
+  tmp = build_call_expr_loc (UNKNOWN_LOCATION,
+			 io_call, 4,
+			 tmp, addr_expr, kind_arg, charlen_arg);
+  gfc_add_expr_to_block (&se->pre, tmp);
+  gfc_add_block_to_block (&se->pre, &se->post);
+}
+
+
+/* gfc_trans_transfer()-- Translate a TRANSFER code node */
+
+tree
+gfc_trans_transfer (gfc_code * code)
+{
+  stmtblock_t block, body;
+  gfc_loopinfo loop;
+  gfc_expr *expr;
+  gfc_ref *ref;
+  gfc_ss *ss;
+  gfc_se se;
+  tree tmp;
+  int n;
+
+  gfc_start_block (&block);
+  gfc_init_block (&body);
+
+  expr = code->expr1;
+  ss = gfc_walk_expr (expr);
+
+  ref = NULL;
+  gfc_init_se (&se, NULL);
+
+  if (ss == gfc_ss_terminator)
+    {
+      /* Transfer a scalar value.  */
+      gfc_conv_expr_reference (&se, expr);
+      transfer_expr (&se, &expr->ts, se.expr, code);
+    }
+  else
+    {
+      /* Transfer an array. If it is an array of an intrinsic
+	 type, pass the descriptor to the library.  Otherwise
+	 scalarize the transfer.  */
+      if (expr->ref && !gfc_is_proc_ptr_comp (expr, NULL))
+	{
+	  for (ref = expr->ref; ref && ref->type != REF_ARRAY;
+		 ref = ref->next);
+	  gcc_assert (ref->type == REF_ARRAY);
+	}
+
+      if (expr->ts.type != BT_DERIVED
+	    && ref && ref->next == NULL
+	    && !is_subref_array (expr))
+	{
+	  bool seen_vector = false;
+
+	  if (ref && ref->u.ar.type == AR_SECTION)
+	    {
+	      for (n = 0; n < ref->u.ar.dimen; n++)
+		if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR)
+		  seen_vector = true;
+	    }
+
+	  if (seen_vector && last_dt == READ)
+	    {
+	      /* Create a temp, read to that and copy it back.  */
+	      gfc_conv_subref_array_arg (&se, expr, 0, INTENT_OUT, false);
+	      tmp =  se.expr;
+	    }
+	  else
+	    {
+	      /* Get the descriptor.  */
+	      gfc_conv_expr_descriptor (&se, expr, ss);
+	      tmp = gfc_build_addr_expr (NULL_TREE, se.expr);
+	    }
+
+	  transfer_array_desc (&se, &expr->ts, tmp);
+	  goto finish_block_label;
+	}
+      
+      /* Initialize the scalarizer.  */
+      gfc_init_loopinfo (&loop);
+      gfc_add_ss_to_loop (&loop, ss);
+
+      /* Initialize the loop.  */
+      gfc_conv_ss_startstride (&loop);
+      gfc_conv_loop_setup (&loop, &code->expr1->where);
+
+      /* The main loop body.  */
+      gfc_mark_ss_chain_used (ss, 1);
+      gfc_start_scalarized_body (&loop, &body);
+
+      gfc_copy_loopinfo_to_se (&se, &loop);
+      se.ss = ss;
+
+      gfc_conv_expr_reference (&se, expr);
+      transfer_expr (&se, &expr->ts, se.expr, code);
+    }
+
+ finish_block_label:
+
+  gfc_add_block_to_block (&body, &se.pre);
+  gfc_add_block_to_block (&body, &se.post);
+
+  if (se.ss == NULL)
+    tmp = gfc_finish_block (&body);
+  else
+    {
+      gcc_assert (se.ss == gfc_ss_terminator);
+      gfc_trans_scalarizing_loops (&loop, &body);
+
+      gfc_add_block_to_block (&loop.pre, &loop.post);
+      tmp = gfc_finish_block (&loop.pre);
+      gfc_cleanup_loop (&loop);
+    }
+
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
+
+#include "gt-fortran-trans-io.h"
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
new file mode 100644
index 000000000..733bd10ed
--- /dev/null
+++ b/gcc/fortran/trans-openmp.c
@@ -0,0 +1,1826 @@
+/* OpenMP directive translation -- generate GCC trees from gfc_code.
+   Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Jakub Jelinek <jakub@redhat.com>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "gimple.h"	/* For create_tmp_var_raw.  */
+#include "diagnostic-core.h"	/* For internal_error.  */
+#include "gfortran.h"
+#include "trans.h"
+#include "trans-stmt.h"
+#include "trans-types.h"
+#include "trans-array.h"
+#include "trans-const.h"
+#include "arith.h"
+
+int ompws_flags;
+
+/* True if OpenMP should privatize what this DECL points to rather
+   than the DECL itself.  */
+
+bool
+gfc_omp_privatize_by_reference (const_tree decl)
+{
+  tree type = TREE_TYPE (decl);
+
+  if (TREE_CODE (type) == REFERENCE_TYPE
+      && (!DECL_ARTIFICIAL (decl) || TREE_CODE (decl) == PARM_DECL))
+    return true;
+
+  if (TREE_CODE (type) == POINTER_TYPE)
+    {
+      /* Array POINTER/ALLOCATABLE have aggregate types, all user variables
+	 that have POINTER_TYPE type and don't have GFC_POINTER_TYPE_P
+	 set are supposed to be privatized by reference.  */
+      if (GFC_POINTER_TYPE_P (type))
+	return false;
+
+      if (!DECL_ARTIFICIAL (decl)
+	  && TREE_CODE (TREE_TYPE (type)) != FUNCTION_TYPE)
+	return true;
+
+      /* Some arrays are expanded as DECL_ARTIFICIAL pointers
+	 by the frontend.  */
+      if (DECL_LANG_SPECIFIC (decl)
+	  && GFC_DECL_SAVED_DESCRIPTOR (decl))
+	return true;
+    }
+
+  return false;
+}
+
+/* True if OpenMP sharing attribute of DECL is predetermined.  */
+
+enum omp_clause_default_kind
+gfc_omp_predetermined_sharing (tree decl)
+{
+  if (DECL_ARTIFICIAL (decl)
+      && ! GFC_DECL_RESULT (decl)
+      && ! (DECL_LANG_SPECIFIC (decl)
+	    && GFC_DECL_SAVED_DESCRIPTOR (decl)))
+    return OMP_CLAUSE_DEFAULT_SHARED;
+
+  /* Cray pointees shouldn't be listed in any clauses and should be
+     gimplified to dereference of the corresponding Cray pointer.
+     Make them all private, so that they are emitted in the debug
+     information.  */
+  if (GFC_DECL_CRAY_POINTEE (decl))
+    return OMP_CLAUSE_DEFAULT_PRIVATE;
+
+  /* Assumed-size arrays are predetermined to inherit sharing
+     attributes of the associated actual argument, which is shared
+     for all we care.  */
+  if (TREE_CODE (decl) == PARM_DECL
+      && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))
+      && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_UNKNOWN
+      && GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (decl),
+				GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)) - 1)
+	 == NULL)
+    return OMP_CLAUSE_DEFAULT_SHARED;
+
+  /* Dummy procedures aren't considered variables by OpenMP, thus are
+     disallowed in OpenMP clauses.  They are represented as PARM_DECLs
+     in the middle-end, so return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE here
+     to avoid complaining about their uses with default(none).  */
+  if (TREE_CODE (decl) == PARM_DECL
+      && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
+      && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) == FUNCTION_TYPE)
+    return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
+
+  /* COMMON and EQUIVALENCE decls are shared.  They
+     are only referenced through DECL_VALUE_EXPR of the variables
+     contained in them.  If those are privatized, they will not be
+     gimplified to the COMMON or EQUIVALENCE decls.  */
+  if (GFC_DECL_COMMON_OR_EQUIV (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
+    return OMP_CLAUSE_DEFAULT_SHARED;
+
+  if (GFC_DECL_RESULT (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
+    return OMP_CLAUSE_DEFAULT_SHARED;
+
+  return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
+}
+
+/* Return decl that should be used when reporting DEFAULT(NONE)
+   diagnostics.  */
+
+tree
+gfc_omp_report_decl (tree decl)
+{
+  if (DECL_ARTIFICIAL (decl)
+      && DECL_LANG_SPECIFIC (decl)
+      && GFC_DECL_SAVED_DESCRIPTOR (decl))
+    return GFC_DECL_SAVED_DESCRIPTOR (decl);
+
+  return decl;
+}
+
+/* Return true if DECL in private clause needs
+   OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause.  */
+bool
+gfc_omp_private_outer_ref (tree decl)
+{
+  tree type = TREE_TYPE (decl);
+
+  if (GFC_DESCRIPTOR_TYPE_P (type)
+      && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
+    return true;
+
+  return false;
+}
+
+/* Return code to initialize DECL with its default constructor, or
+   NULL if there's nothing to do.  */
+
+tree
+gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
+{
+  tree type = TREE_TYPE (decl), rank, size, esize, ptr, cond, then_b, else_b;
+  stmtblock_t block, cond_block;
+
+  if (! GFC_DESCRIPTOR_TYPE_P (type)
+      || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
+    return NULL;
+
+  gcc_assert (outer != NULL);
+  gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_PRIVATE
+	      || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LASTPRIVATE);
+
+  /* Allocatable arrays in PRIVATE clauses need to be set to
+     "not currently allocated" allocation status if outer
+     array is "not currently allocated", otherwise should be allocated.  */
+  gfc_start_block (&block);
+
+  gfc_init_block (&cond_block);
+
+  gfc_add_modify (&cond_block, decl, outer);
+  rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
+  size = gfc_conv_descriptor_ubound_get (decl, rank);
+  size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			  size, gfc_conv_descriptor_lbound_get (decl, rank));
+  size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			  size, gfc_index_one_node);
+  if (GFC_TYPE_ARRAY_RANK (type) > 1)
+    size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			    size, gfc_conv_descriptor_stride_get (decl, rank));
+  esize = fold_convert (gfc_array_index_type,
+			TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+  size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			  size, esize);
+  size = gfc_evaluate_now (fold_convert (size_type_node, size), &cond_block);
+  ptr = gfc_allocate_array_with_status (&cond_block,
+					build_int_cst (pvoid_type_node, 0),
+					size, NULL, NULL);
+  gfc_conv_descriptor_data_set (&cond_block, decl, ptr);
+  then_b = gfc_finish_block (&cond_block);
+
+  gfc_init_block (&cond_block);
+  gfc_conv_descriptor_data_set (&cond_block, decl, null_pointer_node);
+  else_b = gfc_finish_block (&cond_block);
+
+  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			  fold_convert (pvoid_type_node,
+					gfc_conv_descriptor_data_get (outer)),
+			  null_pointer_node);
+  gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
+			 void_type_node, cond, then_b, else_b));
+
+  return gfc_finish_block (&block);
+}
+
+/* Build and return code for a copy constructor from SRC to DEST.  */
+
+tree
+gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
+{
+  tree type = TREE_TYPE (dest), ptr, size, esize, rank, call;
+  stmtblock_t block;
+
+  if (! GFC_DESCRIPTOR_TYPE_P (type)
+      || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
+    return build2_v (MODIFY_EXPR, dest, src);
+
+  gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE);
+
+  /* Allocatable arrays in FIRSTPRIVATE clauses need to be allocated
+     and copied from SRC.  */
+  gfc_start_block (&block);
+
+  gfc_add_modify (&block, dest, src);
+  rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
+  size = gfc_conv_descriptor_ubound_get (dest, rank);
+  size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			  size, gfc_conv_descriptor_lbound_get (dest, rank));
+  size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			  size, gfc_index_one_node);
+  if (GFC_TYPE_ARRAY_RANK (type) > 1)
+    size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			    size, gfc_conv_descriptor_stride_get (dest, rank));
+  esize = fold_convert (gfc_array_index_type,
+			TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+  size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			  size, esize);
+  size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
+  ptr = gfc_allocate_array_with_status (&block,
+					build_int_cst (pvoid_type_node, 0),
+					size, NULL, NULL);
+  gfc_conv_descriptor_data_set (&block, dest, ptr);
+  call = build_call_expr_loc (input_location,
+			  built_in_decls[BUILT_IN_MEMCPY], 3, ptr,
+			  fold_convert (pvoid_type_node,
+					gfc_conv_descriptor_data_get (src)),
+			  size);
+  gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
+
+  return gfc_finish_block (&block);
+}
+
+/* Similarly, except use an assignment operator instead.  */
+
+tree
+gfc_omp_clause_assign_op (tree clause ATTRIBUTE_UNUSED, tree dest, tree src)
+{
+  tree type = TREE_TYPE (dest), rank, size, esize, call;
+  stmtblock_t block;
+
+  if (! GFC_DESCRIPTOR_TYPE_P (type)
+      || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
+    return build2_v (MODIFY_EXPR, dest, src);
+
+  /* Handle copying allocatable arrays.  */
+  gfc_start_block (&block);
+
+  rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
+  size = gfc_conv_descriptor_ubound_get (dest, rank);
+  size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			  size, gfc_conv_descriptor_lbound_get (dest, rank));
+  size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			  size, gfc_index_one_node);
+  if (GFC_TYPE_ARRAY_RANK (type) > 1)
+    size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			    size, gfc_conv_descriptor_stride_get (dest, rank));
+  esize = fold_convert (gfc_array_index_type,
+			TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+  size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			  size, esize);
+  size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
+  call = build_call_expr_loc (input_location,
+			  built_in_decls[BUILT_IN_MEMCPY], 3,
+			  fold_convert (pvoid_type_node,
+					gfc_conv_descriptor_data_get (dest)),
+			  fold_convert (pvoid_type_node,
+					gfc_conv_descriptor_data_get (src)),
+			  size);
+  gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
+
+  return gfc_finish_block (&block);
+}
+
+/* Build and return code destructing DECL.  Return NULL if nothing
+   to be done.  */
+
+tree
+gfc_omp_clause_dtor (tree clause ATTRIBUTE_UNUSED, tree decl)
+{
+  tree type = TREE_TYPE (decl);
+
+  if (! GFC_DESCRIPTOR_TYPE_P (type)
+      || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
+    return NULL;
+
+  /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need
+     to be deallocated if they were allocated.  */
+  return gfc_trans_dealloc_allocated (decl);
+}
+
+
+/* Return true if DECL's DECL_VALUE_EXPR (if any) should be
+   disregarded in OpenMP construct, because it is going to be
+   remapped during OpenMP lowering.  SHARED is true if DECL
+   is going to be shared, false if it is going to be privatized.  */
+
+bool
+gfc_omp_disregard_value_expr (tree decl, bool shared)
+{
+  if (GFC_DECL_COMMON_OR_EQUIV (decl)
+      && DECL_HAS_VALUE_EXPR_P (decl))
+    {
+      tree value = DECL_VALUE_EXPR (decl);
+
+      if (TREE_CODE (value) == COMPONENT_REF
+	  && TREE_CODE (TREE_OPERAND (value, 0)) == VAR_DECL
+	  && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
+	{
+	  /* If variable in COMMON or EQUIVALENCE is privatized, return
+	     true, as just that variable is supposed to be privatized,
+	     not the whole COMMON or whole EQUIVALENCE.
+	     For shared variables in COMMON or EQUIVALENCE, let them be
+	     gimplified to DECL_VALUE_EXPR, so that for multiple shared vars
+	     from the same COMMON or EQUIVALENCE just one sharing of the
+	     whole COMMON or EQUIVALENCE is enough.  */
+	  return ! shared;
+	}
+    }
+
+  if (GFC_DECL_RESULT (decl) && DECL_HAS_VALUE_EXPR_P (decl))
+    return ! shared;
+
+  return false;
+}
+
+/* Return true if DECL that is shared iff SHARED is true should
+   be put into OMP_CLAUSE_PRIVATE with OMP_CLAUSE_PRIVATE_DEBUG
+   flag set.  */
+
+bool
+gfc_omp_private_debug_clause (tree decl, bool shared)
+{
+  if (GFC_DECL_CRAY_POINTEE (decl))
+    return true;
+
+  if (GFC_DECL_COMMON_OR_EQUIV (decl)
+      && DECL_HAS_VALUE_EXPR_P (decl))
+    {
+      tree value = DECL_VALUE_EXPR (decl);
+
+      if (TREE_CODE (value) == COMPONENT_REF
+	  && TREE_CODE (TREE_OPERAND (value, 0)) == VAR_DECL
+	  && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
+	return shared;
+    }
+
+  return false;
+}
+
+/* Register language specific type size variables as potentially OpenMP
+   firstprivate variables.  */
+
+void
+gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *ctx, tree type)
+{
+  if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
+    {
+      int r;
+
+      gcc_assert (TYPE_LANG_SPECIFIC (type) != NULL);
+      for (r = 0; r < GFC_TYPE_ARRAY_RANK (type); r++)
+	{
+	  omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_LBOUND (type, r));
+	  omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_UBOUND (type, r));
+	  omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_STRIDE (type, r));
+	}
+      omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_SIZE (type));
+      omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_OFFSET (type));
+    }
+}
+
+
+static inline tree
+gfc_trans_add_clause (tree node, tree tail)
+{
+  OMP_CLAUSE_CHAIN (node) = tail;
+  return node;
+}
+
+static tree
+gfc_trans_omp_variable (gfc_symbol *sym)
+{
+  tree t = gfc_get_symbol_decl (sym);
+  tree parent_decl;
+  int parent_flag;
+  bool return_value;
+  bool alternate_entry;
+  bool entry_master;
+
+  return_value = sym->attr.function && sym->result == sym;
+  alternate_entry = sym->attr.function && sym->attr.entry
+		    && sym->result == sym;
+  entry_master = sym->attr.result
+		 && sym->ns->proc_name->attr.entry_master
+		 && !gfc_return_by_reference (sym->ns->proc_name);
+  parent_decl = DECL_CONTEXT (current_function_decl);
+
+  if ((t == parent_decl && return_value)
+       || (sym->ns && sym->ns->proc_name
+	   && sym->ns->proc_name->backend_decl == parent_decl
+	   && (alternate_entry || entry_master)))
+    parent_flag = 1;
+  else
+    parent_flag = 0;
+
+  /* Special case for assigning the return value of a function.
+     Self recursive functions must have an explicit return value.  */
+  if (return_value && (t == current_function_decl || parent_flag))
+    t = gfc_get_fake_result_decl (sym, parent_flag);
+
+  /* Similarly for alternate entry points.  */
+  else if (alternate_entry
+	   && (sym->ns->proc_name->backend_decl == current_function_decl
+	       || parent_flag))
+    {
+      gfc_entry_list *el = NULL;
+
+      for (el = sym->ns->entries; el; el = el->next)
+	if (sym == el->sym)
+	  {
+	    t = gfc_get_fake_result_decl (sym, parent_flag);
+	    break;
+	  }
+    }
+
+  else if (entry_master
+	   && (sym->ns->proc_name->backend_decl == current_function_decl
+	       || parent_flag))
+    t = gfc_get_fake_result_decl (sym, parent_flag);
+
+  return t;
+}
+
+static tree
+gfc_trans_omp_variable_list (enum omp_clause_code code, gfc_namelist *namelist,
+			     tree list)
+{
+  for (; namelist != NULL; namelist = namelist->next)
+    if (namelist->sym->attr.referenced)
+      {
+	tree t = gfc_trans_omp_variable (namelist->sym);
+	if (t != error_mark_node)
+	  {
+	    tree node = build_omp_clause (input_location, code);
+	    OMP_CLAUSE_DECL (node) = t;
+	    list = gfc_trans_add_clause (node, list);
+	  }
+      }
+  return list;
+}
+
+static void
+gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
+{
+  gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL;
+  gfc_symtree *symtree1, *symtree2, *symtree3, *symtree4 = NULL;
+  gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
+  gfc_expr *e1, *e2, *e3, *e4;
+  gfc_ref *ref;
+  tree decl, backend_decl, stmt, type, outer_decl;
+  locus old_loc = gfc_current_locus;
+  const char *iname;
+  gfc_try t;
+
+  decl = OMP_CLAUSE_DECL (c);
+  gfc_current_locus = where;
+  type = TREE_TYPE (decl);
+  outer_decl = create_tmp_var_raw (type, NULL);
+  if (TREE_CODE (decl) == PARM_DECL
+      && TREE_CODE (type) == REFERENCE_TYPE
+      && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))
+      && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (type)) == GFC_ARRAY_ALLOCATABLE)
+    {
+      decl = build_fold_indirect_ref (decl);
+      type = TREE_TYPE (type);
+    }
+
+  /* Create a fake symbol for init value.  */
+  memset (&init_val_sym, 0, sizeof (init_val_sym));
+  init_val_sym.ns = sym->ns;
+  init_val_sym.name = sym->name;
+  init_val_sym.ts = sym->ts;
+  init_val_sym.attr.referenced = 1;
+  init_val_sym.declared_at = where;
+  init_val_sym.attr.flavor = FL_VARIABLE;
+  backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym));
+  init_val_sym.backend_decl = backend_decl;
+
+  /* Create a fake symbol for the outer array reference.  */
+  outer_sym = *sym;
+  outer_sym.as = gfc_copy_array_spec (sym->as);
+  outer_sym.attr.dummy = 0;
+  outer_sym.attr.result = 0;
+  outer_sym.attr.flavor = FL_VARIABLE;
+  outer_sym.backend_decl = outer_decl;
+  if (decl != OMP_CLAUSE_DECL (c))
+    outer_sym.backend_decl = build_fold_indirect_ref (outer_decl);
+
+  /* Create fake symtrees for it.  */
+  symtree1 = gfc_new_symtree (&root1, sym->name);
+  symtree1->n.sym = sym;
+  gcc_assert (symtree1 == root1);
+
+  symtree2 = gfc_new_symtree (&root2, sym->name);
+  symtree2->n.sym = &init_val_sym;
+  gcc_assert (symtree2 == root2);
+
+  symtree3 = gfc_new_symtree (&root3, sym->name);
+  symtree3->n.sym = &outer_sym;
+  gcc_assert (symtree3 == root3);
+
+  /* Create expressions.  */
+  e1 = gfc_get_expr ();
+  e1->expr_type = EXPR_VARIABLE;
+  e1->where = where;
+  e1->symtree = symtree1;
+  e1->ts = sym->ts;
+  e1->ref = ref = gfc_get_ref ();
+  ref->type = REF_ARRAY;
+  ref->u.ar.where = where;
+  ref->u.ar.as = sym->as;
+  ref->u.ar.type = AR_FULL;
+  ref->u.ar.dimen = 0;
+  t = gfc_resolve_expr (e1);
+  gcc_assert (t == SUCCESS);
+
+  e2 = gfc_get_expr ();
+  e2->expr_type = EXPR_VARIABLE;
+  e2->where = where;
+  e2->symtree = symtree2;
+  e2->ts = sym->ts;
+  t = gfc_resolve_expr (e2);
+  gcc_assert (t == SUCCESS);
+
+  e3 = gfc_copy_expr (e1);
+  e3->symtree = symtree3;
+  t = gfc_resolve_expr (e3);
+  gcc_assert (t == SUCCESS);
+
+  iname = NULL;
+  switch (OMP_CLAUSE_REDUCTION_CODE (c))
+    {
+    case PLUS_EXPR:
+    case MINUS_EXPR:
+      e4 = gfc_add (e3, e1);
+      break;
+    case MULT_EXPR:
+      e4 = gfc_multiply (e3, e1);
+      break;
+    case TRUTH_ANDIF_EXPR:
+      e4 = gfc_and (e3, e1);
+      break;
+    case TRUTH_ORIF_EXPR:
+      e4 = gfc_or (e3, e1);
+      break;
+    case EQ_EXPR:
+      e4 = gfc_eqv (e3, e1);
+      break;
+    case NE_EXPR:
+      e4 = gfc_neqv (e3, e1);
+      break;
+    case MIN_EXPR:
+      iname = "min";
+      break;
+    case MAX_EXPR:
+      iname = "max";
+      break;
+    case BIT_AND_EXPR:
+      iname = "iand";
+      break;
+    case BIT_IOR_EXPR:
+      iname = "ior";
+      break;
+    case BIT_XOR_EXPR:
+      iname = "ieor";
+      break;
+    default:
+      gcc_unreachable ();
+    }
+  if (iname != NULL)
+    {
+      memset (&intrinsic_sym, 0, sizeof (intrinsic_sym));
+      intrinsic_sym.ns = sym->ns;
+      intrinsic_sym.name = iname;
+      intrinsic_sym.ts = sym->ts;
+      intrinsic_sym.attr.referenced = 1;
+      intrinsic_sym.attr.intrinsic = 1;
+      intrinsic_sym.attr.function = 1;
+      intrinsic_sym.result = &intrinsic_sym;
+      intrinsic_sym.declared_at = where;
+
+      symtree4 = gfc_new_symtree (&root4, iname);
+      symtree4->n.sym = &intrinsic_sym;
+      gcc_assert (symtree4 == root4);
+
+      e4 = gfc_get_expr ();
+      e4->expr_type = EXPR_FUNCTION;
+      e4->where = where;
+      e4->symtree = symtree4;
+      e4->value.function.isym = gfc_find_function (iname);
+      e4->value.function.actual = gfc_get_actual_arglist ();
+      e4->value.function.actual->expr = e3;
+      e4->value.function.actual->next = gfc_get_actual_arglist ();
+      e4->value.function.actual->next->expr = e1;
+    }
+  /* e1 and e3 have been stored as arguments of e4, avoid sharing.  */
+  e1 = gfc_copy_expr (e1);
+  e3 = gfc_copy_expr (e3);
+  t = gfc_resolve_expr (e4);
+  gcc_assert (t == SUCCESS);
+
+  /* Create the init statement list.  */
+  pushlevel (0);
+  if (GFC_DESCRIPTOR_TYPE_P (type)
+      && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
+    {
+      /* If decl is an allocatable array, it needs to be allocated
+	 with the same bounds as the outer var.  */
+      tree rank, size, esize, ptr;
+      stmtblock_t block;
+
+      gfc_start_block (&block);
+
+      gfc_add_modify (&block, decl, outer_sym.backend_decl);
+      rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
+      size = gfc_conv_descriptor_ubound_get (decl, rank);
+      size = fold_build2_loc (input_location, MINUS_EXPR,
+			      gfc_array_index_type, size,
+			      gfc_conv_descriptor_lbound_get (decl, rank));
+      size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			      size, gfc_index_one_node);
+      if (GFC_TYPE_ARRAY_RANK (type) > 1)
+	size = fold_build2_loc (input_location, MULT_EXPR,
+				gfc_array_index_type, size,
+				gfc_conv_descriptor_stride_get (decl, rank));
+      esize = fold_convert (gfc_array_index_type,
+			    TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+      size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			      size, esize);
+      size = gfc_evaluate_now (fold_convert (size_type_node, size), &block);
+      ptr = gfc_allocate_array_with_status (&block,
+					    build_int_cst (pvoid_type_node, 0),
+					    size, NULL, NULL);
+      gfc_conv_descriptor_data_set (&block, decl, ptr);
+      gfc_add_expr_to_block (&block, gfc_trans_assignment (e1, e2, false,
+			     false));
+      stmt = gfc_finish_block (&block);
+    }
+  else
+    stmt = gfc_trans_assignment (e1, e2, false, false);
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
+  else
+    poplevel (0, 0, 0);
+  OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
+
+  /* Create the merge statement list.  */
+  pushlevel (0);
+  if (GFC_DESCRIPTOR_TYPE_P (type)
+      && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
+    {
+      /* If decl is an allocatable array, it needs to be deallocated
+	 afterwards.  */
+      stmtblock_t block;
+
+      gfc_start_block (&block);
+      gfc_add_expr_to_block (&block, gfc_trans_assignment (e3, e4, false,
+			     true));
+      gfc_add_expr_to_block (&block, gfc_trans_dealloc_allocated (decl));
+      stmt = gfc_finish_block (&block);
+    }
+  else
+    stmt = gfc_trans_assignment (e3, e4, false, true);
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
+  else
+    poplevel (0, 0, 0);
+  OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
+
+  /* And stick the placeholder VAR_DECL into the clause as well.  */
+  OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_decl;
+
+  gfc_current_locus = old_loc;
+
+  gfc_free_expr (e1);
+  gfc_free_expr (e2);
+  gfc_free_expr (e3);
+  gfc_free_expr (e4);
+  gfc_free (symtree1);
+  gfc_free (symtree2);
+  gfc_free (symtree3);
+  if (symtree4)
+    gfc_free (symtree4);
+  gfc_free_array_spec (outer_sym.as);
+}
+
+static tree
+gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list, 
+			      enum tree_code reduction_code, locus where)
+{
+  for (; namelist != NULL; namelist = namelist->next)
+    if (namelist->sym->attr.referenced)
+      {
+	tree t = gfc_trans_omp_variable (namelist->sym);
+	if (t != error_mark_node)
+	  {
+	    tree node = build_omp_clause (where.lb->location,
+					  OMP_CLAUSE_REDUCTION);
+	    OMP_CLAUSE_DECL (node) = t;
+	    OMP_CLAUSE_REDUCTION_CODE (node) = reduction_code;
+	    if (namelist->sym->attr.dimension)
+	      gfc_trans_omp_array_reduction (node, namelist->sym, where);
+	    list = gfc_trans_add_clause (node, list);
+	  }
+      }
+  return list;
+}
+
+static tree
+gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
+		       locus where)
+{
+  tree omp_clauses = NULL_TREE, chunk_size, c;
+  int list;
+  enum omp_clause_code clause_code;
+  gfc_se se;
+
+  if (clauses == NULL)
+    return NULL_TREE;
+
+  for (list = 0; list < OMP_LIST_NUM; list++)
+    {
+      gfc_namelist *n = clauses->lists[list];
+
+      if (n == NULL)
+	continue;
+      if (list >= OMP_LIST_REDUCTION_FIRST
+	  && list <= OMP_LIST_REDUCTION_LAST)
+	{
+	  enum tree_code reduction_code;
+	  switch (list)
+	    {
+	    case OMP_LIST_PLUS:
+	      reduction_code = PLUS_EXPR;
+	      break;
+	    case OMP_LIST_MULT:
+	      reduction_code = MULT_EXPR;
+	      break;
+	    case OMP_LIST_SUB:
+	      reduction_code = MINUS_EXPR;
+	      break;
+	    case OMP_LIST_AND:
+	      reduction_code = TRUTH_ANDIF_EXPR;
+	      break;
+	    case OMP_LIST_OR:
+	      reduction_code = TRUTH_ORIF_EXPR;
+	      break;
+	    case OMP_LIST_EQV:
+	      reduction_code = EQ_EXPR;
+	      break;
+	    case OMP_LIST_NEQV:
+	      reduction_code = NE_EXPR;
+	      break;
+	    case OMP_LIST_MAX:
+	      reduction_code = MAX_EXPR;
+	      break;
+	    case OMP_LIST_MIN:
+	      reduction_code = MIN_EXPR;
+	      break;
+	    case OMP_LIST_IAND:
+	      reduction_code = BIT_AND_EXPR;
+	      break;
+	    case OMP_LIST_IOR:
+	      reduction_code = BIT_IOR_EXPR;
+	      break;
+	    case OMP_LIST_IEOR:
+	      reduction_code = BIT_XOR_EXPR;
+	      break;
+	    default:
+	      gcc_unreachable ();
+	    }
+	  omp_clauses
+	    = gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code,
+					    where);
+	  continue;
+	}
+      switch (list)
+	{
+	case OMP_LIST_PRIVATE:
+	  clause_code = OMP_CLAUSE_PRIVATE;
+	  goto add_clause;
+	case OMP_LIST_SHARED:
+	  clause_code = OMP_CLAUSE_SHARED;
+	  goto add_clause;
+	case OMP_LIST_FIRSTPRIVATE:
+	  clause_code = OMP_CLAUSE_FIRSTPRIVATE;
+	  goto add_clause;
+	case OMP_LIST_LASTPRIVATE:
+	  clause_code = OMP_CLAUSE_LASTPRIVATE;
+	  goto add_clause;
+	case OMP_LIST_COPYIN:
+	  clause_code = OMP_CLAUSE_COPYIN;
+	  goto add_clause;
+	case OMP_LIST_COPYPRIVATE:
+	  clause_code = OMP_CLAUSE_COPYPRIVATE;
+	  /* FALLTHROUGH */
+	add_clause:
+	  omp_clauses
+	    = gfc_trans_omp_variable_list (clause_code, n, omp_clauses);
+	  break;
+	default:
+	  break;
+	}
+    }
+
+  if (clauses->if_expr)
+    {
+      tree if_var;
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr (&se, clauses->if_expr);
+      gfc_add_block_to_block (block, &se.pre);
+      if_var = gfc_evaluate_now (se.expr, block);
+      gfc_add_block_to_block (block, &se.post);
+
+      c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF);
+      OMP_CLAUSE_IF_EXPR (c) = if_var;
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  if (clauses->num_threads)
+    {
+      tree num_threads;
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr (&se, clauses->num_threads);
+      gfc_add_block_to_block (block, &se.pre);
+      num_threads = gfc_evaluate_now (se.expr, block);
+      gfc_add_block_to_block (block, &se.post);
+
+      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_THREADS);
+      OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  chunk_size = NULL_TREE;
+  if (clauses->chunk_size)
+    {
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr (&se, clauses->chunk_size);
+      gfc_add_block_to_block (block, &se.pre);
+      chunk_size = gfc_evaluate_now (se.expr, block);
+      gfc_add_block_to_block (block, &se.post);
+    }
+
+  if (clauses->sched_kind != OMP_SCHED_NONE)
+    {
+      c = build_omp_clause (where.lb->location, OMP_CLAUSE_SCHEDULE);
+      OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
+      switch (clauses->sched_kind)
+	{
+	case OMP_SCHED_STATIC:
+	  OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC;
+	  break;
+	case OMP_SCHED_DYNAMIC:
+	  OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_DYNAMIC;
+	  break;
+	case OMP_SCHED_GUIDED:
+	  OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_GUIDED;
+	  break;
+	case OMP_SCHED_RUNTIME:
+	  OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME;
+	  break;
+	case OMP_SCHED_AUTO:
+	  OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_AUTO;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
+    {
+      c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULT);
+      switch (clauses->default_sharing)
+	{
+	case OMP_DEFAULT_NONE:
+	  OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE;
+	  break;
+	case OMP_DEFAULT_SHARED:
+	  OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_SHARED;
+	  break;
+	case OMP_DEFAULT_PRIVATE:
+	  OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE;
+	  break;
+	case OMP_DEFAULT_FIRSTPRIVATE:
+	  OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  if (clauses->nowait)
+    {
+      c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOWAIT);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  if (clauses->ordered)
+    {
+      c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  if (clauses->untied)
+    {
+      c = build_omp_clause (where.lb->location, OMP_CLAUSE_UNTIED);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  if (clauses->collapse)
+    {
+      c = build_omp_clause (where.lb->location, OMP_CLAUSE_COLLAPSE);
+      OMP_CLAUSE_COLLAPSE_EXPR (c) = build_int_cst (NULL, clauses->collapse);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  return omp_clauses;
+}
+
+/* Like gfc_trans_code, but force creation of a BIND_EXPR around it.  */
+
+static tree
+gfc_trans_omp_code (gfc_code *code, bool force_empty)
+{
+  tree stmt;
+
+  pushlevel (0);
+  stmt = gfc_trans_code (code);
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    {
+      if (!IS_EMPTY_STMT (stmt) || force_empty)
+	{
+	  tree block = poplevel (1, 0, 0);
+	  stmt = build3_v (BIND_EXPR, NULL, stmt, block);
+	}
+      else
+	poplevel (0, 0, 0);
+    }
+  else
+    poplevel (0, 0, 0);
+  return stmt;
+}
+
+
+static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
+static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
+
+static tree
+gfc_trans_omp_atomic (gfc_code *code)
+{
+  gfc_se lse;
+  gfc_se rse;
+  gfc_expr *expr2, *e;
+  gfc_symbol *var;
+  stmtblock_t block;
+  tree lhsaddr, type, rhs, x;
+  enum tree_code op = ERROR_MARK;
+  bool var_on_left = false;
+
+  code = code->block->next;
+  gcc_assert (code->op == EXEC_ASSIGN);
+  gcc_assert (code->next == NULL);
+  var = code->expr1->symtree->n.sym;
+
+  gfc_init_se (&lse, NULL);
+  gfc_init_se (&rse, NULL);
+  gfc_start_block (&block);
+
+  gfc_conv_expr (&lse, code->expr1);
+  gfc_add_block_to_block (&block, &lse.pre);
+  type = TREE_TYPE (lse.expr);
+  lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
+
+  expr2 = code->expr2;
+  if (expr2->expr_type == EXPR_FUNCTION
+      && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
+    expr2 = expr2->value.function.actual->expr;
+
+  if (expr2->expr_type == EXPR_OP)
+    {
+      gfc_expr *e;
+      switch (expr2->value.op.op)
+	{
+	case INTRINSIC_PLUS:
+	  op = PLUS_EXPR;
+	  break;
+	case INTRINSIC_TIMES:
+	  op = MULT_EXPR;
+	  break;
+	case INTRINSIC_MINUS:
+	  op = MINUS_EXPR;
+	  break;
+	case INTRINSIC_DIVIDE:
+	  if (expr2->ts.type == BT_INTEGER)
+	    op = TRUNC_DIV_EXPR;
+	  else
+	    op = RDIV_EXPR;
+	  break;
+	case INTRINSIC_AND:
+	  op = TRUTH_ANDIF_EXPR;
+	  break;
+	case INTRINSIC_OR:
+	  op = TRUTH_ORIF_EXPR;
+	  break;
+	case INTRINSIC_EQV:
+	  op = EQ_EXPR;
+	  break;
+	case INTRINSIC_NEQV:
+	  op = NE_EXPR;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+      e = expr2->value.op.op1;
+      if (e->expr_type == EXPR_FUNCTION
+	  && e->value.function.isym->id == GFC_ISYM_CONVERSION)
+	e = e->value.function.actual->expr;
+      if (e->expr_type == EXPR_VARIABLE
+	  && e->symtree != NULL
+	  && e->symtree->n.sym == var)
+	{
+	  expr2 = expr2->value.op.op2;
+	  var_on_left = true;
+	}
+      else
+	{
+	  e = expr2->value.op.op2;
+	  if (e->expr_type == EXPR_FUNCTION
+	      && e->value.function.isym->id == GFC_ISYM_CONVERSION)
+	    e = e->value.function.actual->expr;
+	  gcc_assert (e->expr_type == EXPR_VARIABLE
+		      && e->symtree != NULL
+		      && e->symtree->n.sym == var);
+	  expr2 = expr2->value.op.op1;
+	  var_on_left = false;
+	}
+      gfc_conv_expr (&rse, expr2);
+      gfc_add_block_to_block (&block, &rse.pre);
+    }
+  else
+    {
+      gcc_assert (expr2->expr_type == EXPR_FUNCTION);
+      switch (expr2->value.function.isym->id)
+	{
+	case GFC_ISYM_MIN:
+	  op = MIN_EXPR;
+	  break;
+	case GFC_ISYM_MAX:
+	  op = MAX_EXPR;
+	  break;
+	case GFC_ISYM_IAND:
+	  op = BIT_AND_EXPR;
+	  break;
+	case GFC_ISYM_IOR:
+	  op = BIT_IOR_EXPR;
+	  break;
+	case GFC_ISYM_IEOR:
+	  op = BIT_XOR_EXPR;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+      e = expr2->value.function.actual->expr;
+      gcc_assert (e->expr_type == EXPR_VARIABLE
+		  && e->symtree != NULL
+		  && e->symtree->n.sym == var);
+
+      gfc_conv_expr (&rse, expr2->value.function.actual->next->expr);
+      gfc_add_block_to_block (&block, &rse.pre);
+      if (expr2->value.function.actual->next->next != NULL)
+	{
+	  tree accum = gfc_create_var (TREE_TYPE (rse.expr), NULL);
+	  gfc_actual_arglist *arg;
+
+	  gfc_add_modify (&block, accum, rse.expr);
+	  for (arg = expr2->value.function.actual->next->next; arg;
+	       arg = arg->next)
+	    {
+	      gfc_init_block (&rse.pre);
+	      gfc_conv_expr (&rse, arg->expr);
+	      gfc_add_block_to_block (&block, &rse.pre);
+	      x = fold_build2_loc (input_location, op, TREE_TYPE (accum),
+				   accum, rse.expr);
+	      gfc_add_modify (&block, accum, x);
+	    }
+
+	  rse.expr = accum;
+	}
+
+      expr2 = expr2->value.function.actual->next->expr;
+    }
+
+  lhsaddr = save_expr (lhsaddr);
+  rhs = gfc_evaluate_now (rse.expr, &block);
+  x = convert (TREE_TYPE (rhs), build_fold_indirect_ref_loc (input_location,
+							 lhsaddr));
+
+  if (var_on_left)
+    x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), x, rhs);
+  else
+    x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), rhs, x);
+
+  if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
+      && TREE_CODE (type) != COMPLEX_TYPE)
+    x = fold_build1_loc (input_location, REALPART_EXPR,
+			 TREE_TYPE (TREE_TYPE (rhs)), x);
+
+  x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
+  gfc_add_expr_to_block (&block, x);
+
+  gfc_add_block_to_block (&block, &lse.pre);
+  gfc_add_block_to_block (&block, &rse.pre);
+
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_barrier (void)
+{
+  tree decl = built_in_decls [BUILT_IN_GOMP_BARRIER];
+  return build_call_expr_loc (input_location, decl, 0);
+}
+
+static tree
+gfc_trans_omp_critical (gfc_code *code)
+{
+  tree name = NULL_TREE, stmt;
+  if (code->ext.omp_name != NULL)
+    name = get_identifier (code->ext.omp_name);
+  stmt = gfc_trans_code (code->block->next);
+  return build2_loc (input_location, OMP_CRITICAL, void_type_node, stmt, name);
+}
+
+typedef struct dovar_init_d {
+  tree var;
+  tree init;
+} dovar_init;
+
+DEF_VEC_O(dovar_init);
+DEF_VEC_ALLOC_O(dovar_init,heap);
+
+static tree
+gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
+		  gfc_omp_clauses *do_clauses, tree par_clauses)
+{
+  gfc_se se;
+  tree dovar, stmt, from, to, step, type, init, cond, incr;
+  tree count = NULL_TREE, cycle_label, tmp, omp_clauses;
+  stmtblock_t block;
+  stmtblock_t body;
+  gfc_omp_clauses *clauses = code->ext.omp_clauses;
+  int i, collapse = clauses->collapse;
+  VEC(dovar_init,heap) *inits = NULL;
+  dovar_init *di;
+  unsigned ix;
+
+  if (collapse <= 0)
+    collapse = 1;
+
+  code = code->block->next;
+  gcc_assert (code->op == EXEC_DO);
+
+  init = make_tree_vec (collapse);
+  cond = make_tree_vec (collapse);
+  incr = make_tree_vec (collapse);
+
+  if (pblock == NULL)
+    {
+      gfc_start_block (&block);
+      pblock = &block;
+    }
+
+  omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
+
+  for (i = 0; i < collapse; i++)
+    {
+      int simple = 0;
+      int dovar_found = 0;
+      tree dovar_decl;
+
+      if (clauses)
+	{
+	  gfc_namelist *n;
+	  for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL;
+	       n = n->next)
+	    if (code->ext.iterator->var->symtree->n.sym == n->sym)
+	      break;
+	  if (n != NULL)
+	    dovar_found = 1;
+	  else if (n == NULL)
+	    for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
+	      if (code->ext.iterator->var->symtree->n.sym == n->sym)
+		break;
+	  if (n != NULL)
+	    dovar_found++;
+	}
+
+      /* Evaluate all the expressions in the iterator.  */
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_lhs (&se, code->ext.iterator->var);
+      gfc_add_block_to_block (pblock, &se.pre);
+      dovar = se.expr;
+      type = TREE_TYPE (dovar);
+      gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_val (&se, code->ext.iterator->start);
+      gfc_add_block_to_block (pblock, &se.pre);
+      from = gfc_evaluate_now (se.expr, pblock);
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_val (&se, code->ext.iterator->end);
+      gfc_add_block_to_block (pblock, &se.pre);
+      to = gfc_evaluate_now (se.expr, pblock);
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_val (&se, code->ext.iterator->step);
+      gfc_add_block_to_block (pblock, &se.pre);
+      step = gfc_evaluate_now (se.expr, pblock);
+      dovar_decl = dovar;
+
+      /* Special case simple loops.  */
+      if (TREE_CODE (dovar) == VAR_DECL)
+	{
+	  if (integer_onep (step))
+	    simple = 1;
+	  else if (tree_int_cst_equal (step, integer_minus_one_node))
+	    simple = -1;
+	}
+      else
+	dovar_decl
+	  = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym);
+
+      /* Loop body.  */
+      if (simple)
+	{
+	  TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from);
+	  /* The condition should not be folded.  */
+	  TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0
+					       ? LE_EXPR : GE_EXPR,
+					       boolean_type_node, dovar, to);
+	  TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
+						    type, dovar, step);
+	  TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
+						    MODIFY_EXPR,
+						    type, dovar,
+						    TREE_VEC_ELT (incr, i));
+	}
+      else
+	{
+	  /* STEP is not 1 or -1.  Use:
+	     for (count = 0; count < (to + step - from) / step; count++)
+	       {
+		 dovar = from + count * step;
+		 body;
+	       cycle_label:;
+	       }  */
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR, type, step, from);
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR, type, to, tmp);
+	  tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, type, tmp,
+				 step);
+	  tmp = gfc_evaluate_now (tmp, pblock);
+	  count = gfc_create_var (type, "count");
+	  TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count,
+					     build_int_cst (type, 0));
+	  /* The condition should not be folded.  */
+	  TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR,
+					       boolean_type_node,
+					       count, tmp);
+	  TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
+						    type, count,
+						    build_int_cst (type, 1));
+	  TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
+						    MODIFY_EXPR, type, count,
+						    TREE_VEC_ELT (incr, i));
+
+	  /* Initialize DOVAR.  */
+	  tmp = fold_build2_loc (input_location, MULT_EXPR, type, count, step);
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR, type, from, tmp);
+	  di = VEC_safe_push (dovar_init, heap, inits, NULL);
+	  di->var = dovar;
+	  di->init = tmp;
+	}
+
+      if (!dovar_found)
+	{
+	  tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
+	  OMP_CLAUSE_DECL (tmp) = dovar_decl;
+	  omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
+	}
+      else if (dovar_found == 2)
+	{
+	  tree c = NULL;
+
+	  tmp = NULL;
+	  if (!simple)
+	    {
+	      /* If dovar is lastprivate, but different counter is used,
+		 dovar += step needs to be added to
+		 OMP_CLAUSE_LASTPRIVATE_STMT, otherwise the copied dovar
+		 will have the value on entry of the last loop, rather
+		 than value after iterator increment.  */
+	      tmp = gfc_evaluate_now (step, pblock);
+	      tmp = fold_build2_loc (input_location, PLUS_EXPR, type, dovar,
+				     tmp);
+	      tmp = fold_build2_loc (input_location, MODIFY_EXPR, type,
+				     dovar, tmp);
+	      for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
+		if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
+		    && OMP_CLAUSE_DECL (c) == dovar_decl)
+		  {
+		    OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp;
+		    break;
+		  }
+	    }
+	  if (c == NULL && par_clauses != NULL)
+	    {
+	      for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
+		if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
+		    && OMP_CLAUSE_DECL (c) == dovar_decl)
+		  {
+		    tree l = build_omp_clause (input_location,
+					       OMP_CLAUSE_LASTPRIVATE);
+		    OMP_CLAUSE_DECL (l) = dovar_decl;
+		    OMP_CLAUSE_CHAIN (l) = omp_clauses;
+		    OMP_CLAUSE_LASTPRIVATE_STMT (l) = tmp;
+		    omp_clauses = l;
+		    OMP_CLAUSE_SET_CODE (c, OMP_CLAUSE_SHARED);
+		    break;
+		  }
+	    }
+	  gcc_assert (simple || c != NULL);
+	}
+      if (!simple)
+	{
+	  tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
+	  OMP_CLAUSE_DECL (tmp) = count;
+	  omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
+	}
+
+      if (i + 1 < collapse)
+	code = code->block->next;
+    }
+
+  if (pblock != &block)
+    {
+      pushlevel (0);
+      gfc_start_block (&block);
+    }
+
+  gfc_start_block (&body);
+
+  FOR_EACH_VEC_ELT (dovar_init, inits, ix, di)
+    gfc_add_modify (&body, di->var, di->init);
+  VEC_free (dovar_init, heap, inits);
+
+  /* Cycle statement is implemented with a goto.  Exit statement must not be
+     present for this loop.  */
+  cycle_label = gfc_build_label_decl (NULL_TREE);
+
+  /* Put these labels where they can be found later.  */
+
+  code->cycle_label = cycle_label;
+  code->exit_label = NULL_TREE;
+
+  /* Main loop body.  */
+  tmp = gfc_trans_omp_code (code->block->next, true);
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Label for cycle statements (if needed).  */
+  if (TREE_USED (cycle_label))
+    {
+      tmp = build1_v (LABEL_EXPR, cycle_label);
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* End of loop body.  */
+  stmt = make_node (OMP_FOR);
+
+  TREE_TYPE (stmt) = void_type_node;
+  OMP_FOR_BODY (stmt) = gfc_finish_block (&body);
+  OMP_FOR_CLAUSES (stmt) = omp_clauses;
+  OMP_FOR_INIT (stmt) = init;
+  OMP_FOR_COND (stmt) = cond;
+  OMP_FOR_INCR (stmt) = incr;
+  gfc_add_expr_to_block (&block, stmt);
+
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_flush (void)
+{
+  tree decl = built_in_decls [BUILT_IN_SYNCHRONIZE];
+  return build_call_expr_loc (input_location, decl, 0);
+}
+
+static tree
+gfc_trans_omp_master (gfc_code *code)
+{
+  tree stmt = gfc_trans_code (code->block->next);
+  if (IS_EMPTY_STMT (stmt))
+    return stmt;
+  return build1_v (OMP_MASTER, stmt);
+}
+
+static tree
+gfc_trans_omp_ordered (gfc_code *code)
+{
+  return build1_v (OMP_ORDERED, gfc_trans_code (code->block->next));
+}
+
+static tree
+gfc_trans_omp_parallel (gfc_code *code)
+{
+  stmtblock_t block;
+  tree stmt, omp_clauses;
+
+  gfc_start_block (&block);
+  omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+				       code->loc);
+  stmt = gfc_trans_omp_code (code->block->next, true);
+  stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
+		     omp_clauses);
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_parallel_do (gfc_code *code)
+{
+  stmtblock_t block, *pblock = NULL;
+  gfc_omp_clauses parallel_clauses, do_clauses;
+  tree stmt, omp_clauses = NULL_TREE;
+
+  gfc_start_block (&block);
+
+  memset (&do_clauses, 0, sizeof (do_clauses));
+  if (code->ext.omp_clauses != NULL)
+    {
+      memcpy (&parallel_clauses, code->ext.omp_clauses,
+	      sizeof (parallel_clauses));
+      do_clauses.sched_kind = parallel_clauses.sched_kind;
+      do_clauses.chunk_size = parallel_clauses.chunk_size;
+      do_clauses.ordered = parallel_clauses.ordered;
+      do_clauses.collapse = parallel_clauses.collapse;
+      parallel_clauses.sched_kind = OMP_SCHED_NONE;
+      parallel_clauses.chunk_size = NULL;
+      parallel_clauses.ordered = false;
+      parallel_clauses.collapse = 0;
+      omp_clauses = gfc_trans_omp_clauses (&block, &parallel_clauses,
+					   code->loc);
+    }
+  do_clauses.nowait = true;
+  if (!do_clauses.ordered && do_clauses.sched_kind != OMP_SCHED_STATIC)
+    pblock = &block;
+  else
+    pushlevel (0);
+  stmt = gfc_trans_omp_do (code, pblock, &do_clauses, omp_clauses);
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
+  else
+    poplevel (0, 0, 0);
+  stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
+		     omp_clauses);
+  OMP_PARALLEL_COMBINED (stmt) = 1;
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_parallel_sections (gfc_code *code)
+{
+  stmtblock_t block;
+  gfc_omp_clauses section_clauses;
+  tree stmt, omp_clauses;
+
+  memset (&section_clauses, 0, sizeof (section_clauses));
+  section_clauses.nowait = true;
+
+  gfc_start_block (&block);
+  omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+				       code->loc);
+  pushlevel (0);
+  stmt = gfc_trans_omp_sections (code, &section_clauses);
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
+  else
+    poplevel (0, 0, 0);
+  stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
+		     omp_clauses);
+  OMP_PARALLEL_COMBINED (stmt) = 1;
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_parallel_workshare (gfc_code *code)
+{
+  stmtblock_t block;
+  gfc_omp_clauses workshare_clauses;
+  tree stmt, omp_clauses;
+
+  memset (&workshare_clauses, 0, sizeof (workshare_clauses));
+  workshare_clauses.nowait = true;
+
+  gfc_start_block (&block);
+  omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+				       code->loc);
+  pushlevel (0);
+  stmt = gfc_trans_omp_workshare (code, &workshare_clauses);
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
+  else
+    poplevel (0, 0, 0);
+  stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
+		     omp_clauses);
+  OMP_PARALLEL_COMBINED (stmt) = 1;
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
+{
+  stmtblock_t block, body;
+  tree omp_clauses, stmt;
+  bool has_lastprivate = clauses->lists[OMP_LIST_LASTPRIVATE] != NULL;
+
+  gfc_start_block (&block);
+
+  omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
+
+  gfc_init_block (&body);
+  for (code = code->block; code; code = code->block)
+    {
+      /* Last section is special because of lastprivate, so even if it
+	 is empty, chain it in.  */
+      stmt = gfc_trans_omp_code (code->next,
+				 has_lastprivate && code->block == NULL);
+      if (! IS_EMPTY_STMT (stmt))
+	{
+	  stmt = build1_v (OMP_SECTION, stmt);
+	  gfc_add_expr_to_block (&body, stmt);
+	}
+    }
+  stmt = gfc_finish_block (&body);
+
+  stmt = build2_loc (input_location, OMP_SECTIONS, void_type_node, stmt,
+		     omp_clauses);
+  gfc_add_expr_to_block (&block, stmt);
+
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
+{
+  tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc);
+  tree stmt = gfc_trans_omp_code (code->block->next, true);
+  stmt = build2_loc (input_location, OMP_SINGLE, void_type_node, stmt,
+		     omp_clauses);
+  return stmt;
+}
+
+static tree
+gfc_trans_omp_task (gfc_code *code)
+{
+  stmtblock_t block;
+  tree stmt, omp_clauses;
+
+  gfc_start_block (&block);
+  omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+				       code->loc);
+  stmt = gfc_trans_omp_code (code->block->next, true);
+  stmt = build2_loc (input_location, OMP_TASK, void_type_node, stmt,
+		     omp_clauses);
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_taskwait (void)
+{
+  tree decl = built_in_decls [BUILT_IN_GOMP_TASKWAIT];
+  return build_call_expr_loc (input_location, decl, 0);
+}
+
+static tree
+gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
+{
+  tree res, tmp, stmt;
+  stmtblock_t block, *pblock = NULL;
+  stmtblock_t singleblock;
+  int saved_ompws_flags;
+  bool singleblock_in_progress = false;
+  /* True if previous gfc_code in workshare construct is not workshared.  */
+  bool prev_singleunit;
+
+  code = code->block->next;
+
+  pushlevel (0);
+
+  gfc_start_block (&block);
+  pblock = &block;
+
+  ompws_flags = OMPWS_WORKSHARE_FLAG;
+  prev_singleunit = false;
+
+  /* Translate statements one by one to trees until we reach
+     the end of the workshare construct.  Adjacent gfc_codes that
+     are a single unit of work are clustered and encapsulated in a
+     single OMP_SINGLE construct.  */
+  for (; code; code = code->next)
+    {
+      if (code->here != 0)
+	{
+	  res = gfc_trans_label_here (code);
+	  gfc_add_expr_to_block (pblock, res);
+	}
+
+      /* No dependence analysis, use for clauses with wait.
+	 If this is the last gfc_code, use default omp_clauses.  */
+      if (code->next == NULL && clauses->nowait)
+	ompws_flags |= OMPWS_NOWAIT;
+
+      /* By default, every gfc_code is a single unit of work.  */
+      ompws_flags |= OMPWS_CURR_SINGLEUNIT;
+      ompws_flags &= ~OMPWS_SCALARIZER_WS;
+
+      switch (code->op)
+	{
+	case EXEC_NOP:
+	  res = NULL_TREE;
+	  break;
+
+	case EXEC_ASSIGN:
+	  res = gfc_trans_assign (code);
+	  break;
+
+	case EXEC_POINTER_ASSIGN:
+	  res = gfc_trans_pointer_assign (code);
+	  break;
+
+	case EXEC_INIT_ASSIGN:
+	  res = gfc_trans_init_assign (code);
+	  break;
+
+	case EXEC_FORALL:
+	  res = gfc_trans_forall (code);
+	  break;
+
+	case EXEC_WHERE:
+	  res = gfc_trans_where (code);
+	  break;
+
+	case EXEC_OMP_ATOMIC:
+	  res = gfc_trans_omp_directive (code);
+	  break;
+
+	case EXEC_OMP_PARALLEL:
+	case EXEC_OMP_PARALLEL_DO:
+	case EXEC_OMP_PARALLEL_SECTIONS:
+	case EXEC_OMP_PARALLEL_WORKSHARE:
+	case EXEC_OMP_CRITICAL:
+	  saved_ompws_flags = ompws_flags;
+	  ompws_flags = 0;
+	  res = gfc_trans_omp_directive (code);
+	  ompws_flags = saved_ompws_flags;
+	  break;
+	
+	default:
+	  internal_error ("gfc_trans_omp_workshare(): Bad statement code");
+	}
+
+      gfc_set_backend_locus (&code->loc);
+
+      if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
+	{
+	  if (prev_singleunit)
+	    {
+	      if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
+		/* Add current gfc_code to single block.  */
+		gfc_add_expr_to_block (&singleblock, res);
+	      else
+		{
+		  /* Finish single block and add it to pblock.  */
+		  tmp = gfc_finish_block (&singleblock);
+		  tmp = build2_loc (input_location, OMP_SINGLE,
+				    void_type_node, tmp, NULL_TREE);
+		  gfc_add_expr_to_block (pblock, tmp);
+		  /* Add current gfc_code to pblock.  */
+		  gfc_add_expr_to_block (pblock, res);
+		  singleblock_in_progress = false;
+		}
+	    }
+	  else
+	    {
+	      if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
+		{
+		  /* Start single block.  */
+		  gfc_init_block (&singleblock);
+		  gfc_add_expr_to_block (&singleblock, res);
+		  singleblock_in_progress = true;
+		}
+	      else
+		/* Add the new statement to the block.  */
+		gfc_add_expr_to_block (pblock, res);
+	    }
+	  prev_singleunit = (ompws_flags & OMPWS_CURR_SINGLEUNIT) != 0;
+	}
+    }
+
+  /* Finish remaining SINGLE block, if we were in the middle of one.  */
+  if (singleblock_in_progress)
+    {
+      /* Finish single block and add it to pblock.  */
+      tmp = gfc_finish_block (&singleblock);
+      tmp = build2_loc (input_location, OMP_SINGLE, void_type_node, tmp,
+			clauses->nowait
+			? build_omp_clause (input_location, OMP_CLAUSE_NOWAIT)
+			: NULL_TREE);
+      gfc_add_expr_to_block (pblock, tmp);
+    }
+
+  stmt = gfc_finish_block (pblock);
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    {
+      if (!IS_EMPTY_STMT (stmt))
+	{
+	  tree bindblock = poplevel (1, 0, 0);
+	  stmt = build3_v (BIND_EXPR, NULL, stmt, bindblock);
+	}
+      else
+	poplevel (0, 0, 0);
+    }
+  else
+    poplevel (0, 0, 0);
+
+  if (IS_EMPTY_STMT (stmt) && !clauses->nowait)
+    stmt = gfc_trans_omp_barrier ();
+
+  ompws_flags = 0;
+  return stmt;
+}
+
+tree
+gfc_trans_omp_directive (gfc_code *code)
+{
+  switch (code->op)
+    {
+    case EXEC_OMP_ATOMIC:
+      return gfc_trans_omp_atomic (code);
+    case EXEC_OMP_BARRIER:
+      return gfc_trans_omp_barrier ();
+    case EXEC_OMP_CRITICAL:
+      return gfc_trans_omp_critical (code);
+    case EXEC_OMP_DO:
+      return gfc_trans_omp_do (code, NULL, code->ext.omp_clauses, NULL);
+    case EXEC_OMP_FLUSH:
+      return gfc_trans_omp_flush ();
+    case EXEC_OMP_MASTER:
+      return gfc_trans_omp_master (code);
+    case EXEC_OMP_ORDERED:
+      return gfc_trans_omp_ordered (code);
+    case EXEC_OMP_PARALLEL:
+      return gfc_trans_omp_parallel (code);
+    case EXEC_OMP_PARALLEL_DO:
+      return gfc_trans_omp_parallel_do (code);
+    case EXEC_OMP_PARALLEL_SECTIONS:
+      return gfc_trans_omp_parallel_sections (code);
+    case EXEC_OMP_PARALLEL_WORKSHARE:
+      return gfc_trans_omp_parallel_workshare (code);
+    case EXEC_OMP_SECTIONS:
+      return gfc_trans_omp_sections (code, code->ext.omp_clauses);
+    case EXEC_OMP_SINGLE:
+      return gfc_trans_omp_single (code, code->ext.omp_clauses);
+    case EXEC_OMP_TASK:
+      return gfc_trans_omp_task (code);
+    case EXEC_OMP_TASKWAIT:
+      return gfc_trans_omp_taskwait ();
+    case EXEC_OMP_WORKSHARE:
+      return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
+    default:
+      gcc_unreachable ();
+    }
+}
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
new file mode 100644
index 000000000..e72814e68
--- /dev/null
+++ b/gcc/fortran/trans-stmt.c
@@ -0,0 +1,4987 @@
+/* Statement translation -- generate GCC trees from gfc_code.
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
+   2011
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+   and Steven Bosscher <s.bosscher@student.tudelft.nl>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "gfortran.h"
+#include "flags.h"
+#include "trans.h"
+#include "trans-stmt.h"
+#include "trans-types.h"
+#include "trans-array.h"
+#include "trans-const.h"
+#include "arith.h"
+#include "dependency.h"
+#include "ggc.h"
+
+typedef struct iter_info
+{
+  tree var;
+  tree start;
+  tree end;
+  tree step;
+  struct iter_info *next;
+}
+iter_info;
+
+typedef struct forall_info
+{
+  iter_info *this_loop;
+  tree mask;
+  tree maskindex;
+  int nvar;
+  tree size;
+  struct forall_info  *prev_nest;
+}
+forall_info;
+
+static void gfc_trans_where_2 (gfc_code *, tree, bool,
+			       forall_info *, stmtblock_t *);
+
+/* Translate a F95 label number to a LABEL_EXPR.  */
+
+tree
+gfc_trans_label_here (gfc_code * code)
+{
+  return build1_v (LABEL_EXPR, gfc_get_label_decl (code->here));
+}
+
+
+/* Given a variable expression which has been ASSIGNed to, find the decl
+   containing the auxiliary variables.  For variables in common blocks this
+   is a field_decl.  */
+
+void
+gfc_conv_label_variable (gfc_se * se, gfc_expr * expr)
+{
+  gcc_assert (expr->symtree->n.sym->attr.assign == 1);
+  gfc_conv_expr (se, expr);
+  /* Deals with variable in common block. Get the field declaration.  */
+  if (TREE_CODE (se->expr) == COMPONENT_REF)
+    se->expr = TREE_OPERAND (se->expr, 1);
+  /* Deals with dummy argument. Get the parameter declaration.  */
+  else if (TREE_CODE (se->expr) == INDIRECT_REF)
+    se->expr = TREE_OPERAND (se->expr, 0);
+}
+
+/* Translate a label assignment statement.  */
+
+tree
+gfc_trans_label_assign (gfc_code * code)
+{
+  tree label_tree;
+  gfc_se se;
+  tree len;
+  tree addr;
+  tree len_tree;
+  int label_len;
+
+  /* Start a new block.  */
+  gfc_init_se (&se, NULL);
+  gfc_start_block (&se.pre);
+  gfc_conv_label_variable (&se, code->expr1);
+
+  len = GFC_DECL_STRING_LEN (se.expr);
+  addr = GFC_DECL_ASSIGN_ADDR (se.expr);
+
+  label_tree = gfc_get_label_decl (code->label1);
+
+  if (code->label1->defined == ST_LABEL_TARGET)
+    {
+      label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree);
+      len_tree = integer_minus_one_node;
+    }
+  else
+    {
+      gfc_expr *format = code->label1->format;
+
+      label_len = format->value.character.length;
+      len_tree = build_int_cst (NULL_TREE, label_len);
+      label_tree = gfc_build_wide_string_const (format->ts.kind, label_len + 1,
+						format->value.character.string);
+      label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree);
+    }
+
+  gfc_add_modify (&se.pre, len, len_tree);
+  gfc_add_modify (&se.pre, addr, label_tree);
+
+  return gfc_finish_block (&se.pre);
+}
+
+/* Translate a GOTO statement.  */
+
+tree
+gfc_trans_goto (gfc_code * code)
+{
+  locus loc = code->loc;
+  tree assigned_goto;
+  tree target;
+  tree tmp;
+  gfc_se se;
+
+  if (code->label1 != NULL)
+    return build1_v (GOTO_EXPR, gfc_get_label_decl (code->label1));
+
+  /* ASSIGNED GOTO.  */
+  gfc_init_se (&se, NULL);
+  gfc_start_block (&se.pre);
+  gfc_conv_label_variable (&se, code->expr1);
+  tmp = GFC_DECL_STRING_LEN (se.expr);
+  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp,
+			 build_int_cst (TREE_TYPE (tmp), -1));
+  gfc_trans_runtime_check (true, false, tmp, &se.pre, &loc,
+			   "Assigned label is not a target label");
+
+  assigned_goto = GFC_DECL_ASSIGN_ADDR (se.expr);
+
+  /* We're going to ignore a label list.  It does not really change the
+     statement's semantics (because it is just a further restriction on
+     what's legal code); before, we were comparing label addresses here, but
+     that's a very fragile business and may break with optimization.  So
+     just ignore it.  */
+
+  target = fold_build1_loc (input_location, GOTO_EXPR, void_type_node,
+			    assigned_goto);
+  gfc_add_expr_to_block (&se.pre, target);
+  return gfc_finish_block (&se.pre);
+}
+
+
+/* Translate an ENTRY statement.  Just adds a label for this entry point.  */
+tree
+gfc_trans_entry (gfc_code * code)
+{
+  return build1_v (LABEL_EXPR, code->ext.entry->label);
+}
+
+
+/* Check for dependencies between INTENT(IN) and INTENT(OUT) arguments of
+   elemental subroutines.  Make temporaries for output arguments if any such
+   dependencies are found.  Output arguments are chosen because internal_unpack
+   can be used, as is, to copy the result back to the variable.  */
+static void
+gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
+				 gfc_symbol * sym, gfc_actual_arglist * arg,
+				 gfc_dep_check check_variable)
+{
+  gfc_actual_arglist *arg0;
+  gfc_expr *e;
+  gfc_formal_arglist *formal;
+  gfc_loopinfo tmp_loop;
+  gfc_se parmse;
+  gfc_ss *ss;
+  gfc_ss_info *info;
+  gfc_symbol *fsym;
+  gfc_ref *ref;
+  int n;
+  tree data;
+  tree offset;
+  tree size;
+  tree tmp;
+
+  if (loopse->ss == NULL)
+    return;
+
+  ss = loopse->ss;
+  arg0 = arg;
+  formal = sym->formal;
+
+  /* Loop over all the arguments testing for dependencies.  */
+  for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
+    {
+      e = arg->expr;
+      if (e == NULL)
+	continue;
+
+      /* Obtain the info structure for the current argument.  */ 
+      info = NULL;
+      for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next)
+	{
+	  if (ss->expr != e)
+	    continue;
+	  info = &ss->data.info;
+	  break;
+	}
+
+      /* If there is a dependency, create a temporary and use it
+	 instead of the variable.  */
+      fsym = formal ? formal->sym : NULL;
+      if (e->expr_type == EXPR_VARIABLE
+	    && e->rank && fsym
+	    && fsym->attr.intent != INTENT_IN
+	    && gfc_check_fncall_dependency (e, fsym->attr.intent,
+					    sym, arg0, check_variable))
+	{
+	  tree initial, temptype;
+	  stmtblock_t temp_post;
+
+	  /* Make a local loopinfo for the temporary creation, so that
+	     none of the other ss->info's have to be renormalized.  */
+	  gfc_init_loopinfo (&tmp_loop);
+	  tmp_loop.dimen = info->dimen;
+	  for (n = 0; n < info->dimen; n++)
+	    {
+	      tmp_loop.to[n] = loopse->loop->to[n];
+	      tmp_loop.from[n] = loopse->loop->from[n];
+	      tmp_loop.order[n] = loopse->loop->order[n];
+	    }
+
+	  /* Obtain the argument descriptor for unpacking.  */
+	  gfc_init_se (&parmse, NULL);
+	  parmse.want_pointer = 1;
+
+	  /* The scalarizer introduces some specific peculiarities when
+	     handling elemental subroutines; the stride can be needed up to
+	     the dim_array - 1, rather than dim_loop - 1 to calculate
+	     offsets outside the loop.  For this reason, we make sure that
+	     the descriptor has the dimensionality of the array by converting
+	     trailing elements into ranges with end = start.  */
+	  for (ref = e->ref; ref; ref = ref->next)
+	    if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
+	      break;
+
+	  if (ref)
+	    {
+	      bool seen_range = false;
+	      for (n = 0; n < ref->u.ar.dimen; n++)
+		{
+		  if (ref->u.ar.dimen_type[n] == DIMEN_RANGE)
+		    seen_range = true;
+
+		  if (!seen_range
+			|| ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
+		    continue;
+
+		  ref->u.ar.end[n] = gfc_copy_expr (ref->u.ar.start[n]);
+		  ref->u.ar.dimen_type[n] = DIMEN_RANGE;
+		}
+	    }
+
+	  gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e));
+	  gfc_add_block_to_block (&se->pre, &parmse.pre);
+
+	  /* If we've got INTENT(INOUT) or a derived type with INTENT(OUT),
+	     initialize the array temporary with a copy of the values.  */
+	  if (fsym->attr.intent == INTENT_INOUT
+		|| (fsym->ts.type ==BT_DERIVED
+		      && fsym->attr.intent == INTENT_OUT))
+	    initial = parmse.expr;
+	  else
+	    initial = NULL_TREE;
+
+	  /* Find the type of the temporary to create; we don't use the type
+	     of e itself as this breaks for subcomponent-references in e (where
+	     the type of e is that of the final reference, but parmse.expr's
+	     type corresponds to the full derived-type).  */
+	  /* TODO: Fix this somehow so we don't need a temporary of the whole
+	     array but instead only the components referenced.  */
+	  temptype = TREE_TYPE (parmse.expr); /* Pointer to descriptor.  */
+	  gcc_assert (TREE_CODE (temptype) == POINTER_TYPE);
+	  temptype = TREE_TYPE (temptype);
+	  temptype = gfc_get_element_type (temptype);
+
+	  /* Generate the temporary.  Cleaning up the temporary should be the
+	     very last thing done, so we add the code to a new block and add it
+	     to se->post as last instructions.  */
+	  size = gfc_create_var (gfc_array_index_type, NULL);
+	  data = gfc_create_var (pvoid_type_node, NULL);
+	  gfc_init_block (&temp_post);
+	  tmp = gfc_trans_create_temp_array (&se->pre, &temp_post,
+					     &tmp_loop, info, temptype,
+					     initial,
+					     false, true, false,
+					     &arg->expr->where);
+	  gfc_add_modify (&se->pre, size, tmp);
+	  tmp = fold_convert (pvoid_type_node, info->data);
+	  gfc_add_modify (&se->pre, data, tmp);
+
+	  /* Calculate the offset for the temporary.  */
+	  offset = gfc_index_zero_node;
+	  for (n = 0; n < info->dimen; n++)
+	    {
+	      tmp = gfc_conv_descriptor_stride_get (info->descriptor,
+						    gfc_rank_cst[n]);
+	      tmp = fold_build2_loc (input_location, MULT_EXPR,
+				     gfc_array_index_type,
+				     loopse->loop->from[n], tmp);
+	      offset = fold_build2_loc (input_location, MINUS_EXPR,
+					gfc_array_index_type, offset, tmp);
+	    }
+	  info->offset = gfc_create_var (gfc_array_index_type, NULL);	  
+	  gfc_add_modify (&se->pre, info->offset, offset);
+
+	  /* Copy the result back using unpack.  */
+	  tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_in_unpack, 2, parmse.expr, data);
+	  gfc_add_expr_to_block (&se->post, tmp);
+
+	  /* parmse.pre is already added above.  */
+	  gfc_add_block_to_block (&se->post, &parmse.post);
+	  gfc_add_block_to_block (&se->post, &temp_post);
+	}
+    }
+}
+
+
+/* Translate the CALL statement.  Builds a call to an F95 subroutine.  */
+
+tree
+gfc_trans_call (gfc_code * code, bool dependency_check,
+		tree mask, tree count1, bool invert)
+{
+  gfc_se se;
+  gfc_ss * ss;
+  int has_alternate_specifier;
+  gfc_dep_check check_variable;
+  tree index = NULL_TREE;
+  tree maskexpr = NULL_TREE;
+  tree tmp;
+
+  /* A CALL starts a new block because the actual arguments may have to
+     be evaluated first.  */
+  gfc_init_se (&se, NULL);
+  gfc_start_block (&se.pre);
+
+  gcc_assert (code->resolved_sym);
+
+  ss = gfc_ss_terminator;
+  if (code->resolved_sym->attr.elemental)
+    ss = gfc_walk_elemental_function_args (ss, code->ext.actual, GFC_SS_REFERENCE);
+
+  /* Is not an elemental subroutine call with array valued arguments.  */
+  if (ss == gfc_ss_terminator)
+    {
+
+      /* Translate the call.  */
+      has_alternate_specifier
+	= gfc_conv_procedure_call (&se, code->resolved_sym, code->ext.actual,
+				  code->expr1, NULL);
+
+      /* A subroutine without side-effect, by definition, does nothing!  */
+      TREE_SIDE_EFFECTS (se.expr) = 1;
+
+      /* Chain the pieces together and return the block.  */
+      if (has_alternate_specifier)
+	{
+	  gfc_code *select_code;
+	  gfc_symbol *sym;
+	  select_code = code->next;
+	  gcc_assert(select_code->op == EXEC_SELECT);
+	  sym = select_code->expr1->symtree->n.sym;
+	  se.expr = convert (gfc_typenode_for_spec (&sym->ts), se.expr);
+	  if (sym->backend_decl == NULL)
+	    sym->backend_decl = gfc_get_symbol_decl (sym);
+	  gfc_add_modify (&se.pre, sym->backend_decl, se.expr);
+	}
+      else
+	gfc_add_expr_to_block (&se.pre, se.expr);
+
+      gfc_add_block_to_block (&se.pre, &se.post);
+    }
+
+  else
+    {
+      /* An elemental subroutine call with array valued arguments has
+	 to be scalarized.  */
+      gfc_loopinfo loop;
+      stmtblock_t body;
+      stmtblock_t block;
+      gfc_se loopse;
+      gfc_se depse;
+
+      /* gfc_walk_elemental_function_args renders the ss chain in the
+	 reverse order to the actual argument order.  */
+      ss = gfc_reverse_ss (ss);
+
+      /* Initialize the loop.  */
+      gfc_init_se (&loopse, NULL);
+      gfc_init_loopinfo (&loop);
+      gfc_add_ss_to_loop (&loop, ss);
+
+      gfc_conv_ss_startstride (&loop);
+      /* TODO: gfc_conv_loop_setup generates a temporary for vector 
+	 subscripts.  This could be prevented in the elemental case  
+	 as temporaries are handled separatedly 
+	 (below in gfc_conv_elemental_dependencies).  */
+      gfc_conv_loop_setup (&loop, &code->expr1->where);
+      gfc_mark_ss_chain_used (ss, 1);
+
+      /* Convert the arguments, checking for dependencies.  */
+      gfc_copy_loopinfo_to_se (&loopse, &loop);
+      loopse.ss = ss;
+
+      /* For operator assignment, do dependency checking.  */
+      if (dependency_check)
+	check_variable = ELEM_CHECK_VARIABLE;
+      else
+	check_variable = ELEM_DONT_CHECK_VARIABLE;
+
+      gfc_init_se (&depse, NULL);
+      gfc_conv_elemental_dependencies (&depse, &loopse, code->resolved_sym,
+				       code->ext.actual, check_variable);
+
+      gfc_add_block_to_block (&loop.pre,  &depse.pre);
+      gfc_add_block_to_block (&loop.post, &depse.post);
+
+      /* Generate the loop body.  */
+      gfc_start_scalarized_body (&loop, &body);
+      gfc_init_block (&block);
+
+      if (mask && count1)
+	{
+	  /* Form the mask expression according to the mask.  */
+	  index = count1;
+	  maskexpr = gfc_build_array_ref (mask, index, NULL);
+	  if (invert)
+	    maskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
+					TREE_TYPE (maskexpr), maskexpr);
+	}
+
+      /* Add the subroutine call to the block.  */
+      gfc_conv_procedure_call (&loopse, code->resolved_sym,
+			       code->ext.actual, code->expr1, NULL);
+
+      if (mask && count1)
+	{
+	  tmp = build3_v (COND_EXPR, maskexpr, loopse.expr,
+			  build_empty_stmt (input_location));
+	  gfc_add_expr_to_block (&loopse.pre, tmp);
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type,
+				 count1, gfc_index_one_node);
+	  gfc_add_modify (&loopse.pre, count1, tmp);
+	}
+      else
+	gfc_add_expr_to_block (&loopse.pre, loopse.expr);
+
+      gfc_add_block_to_block (&block, &loopse.pre);
+      gfc_add_block_to_block (&block, &loopse.post);
+
+      /* Finish up the loop block and the loop.  */
+      gfc_add_expr_to_block (&body, gfc_finish_block (&block));
+      gfc_trans_scalarizing_loops (&loop, &body);
+      gfc_add_block_to_block (&se.pre, &loop.pre);
+      gfc_add_block_to_block (&se.pre, &loop.post);
+      gfc_add_block_to_block (&se.pre, &se.post);
+      gfc_cleanup_loop (&loop);
+    }
+
+  return gfc_finish_block (&se.pre);
+}
+
+
+/* Translate the RETURN statement.  */
+
+tree
+gfc_trans_return (gfc_code * code)
+{
+  if (code->expr1)
+    {
+      gfc_se se;
+      tree tmp;
+      tree result;
+
+      /* If code->expr is not NULL, this return statement must appear
+	 in a subroutine and current_fake_result_decl has already
+	 been generated.  */
+
+      result = gfc_get_fake_result_decl (NULL, 0);
+      if (!result)
+	{
+	  gfc_warning ("An alternate return at %L without a * dummy argument",
+			&code->expr1->where);
+	  return gfc_generate_return ();
+	}
+
+      /* Start a new block for this statement.  */
+      gfc_init_se (&se, NULL);
+      gfc_start_block (&se.pre);
+
+      gfc_conv_expr (&se, code->expr1);
+
+      /* Note that the actually returned expression is a simple value and
+	 does not depend on any pointers or such; thus we can clean-up with
+	 se.post before returning.  */
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (result),
+			     result, fold_convert (TREE_TYPE (result),
+			     se.expr));
+      gfc_add_expr_to_block (&se.pre, tmp);
+      gfc_add_block_to_block (&se.pre, &se.post);
+
+      tmp = gfc_generate_return ();
+      gfc_add_expr_to_block (&se.pre, tmp);
+      return gfc_finish_block (&se.pre);
+    }
+
+  return gfc_generate_return ();
+}
+
+
+/* Translate the PAUSE statement.  We have to translate this statement
+   to a runtime library call.  */
+
+tree
+gfc_trans_pause (gfc_code * code)
+{
+  tree gfc_int4_type_node = gfc_get_int_type (4);
+  gfc_se se;
+  tree tmp;
+
+  /* Start a new block for this statement.  */
+  gfc_init_se (&se, NULL);
+  gfc_start_block (&se.pre);
+
+
+  if (code->expr1 == NULL)
+    {
+      tmp = build_int_cst (gfc_int4_type_node, 0);
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_pause_string, 2,
+				 build_int_cst (pchar_type_node, 0), tmp);
+    }
+  else if (code->expr1->ts.type == BT_INTEGER)
+    {
+      gfc_conv_expr (&se, code->expr1);
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_pause_numeric, 1,
+				 fold_convert (gfc_int4_type_node, se.expr));
+    }
+  else
+    {
+      gfc_conv_expr_reference (&se, code->expr1);
+      tmp = build_call_expr_loc (input_location,
+			     gfor_fndecl_pause_string, 2,
+			     se.expr, se.string_length);
+    }
+
+  gfc_add_expr_to_block (&se.pre, tmp);
+
+  gfc_add_block_to_block (&se.pre, &se.post);
+
+  return gfc_finish_block (&se.pre);
+}
+
+
+/* Translate the STOP statement.  We have to translate this statement
+   to a runtime library call.  */
+
+tree
+gfc_trans_stop (gfc_code *code, bool error_stop)
+{
+  tree gfc_int4_type_node = gfc_get_int_type (4);
+  gfc_se se;
+  tree tmp;
+
+  /* Start a new block for this statement.  */
+  gfc_init_se (&se, NULL);
+  gfc_start_block (&se.pre);
+
+  if (code->expr1 == NULL)
+    {
+      tmp = build_int_cst (gfc_int4_type_node, 0);
+      tmp = build_call_expr_loc (input_location,
+				 error_stop ? gfor_fndecl_error_stop_string
+				 : gfor_fndecl_stop_string,
+				 2, build_int_cst (pchar_type_node, 0), tmp);
+    }
+  else if (code->expr1->ts.type == BT_INTEGER)
+    {
+      gfc_conv_expr (&se, code->expr1);
+      tmp = build_call_expr_loc (input_location,
+				 error_stop ? gfor_fndecl_error_stop_numeric
+				 : gfor_fndecl_stop_numeric_f08, 1, 
+				 fold_convert (gfc_int4_type_node, se.expr));
+    }
+  else
+    {
+      gfc_conv_expr_reference (&se, code->expr1);
+      tmp = build_call_expr_loc (input_location,
+				 error_stop ? gfor_fndecl_error_stop_string
+				 : gfor_fndecl_stop_string,
+				 2, se.expr, se.string_length);
+    }
+
+  gfc_add_expr_to_block (&se.pre, tmp);
+
+  gfc_add_block_to_block (&se.pre, &se.post);
+
+  return gfc_finish_block (&se.pre);
+}
+
+
+tree
+gfc_trans_sync (gfc_code *code, gfc_exec_op type __attribute__ ((unused)))
+{
+  gfc_se se;
+
+  if ((code->expr1 && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)) || code->expr2)
+    {
+      gfc_init_se (&se, NULL);
+      gfc_start_block (&se.pre);
+    }
+
+  /* Check SYNC IMAGES(imageset) for valid image index.
+     FIXME: Add a check for image-set arrays. */
+  if (code->expr1 && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+      && code->expr1->rank == 0)
+    {
+      tree cond;
+      gfc_conv_expr (&se, code->expr1);
+      cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			      se.expr, build_int_cst (TREE_TYPE (se.expr), 1));
+      gfc_trans_runtime_check (true, false, cond, &se.pre,
+			       &code->expr1->where, "Invalid image number "
+			       "%d in SYNC IMAGES",
+			       fold_convert (integer_type_node, se.expr));
+    }
+
+  /* If STAT is present, set it to zero.  */
+  if (code->expr2)
+    {
+      gcc_assert (code->expr2->expr_type == EXPR_VARIABLE);
+      gfc_conv_expr (&se, code->expr2);
+      gfc_add_modify (&se.pre, se.expr, build_int_cst (TREE_TYPE (se.expr), 0));
+    }
+
+  if ((code->expr1 && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)) || code->expr2)
+    return gfc_finish_block (&se.pre);
+ 
+  return NULL_TREE;
+}
+
+
+/* Generate GENERIC for the IF construct. This function also deals with
+   the simple IF statement, because the front end translates the IF
+   statement into an IF construct.
+
+   We translate:
+
+        IF (cond) THEN
+           then_clause
+        ELSEIF (cond2)
+           elseif_clause
+        ELSE
+           else_clause
+        ENDIF
+
+   into:
+
+        pre_cond_s;
+        if (cond_s)
+          {
+            then_clause;
+          }
+        else
+          {
+            pre_cond_s
+            if (cond_s)
+              {
+                elseif_clause
+              }
+            else
+              {
+                else_clause;
+              }
+          }
+
+   where COND_S is the simplified version of the predicate. PRE_COND_S
+   are the pre side-effects produced by the translation of the
+   conditional.
+   We need to build the chain recursively otherwise we run into
+   problems with folding incomplete statements.  */
+
+static tree
+gfc_trans_if_1 (gfc_code * code)
+{
+  gfc_se if_se;
+  tree stmt, elsestmt;
+  locus saved_loc;
+  location_t loc;
+
+  /* Check for an unconditional ELSE clause.  */
+  if (!code->expr1)
+    return gfc_trans_code (code->next);
+
+  /* Initialize a statement builder for each block. Puts in NULL_TREEs.  */
+  gfc_init_se (&if_se, NULL);
+  gfc_start_block (&if_se.pre);
+
+  /* Calculate the IF condition expression.  */
+  if (code->expr1->where.lb)
+    {
+      gfc_save_backend_locus (&saved_loc);
+      gfc_set_backend_locus (&code->expr1->where);
+    }
+
+  gfc_conv_expr_val (&if_se, code->expr1);
+
+  if (code->expr1->where.lb)
+    gfc_restore_backend_locus (&saved_loc);
+
+  /* Translate the THEN clause.  */
+  stmt = gfc_trans_code (code->next);
+
+  /* Translate the ELSE clause.  */
+  if (code->block)
+    elsestmt = gfc_trans_if_1 (code->block);
+  else
+    elsestmt = build_empty_stmt (input_location);
+
+  /* Build the condition expression and add it to the condition block.  */
+  loc = code->expr1->where.lb ? code->expr1->where.lb->location : input_location;
+  stmt = fold_build3_loc (loc, COND_EXPR, void_type_node, if_se.expr, stmt,
+			  elsestmt);
+  
+  gfc_add_expr_to_block (&if_se.pre, stmt);
+
+  /* Finish off this statement.  */
+  return gfc_finish_block (&if_se.pre);
+}
+
+tree
+gfc_trans_if (gfc_code * code)
+{
+  stmtblock_t body;
+  tree exit_label;
+
+  /* Create exit label so it is available for trans'ing the body code.  */
+  exit_label = gfc_build_label_decl (NULL_TREE);
+  code->exit_label = exit_label;
+
+  /* Translate the actual code in code->block.  */
+  gfc_init_block (&body);
+  gfc_add_expr_to_block (&body, gfc_trans_if_1 (code->block));
+
+  /* Add exit label.  */
+  gfc_add_expr_to_block (&body, build1_v (LABEL_EXPR, exit_label));
+
+  return gfc_finish_block (&body);
+}
+
+
+/* Translate an arithmetic IF expression.
+
+   IF (cond) label1, label2, label3 translates to
+
+    if (cond <= 0)
+      {
+        if (cond < 0)
+          goto label1;
+        else // cond == 0
+          goto label2;
+      }
+    else // cond > 0
+      goto label3;
+
+   An optimized version can be generated in case of equal labels.
+   E.g., if label1 is equal to label2, we can translate it to
+
+    if (cond <= 0)
+      goto label1;
+    else
+      goto label3;
+*/
+
+tree
+gfc_trans_arithmetic_if (gfc_code * code)
+{
+  gfc_se se;
+  tree tmp;
+  tree branch1;
+  tree branch2;
+  tree zero;
+
+  /* Start a new block.  */
+  gfc_init_se (&se, NULL);
+  gfc_start_block (&se.pre);
+
+  /* Pre-evaluate COND.  */
+  gfc_conv_expr_val (&se, code->expr1);
+  se.expr = gfc_evaluate_now (se.expr, &se.pre);
+
+  /* Build something to compare with.  */
+  zero = gfc_build_const (TREE_TYPE (se.expr), integer_zero_node);
+
+  if (code->label1->value != code->label2->value)
+    {
+      /* If (cond < 0) take branch1 else take branch2.
+         First build jumps to the COND .LT. 0 and the COND .EQ. 0 cases.  */
+      branch1 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label1));
+      branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label2));
+
+      if (code->label1->value != code->label3->value)
+        tmp = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+			       se.expr, zero);
+      else
+        tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			       se.expr, zero);
+
+      branch1 = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+				 tmp, branch1, branch2);
+    }
+  else
+    branch1 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label1));
+
+  if (code->label1->value != code->label3->value
+      && code->label2->value != code->label3->value)
+    {
+      /* if (cond <= 0) take branch1 else take branch2.  */
+      branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label3));
+      tmp = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
+			     se.expr, zero);
+      branch1 = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+				 tmp, branch1, branch2);
+    }
+
+  /* Append the COND_EXPR to the evaluation of COND, and return.  */
+  gfc_add_expr_to_block (&se.pre, branch1);
+  return gfc_finish_block (&se.pre);
+}
+
+
+/* Translate a CRITICAL block. */
+tree
+gfc_trans_critical (gfc_code *code)
+{
+  stmtblock_t block;
+  tree tmp;
+
+  gfc_start_block (&block);
+  tmp = gfc_trans_code (code->block->next);
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Do proper initialization for ASSOCIATE names.  */
+
+static void
+trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
+{
+  gfc_expr *e;
+  tree tmp;
+
+  gcc_assert (sym->assoc);
+  e = sym->assoc->target;
+
+  /* Do a `pointer assignment' with updated descriptor (or assign descriptor
+     to array temporary) for arrays with either unknown shape or if associating
+     to a variable.  */
+  if (sym->attr.dimension
+      && (sym->as->type == AS_DEFERRED || sym->assoc->variable))
+    {
+      gfc_se se;
+      gfc_ss *ss;
+      tree desc;
+
+      desc = sym->backend_decl;
+
+      /* If association is to an expression, evaluate it and create temporary.
+	 Otherwise, get descriptor of target for pointer assignment.  */
+      gfc_init_se (&se, NULL);
+      ss = gfc_walk_expr (e);
+      if (sym->assoc->variable)
+	{
+	  se.direct_byref = 1;
+	  se.expr = desc;
+	}
+      gfc_conv_expr_descriptor (&se, e, ss);
+
+      /* If we didn't already do the pointer assignment, set associate-name
+	 descriptor to the one generated for the temporary.  */
+      if (!sym->assoc->variable)
+	{
+	  int dim;
+
+	  gfc_add_modify (&se.pre, desc, se.expr);
+
+	  /* The generated descriptor has lower bound zero (as array
+	     temporary), shift bounds so we get lower bounds of 1.  */
+	  for (dim = 0; dim < e->rank; ++dim)
+	    gfc_conv_shift_descriptor_lbound (&se.pre, desc,
+					      dim, gfc_index_one_node);
+	}
+
+      /* Done, register stuff as init / cleanup code.  */
+      gfc_add_init_cleanup (block, gfc_finish_block (&se.pre),
+			    gfc_finish_block (&se.post));
+    }
+
+  /* Do a scalar pointer assignment; this is for scalar variable targets.  */
+  else if (gfc_is_associate_pointer (sym))
+    {
+      gfc_se se;
+
+      gcc_assert (!sym->attr.dimension);
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr (&se, e);
+
+      tmp = TREE_TYPE (sym->backend_decl);
+      tmp = gfc_build_addr_expr (tmp, se.expr);
+      gfc_add_modify (&se.pre, sym->backend_decl, tmp);
+      
+      gfc_add_init_cleanup (block, gfc_finish_block( &se.pre),
+			    gfc_finish_block (&se.post));
+    }
+
+  /* Do a simple assignment.  This is for scalar expressions, where we
+     can simply use expression assignment.  */
+  else
+    {
+      gfc_expr *lhs;
+
+      lhs = gfc_lval_expr_from_sym (sym);
+      tmp = gfc_trans_assignment (lhs, e, false, true);
+      gfc_add_init_cleanup (block, tmp, NULL_TREE);
+    }
+}
+
+
+/* Translate a BLOCK construct.  This is basically what we would do for a
+   procedure body.  */
+
+tree
+gfc_trans_block_construct (gfc_code* code)
+{
+  gfc_namespace* ns;
+  gfc_symbol* sym;
+  gfc_wrapped_block block;
+  tree exit_label;
+  stmtblock_t body;
+  gfc_association_list *ass;
+
+  ns = code->ext.block.ns;
+  gcc_assert (ns);
+  sym = ns->proc_name;
+  gcc_assert (sym);
+
+  /* Process local variables.  */
+  gcc_assert (!sym->tlink);
+  sym->tlink = sym;
+  gfc_process_block_locals (ns);
+
+  /* Generate code including exit-label.  */
+  gfc_init_block (&body);
+  exit_label = gfc_build_label_decl (NULL_TREE);
+  code->exit_label = exit_label;
+  gfc_add_expr_to_block (&body, gfc_trans_code (ns->code));
+  gfc_add_expr_to_block (&body, build1_v (LABEL_EXPR, exit_label));
+
+  /* Finish everything.  */
+  gfc_start_wrapped_block (&block, gfc_finish_block (&body));
+  gfc_trans_deferred_vars (sym, &block);
+  for (ass = code->ext.block.assoc; ass; ass = ass->next)
+    trans_associate_var (ass->st->n.sym, &block);
+    
+  return gfc_finish_wrapped_block (&block);
+}
+
+
+/* Translate the simple DO construct.  This is where the loop variable has
+   integer type and step +-1.  We can't use this in the general case
+   because integer overflow and floating point errors could give incorrect
+   results.
+   We translate a do loop from:
+
+   DO dovar = from, to, step
+      body
+   END DO
+
+   to:
+
+   [Evaluate loop bounds and step]
+   dovar = from;
+   if ((step > 0) ? (dovar <= to) : (dovar => to))
+    {
+      for (;;)
+        {
+	  body;
+   cycle_label:
+	  cond = (dovar == to);
+	  dovar += step;
+	  if (cond) goto end_label;
+	}
+      }
+   end_label:
+
+   This helps the optimizers by avoiding the extra induction variable
+   used in the general case.  */
+
+static tree
+gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar,
+		     tree from, tree to, tree step, tree exit_cond)
+{
+  stmtblock_t body;
+  tree type;
+  tree cond;
+  tree tmp;
+  tree saved_dovar = NULL;
+  tree cycle_label;
+  tree exit_label;
+  location_t loc;
+  
+  type = TREE_TYPE (dovar);
+
+  loc = code->ext.iterator->start->where.lb->location;
+
+  /* Initialize the DO variable: dovar = from.  */
+  gfc_add_modify_loc (loc, pblock, dovar, from);
+  
+  /* Save value for do-tinkering checking. */
+  if (gfc_option.rtcheck & GFC_RTCHECK_DO)
+    {
+      saved_dovar = gfc_create_var (type, ".saved_dovar");
+      gfc_add_modify_loc (loc, pblock, saved_dovar, dovar);
+    }
+
+  /* Cycle and exit statements are implemented with gotos.  */
+  cycle_label = gfc_build_label_decl (NULL_TREE);
+  exit_label = gfc_build_label_decl (NULL_TREE);
+
+  /* Put the labels where they can be found later. See gfc_trans_do().  */
+  code->cycle_label = cycle_label;
+  code->exit_label = exit_label;
+
+  /* Loop body.  */
+  gfc_start_block (&body);
+
+  /* Main loop body.  */
+  tmp = gfc_trans_code_cond (code->block->next, exit_cond);
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Label for cycle statements (if needed).  */
+  if (TREE_USED (cycle_label))
+    {
+      tmp = build1_v (LABEL_EXPR, cycle_label);
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* Check whether someone has modified the loop variable. */
+  if (gfc_option.rtcheck & GFC_RTCHECK_DO)
+    {
+      tmp = fold_build2_loc (loc, NE_EXPR, boolean_type_node,
+			     dovar, saved_dovar);
+      gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
+			       "Loop variable has been modified");
+    }
+
+  /* Exit the loop if there is an I/O result condition or error.  */
+  if (exit_cond)
+    {
+      tmp = build1_v (GOTO_EXPR, exit_label);
+      tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
+			     exit_cond, tmp,
+			     build_empty_stmt (loc));
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* Evaluate the loop condition.  */
+  cond = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, dovar,
+			  to);
+  cond = gfc_evaluate_now_loc (loc, cond, &body);
+
+  /* Increment the loop variable.  */
+  tmp = fold_build2_loc (loc, PLUS_EXPR, type, dovar, step);
+  gfc_add_modify_loc (loc, &body, dovar, tmp);
+
+  if (gfc_option.rtcheck & GFC_RTCHECK_DO)
+    gfc_add_modify_loc (loc, &body, saved_dovar, dovar);
+
+  /* The loop exit.  */
+  tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label);
+  TREE_USED (exit_label) = 1;
+  tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
+			 cond, tmp, build_empty_stmt (loc));
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Finish the loop body.  */
+  tmp = gfc_finish_block (&body);
+  tmp = fold_build1_loc (loc, LOOP_EXPR, void_type_node, tmp);
+
+  /* Only execute the loop if the number of iterations is positive.  */
+  if (tree_int_cst_sgn (step) > 0)
+    cond = fold_build2_loc (loc, LE_EXPR, boolean_type_node, dovar,
+			    to);
+  else
+    cond = fold_build2_loc (loc, GE_EXPR, boolean_type_node, dovar,
+			    to);
+  tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, cond, tmp,
+			 build_empty_stmt (loc));
+  gfc_add_expr_to_block (pblock, tmp);
+
+  /* Add the exit label.  */
+  tmp = build1_v (LABEL_EXPR, exit_label);
+  gfc_add_expr_to_block (pblock, tmp);
+
+  return gfc_finish_block (pblock);
+}
+
+/* Translate the DO construct.  This obviously is one of the most
+   important ones to get right with any compiler, but especially
+   so for Fortran.
+
+   We special case some loop forms as described in gfc_trans_simple_do.
+   For other cases we implement them with a separate loop count,
+   as described in the standard.
+
+   We translate a do loop from:
+
+   DO dovar = from, to, step
+      body
+   END DO
+
+   to:
+
+   [evaluate loop bounds and step]
+   empty = (step > 0 ? to < from : to > from);
+   countm1 = (to - from) / step;
+   dovar = from;
+   if (empty) goto exit_label;
+   for (;;)
+     {
+       body;
+cycle_label:
+       dovar += step
+       if (countm1 ==0) goto exit_label;
+       countm1--;
+     }
+exit_label:
+
+   countm1 is an unsigned integer.  It is equal to the loop count minus one,
+   because the loop count itself can overflow.  */
+
+tree
+gfc_trans_do (gfc_code * code, tree exit_cond)
+{
+  gfc_se se;
+  tree dovar;
+  tree saved_dovar = NULL;
+  tree from;
+  tree to;
+  tree step;
+  tree countm1;
+  tree type;
+  tree utype;
+  tree cond;
+  tree cycle_label;
+  tree exit_label;
+  tree tmp;
+  tree pos_step;
+  stmtblock_t block;
+  stmtblock_t body;
+  location_t loc;
+
+  gfc_start_block (&block);
+
+  loc = code->ext.iterator->start->where.lb->location;
+
+  /* Evaluate all the expressions in the iterator.  */
+  gfc_init_se (&se, NULL);
+  gfc_conv_expr_lhs (&se, code->ext.iterator->var);
+  gfc_add_block_to_block (&block, &se.pre);
+  dovar = se.expr;
+  type = TREE_TYPE (dovar);
+
+  gfc_init_se (&se, NULL);
+  gfc_conv_expr_val (&se, code->ext.iterator->start);
+  gfc_add_block_to_block (&block, &se.pre);
+  from = gfc_evaluate_now (se.expr, &block);
+
+  gfc_init_se (&se, NULL);
+  gfc_conv_expr_val (&se, code->ext.iterator->end);
+  gfc_add_block_to_block (&block, &se.pre);
+  to = gfc_evaluate_now (se.expr, &block);
+
+  gfc_init_se (&se, NULL);
+  gfc_conv_expr_val (&se, code->ext.iterator->step);
+  gfc_add_block_to_block (&block, &se.pre);
+  step = gfc_evaluate_now (se.expr, &block);
+
+  if (gfc_option.rtcheck & GFC_RTCHECK_DO)
+    {
+      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, step,
+			     build_zero_cst (type));
+      gfc_trans_runtime_check (true, false, tmp, &block, &code->loc,
+			       "DO step value is zero");
+    }
+
+  /* Special case simple loops.  */
+  if (TREE_CODE (type) == INTEGER_TYPE
+      && (integer_onep (step)
+	|| tree_int_cst_equal (step, integer_minus_one_node)))
+    return gfc_trans_simple_do (code, &block, dovar, from, to, step, exit_cond);
+
+  pos_step = fold_build2_loc (loc, GT_EXPR, boolean_type_node, step,
+			      build_zero_cst (type));
+
+  if (TREE_CODE (type) == INTEGER_TYPE)
+    utype = unsigned_type_for (type);
+  else
+    utype = unsigned_type_for (gfc_array_index_type);
+  countm1 = gfc_create_var (utype, "countm1");
+
+  /* Cycle and exit statements are implemented with gotos.  */
+  cycle_label = gfc_build_label_decl (NULL_TREE);
+  exit_label = gfc_build_label_decl (NULL_TREE);
+  TREE_USED (exit_label) = 1;
+
+  /* Put these labels where they can be found later.  */
+  code->cycle_label = cycle_label;
+  code->exit_label = exit_label;
+
+  /* Initialize the DO variable: dovar = from.  */
+  gfc_add_modify (&block, dovar, from);
+
+  /* Save value for do-tinkering checking. */
+  if (gfc_option.rtcheck & GFC_RTCHECK_DO)
+    {
+      saved_dovar = gfc_create_var (type, ".saved_dovar");
+      gfc_add_modify_loc (loc, &block, saved_dovar, dovar);
+    }
+
+  /* Initialize loop count and jump to exit label if the loop is empty.
+     This code is executed before we enter the loop body. We generate:
+     step_sign = sign(1,step);
+     if (step > 0)
+       {
+	 if (to < from)
+	   goto exit_label;
+       }
+     else
+       {
+	 if (to > from)
+	   goto exit_label;
+       }
+       countm1 = (to*step_sign - from*step_sign) / (step*step_sign);
+
+  */
+
+  if (TREE_CODE (type) == INTEGER_TYPE)
+    {
+      tree pos, neg, step_sign, to2, from2, step2;
+
+      /* Calculate SIGN (1,step), as (step < 0 ? -1 : 1)  */
+
+      tmp = fold_build2_loc (loc, LT_EXPR, boolean_type_node, step,
+			     build_int_cst (TREE_TYPE (step), 0));
+      step_sign = fold_build3_loc (loc, COND_EXPR, type, tmp, 
+				   build_int_cst (type, -1), 
+				   build_int_cst (type, 1));
+
+      tmp = fold_build2_loc (loc, LT_EXPR, boolean_type_node, to, from);
+      pos = fold_build3_loc (loc, COND_EXPR, void_type_node, tmp,
+			     fold_build1_loc (loc, GOTO_EXPR, void_type_node,
+					      exit_label),
+			     build_empty_stmt (loc));
+
+      tmp = fold_build2_loc (loc, GT_EXPR, boolean_type_node, to,
+			     from);
+      neg = fold_build3_loc (loc, COND_EXPR, void_type_node, tmp,
+			     fold_build1_loc (loc, GOTO_EXPR, void_type_node,
+					      exit_label),
+			     build_empty_stmt (loc));
+      tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
+			     pos_step, pos, neg);
+
+      gfc_add_expr_to_block (&block, tmp);
+
+      /* Calculate the loop count.  to-from can overflow, so
+	 we cast to unsigned.  */
+
+      to2 = fold_build2_loc (loc, MULT_EXPR, type, step_sign, to);
+      from2 = fold_build2_loc (loc, MULT_EXPR, type, step_sign, from);
+      step2 = fold_build2_loc (loc, MULT_EXPR, type, step_sign, step);
+      step2 = fold_convert (utype, step2);
+      tmp = fold_build2_loc (loc, MINUS_EXPR, type, to2, from2);
+      tmp = fold_convert (utype, tmp);
+      tmp = fold_build2_loc (loc, TRUNC_DIV_EXPR, utype, tmp, step2);
+      tmp = fold_build2_loc (loc, MODIFY_EXPR, void_type_node, countm1, tmp);
+      gfc_add_expr_to_block (&block, tmp);
+    }
+  else
+    {
+      /* TODO: We could use the same width as the real type.
+	 This would probably cause more problems that it solves
+	 when we implement "long double" types.  */
+
+      tmp = fold_build2_loc (loc, MINUS_EXPR, type, to, from);
+      tmp = fold_build2_loc (loc, RDIV_EXPR, type, tmp, step);
+      tmp = fold_build1_loc (loc, FIX_TRUNC_EXPR, utype, tmp);
+      gfc_add_modify (&block, countm1, tmp);
+
+      /* We need a special check for empty loops:
+	 empty = (step > 0 ? to < from : to > from);  */
+      tmp = fold_build3_loc (loc, COND_EXPR, boolean_type_node, pos_step,
+			     fold_build2_loc (loc, LT_EXPR,
+					      boolean_type_node, to, from),
+			     fold_build2_loc (loc, GT_EXPR,
+					      boolean_type_node, to, from));
+      /* If the loop is empty, go directly to the exit label.  */
+      tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, tmp,
+			 build1_v (GOTO_EXPR, exit_label),
+			 build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block, tmp);
+    }
+
+  /* Loop body.  */
+  gfc_start_block (&body);
+
+  /* Main loop body.  */
+  tmp = gfc_trans_code_cond (code->block->next, exit_cond);
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Label for cycle statements (if needed).  */
+  if (TREE_USED (cycle_label))
+    {
+      tmp = build1_v (LABEL_EXPR, cycle_label);
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* Check whether someone has modified the loop variable. */
+  if (gfc_option.rtcheck & GFC_RTCHECK_DO)
+    {
+      tmp = fold_build2_loc (loc, NE_EXPR, boolean_type_node, dovar,
+			     saved_dovar);
+      gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
+			       "Loop variable has been modified");
+    }
+
+  /* Exit the loop if there is an I/O result condition or error.  */
+  if (exit_cond)
+    {
+      tmp = build1_v (GOTO_EXPR, exit_label);
+      tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
+			     exit_cond, tmp,
+			     build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* Increment the loop variable.  */
+  tmp = fold_build2_loc (loc, PLUS_EXPR, type, dovar, step);
+  gfc_add_modify_loc (loc, &body, dovar, tmp);
+
+  if (gfc_option.rtcheck & GFC_RTCHECK_DO)
+    gfc_add_modify_loc (loc, &body, saved_dovar, dovar);
+
+  /* End with the loop condition.  Loop until countm1 == 0.  */
+  cond = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, countm1,
+			  build_int_cst (utype, 0));
+  tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label);
+  tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
+			 cond, tmp, build_empty_stmt (loc));
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Decrement the loop count.  */
+  tmp = fold_build2_loc (loc, MINUS_EXPR, utype, countm1,
+			 build_int_cst (utype, 1));
+  gfc_add_modify_loc (loc, &body, countm1, tmp);
+
+  /* End of loop body.  */
+  tmp = gfc_finish_block (&body);
+
+  /* The for loop itself.  */
+  tmp = fold_build1_loc (loc, LOOP_EXPR, void_type_node, tmp);
+  gfc_add_expr_to_block (&block, tmp);
+
+  /* Add the exit label.  */
+  tmp = build1_v (LABEL_EXPR, exit_label);
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Translate the DO WHILE construct.
+
+   We translate
+
+   DO WHILE (cond)
+      body
+   END DO
+
+   to:
+
+   for ( ; ; )
+     {
+       pre_cond;
+       if (! cond) goto exit_label;
+       body;
+cycle_label:
+     }
+exit_label:
+
+   Because the evaluation of the exit condition `cond' may have side
+   effects, we can't do much for empty loop bodies.  The backend optimizers
+   should be smart enough to eliminate any dead loops.  */
+
+tree
+gfc_trans_do_while (gfc_code * code)
+{
+  gfc_se cond;
+  tree tmp;
+  tree cycle_label;
+  tree exit_label;
+  stmtblock_t block;
+
+  /* Everything we build here is part of the loop body.  */
+  gfc_start_block (&block);
+
+  /* Cycle and exit statements are implemented with gotos.  */
+  cycle_label = gfc_build_label_decl (NULL_TREE);
+  exit_label = gfc_build_label_decl (NULL_TREE);
+
+  /* Put the labels where they can be found later. See gfc_trans_do().  */
+  code->cycle_label = cycle_label;
+  code->exit_label = exit_label;
+
+  /* Create a GIMPLE version of the exit condition.  */
+  gfc_init_se (&cond, NULL);
+  gfc_conv_expr_val (&cond, code->expr1);
+  gfc_add_block_to_block (&block, &cond.pre);
+  cond.expr = fold_build1_loc (code->expr1->where.lb->location,
+			       TRUTH_NOT_EXPR, boolean_type_node, cond.expr);
+
+  /* Build "IF (! cond) GOTO exit_label".  */
+  tmp = build1_v (GOTO_EXPR, exit_label);
+  TREE_USED (exit_label) = 1;
+  tmp = fold_build3_loc (code->expr1->where.lb->location, COND_EXPR,
+			 void_type_node, cond.expr, tmp,
+			 build_empty_stmt (code->expr1->where.lb->location));
+  gfc_add_expr_to_block (&block, tmp);
+
+  /* The main body of the loop.  */
+  tmp = gfc_trans_code (code->block->next);
+  gfc_add_expr_to_block (&block, tmp);
+
+  /* Label for cycle statements (if needed).  */
+  if (TREE_USED (cycle_label))
+    {
+      tmp = build1_v (LABEL_EXPR, cycle_label);
+      gfc_add_expr_to_block (&block, tmp);
+    }
+
+  /* End of loop body.  */
+  tmp = gfc_finish_block (&block);
+
+  gfc_init_block (&block);
+  /* Build the loop.  */
+  tmp = fold_build1_loc (code->expr1->where.lb->location, LOOP_EXPR,
+			 void_type_node, tmp);
+  gfc_add_expr_to_block (&block, tmp);
+
+  /* Add the exit label.  */
+  tmp = build1_v (LABEL_EXPR, exit_label);
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Translate the SELECT CASE construct for INTEGER case expressions,
+   without killing all potential optimizations.  The problem is that
+   Fortran allows unbounded cases, but the back-end does not, so we
+   need to intercept those before we enter the equivalent SWITCH_EXPR
+   we can build.
+
+   For example, we translate this,
+
+   SELECT CASE (expr)
+      CASE (:100,101,105:115)
+	 block_1
+      CASE (190:199,200:)
+	 block_2
+      CASE (300)
+	 block_3
+      CASE DEFAULT
+	 block_4
+   END SELECT
+
+   to the GENERIC equivalent,
+
+     switch (expr)
+       {
+	 case (minimum value for typeof(expr) ... 100:
+	 case 101:
+	 case 105 ... 114:
+	   block1:
+	   goto end_label;
+
+	 case 200 ... (maximum value for typeof(expr):
+	 case 190 ... 199:
+	   block2;
+	   goto end_label;
+
+	 case 300:
+	   block_3;
+	   goto end_label;
+
+	 default:
+	   block_4;
+	   goto end_label;
+       }
+
+     end_label:  */
+
+static tree
+gfc_trans_integer_select (gfc_code * code)
+{
+  gfc_code *c;
+  gfc_case *cp;
+  tree end_label;
+  tree tmp;
+  gfc_se se;
+  stmtblock_t block;
+  stmtblock_t body;
+
+  gfc_start_block (&block);
+
+  /* Calculate the switch expression.  */
+  gfc_init_se (&se, NULL);
+  gfc_conv_expr_val (&se, code->expr1);
+  gfc_add_block_to_block (&block, &se.pre);
+
+  end_label = gfc_build_label_decl (NULL_TREE);
+
+  gfc_init_block (&body);
+
+  for (c = code->block; c; c = c->block)
+    {
+      for (cp = c->ext.block.case_list; cp; cp = cp->next)
+	{
+	  tree low, high;
+          tree label;
+
+	  /* Assume it's the default case.  */
+	  low = high = NULL_TREE;
+
+	  if (cp->low)
+	    {
+	      low = gfc_conv_mpz_to_tree (cp->low->value.integer,
+					  cp->low->ts.kind);
+
+	      /* If there's only a lower bound, set the high bound to the
+		 maximum value of the case expression.  */
+	      if (!cp->high)
+		high = TYPE_MAX_VALUE (TREE_TYPE (se.expr));
+	    }
+
+	  if (cp->high)
+	    {
+	      /* Three cases are possible here:
+
+		 1) There is no lower bound, e.g. CASE (:N).
+		 2) There is a lower bound .NE. high bound, that is
+		    a case range, e.g. CASE (N:M) where M>N (we make
+		    sure that M>N during type resolution).
+		 3) There is a lower bound, and it has the same value
+		    as the high bound, e.g. CASE (N:N).  This is our
+		    internal representation of CASE(N).
+
+		 In the first and second case, we need to set a value for
+		 high.  In the third case, we don't because the GCC middle
+		 end represents a single case value by just letting high be
+		 a NULL_TREE.  We can't do that because we need to be able
+		 to represent unbounded cases.  */
+
+	      if (!cp->low
+		  || (cp->low
+		      && mpz_cmp (cp->low->value.integer,
+				  cp->high->value.integer) != 0))
+		high = gfc_conv_mpz_to_tree (cp->high->value.integer,
+					     cp->high->ts.kind);
+
+	      /* Unbounded case.  */
+	      if (!cp->low)
+		low = TYPE_MIN_VALUE (TREE_TYPE (se.expr));
+	    }
+
+          /* Build a label.  */
+          label = gfc_build_label_decl (NULL_TREE);
+
+	  /* Add this case label.
+             Add parameter 'label', make it match GCC backend.  */
+	  tmp = fold_build3_loc (input_location, CASE_LABEL_EXPR,
+				 void_type_node, low, high, label);
+	  gfc_add_expr_to_block (&body, tmp);
+	}
+
+      /* Add the statements for this case.  */
+      tmp = gfc_trans_code (c->next);
+      gfc_add_expr_to_block (&body, tmp);
+
+      /* Break to the end of the construct.  */
+      tmp = build1_v (GOTO_EXPR, end_label);
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  tmp = gfc_finish_block (&body);
+  tmp = build3_v (SWITCH_EXPR, se.expr, tmp, NULL_TREE);
+  gfc_add_expr_to_block (&block, tmp);
+
+  tmp = build1_v (LABEL_EXPR, end_label);
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Translate the SELECT CASE construct for LOGICAL case expressions.
+
+   There are only two cases possible here, even though the standard
+   does allow three cases in a LOGICAL SELECT CASE construct: .TRUE.,
+   .FALSE., and DEFAULT.
+
+   We never generate more than two blocks here.  Instead, we always
+   try to eliminate the DEFAULT case.  This way, we can translate this
+   kind of SELECT construct to a simple
+
+   if {} else {};
+
+   expression in GENERIC.  */
+
+static tree
+gfc_trans_logical_select (gfc_code * code)
+{
+  gfc_code *c;
+  gfc_code *t, *f, *d;
+  gfc_case *cp;
+  gfc_se se;
+  stmtblock_t block;
+
+  /* Assume we don't have any cases at all.  */
+  t = f = d = NULL;
+
+  /* Now see which ones we actually do have.  We can have at most two
+     cases in a single case list: one for .TRUE. and one for .FALSE.
+     The default case is always separate.  If the cases for .TRUE. and
+     .FALSE. are in the same case list, the block for that case list
+     always executed, and we don't generate code a COND_EXPR.  */
+  for (c = code->block; c; c = c->block)
+    {
+      for (cp = c->ext.block.case_list; cp; cp = cp->next)
+	{
+	  if (cp->low)
+	    {
+	      if (cp->low->value.logical == 0) /* .FALSE.  */
+		f = c;
+	      else /* if (cp->value.logical != 0), thus .TRUE.  */
+		t = c;
+	    }
+	  else
+	    d = c;
+	}
+    }
+
+  /* Start a new block.  */
+  gfc_start_block (&block);
+
+  /* Calculate the switch expression.  We always need to do this
+     because it may have side effects.  */
+  gfc_init_se (&se, NULL);
+  gfc_conv_expr_val (&se, code->expr1);
+  gfc_add_block_to_block (&block, &se.pre);
+
+  if (t == f && t != NULL)
+    {
+      /* Cases for .TRUE. and .FALSE. are in the same block.  Just
+         translate the code for these cases, append it to the current
+         block.  */
+      gfc_add_expr_to_block (&block, gfc_trans_code (t->next));
+    }
+  else
+    {
+      tree true_tree, false_tree, stmt;
+
+      true_tree = build_empty_stmt (input_location);
+      false_tree = build_empty_stmt (input_location);
+
+      /* If we have a case for .TRUE. and for .FALSE., discard the default case.
+          Otherwise, if .TRUE. or .FALSE. is missing and there is a default case,
+          make the missing case the default case.  */
+      if (t != NULL && f != NULL)
+	d = NULL;
+      else if (d != NULL)
+        {
+	  if (t == NULL)
+	    t = d;
+	  else
+	    f = d;
+	}
+
+      /* Translate the code for each of these blocks, and append it to
+         the current block.  */
+      if (t != NULL)
+        true_tree = gfc_trans_code (t->next);
+
+      if (f != NULL)
+	false_tree = gfc_trans_code (f->next);
+
+      stmt = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+			      se.expr, true_tree, false_tree);
+      gfc_add_expr_to_block (&block, stmt);
+    }
+
+  return gfc_finish_block (&block);
+}
+
+
+/* The jump table types are stored in static variables to avoid
+   constructing them from scratch every single time.  */
+static GTY(()) tree select_struct[2];
+
+/* Translate the SELECT CASE construct for CHARACTER case expressions.
+   Instead of generating compares and jumps, it is far simpler to
+   generate a data structure describing the cases in order and call a
+   library subroutine that locates the right case.
+   This is particularly true because this is the only case where we
+   might have to dispose of a temporary.
+   The library subroutine returns a pointer to jump to or NULL if no
+   branches are to be taken.  */
+
+static tree
+gfc_trans_character_select (gfc_code *code)
+{
+  tree init, end_label, tmp, type, case_num, label, fndecl;
+  stmtblock_t block, body;
+  gfc_case *cp, *d;
+  gfc_code *c;
+  gfc_se se, expr1se;
+  int n, k;
+  VEC(constructor_elt,gc) *inits = NULL;
+
+  tree pchartype = gfc_get_pchar_type (code->expr1->ts.kind);
+
+  /* The jump table types are stored in static variables to avoid
+     constructing them from scratch every single time.  */
+  static tree ss_string1[2], ss_string1_len[2];
+  static tree ss_string2[2], ss_string2_len[2];
+  static tree ss_target[2];
+
+  cp = code->block->ext.block.case_list;
+  while (cp->left != NULL)
+    cp = cp->left;
+
+  /* Generate the body */
+  gfc_start_block (&block);
+  gfc_init_se (&expr1se, NULL);
+  gfc_conv_expr_reference (&expr1se, code->expr1);
+
+  gfc_add_block_to_block (&block, &expr1se.pre);
+
+  end_label = gfc_build_label_decl (NULL_TREE);
+
+  gfc_init_block (&body);
+
+  /* Attempt to optimize length 1 selects.  */
+  if (integer_onep (expr1se.string_length))
+    {
+      for (d = cp; d; d = d->right)
+	{
+	  int i;
+	  if (d->low)
+	    {
+	      gcc_assert (d->low->expr_type == EXPR_CONSTANT
+			  && d->low->ts.type == BT_CHARACTER);
+	      if (d->low->value.character.length > 1)
+		{
+		  for (i = 1; i < d->low->value.character.length; i++)
+		    if (d->low->value.character.string[i] != ' ')
+		      break;
+		  if (i != d->low->value.character.length)
+		    {
+		      if (optimize && d->high && i == 1)
+			{
+			  gcc_assert (d->high->expr_type == EXPR_CONSTANT
+				      && d->high->ts.type == BT_CHARACTER);
+			  if (d->high->value.character.length > 1
+			      && (d->low->value.character.string[0]
+				  == d->high->value.character.string[0])
+			      && d->high->value.character.string[1] != ' '
+			      && ((d->low->value.character.string[1] < ' ')
+				  == (d->high->value.character.string[1]
+				      < ' ')))
+			    continue;
+			}
+		      break;
+		    }
+		}
+	    }
+	  if (d->high)
+	    {
+	      gcc_assert (d->high->expr_type == EXPR_CONSTANT
+			  && d->high->ts.type == BT_CHARACTER);
+	      if (d->high->value.character.length > 1)
+		{
+		  for (i = 1; i < d->high->value.character.length; i++)
+		    if (d->high->value.character.string[i] != ' ')
+		      break;
+		  if (i != d->high->value.character.length)
+		    break;
+		}
+	    }
+	}
+      if (d == NULL)
+	{
+	  tree ctype = gfc_get_char_type (code->expr1->ts.kind);
+
+	  for (c = code->block; c; c = c->block)
+	    {
+	      for (cp = c->ext.block.case_list; cp; cp = cp->next)
+		{
+		  tree low, high;
+		  tree label;
+		  gfc_char_t r;
+
+		  /* Assume it's the default case.  */
+		  low = high = NULL_TREE;
+
+		  if (cp->low)
+		    {
+		      /* CASE ('ab') or CASE ('ab':'az') will never match
+			 any length 1 character.  */
+		      if (cp->low->value.character.length > 1
+			  && cp->low->value.character.string[1] != ' ')
+			continue;
+
+		      if (cp->low->value.character.length > 0)
+			r = cp->low->value.character.string[0];
+		      else
+			r = ' ';
+		      low = build_int_cst (ctype, r);
+
+		      /* If there's only a lower bound, set the high bound
+			 to the maximum value of the case expression.  */
+		      if (!cp->high)
+			high = TYPE_MAX_VALUE (ctype);
+		    }
+
+		  if (cp->high)
+		    {
+		      if (!cp->low
+			  || (cp->low->value.character.string[0]
+			      != cp->high->value.character.string[0]))
+			{
+			  if (cp->high->value.character.length > 0)
+			    r = cp->high->value.character.string[0];
+			  else
+			    r = ' ';
+			  high = build_int_cst (ctype, r);
+			}
+
+		      /* Unbounded case.  */
+		      if (!cp->low)
+			low = TYPE_MIN_VALUE (ctype);
+		    }
+
+		  /* Build a label.  */
+		  label = gfc_build_label_decl (NULL_TREE);
+
+		  /* Add this case label.
+		     Add parameter 'label', make it match GCC backend.  */
+		  tmp = fold_build3_loc (input_location, CASE_LABEL_EXPR,
+					 void_type_node, low, high, label);
+		  gfc_add_expr_to_block (&body, tmp);
+		}
+
+	      /* Add the statements for this case.  */
+	      tmp = gfc_trans_code (c->next);
+	      gfc_add_expr_to_block (&body, tmp);
+
+	      /* Break to the end of the construct.  */
+	      tmp = build1_v (GOTO_EXPR, end_label);
+	      gfc_add_expr_to_block (&body, tmp);
+	    }
+
+	  tmp = gfc_string_to_single_character (expr1se.string_length,
+						expr1se.expr,
+						code->expr1->ts.kind);
+	  case_num = gfc_create_var (ctype, "case_num");
+	  gfc_add_modify (&block, case_num, tmp);
+
+	  gfc_add_block_to_block (&block, &expr1se.post);
+
+	  tmp = gfc_finish_block (&body);
+	  tmp = build3_v (SWITCH_EXPR, case_num, tmp, NULL_TREE);
+	  gfc_add_expr_to_block (&block, tmp);
+
+	  tmp = build1_v (LABEL_EXPR, end_label);
+	  gfc_add_expr_to_block (&block, tmp);
+
+	  return gfc_finish_block (&block);
+	}
+    }
+
+  if (code->expr1->ts.kind == 1)
+    k = 0;
+  else if (code->expr1->ts.kind == 4)
+    k = 1;
+  else
+    gcc_unreachable ();
+
+  if (select_struct[k] == NULL)
+    {
+      tree *chain = NULL;
+      select_struct[k] = make_node (RECORD_TYPE);
+
+      if (code->expr1->ts.kind == 1)
+	TYPE_NAME (select_struct[k]) = get_identifier ("_jump_struct_char1");
+      else if (code->expr1->ts.kind == 4)
+	TYPE_NAME (select_struct[k]) = get_identifier ("_jump_struct_char4");
+      else
+	gcc_unreachable ();
+
+#undef ADD_FIELD
+#define ADD_FIELD(NAME, TYPE)						    \
+  ss_##NAME[k] = gfc_add_field_to_struct (select_struct[k],		    \
+					  get_identifier (stringize(NAME)), \
+					  TYPE,				    \
+					  &chain)
+
+      ADD_FIELD (string1, pchartype);
+      ADD_FIELD (string1_len, gfc_charlen_type_node);
+
+      ADD_FIELD (string2, pchartype);
+      ADD_FIELD (string2_len, gfc_charlen_type_node);
+
+      ADD_FIELD (target, integer_type_node);
+#undef ADD_FIELD
+
+      gfc_finish_type (select_struct[k]);
+    }
+
+  n = 0;
+  for (d = cp; d; d = d->right)
+    d->n = n++;
+
+  for (c = code->block; c; c = c->block)
+    {
+      for (d = c->ext.block.case_list; d; d = d->next)
+        {
+	  label = gfc_build_label_decl (NULL_TREE);
+	  tmp = fold_build3_loc (input_location, CASE_LABEL_EXPR,
+				 void_type_node,
+				 (d->low == NULL && d->high == NULL)
+				 ? NULL : build_int_cst (NULL_TREE, d->n),
+				 NULL, label);
+          gfc_add_expr_to_block (&body, tmp);
+        }
+
+      tmp = gfc_trans_code (c->next);
+      gfc_add_expr_to_block (&body, tmp);
+
+      tmp = build1_v (GOTO_EXPR, end_label);
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* Generate the structure describing the branches */
+  for (d = cp; d; d = d->right)
+    {
+      VEC(constructor_elt,gc) *node = NULL;
+
+      gfc_init_se (&se, NULL);
+
+      if (d->low == NULL)
+        {
+          CONSTRUCTOR_APPEND_ELT (node, ss_string1[k], null_pointer_node);
+          CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], integer_zero_node);
+        }
+      else
+        {
+          gfc_conv_expr_reference (&se, d->low);
+
+          CONSTRUCTOR_APPEND_ELT (node, ss_string1[k], se.expr);
+          CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], se.string_length);
+        }
+
+      if (d->high == NULL)
+        {
+          CONSTRUCTOR_APPEND_ELT (node, ss_string2[k], null_pointer_node);
+          CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], integer_zero_node);
+        }
+      else
+        {
+          gfc_init_se (&se, NULL);
+          gfc_conv_expr_reference (&se, d->high);
+
+          CONSTRUCTOR_APPEND_ELT (node, ss_string2[k], se.expr);
+          CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], se.string_length);
+        }
+
+      CONSTRUCTOR_APPEND_ELT (node, ss_target[k],
+                              build_int_cst (integer_type_node, d->n));
+
+      tmp = build_constructor (select_struct[k], node);
+      CONSTRUCTOR_APPEND_ELT (inits, NULL_TREE, tmp);
+    }
+
+  type = build_array_type (select_struct[k],
+			   build_index_type (build_int_cst (NULL_TREE, n-1)));
+
+  init = build_constructor (type, inits);
+  TREE_CONSTANT (init) = 1;
+  TREE_STATIC (init) = 1;
+  /* Create a static variable to hold the jump table.  */
+  tmp = gfc_create_var (type, "jumptable");
+  TREE_CONSTANT (tmp) = 1;
+  TREE_STATIC (tmp) = 1;
+  TREE_READONLY (tmp) = 1;
+  DECL_INITIAL (tmp) = init;
+  init = tmp;
+
+  /* Build the library call */
+  init = gfc_build_addr_expr (pvoid_type_node, init);
+
+  if (code->expr1->ts.kind == 1)
+    fndecl = gfor_fndecl_select_string;
+  else if (code->expr1->ts.kind == 4)
+    fndecl = gfor_fndecl_select_string_char4;
+  else
+    gcc_unreachable ();
+
+  tmp = build_call_expr_loc (input_location,
+			 fndecl, 4, init, build_int_cst (NULL_TREE, n),
+			 expr1se.expr, expr1se.string_length);
+  case_num = gfc_create_var (integer_type_node, "case_num");
+  gfc_add_modify (&block, case_num, tmp);
+
+  gfc_add_block_to_block (&block, &expr1se.post);
+
+  tmp = gfc_finish_block (&body);
+  tmp = build3_v (SWITCH_EXPR, case_num, tmp, NULL_TREE);
+  gfc_add_expr_to_block (&block, tmp);
+
+  tmp = build1_v (LABEL_EXPR, end_label);
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Translate the three variants of the SELECT CASE construct.
+
+   SELECT CASEs with INTEGER case expressions can be translated to an
+   equivalent GENERIC switch statement, and for LOGICAL case
+   expressions we build one or two if-else compares.
+
+   SELECT CASEs with CHARACTER case expressions are a whole different
+   story, because they don't exist in GENERIC.  So we sort them and
+   do a binary search at runtime.
+
+   Fortran has no BREAK statement, and it does not allow jumps from
+   one case block to another.  That makes things a lot easier for
+   the optimizers.  */
+
+tree
+gfc_trans_select (gfc_code * code)
+{
+  stmtblock_t block;
+  tree body;
+  tree exit_label;
+
+  gcc_assert (code && code->expr1);
+  gfc_init_block (&block);
+
+  /* Build the exit label and hang it in.  */
+  exit_label = gfc_build_label_decl (NULL_TREE);
+  code->exit_label = exit_label;
+
+  /* Empty SELECT constructs are legal.  */
+  if (code->block == NULL)
+    body = build_empty_stmt (input_location);
+
+  /* Select the correct translation function.  */
+  else
+    switch (code->expr1->ts.type)
+      {
+      case BT_LOGICAL:
+	body = gfc_trans_logical_select (code);
+	break;
+
+      case BT_INTEGER:
+	body = gfc_trans_integer_select (code);
+	break;
+
+      case BT_CHARACTER:
+	body = gfc_trans_character_select (code);
+	break;
+
+      default:
+	gfc_internal_error ("gfc_trans_select(): Bad type for case expr.");
+	/* Not reached */
+      }
+
+  /* Build everything together.  */
+  gfc_add_expr_to_block (&block, body);
+  gfc_add_expr_to_block (&block, build1_v (LABEL_EXPR, exit_label));
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Traversal function to substitute a replacement symtree if the symbol
+   in the expression is the same as that passed.  f == 2 signals that
+   that variable itself is not to be checked - only the references.
+   This group of functions is used when the variable expression in a
+   FORALL assignment has internal references.  For example:
+		FORALL (i = 1:4) p(p(i)) = i
+   The only recourse here is to store a copy of 'p' for the index
+   expression.  */
+
+static gfc_symtree *new_symtree;
+static gfc_symtree *old_symtree;
+
+static bool
+forall_replace (gfc_expr *expr, gfc_symbol *sym, int *f)
+{
+  if (expr->expr_type != EXPR_VARIABLE)
+    return false;
+
+  if (*f == 2)
+    *f = 1;
+  else if (expr->symtree->n.sym == sym)
+    expr->symtree = new_symtree;
+
+  return false;
+}
+
+static void
+forall_replace_symtree (gfc_expr *e, gfc_symbol *sym, int f)
+{
+  gfc_traverse_expr (e, sym, forall_replace, f);
+}
+
+static bool
+forall_restore (gfc_expr *expr,
+		gfc_symbol *sym ATTRIBUTE_UNUSED,
+		int *f ATTRIBUTE_UNUSED)
+{
+  if (expr->expr_type != EXPR_VARIABLE)
+    return false;
+
+  if (expr->symtree == new_symtree)
+    expr->symtree = old_symtree;
+
+  return false;
+}
+
+static void
+forall_restore_symtree (gfc_expr *e)
+{
+  gfc_traverse_expr (e, NULL, forall_restore, 0);
+}
+
+static void
+forall_make_variable_temp (gfc_code *c, stmtblock_t *pre, stmtblock_t *post)
+{
+  gfc_se tse;
+  gfc_se rse;
+  gfc_expr *e;
+  gfc_symbol *new_sym;
+  gfc_symbol *old_sym;
+  gfc_symtree *root;
+  tree tmp;
+
+  /* Build a copy of the lvalue.  */
+  old_symtree = c->expr1->symtree;
+  old_sym = old_symtree->n.sym;
+  e = gfc_lval_expr_from_sym (old_sym);
+  if (old_sym->attr.dimension)
+    {
+      gfc_init_se (&tse, NULL);
+      gfc_conv_subref_array_arg (&tse, e, 0, INTENT_IN, false);
+      gfc_add_block_to_block (pre, &tse.pre);
+      gfc_add_block_to_block (post, &tse.post);
+      tse.expr = build_fold_indirect_ref_loc (input_location, tse.expr);
+
+      if (e->ts.type != BT_CHARACTER)
+	{
+	  /* Use the variable offset for the temporary.  */
+	  tmp = gfc_conv_array_offset (old_sym->backend_decl);
+	  gfc_conv_descriptor_offset_set (pre, tse.expr, tmp);
+	}
+    }
+  else
+    {
+      gfc_init_se (&tse, NULL);
+      gfc_init_se (&rse, NULL);
+      gfc_conv_expr (&rse, e);
+      if (e->ts.type == BT_CHARACTER)
+	{
+	  tse.string_length = rse.string_length;
+	  tmp = gfc_get_character_type_len (gfc_default_character_kind,
+					    tse.string_length);
+	  tse.expr = gfc_conv_string_tmp (&tse, build_pointer_type (tmp),
+					  rse.string_length);
+	  gfc_add_block_to_block (pre, &tse.pre);
+	  gfc_add_block_to_block (post, &tse.post);
+	}
+      else
+	{
+	  tmp = gfc_typenode_for_spec (&e->ts);
+	  tse.expr = gfc_create_var (tmp, "temp");
+	}
+
+      tmp = gfc_trans_scalar_assign (&tse, &rse, e->ts, true,
+				     e->expr_type == EXPR_VARIABLE, true);
+      gfc_add_expr_to_block (pre, tmp);
+    }
+  gfc_free_expr (e);
+
+  /* Create a new symbol to represent the lvalue.  */
+  new_sym = gfc_new_symbol (old_sym->name, NULL);
+  new_sym->ts = old_sym->ts;
+  new_sym->attr.referenced = 1;
+  new_sym->attr.temporary = 1;
+  new_sym->attr.dimension = old_sym->attr.dimension;
+  new_sym->attr.flavor = old_sym->attr.flavor;
+
+  /* Use the temporary as the backend_decl.  */
+  new_sym->backend_decl = tse.expr;
+
+  /* Create a fake symtree for it.  */
+  root = NULL;
+  new_symtree = gfc_new_symtree (&root, old_sym->name);
+  new_symtree->n.sym = new_sym;
+  gcc_assert (new_symtree == root);
+
+  /* Go through the expression reference replacing the old_symtree
+     with the new.  */
+  forall_replace_symtree (c->expr1, old_sym, 2);
+
+  /* Now we have made this temporary, we might as well use it for
+  the right hand side.  */
+  forall_replace_symtree (c->expr2, old_sym, 1);
+}
+
+
+/* Handles dependencies in forall assignments.  */
+static int
+check_forall_dependencies (gfc_code *c, stmtblock_t *pre, stmtblock_t *post)
+{
+  gfc_ref *lref;
+  gfc_ref *rref;
+  int need_temp;
+  gfc_symbol *lsym;
+
+  lsym = c->expr1->symtree->n.sym;
+  need_temp = gfc_check_dependency (c->expr1, c->expr2, 0);
+
+  /* Now check for dependencies within the 'variable'
+     expression itself.  These are treated by making a complete
+     copy of variable and changing all the references to it
+     point to the copy instead.  Note that the shallow copy of
+     the variable will not suffice for derived types with
+     pointer components.  We therefore leave these to their
+     own devices.  */
+  if (lsym->ts.type == BT_DERIVED
+	&& lsym->ts.u.derived->attr.pointer_comp)
+    return need_temp;
+
+  new_symtree = NULL;
+  if (find_forall_index (c->expr1, lsym, 2) == SUCCESS)
+    {
+      forall_make_variable_temp (c, pre, post);
+      need_temp = 0;
+    }
+
+  /* Substrings with dependencies are treated in the same
+     way.  */
+  if (c->expr1->ts.type == BT_CHARACTER
+	&& c->expr1->ref
+	&& c->expr2->expr_type == EXPR_VARIABLE
+	&& lsym == c->expr2->symtree->n.sym)
+    {
+      for (lref = c->expr1->ref; lref; lref = lref->next)
+	if (lref->type == REF_SUBSTRING)
+	  break;
+      for (rref = c->expr2->ref; rref; rref = rref->next)
+	if (rref->type == REF_SUBSTRING)
+	  break;
+
+      if (rref && lref
+	    && gfc_dep_compare_expr (rref->u.ss.start, lref->u.ss.start) < 0)
+	{
+	  forall_make_variable_temp (c, pre, post);
+	  need_temp = 0;
+	}
+    }
+  return need_temp;
+}
+
+
+static void
+cleanup_forall_symtrees (gfc_code *c)
+{
+  forall_restore_symtree (c->expr1);
+  forall_restore_symtree (c->expr2);
+  gfc_free (new_symtree->n.sym);
+  gfc_free (new_symtree);
+}
+
+
+/* Generate the loops for a FORALL block, specified by FORALL_TMP.  BODY
+   is the contents of the FORALL block/stmt to be iterated.  MASK_FLAG
+   indicates whether we should generate code to test the FORALLs mask
+   array.  OUTER is the loop header to be used for initializing mask
+   indices.
+
+   The generated loop format is:
+    count = (end - start + step) / step
+    loopvar = start
+    while (1)
+      {
+        if (count <=0 )
+          goto end_of_loop
+        <body>
+        loopvar += step
+        count --
+      }
+    end_of_loop:  */
+
+static tree
+gfc_trans_forall_loop (forall_info *forall_tmp, tree body,
+                       int mask_flag, stmtblock_t *outer)
+{
+  int n, nvar;
+  tree tmp;
+  tree cond;
+  stmtblock_t block;
+  tree exit_label;
+  tree count;
+  tree var, start, end, step;
+  iter_info *iter;
+
+  /* Initialize the mask index outside the FORALL nest.  */
+  if (mask_flag && forall_tmp->mask)
+    gfc_add_modify (outer, forall_tmp->maskindex, gfc_index_zero_node);
+
+  iter = forall_tmp->this_loop;
+  nvar = forall_tmp->nvar;
+  for (n = 0; n < nvar; n++)
+    {
+      var = iter->var;
+      start = iter->start;
+      end = iter->end;
+      step = iter->step;
+
+      exit_label = gfc_build_label_decl (NULL_TREE);
+      TREE_USED (exit_label) = 1;
+
+      /* The loop counter.  */
+      count = gfc_create_var (TREE_TYPE (var), "count");
+
+      /* The body of the loop.  */
+      gfc_init_block (&block);
+
+      /* The exit condition.  */
+      cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
+			      count, build_int_cst (TREE_TYPE (count), 0));
+      tmp = build1_v (GOTO_EXPR, exit_label);
+      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+			     cond, tmp, build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block, tmp);
+
+      /* The main loop body.  */
+      gfc_add_expr_to_block (&block, body);
+
+      /* Increment the loop variable.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (var), var,
+			     step);
+      gfc_add_modify (&block, var, tmp);
+
+      /* Advance to the next mask element.  Only do this for the
+	 innermost loop.  */
+      if (n == 0 && mask_flag && forall_tmp->mask)
+	{
+	  tree maskindex = forall_tmp->maskindex;
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+				 maskindex, gfc_index_one_node);
+	  gfc_add_modify (&block, maskindex, tmp);
+	}
+
+      /* Decrement the loop counter.  */
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (var), count,
+			     build_int_cst (TREE_TYPE (var), 1));
+      gfc_add_modify (&block, count, tmp);
+
+      body = gfc_finish_block (&block);
+
+      /* Loop var initialization.  */
+      gfc_init_block (&block);
+      gfc_add_modify (&block, var, start);
+
+
+      /* Initialize the loop counter.  */
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (var), step,
+			     start);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (var), end,
+			     tmp);
+      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, TREE_TYPE (var),
+			     tmp, step);
+      gfc_add_modify (&block, count, tmp);
+
+      /* The loop expression.  */
+      tmp = build1_v (LOOP_EXPR, body);
+      gfc_add_expr_to_block (&block, tmp);
+
+      /* The exit label.  */
+      tmp = build1_v (LABEL_EXPR, exit_label);
+      gfc_add_expr_to_block (&block, tmp);
+
+      body = gfc_finish_block (&block);
+      iter = iter->next;
+    }
+  return body;
+}
+
+
+/* Generate the body and loops according to MASK_FLAG.  If MASK_FLAG
+   is nonzero, the body is controlled by all masks in the forall nest.
+   Otherwise, the innermost loop is not controlled by it's mask.  This
+   is used for initializing that mask.  */
+
+static tree
+gfc_trans_nested_forall_loop (forall_info * nested_forall_info, tree body,
+                              int mask_flag)
+{
+  tree tmp;
+  stmtblock_t header;
+  forall_info *forall_tmp;
+  tree mask, maskindex;
+
+  gfc_start_block (&header);
+
+  forall_tmp = nested_forall_info;
+  while (forall_tmp != NULL)
+    {
+      /* Generate body with masks' control.  */
+      if (mask_flag)
+        {
+          mask = forall_tmp->mask;
+          maskindex = forall_tmp->maskindex;
+
+          /* If a mask was specified make the assignment conditional.  */
+          if (mask)
+            {
+              tmp = gfc_build_array_ref (mask, maskindex, NULL);
+              body = build3_v (COND_EXPR, tmp, body,
+			       build_empty_stmt (input_location));
+            }
+        }
+      body = gfc_trans_forall_loop (forall_tmp, body, mask_flag, &header);
+      forall_tmp = forall_tmp->prev_nest;
+      mask_flag = 1;
+    }
+
+  gfc_add_expr_to_block (&header, body);
+  return gfc_finish_block (&header);
+}
+
+
+/* Allocate data for holding a temporary array.  Returns either a local
+   temporary array or a pointer variable.  */
+
+static tree
+gfc_do_allocate (tree bytesize, tree size, tree * pdata, stmtblock_t * pblock,
+                 tree elem_type)
+{
+  tree tmpvar;
+  tree type;
+  tree tmp;
+
+  if (INTEGER_CST_P (size))
+    tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			   size, gfc_index_one_node);
+  else
+    tmp = NULL_TREE;
+
+  type = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
+  type = build_array_type (elem_type, type);
+  if (gfc_can_put_var_on_stack (bytesize))
+    {
+      gcc_assert (INTEGER_CST_P (size));
+      tmpvar = gfc_create_var (type, "temp");
+      *pdata = NULL_TREE;
+    }
+  else
+    {
+      tmpvar = gfc_create_var (build_pointer_type (type), "temp");
+      *pdata = convert (pvoid_type_node, tmpvar);
+
+      tmp = gfc_call_malloc (pblock, TREE_TYPE (tmpvar), bytesize);
+      gfc_add_modify (pblock, tmpvar, tmp);
+    }
+  return tmpvar;
+}
+
+
+/* Generate codes to copy the temporary to the actual lhs.  */
+
+static tree
+generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3,
+			       tree count1, tree wheremask, bool invert)
+{
+  gfc_ss *lss;
+  gfc_se lse, rse;
+  stmtblock_t block, body;
+  gfc_loopinfo loop1;
+  tree tmp;
+  tree wheremaskexpr;
+
+  /* Walk the lhs.  */
+  lss = gfc_walk_expr (expr);
+
+  if (lss == gfc_ss_terminator)
+    {
+      gfc_start_block (&block);
+
+      gfc_init_se (&lse, NULL);
+
+      /* Translate the expression.  */
+      gfc_conv_expr (&lse, expr);
+
+      /* Form the expression for the temporary.  */
+      tmp = gfc_build_array_ref (tmp1, count1, NULL);
+
+      /* Use the scalar assignment as is.  */
+      gfc_add_block_to_block (&block, &lse.pre);
+      gfc_add_modify (&block, lse.expr, tmp);
+      gfc_add_block_to_block (&block, &lse.post);
+
+      /* Increment the count1.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (count1),
+			     count1, gfc_index_one_node);
+      gfc_add_modify (&block, count1, tmp);
+
+      tmp = gfc_finish_block (&block);
+    }
+  else
+    {
+      gfc_start_block (&block);
+
+      gfc_init_loopinfo (&loop1);
+      gfc_init_se (&rse, NULL);
+      gfc_init_se (&lse, NULL);
+
+      /* Associate the lss with the loop.  */
+      gfc_add_ss_to_loop (&loop1, lss);
+
+      /* Calculate the bounds of the scalarization.  */
+      gfc_conv_ss_startstride (&loop1);
+      /* Setup the scalarizing loops.  */
+      gfc_conv_loop_setup (&loop1, &expr->where);
+
+      gfc_mark_ss_chain_used (lss, 1);
+
+      /* Start the scalarized loop body.  */
+      gfc_start_scalarized_body (&loop1, &body);
+
+      /* Setup the gfc_se structures.  */
+      gfc_copy_loopinfo_to_se (&lse, &loop1);
+      lse.ss = lss;
+
+      /* Form the expression of the temporary.  */
+      if (lss != gfc_ss_terminator)
+	rse.expr = gfc_build_array_ref (tmp1, count1, NULL);
+      /* Translate expr.  */
+      gfc_conv_expr (&lse, expr);
+
+      /* Use the scalar assignment.  */
+      rse.string_length = lse.string_length;
+      tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts, false, true, true);
+
+      /* Form the mask expression according to the mask tree list.  */
+      if (wheremask)
+	{
+	  wheremaskexpr = gfc_build_array_ref (wheremask, count3, NULL);
+	  if (invert)
+	    wheremaskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
+					     TREE_TYPE (wheremaskexpr),
+					     wheremaskexpr);
+	  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+				 wheremaskexpr, tmp,
+				 build_empty_stmt (input_location));
+       }
+
+      gfc_add_expr_to_block (&body, tmp);
+
+      /* Increment count1.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     count1, gfc_index_one_node);
+      gfc_add_modify (&body, count1, tmp);
+
+      /* Increment count3.  */
+      if (count3)
+	{
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, count3,
+				 gfc_index_one_node);
+	  gfc_add_modify (&body, count3, tmp);
+	}
+
+      /* Generate the copying loops.  */
+      gfc_trans_scalarizing_loops (&loop1, &body);
+      gfc_add_block_to_block (&block, &loop1.pre);
+      gfc_add_block_to_block (&block, &loop1.post);
+      gfc_cleanup_loop (&loop1);
+
+      tmp = gfc_finish_block (&block);
+    }
+  return tmp;
+}
+
+
+/* Generate codes to copy rhs to the temporary. TMP1 is the address of
+   temporary, LSS and RSS are formed in function compute_inner_temp_size(),
+   and should not be freed.  WHEREMASK is the conditional execution mask
+   whose sense may be inverted by INVERT.  */
+
+static tree
+generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3,
+			       tree count1, gfc_ss *lss, gfc_ss *rss,
+			       tree wheremask, bool invert)
+{
+  stmtblock_t block, body1;
+  gfc_loopinfo loop;
+  gfc_se lse;
+  gfc_se rse;
+  tree tmp;
+  tree wheremaskexpr;
+
+  gfc_start_block (&block);
+
+  gfc_init_se (&rse, NULL);
+  gfc_init_se (&lse, NULL);
+
+  if (lss == gfc_ss_terminator)
+    {
+      gfc_init_block (&body1);
+      gfc_conv_expr (&rse, expr2);
+      lse.expr = gfc_build_array_ref (tmp1, count1, NULL);
+    }
+  else
+    {
+      /* Initialize the loop.  */
+      gfc_init_loopinfo (&loop);
+
+      /* We may need LSS to determine the shape of the expression.  */
+      gfc_add_ss_to_loop (&loop, lss);
+      gfc_add_ss_to_loop (&loop, rss);
+
+      gfc_conv_ss_startstride (&loop);
+      gfc_conv_loop_setup (&loop, &expr2->where);
+
+      gfc_mark_ss_chain_used (rss, 1);
+      /* Start the loop body.  */
+      gfc_start_scalarized_body (&loop, &body1);
+
+      /* Translate the expression.  */
+      gfc_copy_loopinfo_to_se (&rse, &loop);
+      rse.ss = rss;
+      gfc_conv_expr (&rse, expr2);
+
+      /* Form the expression of the temporary.  */
+      lse.expr = gfc_build_array_ref (tmp1, count1, NULL);
+    }
+
+  /* Use the scalar assignment.  */
+  lse.string_length = rse.string_length;
+  tmp = gfc_trans_scalar_assign (&lse, &rse, expr2->ts, true,
+				 expr2->expr_type == EXPR_VARIABLE, true);
+
+  /* Form the mask expression according to the mask tree list.  */
+  if (wheremask)
+    {
+      wheremaskexpr = gfc_build_array_ref (wheremask, count3, NULL);
+      if (invert)
+	wheremaskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
+					 TREE_TYPE (wheremaskexpr),
+					 wheremaskexpr);
+      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+			     wheremaskexpr, tmp,
+			     build_empty_stmt (input_location));
+    }
+
+  gfc_add_expr_to_block (&body1, tmp);
+
+  if (lss == gfc_ss_terminator)
+    {
+      gfc_add_block_to_block (&block, &body1);
+
+      /* Increment count1.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (count1),
+			     count1, gfc_index_one_node);
+      gfc_add_modify (&block, count1, tmp);
+    }
+  else
+    {
+      /* Increment count1.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     count1, gfc_index_one_node);
+      gfc_add_modify (&body1, count1, tmp);
+
+      /* Increment count3.  */
+      if (count3)
+	{
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type,
+				 count3, gfc_index_one_node);
+	  gfc_add_modify (&body1, count3, tmp);
+	}
+
+      /* Generate the copying loops.  */
+      gfc_trans_scalarizing_loops (&loop, &body1);
+
+      gfc_add_block_to_block (&block, &loop.pre);
+      gfc_add_block_to_block (&block, &loop.post);
+
+      gfc_cleanup_loop (&loop);
+      /* TODO: Reuse lss and rss when copying temp->lhs.  Need to be careful
+	 as tree nodes in SS may not be valid in different scope.  */
+    }
+
+  tmp = gfc_finish_block (&block);
+  return tmp;
+}
+
+
+/* Calculate the size of temporary needed in the assignment inside forall.
+   LSS and RSS are filled in this function.  */
+
+static tree
+compute_inner_temp_size (gfc_expr *expr1, gfc_expr *expr2,
+			 stmtblock_t * pblock,
+                         gfc_ss **lss, gfc_ss **rss)
+{
+  gfc_loopinfo loop;
+  tree size;
+  int i;
+  int save_flag;
+  tree tmp;
+
+  *lss = gfc_walk_expr (expr1);
+  *rss = NULL;
+
+  size = gfc_index_one_node;
+  if (*lss != gfc_ss_terminator)
+    {
+      gfc_init_loopinfo (&loop);
+
+      /* Walk the RHS of the expression.  */
+      *rss = gfc_walk_expr (expr2);
+      if (*rss == gfc_ss_terminator)
+        {
+          /* The rhs is scalar.  Add a ss for the expression.  */
+          *rss = gfc_get_ss ();
+          (*rss)->next = gfc_ss_terminator;
+          (*rss)->type = GFC_SS_SCALAR;
+          (*rss)->expr = expr2;
+        }
+
+      /* Associate the SS with the loop.  */
+      gfc_add_ss_to_loop (&loop, *lss);
+      /* We don't actually need to add the rhs at this point, but it might
+         make guessing the loop bounds a bit easier.  */
+      gfc_add_ss_to_loop (&loop, *rss);
+
+      /* We only want the shape of the expression, not rest of the junk
+         generated by the scalarizer.  */
+      loop.array_parameter = 1;
+
+      /* Calculate the bounds of the scalarization.  */
+      save_flag = gfc_option.rtcheck;
+      gfc_option.rtcheck &= !GFC_RTCHECK_BOUNDS;
+      gfc_conv_ss_startstride (&loop);
+      gfc_option.rtcheck = save_flag;
+      gfc_conv_loop_setup (&loop, &expr2->where);
+
+      /* Figure out how many elements we need.  */
+      for (i = 0; i < loop.dimen; i++)
+        {
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type,
+				 gfc_index_one_node, loop.from[i]);
+          tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, tmp, loop.to[i]);
+          size = fold_build2_loc (input_location, MULT_EXPR,
+				  gfc_array_index_type, size, tmp);
+        }
+      gfc_add_block_to_block (pblock, &loop.pre);
+      size = gfc_evaluate_now (size, pblock);
+      gfc_add_block_to_block (pblock, &loop.post);
+
+      /* TODO: write a function that cleans up a loopinfo without freeing
+         the SS chains.  Currently a NOP.  */
+    }
+
+  return size;
+}
+
+
+/* Calculate the overall iterator number of the nested forall construct.
+   This routine actually calculates the number of times the body of the
+   nested forall specified by NESTED_FORALL_INFO is executed and multiplies
+   that by the expression INNER_SIZE.  The BLOCK argument specifies the
+   block in which to calculate the result, and the optional INNER_SIZE_BODY
+   argument contains any statements that need to executed (inside the loop)
+   to initialize or calculate INNER_SIZE.  */
+
+static tree
+compute_overall_iter_number (forall_info *nested_forall_info, tree inner_size,
+			     stmtblock_t *inner_size_body, stmtblock_t *block)
+{
+  forall_info *forall_tmp = nested_forall_info;
+  tree tmp, number;
+  stmtblock_t body;
+
+  /* We can eliminate the innermost unconditional loops with constant
+     array bounds.  */
+  if (INTEGER_CST_P (inner_size))
+    {
+      while (forall_tmp
+	     && !forall_tmp->mask 
+	     && INTEGER_CST_P (forall_tmp->size))
+	{
+	  inner_size = fold_build2_loc (input_location, MULT_EXPR,
+					gfc_array_index_type,
+					inner_size, forall_tmp->size);
+	  forall_tmp = forall_tmp->prev_nest;
+	}
+
+      /* If there are no loops left, we have our constant result.  */
+      if (!forall_tmp)
+	return inner_size;
+    }
+
+  /* Otherwise, create a temporary variable to compute the result.  */
+  number = gfc_create_var (gfc_array_index_type, "num");
+  gfc_add_modify (block, number, gfc_index_zero_node);
+
+  gfc_start_block (&body);
+  if (inner_size_body)
+    gfc_add_block_to_block (&body, inner_size_body);
+  if (forall_tmp)
+    tmp = fold_build2_loc (input_location, PLUS_EXPR,
+			   gfc_array_index_type, number, inner_size);
+  else
+    tmp = inner_size;
+  gfc_add_modify (&body, number, tmp);
+  tmp = gfc_finish_block (&body);
+
+  /* Generate loops.  */
+  if (forall_tmp != NULL)
+    tmp = gfc_trans_nested_forall_loop (forall_tmp, tmp, 1);
+
+  gfc_add_expr_to_block (block, tmp);
+
+  return number;
+}
+
+
+/* Allocate temporary for forall construct.  SIZE is the size of temporary
+   needed.  PTEMP1 is returned for space free.  */
+
+static tree
+allocate_temp_for_forall_nest_1 (tree type, tree size, stmtblock_t * block,
+				 tree * ptemp1)
+{
+  tree bytesize;
+  tree unit;
+  tree tmp;
+
+  unit = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (type));
+  if (!integer_onep (unit))
+    bytesize = fold_build2_loc (input_location, MULT_EXPR,
+				gfc_array_index_type, size, unit);
+  else
+    bytesize = size;
+
+  *ptemp1 = NULL;
+  tmp = gfc_do_allocate (bytesize, size, ptemp1, block, type);
+
+  if (*ptemp1)
+    tmp = build_fold_indirect_ref_loc (input_location, tmp);
+  return tmp;
+}
+
+
+/* Allocate temporary for forall construct according to the information in
+   nested_forall_info.  INNER_SIZE is the size of temporary needed in the
+   assignment inside forall.  PTEMP1 is returned for space free.  */
+
+static tree
+allocate_temp_for_forall_nest (forall_info * nested_forall_info, tree type,
+			       tree inner_size, stmtblock_t * inner_size_body,
+			       stmtblock_t * block, tree * ptemp1)
+{
+  tree size;
+
+  /* Calculate the total size of temporary needed in forall construct.  */
+  size = compute_overall_iter_number (nested_forall_info, inner_size,
+				      inner_size_body, block);
+
+  return allocate_temp_for_forall_nest_1 (type, size, block, ptemp1);
+}
+
+
+/* Handle assignments inside forall which need temporary.
+
+    forall (i=start:end:stride; maskexpr)
+      e<i> = f<i>
+    end forall
+   (where e,f<i> are arbitrary expressions possibly involving i
+    and there is a dependency between e<i> and f<i>)
+   Translates to:
+    masktmp(:) = maskexpr(:)
+
+    maskindex = 0;
+    count1 = 0;
+    num = 0;
+    for (i = start; i <= end; i += stride)
+      num += SIZE (f<i>)
+    count1 = 0;
+    ALLOCATE (tmp(num))
+    for (i = start; i <= end; i += stride)
+      {
+	if (masktmp[maskindex++])
+	  tmp[count1++] = f<i>
+      }
+    maskindex = 0;
+    count1 = 0;
+    for (i = start; i <= end; i += stride)
+      {
+	if (masktmp[maskindex++])
+	  e<i> = tmp[count1++]
+      }
+    DEALLOCATE (tmp)
+  */
+static void
+gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
+			    tree wheremask, bool invert,
+                            forall_info * nested_forall_info,
+                            stmtblock_t * block)
+{
+  tree type;
+  tree inner_size;
+  gfc_ss *lss, *rss;
+  tree count, count1;
+  tree tmp, tmp1;
+  tree ptemp1;
+  stmtblock_t inner_size_body;
+
+  /* Create vars. count1 is the current iterator number of the nested
+     forall.  */
+  count1 = gfc_create_var (gfc_array_index_type, "count1");
+
+  /* Count is the wheremask index.  */
+  if (wheremask)
+    {
+      count = gfc_create_var (gfc_array_index_type, "count");
+      gfc_add_modify (block, count, gfc_index_zero_node);
+    }
+  else
+    count = NULL;
+
+  /* Initialize count1.  */
+  gfc_add_modify (block, count1, gfc_index_zero_node);
+
+  /* Calculate the size of temporary needed in the assignment. Return loop, lss
+     and rss which are used in function generate_loop_for_rhs_to_temp().  */
+  gfc_init_block (&inner_size_body);
+  inner_size = compute_inner_temp_size (expr1, expr2, &inner_size_body,
+					&lss, &rss);
+
+  /* The type of LHS. Used in function allocate_temp_for_forall_nest */
+  if (expr1->ts.type == BT_CHARACTER && expr1->ts.u.cl->length)
+    {
+      if (!expr1->ts.u.cl->backend_decl)
+	{
+	  gfc_se tse;
+	  gfc_init_se (&tse, NULL);
+	  gfc_conv_expr (&tse, expr1->ts.u.cl->length);
+	  expr1->ts.u.cl->backend_decl = tse.expr;
+	}
+      type = gfc_get_character_type_len (gfc_default_character_kind,
+				         expr1->ts.u.cl->backend_decl);
+    }
+  else
+    type = gfc_typenode_for_spec (&expr1->ts);
+
+  /* Allocate temporary for nested forall construct according to the
+     information in nested_forall_info and inner_size.  */
+  tmp1 = allocate_temp_for_forall_nest (nested_forall_info, type, inner_size,
+					&inner_size_body, block, &ptemp1);
+
+  /* Generate codes to copy rhs to the temporary .  */
+  tmp = generate_loop_for_rhs_to_temp (expr2, tmp1, count, count1, lss, rss,
+				       wheremask, invert);
+
+  /* Generate body and loops according to the information in
+     nested_forall_info.  */
+  tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
+  gfc_add_expr_to_block (block, tmp);
+
+  /* Reset count1.  */
+  gfc_add_modify (block, count1, gfc_index_zero_node);
+
+  /* Reset count.  */
+  if (wheremask)
+    gfc_add_modify (block, count, gfc_index_zero_node);
+
+  /* Generate codes to copy the temporary to lhs.  */
+  tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, count, count1,
+				       wheremask, invert);
+
+  /* Generate body and loops according to the information in
+     nested_forall_info.  */
+  tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
+  gfc_add_expr_to_block (block, tmp);
+
+  if (ptemp1)
+    {
+      /* Free the temporary.  */
+      tmp = gfc_call_free (ptemp1);
+      gfc_add_expr_to_block (block, tmp);
+    }
+}
+
+
+/* Translate pointer assignment inside FORALL which need temporary.  */
+
+static void
+gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
+                                    forall_info * nested_forall_info,
+                                    stmtblock_t * block)
+{
+  tree type;
+  tree inner_size;
+  gfc_ss *lss, *rss;
+  gfc_se lse;
+  gfc_se rse;
+  gfc_ss_info *info;
+  gfc_loopinfo loop;
+  tree desc;
+  tree parm;
+  tree parmtype;
+  stmtblock_t body;
+  tree count;
+  tree tmp, tmp1, ptemp1;
+
+  count = gfc_create_var (gfc_array_index_type, "count");
+  gfc_add_modify (block, count, gfc_index_zero_node);
+
+  inner_size = gfc_index_one_node;
+  lss = gfc_walk_expr (expr1);
+  rss = gfc_walk_expr (expr2);
+  if (lss == gfc_ss_terminator)
+    {
+      type = gfc_typenode_for_spec (&expr1->ts);
+      type = build_pointer_type (type);
+
+      /* Allocate temporary for nested forall construct according to the
+         information in nested_forall_info and inner_size.  */
+      tmp1 = allocate_temp_for_forall_nest (nested_forall_info, type,
+					    inner_size, NULL, block, &ptemp1);
+      gfc_start_block (&body);
+      gfc_init_se (&lse, NULL);
+      lse.expr = gfc_build_array_ref (tmp1, count, NULL);
+      gfc_init_se (&rse, NULL);
+      rse.want_pointer = 1;
+      gfc_conv_expr (&rse, expr2);
+      gfc_add_block_to_block (&body, &rse.pre);
+      gfc_add_modify (&body, lse.expr,
+			   fold_convert (TREE_TYPE (lse.expr), rse.expr));
+      gfc_add_block_to_block (&body, &rse.post);
+
+      /* Increment count.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     count, gfc_index_one_node);
+      gfc_add_modify (&body, count, tmp);
+
+      tmp = gfc_finish_block (&body);
+
+      /* Generate body and loops according to the information in
+         nested_forall_info.  */
+      tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
+      gfc_add_expr_to_block (block, tmp);
+
+      /* Reset count.  */
+      gfc_add_modify (block, count, gfc_index_zero_node);
+
+      gfc_start_block (&body);
+      gfc_init_se (&lse, NULL);
+      gfc_init_se (&rse, NULL);
+      rse.expr = gfc_build_array_ref (tmp1, count, NULL);
+      lse.want_pointer = 1;
+      gfc_conv_expr (&lse, expr1);
+      gfc_add_block_to_block (&body, &lse.pre);
+      gfc_add_modify (&body, lse.expr, rse.expr);
+      gfc_add_block_to_block (&body, &lse.post);
+      /* Increment count.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     count, gfc_index_one_node);
+      gfc_add_modify (&body, count, tmp);
+      tmp = gfc_finish_block (&body);
+
+      /* Generate body and loops according to the information in
+         nested_forall_info.  */
+      tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
+      gfc_add_expr_to_block (block, tmp);
+    }
+  else
+    {
+      gfc_init_loopinfo (&loop);
+
+      /* Associate the SS with the loop.  */
+      gfc_add_ss_to_loop (&loop, rss);
+
+      /* Setup the scalarizing loops and bounds.  */
+      gfc_conv_ss_startstride (&loop);
+
+      gfc_conv_loop_setup (&loop, &expr2->where);
+
+      info = &rss->data.info;
+      desc = info->descriptor;
+
+      /* Make a new descriptor.  */
+      parmtype = gfc_get_element_type (TREE_TYPE (desc));
+      parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, 0,
+                                            loop.from, loop.to, 1,
+					    GFC_ARRAY_UNKNOWN, true);
+
+      /* Allocate temporary for nested forall construct.  */
+      tmp1 = allocate_temp_for_forall_nest (nested_forall_info, parmtype,
+					    inner_size, NULL, block, &ptemp1);
+      gfc_start_block (&body);
+      gfc_init_se (&lse, NULL);
+      lse.expr = gfc_build_array_ref (tmp1, count, NULL);
+      lse.direct_byref = 1;
+      rss = gfc_walk_expr (expr2);
+      gfc_conv_expr_descriptor (&lse, expr2, rss);
+
+      gfc_add_block_to_block (&body, &lse.pre);
+      gfc_add_block_to_block (&body, &lse.post);
+
+      /* Increment count.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     count, gfc_index_one_node);
+      gfc_add_modify (&body, count, tmp);
+
+      tmp = gfc_finish_block (&body);
+
+      /* Generate body and loops according to the information in
+         nested_forall_info.  */
+      tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
+      gfc_add_expr_to_block (block, tmp);
+
+      /* Reset count.  */
+      gfc_add_modify (block, count, gfc_index_zero_node);
+
+      parm = gfc_build_array_ref (tmp1, count, NULL);
+      lss = gfc_walk_expr (expr1);
+      gfc_init_se (&lse, NULL);
+      gfc_conv_expr_descriptor (&lse, expr1, lss);
+      gfc_add_modify (&lse.pre, lse.expr, parm);
+      gfc_start_block (&body);
+      gfc_add_block_to_block (&body, &lse.pre);
+      gfc_add_block_to_block (&body, &lse.post);
+
+      /* Increment count.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     count, gfc_index_one_node);
+      gfc_add_modify (&body, count, tmp);
+
+      tmp = gfc_finish_block (&body);
+
+      tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1);
+      gfc_add_expr_to_block (block, tmp);
+    }
+  /* Free the temporary.  */
+  if (ptemp1)
+    {
+      tmp = gfc_call_free (ptemp1);
+      gfc_add_expr_to_block (block, tmp);
+    }
+}
+
+
+/* FORALL and WHERE statements are really nasty, especially when you nest
+   them. All the rhs of a forall assignment must be evaluated before the
+   actual assignments are performed. Presumably this also applies to all the
+   assignments in an inner where statement.  */
+
+/* Generate code for a FORALL statement.  Any temporaries are allocated as a
+   linear array, relying on the fact that we process in the same order in all
+   loops.
+
+    forall (i=start:end:stride; maskexpr)
+      e<i> = f<i>
+      g<i> = h<i>
+    end forall
+   (where e,f,g,h<i> are arbitrary expressions possibly involving i)
+   Translates to:
+    count = ((end + 1 - start) / stride)
+    masktmp(:) = maskexpr(:)
+
+    maskindex = 0;
+    for (i = start; i <= end; i += stride)
+      {
+        if (masktmp[maskindex++])
+          e<i> = f<i>
+      }
+    maskindex = 0;
+    for (i = start; i <= end; i += stride)
+      {
+        if (masktmp[maskindex++])
+          g<i> = h<i>
+      }
+
+    Note that this code only works when there are no dependencies.
+    Forall loop with array assignments and data dependencies are a real pain,
+    because the size of the temporary cannot always be determined before the
+    loop is executed.  This problem is compounded by the presence of nested
+    FORALL constructs.
+ */
+
+static tree
+gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
+{
+  stmtblock_t pre;
+  stmtblock_t post;
+  stmtblock_t block;
+  stmtblock_t body;
+  tree *var;
+  tree *start;
+  tree *end;
+  tree *step;
+  gfc_expr **varexpr;
+  tree tmp;
+  tree assign;
+  tree size;
+  tree maskindex;
+  tree mask;
+  tree pmask;
+  int n;
+  int nvar;
+  int need_temp;
+  gfc_forall_iterator *fa;
+  gfc_se se;
+  gfc_code *c;
+  gfc_saved_var *saved_vars;
+  iter_info *this_forall;
+  forall_info *info;
+  bool need_mask;
+
+  /* Do nothing if the mask is false.  */
+  if (code->expr1
+      && code->expr1->expr_type == EXPR_CONSTANT
+      && !code->expr1->value.logical)
+    return build_empty_stmt (input_location);
+
+  n = 0;
+  /* Count the FORALL index number.  */
+  for (fa = code->ext.forall_iterator; fa; fa = fa->next)
+    n++;
+  nvar = n;
+
+  /* Allocate the space for var, start, end, step, varexpr.  */
+  var = (tree *) gfc_getmem (nvar * sizeof (tree));
+  start = (tree *) gfc_getmem (nvar * sizeof (tree));
+  end = (tree *) gfc_getmem (nvar * sizeof (tree));
+  step = (tree *) gfc_getmem (nvar * sizeof (tree));
+  varexpr = (gfc_expr **) gfc_getmem (nvar * sizeof (gfc_expr *));
+  saved_vars = (gfc_saved_var *) gfc_getmem (nvar * sizeof (gfc_saved_var));
+
+  /* Allocate the space for info.  */
+  info = (forall_info *) gfc_getmem (sizeof (forall_info));
+
+  gfc_start_block (&pre);
+  gfc_init_block (&post);
+  gfc_init_block (&block);
+
+  n = 0;
+  for (fa = code->ext.forall_iterator; fa; fa = fa->next)
+    {
+      gfc_symbol *sym = fa->var->symtree->n.sym;
+
+      /* Allocate space for this_forall.  */
+      this_forall = (iter_info *) gfc_getmem (sizeof (iter_info));
+
+      /* Create a temporary variable for the FORALL index.  */
+      tmp = gfc_typenode_for_spec (&sym->ts);
+      var[n] = gfc_create_var (tmp, sym->name);
+      gfc_shadow_sym (sym, var[n], &saved_vars[n]);
+
+      /* Record it in this_forall.  */
+      this_forall->var = var[n];
+
+      /* Replace the index symbol's backend_decl with the temporary decl.  */
+      sym->backend_decl = var[n];
+
+      /* Work out the start, end and stride for the loop.  */
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_val (&se, fa->start);
+      /* Record it in this_forall.  */
+      this_forall->start = se.expr;
+      gfc_add_block_to_block (&block, &se.pre);
+      start[n] = se.expr;
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_val (&se, fa->end);
+      /* Record it in this_forall.  */
+      this_forall->end = se.expr;
+      gfc_make_safe_expr (&se);
+      gfc_add_block_to_block (&block, &se.pre);
+      end[n] = se.expr;
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_val (&se, fa->stride);
+      /* Record it in this_forall.  */
+      this_forall->step = se.expr;
+      gfc_make_safe_expr (&se);
+      gfc_add_block_to_block (&block, &se.pre);
+      step[n] = se.expr;
+
+      /* Set the NEXT field of this_forall to NULL.  */
+      this_forall->next = NULL;
+      /* Link this_forall to the info construct.  */
+      if (info->this_loop)
+        {
+          iter_info *iter_tmp = info->this_loop;
+          while (iter_tmp->next != NULL)
+            iter_tmp = iter_tmp->next;
+          iter_tmp->next = this_forall;
+        }
+      else
+        info->this_loop = this_forall;
+
+      n++;
+    }
+  nvar = n;
+
+  /* Calculate the size needed for the current forall level.  */
+  size = gfc_index_one_node;
+  for (n = 0; n < nvar; n++)
+    {
+      /* size = (end + step - start) / step.  */
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, TREE_TYPE (start[n]), 
+			     step[n], start[n]);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (end[n]),
+			     end[n], tmp);
+      tmp = fold_build2_loc (input_location, FLOOR_DIV_EXPR, TREE_TYPE (tmp),
+			     tmp, step[n]);
+      tmp = convert (gfc_array_index_type, tmp);
+
+      size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			      size, tmp);
+    }
+
+  /* Record the nvar and size of current forall level.  */
+  info->nvar = nvar;
+  info->size = size;
+
+  if (code->expr1)
+    {
+      /* If the mask is .true., consider the FORALL unconditional.  */
+      if (code->expr1->expr_type == EXPR_CONSTANT
+	  && code->expr1->value.logical)
+	need_mask = false;
+      else
+	need_mask = true;
+    }
+  else
+    need_mask = false;
+
+  /* First we need to allocate the mask.  */
+  if (need_mask)
+    {
+      /* As the mask array can be very big, prefer compact boolean types.  */
+      tree mask_type = gfc_get_logical_type (gfc_logical_kinds[0].kind);
+      mask = allocate_temp_for_forall_nest (nested_forall_info, mask_type,
+					    size, NULL, &block, &pmask);
+      maskindex = gfc_create_var_np (gfc_array_index_type, "mi");
+
+      /* Record them in the info structure.  */
+      info->maskindex = maskindex;
+      info->mask = mask;
+    }
+  else
+    {
+      /* No mask was specified.  */
+      maskindex = NULL_TREE;
+      mask = pmask = NULL_TREE;
+    }
+
+  /* Link the current forall level to nested_forall_info.  */
+  info->prev_nest = nested_forall_info;
+  nested_forall_info = info;
+
+  /* Copy the mask into a temporary variable if required.
+     For now we assume a mask temporary is needed.  */
+  if (need_mask)
+    {
+      /* As the mask array can be very big, prefer compact boolean types.  */
+      tree mask_type = gfc_get_logical_type (gfc_logical_kinds[0].kind);
+
+      gfc_add_modify (&block, maskindex, gfc_index_zero_node);
+
+      /* Start of mask assignment loop body.  */
+      gfc_start_block (&body);
+
+      /* Evaluate the mask expression.  */
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_val (&se, code->expr1);
+      gfc_add_block_to_block (&body, &se.pre);
+
+      /* Store the mask.  */
+      se.expr = convert (mask_type, se.expr);
+
+      tmp = gfc_build_array_ref (mask, maskindex, NULL);
+      gfc_add_modify (&body, tmp, se.expr);
+
+      /* Advance to the next mask element.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     maskindex, gfc_index_one_node);
+      gfc_add_modify (&body, maskindex, tmp);
+
+      /* Generate the loops.  */
+      tmp = gfc_finish_block (&body);
+      tmp = gfc_trans_nested_forall_loop (info, tmp, 0);
+      gfc_add_expr_to_block (&block, tmp);
+    }
+
+  c = code->block->next;
+
+  /* TODO: loop merging in FORALL statements.  */
+  /* Now that we've got a copy of the mask, generate the assignment loops.  */
+  while (c)
+    {
+      switch (c->op)
+	{
+	case EXEC_ASSIGN:
+          /* A scalar or array assignment.  DO the simple check for
+	     lhs to rhs dependencies.  These make a temporary for the
+	     rhs and form a second forall block to copy to variable.  */
+	  need_temp = check_forall_dependencies(c, &pre, &post);
+
+          /* Temporaries due to array assignment data dependencies introduce
+             no end of problems.  */
+	  if (need_temp)
+            gfc_trans_assign_need_temp (c->expr1, c->expr2, NULL, false,
+                                        nested_forall_info, &block);
+          else
+            {
+              /* Use the normal assignment copying routines.  */
+              assign = gfc_trans_assignment (c->expr1, c->expr2, false, true);
+
+              /* Generate body and loops.  */
+              tmp = gfc_trans_nested_forall_loop (nested_forall_info,
+						  assign, 1);
+              gfc_add_expr_to_block (&block, tmp);
+            }
+
+	  /* Cleanup any temporary symtrees that have been made to deal
+	     with dependencies.  */
+	  if (new_symtree)
+	    cleanup_forall_symtrees (c);
+
+	  break;
+
+        case EXEC_WHERE:
+	  /* Translate WHERE or WHERE construct nested in FORALL.  */
+	  gfc_trans_where_2 (c, NULL, false, nested_forall_info, &block);
+	  break;
+
+        /* Pointer assignment inside FORALL.  */
+	case EXEC_POINTER_ASSIGN:
+          need_temp = gfc_check_dependency (c->expr1, c->expr2, 0);
+          if (need_temp)
+            gfc_trans_pointer_assign_need_temp (c->expr1, c->expr2,
+                                                nested_forall_info, &block);
+          else
+            {
+              /* Use the normal assignment copying routines.  */
+              assign = gfc_trans_pointer_assignment (c->expr1, c->expr2);
+
+              /* Generate body and loops.  */
+              tmp = gfc_trans_nested_forall_loop (nested_forall_info,
+						  assign, 1);
+              gfc_add_expr_to_block (&block, tmp);
+            }
+          break;
+
+	case EXEC_FORALL:
+	  tmp = gfc_trans_forall_1 (c, nested_forall_info);
+          gfc_add_expr_to_block (&block, tmp);
+          break;
+
+	/* Explicit subroutine calls are prevented by the frontend but interface
+	   assignments can legitimately produce them.  */
+	case EXEC_ASSIGN_CALL:
+	  assign = gfc_trans_call (c, true, NULL_TREE, NULL_TREE, false);
+          tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign, 1);
+          gfc_add_expr_to_block (&block, tmp);
+          break;
+
+	default:
+	  gcc_unreachable ();
+	}
+
+      c = c->next;
+    }
+
+  /* Restore the original index variables.  */
+  for (fa = code->ext.forall_iterator, n = 0; fa; fa = fa->next, n++)
+    gfc_restore_sym (fa->var->symtree->n.sym, &saved_vars[n]);
+
+  /* Free the space for var, start, end, step, varexpr.  */
+  gfc_free (var);
+  gfc_free (start);
+  gfc_free (end);
+  gfc_free (step);
+  gfc_free (varexpr);
+  gfc_free (saved_vars);
+
+  for (this_forall = info->this_loop; this_forall;)
+    {
+      iter_info *next = this_forall->next;
+      gfc_free (this_forall);
+      this_forall = next;
+    }
+
+  /* Free the space for this forall_info.  */
+  gfc_free (info);
+
+  if (pmask)
+    {
+      /* Free the temporary for the mask.  */
+      tmp = gfc_call_free (pmask);
+      gfc_add_expr_to_block (&block, tmp);
+    }
+  if (maskindex)
+    pushdecl (maskindex);
+
+  gfc_add_block_to_block (&pre, &block);
+  gfc_add_block_to_block (&pre, &post);
+
+  return gfc_finish_block (&pre);
+}
+
+
+/* Translate the FORALL statement or construct.  */
+
+tree gfc_trans_forall (gfc_code * code)
+{
+  return gfc_trans_forall_1 (code, NULL);
+}
+
+
+/* Evaluate the WHERE mask expression, copy its value to a temporary.
+   If the WHERE construct is nested in FORALL, compute the overall temporary
+   needed by the WHERE mask expression multiplied by the iterator number of
+   the nested forall.
+   ME is the WHERE mask expression.
+   MASK is the current execution mask upon input, whose sense may or may
+   not be inverted as specified by the INVERT argument.
+   CMASK is the updated execution mask on output, or NULL if not required.
+   PMASK is the pending execution mask on output, or NULL if not required.
+   BLOCK is the block in which to place the condition evaluation loops.  */
+
+static void
+gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
+                         tree mask, bool invert, tree cmask, tree pmask,
+                         tree mask_type, stmtblock_t * block)
+{
+  tree tmp, tmp1;
+  gfc_ss *lss, *rss;
+  gfc_loopinfo loop;
+  stmtblock_t body, body1;
+  tree count, cond, mtmp;
+  gfc_se lse, rse;
+
+  gfc_init_loopinfo (&loop);
+
+  lss = gfc_walk_expr (me);
+  rss = gfc_walk_expr (me);
+
+  /* Variable to index the temporary.  */
+  count = gfc_create_var (gfc_array_index_type, "count");
+  /* Initialize count.  */
+  gfc_add_modify (block, count, gfc_index_zero_node);
+
+  gfc_start_block (&body);
+
+  gfc_init_se (&rse, NULL);
+  gfc_init_se (&lse, NULL);
+
+  if (lss == gfc_ss_terminator)
+    {
+      gfc_init_block (&body1);
+    }
+  else
+    {
+      /* Initialize the loop.  */
+      gfc_init_loopinfo (&loop);
+
+      /* We may need LSS to determine the shape of the expression.  */
+      gfc_add_ss_to_loop (&loop, lss);
+      gfc_add_ss_to_loop (&loop, rss);
+
+      gfc_conv_ss_startstride (&loop);
+      gfc_conv_loop_setup (&loop, &me->where);
+
+      gfc_mark_ss_chain_used (rss, 1);
+      /* Start the loop body.  */
+      gfc_start_scalarized_body (&loop, &body1);
+
+      /* Translate the expression.  */
+      gfc_copy_loopinfo_to_se (&rse, &loop);
+      rse.ss = rss;
+      gfc_conv_expr (&rse, me);
+    }
+
+  /* Variable to evaluate mask condition.  */
+  cond = gfc_create_var (mask_type, "cond");
+  if (mask && (cmask || pmask))
+    mtmp = gfc_create_var (mask_type, "mask");
+  else mtmp = NULL_TREE;
+
+  gfc_add_block_to_block (&body1, &lse.pre);
+  gfc_add_block_to_block (&body1, &rse.pre);
+
+  gfc_add_modify (&body1, cond, fold_convert (mask_type, rse.expr));
+
+  if (mask && (cmask || pmask))
+    {
+      tmp = gfc_build_array_ref (mask, count, NULL);
+      if (invert)
+	tmp = fold_build1_loc (input_location, TRUTH_NOT_EXPR, mask_type, tmp);
+      gfc_add_modify (&body1, mtmp, tmp);
+    }
+
+  if (cmask)
+    {
+      tmp1 = gfc_build_array_ref (cmask, count, NULL);
+      tmp = cond;
+      if (mask)
+	tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, mask_type,
+			       mtmp, tmp);
+      gfc_add_modify (&body1, tmp1, tmp);
+    }
+
+  if (pmask)
+    {
+      tmp1 = gfc_build_array_ref (pmask, count, NULL);
+      tmp = fold_build1_loc (input_location, TRUTH_NOT_EXPR, mask_type, cond);
+      if (mask)
+	tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, mask_type, mtmp,
+			       tmp);
+      gfc_add_modify (&body1, tmp1, tmp);
+    }
+
+  gfc_add_block_to_block (&body1, &lse.post);
+  gfc_add_block_to_block (&body1, &rse.post);
+
+  if (lss == gfc_ss_terminator)
+    {
+      gfc_add_block_to_block (&body, &body1);
+    }
+  else
+    {
+      /* Increment count.  */
+      tmp1 = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			      count, gfc_index_one_node);
+      gfc_add_modify (&body1, count, tmp1);
+
+      /* Generate the copying loops.  */
+      gfc_trans_scalarizing_loops (&loop, &body1);
+
+      gfc_add_block_to_block (&body, &loop.pre);
+      gfc_add_block_to_block (&body, &loop.post);
+
+      gfc_cleanup_loop (&loop);
+      /* TODO: Reuse lss and rss when copying temp->lhs.  Need to be careful
+         as tree nodes in SS may not be valid in different scope.  */
+    }
+
+  tmp1 = gfc_finish_block (&body);
+  /* If the WHERE construct is inside FORALL, fill the full temporary.  */
+  if (nested_forall_info != NULL)
+    tmp1 = gfc_trans_nested_forall_loop (nested_forall_info, tmp1, 1);
+
+  gfc_add_expr_to_block (block, tmp1);
+}
+
+
+/* Translate an assignment statement in a WHERE statement or construct
+   statement. The MASK expression is used to control which elements
+   of EXPR1 shall be assigned.  The sense of MASK is specified by
+   INVERT.  */
+
+static tree
+gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
+			tree mask, bool invert,
+                        tree count1, tree count2,
+			gfc_code *cnext)
+{
+  gfc_se lse;
+  gfc_se rse;
+  gfc_ss *lss;
+  gfc_ss *lss_section;
+  gfc_ss *rss;
+
+  gfc_loopinfo loop;
+  tree tmp;
+  stmtblock_t block;
+  stmtblock_t body;
+  tree index, maskexpr;
+
+  /* A defined assignment. */  
+  if (cnext && cnext->resolved_sym)
+    return gfc_trans_call (cnext, true, mask, count1, invert);
+
+#if 0
+  /* TODO: handle this special case.
+     Special case a single function returning an array.  */
+  if (expr2->expr_type == EXPR_FUNCTION && expr2->rank > 0)
+    {
+      tmp = gfc_trans_arrayfunc_assign (expr1, expr2);
+      if (tmp)
+        return tmp;
+    }
+#endif
+
+ /* Assignment of the form lhs = rhs.  */
+  gfc_start_block (&block);
+
+  gfc_init_se (&lse, NULL);
+  gfc_init_se (&rse, NULL);
+
+  /* Walk the lhs.  */
+  lss = gfc_walk_expr (expr1);
+  rss = NULL;
+
+  /* In each where-assign-stmt, the mask-expr and the variable being
+     defined shall be arrays of the same shape.  */
+  gcc_assert (lss != gfc_ss_terminator);
+
+  /* The assignment needs scalarization.  */
+  lss_section = lss;
+
+  /* Find a non-scalar SS from the lhs.  */
+  while (lss_section != gfc_ss_terminator
+         && lss_section->type != GFC_SS_SECTION)
+    lss_section = lss_section->next;
+
+  gcc_assert (lss_section != gfc_ss_terminator);
+
+  /* Initialize the scalarizer.  */
+  gfc_init_loopinfo (&loop);
+
+  /* Walk the rhs.  */
+  rss = gfc_walk_expr (expr2);
+  if (rss == gfc_ss_terminator)
+   {
+     /* The rhs is scalar.  Add a ss for the expression.  */
+     rss = gfc_get_ss ();
+     rss->where = 1;
+     rss->next = gfc_ss_terminator;
+     rss->type = GFC_SS_SCALAR;
+     rss->expr = expr2;
+    }
+
+  /* Associate the SS with the loop.  */
+  gfc_add_ss_to_loop (&loop, lss);
+  gfc_add_ss_to_loop (&loop, rss);
+
+  /* Calculate the bounds of the scalarization.  */
+  gfc_conv_ss_startstride (&loop);
+
+  /* Resolve any data dependencies in the statement.  */
+  gfc_conv_resolve_dependencies (&loop, lss_section, rss);
+
+  /* Setup the scalarizing loops.  */
+  gfc_conv_loop_setup (&loop, &expr2->where);
+
+  /* Setup the gfc_se structures.  */
+  gfc_copy_loopinfo_to_se (&lse, &loop);
+  gfc_copy_loopinfo_to_se (&rse, &loop);
+
+  rse.ss = rss;
+  gfc_mark_ss_chain_used (rss, 1);
+  if (loop.temp_ss == NULL)
+    {
+      lse.ss = lss;
+      gfc_mark_ss_chain_used (lss, 1);
+    }
+  else
+    {
+      lse.ss = loop.temp_ss;
+      gfc_mark_ss_chain_used (lss, 3);
+      gfc_mark_ss_chain_used (loop.temp_ss, 3);
+    }
+
+  /* Start the scalarized loop body.  */
+  gfc_start_scalarized_body (&loop, &body);
+
+  /* Translate the expression.  */
+  gfc_conv_expr (&rse, expr2);
+  if (lss != gfc_ss_terminator && loop.temp_ss != NULL)
+    gfc_conv_tmp_array_ref (&lse);
+  else
+    gfc_conv_expr (&lse, expr1);
+
+  /* Form the mask expression according to the mask.  */
+  index = count1;
+  maskexpr = gfc_build_array_ref (mask, index, NULL);
+  if (invert)
+    maskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
+				TREE_TYPE (maskexpr), maskexpr);
+
+  /* Use the scalar assignment as is.  */
+  tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
+				 loop.temp_ss != NULL, false, true);
+
+  tmp = build3_v (COND_EXPR, maskexpr, tmp, build_empty_stmt (input_location));
+
+  gfc_add_expr_to_block (&body, tmp);
+
+  if (lss == gfc_ss_terminator)
+    {
+      /* Increment count1.  */
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     count1, gfc_index_one_node);
+      gfc_add_modify (&body, count1, tmp);
+
+      /* Use the scalar assignment as is.  */
+      gfc_add_block_to_block (&block, &body);
+    }
+  else
+    {
+      gcc_assert (lse.ss == gfc_ss_terminator
+		  && rse.ss == gfc_ss_terminator);
+
+      if (loop.temp_ss != NULL)
+        {
+          /* Increment count1 before finish the main body of a scalarized
+             expression.  */
+          tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, count1, gfc_index_one_node);
+          gfc_add_modify (&body, count1, tmp);
+          gfc_trans_scalarized_loop_boundary (&loop, &body);
+
+          /* We need to copy the temporary to the actual lhs.  */
+          gfc_init_se (&lse, NULL);
+          gfc_init_se (&rse, NULL);
+          gfc_copy_loopinfo_to_se (&lse, &loop);
+          gfc_copy_loopinfo_to_se (&rse, &loop);
+
+          rse.ss = loop.temp_ss;
+          lse.ss = lss;
+
+          gfc_conv_tmp_array_ref (&rse);
+          gfc_conv_expr (&lse, expr1);
+
+          gcc_assert (lse.ss == gfc_ss_terminator
+		      && rse.ss == gfc_ss_terminator);
+
+          /* Form the mask expression according to the mask tree list.  */
+          index = count2;
+          maskexpr = gfc_build_array_ref (mask, index, NULL);
+	  if (invert)
+	    maskexpr = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
+					TREE_TYPE (maskexpr), maskexpr);
+
+          /* Use the scalar assignment as is.  */
+          tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts, false, false,
+					 true);
+          tmp = build3_v (COND_EXPR, maskexpr, tmp,
+			  build_empty_stmt (input_location));
+          gfc_add_expr_to_block (&body, tmp);
+
+          /* Increment count2.  */
+          tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, count2,
+				 gfc_index_one_node);
+          gfc_add_modify (&body, count2, tmp);
+        }
+      else
+        {
+          /* Increment count1.  */
+          tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, count1,
+				 gfc_index_one_node);
+          gfc_add_modify (&body, count1, tmp);
+        }
+
+      /* Generate the copying loops.  */
+      gfc_trans_scalarizing_loops (&loop, &body);
+
+      /* Wrap the whole thing up.  */
+      gfc_add_block_to_block (&block, &loop.pre);
+      gfc_add_block_to_block (&block, &loop.post);
+      gfc_cleanup_loop (&loop);
+    }
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Translate the WHERE construct or statement.
+   This function can be called iteratively to translate the nested WHERE
+   construct or statement.
+   MASK is the control mask.  */
+
+static void
+gfc_trans_where_2 (gfc_code * code, tree mask, bool invert,
+		   forall_info * nested_forall_info, stmtblock_t * block)
+{
+  stmtblock_t inner_size_body;
+  tree inner_size, size;
+  gfc_ss *lss, *rss;
+  tree mask_type;
+  gfc_expr *expr1;
+  gfc_expr *expr2;
+  gfc_code *cblock;
+  gfc_code *cnext;
+  tree tmp;
+  tree cond;
+  tree count1, count2;
+  bool need_cmask;
+  bool need_pmask;
+  int need_temp;
+  tree pcmask = NULL_TREE;
+  tree ppmask = NULL_TREE;
+  tree cmask = NULL_TREE;
+  tree pmask = NULL_TREE;
+  gfc_actual_arglist *arg;
+
+  /* the WHERE statement or the WHERE construct statement.  */
+  cblock = code->block;
+
+  /* As the mask array can be very big, prefer compact boolean types.  */
+  mask_type = gfc_get_logical_type (gfc_logical_kinds[0].kind);
+
+  /* Determine which temporary masks are needed.  */
+  if (!cblock->block)
+    {
+      /* One clause: No ELSEWHEREs.  */
+      need_cmask = (cblock->next != 0);
+      need_pmask = false;
+    }
+  else if (cblock->block->block)
+    {
+      /* Three or more clauses: Conditional ELSEWHEREs.  */
+      need_cmask = true;
+      need_pmask = true;
+    }
+  else if (cblock->next)
+    {
+      /* Two clauses, the first non-empty.  */
+      need_cmask = true;
+      need_pmask = (mask != NULL_TREE
+		    && cblock->block->next != 0);
+    }
+  else if (!cblock->block->next)
+    {
+      /* Two clauses, both empty.  */
+      need_cmask = false;
+      need_pmask = false;
+    }
+  /* Two clauses, the first empty, the second non-empty.  */
+  else if (mask)
+    {
+      need_cmask = (cblock->block->expr1 != 0);
+      need_pmask = true;
+    }
+  else
+    {
+      need_cmask = true;
+      need_pmask = false;
+    }
+
+  if (need_cmask || need_pmask)
+    {
+      /* Calculate the size of temporary needed by the mask-expr.  */
+      gfc_init_block (&inner_size_body);
+      inner_size = compute_inner_temp_size (cblock->expr1, cblock->expr1,
+					    &inner_size_body, &lss, &rss);
+
+      gfc_free_ss_chain (lss);
+      gfc_free_ss_chain (rss);
+
+      /* Calculate the total size of temporary needed.  */
+      size = compute_overall_iter_number (nested_forall_info, inner_size,
+					  &inner_size_body, block);
+
+      /* Check whether the size is negative.  */
+      cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, size,
+			      gfc_index_zero_node);
+      size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
+			      cond, gfc_index_zero_node, size);
+      size = gfc_evaluate_now (size, block);
+
+      /* Allocate temporary for WHERE mask if needed.  */
+      if (need_cmask)
+	cmask = allocate_temp_for_forall_nest_1 (mask_type, size, block,
+						 &pcmask);
+
+      /* Allocate temporary for !mask if needed.  */
+      if (need_pmask)
+	pmask = allocate_temp_for_forall_nest_1 (mask_type, size, block,
+						 &ppmask);
+    }
+
+  while (cblock)
+    {
+      /* Each time around this loop, the where clause is conditional
+	 on the value of mask and invert, which are updated at the
+	 bottom of the loop.  */
+
+      /* Has mask-expr.  */
+      if (cblock->expr1)
+        {
+          /* Ensure that the WHERE mask will be evaluated exactly once.
+	     If there are no statements in this WHERE/ELSEWHERE clause,
+	     then we don't need to update the control mask (cmask).
+	     If this is the last clause of the WHERE construct, then
+	     we don't need to update the pending control mask (pmask).  */
+	  if (mask)
+	    gfc_evaluate_where_mask (cblock->expr1, nested_forall_info,
+				     mask, invert,
+				     cblock->next  ? cmask : NULL_TREE,
+				     cblock->block ? pmask : NULL_TREE,
+				     mask_type, block);
+	  else
+	    gfc_evaluate_where_mask (cblock->expr1, nested_forall_info,
+				     NULL_TREE, false,
+				     (cblock->next || cblock->block)
+				     ? cmask : NULL_TREE,
+				     NULL_TREE, mask_type, block);
+
+	  invert = false;
+        }
+      /* It's a final elsewhere-stmt. No mask-expr is present.  */
+      else
+        cmask = mask;
+
+      /* The body of this where clause are controlled by cmask with
+	 sense specified by invert.  */
+
+      /* Get the assignment statement of a WHERE statement, or the first
+         statement in where-body-construct of a WHERE construct.  */
+      cnext = cblock->next;
+      while (cnext)
+        {
+          switch (cnext->op)
+            {
+            /* WHERE assignment statement.  */
+	    case EXEC_ASSIGN_CALL:
+
+	      arg = cnext->ext.actual;
+	      expr1 = expr2 = NULL;
+	      for (; arg; arg = arg->next)
+		{
+		  if (!arg->expr)
+		    continue;
+		  if (expr1 == NULL)
+		    expr1 = arg->expr;
+		  else
+		    expr2 = arg->expr;
+		}
+	      goto evaluate;
+
+            case EXEC_ASSIGN:
+              expr1 = cnext->expr1;
+              expr2 = cnext->expr2;
+    evaluate:
+              if (nested_forall_info != NULL)
+                {
+                  need_temp = gfc_check_dependency (expr1, expr2, 0);
+                  if (need_temp && cnext->op != EXEC_ASSIGN_CALL)
+                    gfc_trans_assign_need_temp (expr1, expr2,
+						cmask, invert,
+                                                nested_forall_info, block);
+                  else
+                    {
+                      /* Variables to control maskexpr.  */
+                      count1 = gfc_create_var (gfc_array_index_type, "count1");
+                      count2 = gfc_create_var (gfc_array_index_type, "count2");
+                      gfc_add_modify (block, count1, gfc_index_zero_node);
+                      gfc_add_modify (block, count2, gfc_index_zero_node);
+
+                      tmp = gfc_trans_where_assign (expr1, expr2,
+						    cmask, invert,
+						    count1, count2,
+						    cnext);
+
+                      tmp = gfc_trans_nested_forall_loop (nested_forall_info,
+                                                          tmp, 1);
+                      gfc_add_expr_to_block (block, tmp);
+                    }
+                }
+              else
+                {
+                  /* Variables to control maskexpr.  */
+                  count1 = gfc_create_var (gfc_array_index_type, "count1");
+                  count2 = gfc_create_var (gfc_array_index_type, "count2");
+                  gfc_add_modify (block, count1, gfc_index_zero_node);
+                  gfc_add_modify (block, count2, gfc_index_zero_node);
+
+                  tmp = gfc_trans_where_assign (expr1, expr2,
+						cmask, invert,
+						count1, count2,
+						cnext);
+                  gfc_add_expr_to_block (block, tmp);
+
+                }
+              break;
+
+            /* WHERE or WHERE construct is part of a where-body-construct.  */
+            case EXEC_WHERE:
+	      gfc_trans_where_2 (cnext, cmask, invert,
+				 nested_forall_info, block);
+	      break;
+
+            default:
+              gcc_unreachable ();
+            }
+
+         /* The next statement within the same where-body-construct.  */
+         cnext = cnext->next;
+       }
+    /* The next masked-elsewhere-stmt, elsewhere-stmt, or end-where-stmt.  */
+    cblock = cblock->block;
+    if (mask == NULL_TREE)
+      {
+        /* If we're the initial WHERE, we can simply invert the sense
+	   of the current mask to obtain the "mask" for the remaining
+	   ELSEWHEREs.  */
+	invert = true;
+	mask = cmask;
+      }
+    else
+      {
+	/* Otherwise, for nested WHERE's we need to use the pending mask.  */
+        invert = false;
+        mask = pmask;
+      }
+  }
+
+  /* If we allocated a pending mask array, deallocate it now.  */
+  if (ppmask)
+    {
+      tmp = gfc_call_free (ppmask);
+      gfc_add_expr_to_block (block, tmp);
+    }
+
+  /* If we allocated a current mask array, deallocate it now.  */
+  if (pcmask)
+    {
+      tmp = gfc_call_free (pcmask);
+      gfc_add_expr_to_block (block, tmp);
+    }
+}
+
+/* Translate a simple WHERE construct or statement without dependencies.
+   CBLOCK is the "then" clause of the WHERE statement, where CBLOCK->EXPR
+   is the mask condition, and EBLOCK if non-NULL is the "else" clause.
+   Currently both CBLOCK and EBLOCK are restricted to single assignments.  */
+
+static tree
+gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock)
+{
+  stmtblock_t block, body;
+  gfc_expr *cond, *tdst, *tsrc, *edst, *esrc;
+  tree tmp, cexpr, tstmt, estmt;
+  gfc_ss *css, *tdss, *tsss;
+  gfc_se cse, tdse, tsse, edse, esse;
+  gfc_loopinfo loop;
+  gfc_ss *edss = 0;
+  gfc_ss *esss = 0;
+
+  /* Allow the scalarizer to workshare simple where loops.  */
+  if (ompws_flags & OMPWS_WORKSHARE_FLAG)
+    ompws_flags |= OMPWS_SCALARIZER_WS;
+
+  cond = cblock->expr1;
+  tdst = cblock->next->expr1;
+  tsrc = cblock->next->expr2;
+  edst = eblock ? eblock->next->expr1 : NULL;
+  esrc = eblock ? eblock->next->expr2 : NULL;
+
+  gfc_start_block (&block);
+  gfc_init_loopinfo (&loop);
+
+  /* Handle the condition.  */
+  gfc_init_se (&cse, NULL);
+  css = gfc_walk_expr (cond);
+  gfc_add_ss_to_loop (&loop, css);
+
+  /* Handle the then-clause.  */
+  gfc_init_se (&tdse, NULL);
+  gfc_init_se (&tsse, NULL);
+  tdss = gfc_walk_expr (tdst);
+  tsss = gfc_walk_expr (tsrc);
+  if (tsss == gfc_ss_terminator)
+    {
+      tsss = gfc_get_ss ();
+      tsss->where = 1;
+      tsss->next = gfc_ss_terminator;
+      tsss->type = GFC_SS_SCALAR;
+      tsss->expr = tsrc;
+    }
+  gfc_add_ss_to_loop (&loop, tdss);
+  gfc_add_ss_to_loop (&loop, tsss);
+
+  if (eblock)
+    {
+      /* Handle the else clause.  */
+      gfc_init_se (&edse, NULL);
+      gfc_init_se (&esse, NULL);
+      edss = gfc_walk_expr (edst);
+      esss = gfc_walk_expr (esrc);
+      if (esss == gfc_ss_terminator)
+	{
+	  esss = gfc_get_ss ();
+	  esss->where = 1;
+	  esss->next = gfc_ss_terminator;
+	  esss->type = GFC_SS_SCALAR;
+	  esss->expr = esrc;
+	}
+      gfc_add_ss_to_loop (&loop, edss);
+      gfc_add_ss_to_loop (&loop, esss);
+    }
+
+  gfc_conv_ss_startstride (&loop);
+  gfc_conv_loop_setup (&loop, &tdst->where);
+
+  gfc_mark_ss_chain_used (css, 1);
+  gfc_mark_ss_chain_used (tdss, 1);
+  gfc_mark_ss_chain_used (tsss, 1);
+  if (eblock)
+    {
+      gfc_mark_ss_chain_used (edss, 1);
+      gfc_mark_ss_chain_used (esss, 1);
+    }
+
+  gfc_start_scalarized_body (&loop, &body);
+
+  gfc_copy_loopinfo_to_se (&cse, &loop);
+  gfc_copy_loopinfo_to_se (&tdse, &loop);
+  gfc_copy_loopinfo_to_se (&tsse, &loop);
+  cse.ss = css;
+  tdse.ss = tdss;
+  tsse.ss = tsss;
+  if (eblock)
+    {
+      gfc_copy_loopinfo_to_se (&edse, &loop);
+      gfc_copy_loopinfo_to_se (&esse, &loop);
+      edse.ss = edss;
+      esse.ss = esss;
+    }
+
+  gfc_conv_expr (&cse, cond);
+  gfc_add_block_to_block (&body, &cse.pre);
+  cexpr = cse.expr;
+
+  gfc_conv_expr (&tsse, tsrc);
+  if (tdss != gfc_ss_terminator && loop.temp_ss != NULL)
+    gfc_conv_tmp_array_ref (&tdse);
+  else
+    gfc_conv_expr (&tdse, tdst);
+
+  if (eblock)
+    {
+      gfc_conv_expr (&esse, esrc);
+      if (edss != gfc_ss_terminator && loop.temp_ss != NULL)
+	gfc_conv_tmp_array_ref (&edse);
+      else
+	gfc_conv_expr (&edse, edst);
+    }
+
+  tstmt = gfc_trans_scalar_assign (&tdse, &tsse, tdst->ts, false, false, true);
+  estmt = eblock ? gfc_trans_scalar_assign (&edse, &esse, edst->ts, false,
+					    false, true)
+		 : build_empty_stmt (input_location);
+  tmp = build3_v (COND_EXPR, cexpr, tstmt, estmt);
+  gfc_add_expr_to_block (&body, tmp);
+  gfc_add_block_to_block (&body, &cse.post);
+
+  gfc_trans_scalarizing_loops (&loop, &body);
+  gfc_add_block_to_block (&block, &loop.pre);
+  gfc_add_block_to_block (&block, &loop.post);
+  gfc_cleanup_loop (&loop);
+
+  return gfc_finish_block (&block);
+}
+
+/* As the WHERE or WHERE construct statement can be nested, we call
+   gfc_trans_where_2 to do the translation, and pass the initial
+   NULL values for both the control mask and the pending control mask.  */
+
+tree
+gfc_trans_where (gfc_code * code)
+{
+  stmtblock_t block;
+  gfc_code *cblock;
+  gfc_code *eblock;
+
+  cblock = code->block;
+  if (cblock->next
+      && cblock->next->op == EXEC_ASSIGN
+      && !cblock->next->next)
+    {
+      eblock = cblock->block;
+      if (!eblock)
+	{
+          /* A simple "WHERE (cond) x = y" statement or block is
+	     dependence free if cond is not dependent upon writing x,
+	     and the source y is unaffected by the destination x.  */
+	  if (!gfc_check_dependency (cblock->next->expr1,
+				     cblock->expr1, 0)
+	      && !gfc_check_dependency (cblock->next->expr1,
+					cblock->next->expr2, 0))
+	    return gfc_trans_where_3 (cblock, NULL);
+	}
+      else if (!eblock->expr1
+	       && !eblock->block
+	       && eblock->next
+	       && eblock->next->op == EXEC_ASSIGN
+	       && !eblock->next->next)
+	{
+          /* A simple "WHERE (cond) x1 = y1 ELSEWHERE x2 = y2 ENDWHERE"
+	     block is dependence free if cond is not dependent on writes
+	     to x1 and x2, y1 is not dependent on writes to x2, and y2
+	     is not dependent on writes to x1, and both y's are not
+	     dependent upon their own x's.  In addition to this, the
+	     final two dependency checks below exclude all but the same
+	     array reference if the where and elswhere destinations
+	     are the same.  In short, this is VERY conservative and this
+	     is needed because the two loops, required by the standard
+	     are coalesced in gfc_trans_where_3.  */
+	  if (!gfc_check_dependency(cblock->next->expr1,
+				    cblock->expr1, 0)
+	      && !gfc_check_dependency(eblock->next->expr1,
+				       cblock->expr1, 0)
+	      && !gfc_check_dependency(cblock->next->expr1,
+				       eblock->next->expr2, 1)
+	      && !gfc_check_dependency(eblock->next->expr1,
+				       cblock->next->expr2, 1)
+	      && !gfc_check_dependency(cblock->next->expr1,
+				       cblock->next->expr2, 1)
+	      && !gfc_check_dependency(eblock->next->expr1,
+				       eblock->next->expr2, 1)
+	      && !gfc_check_dependency(cblock->next->expr1,
+				       eblock->next->expr1, 0)
+	      && !gfc_check_dependency(eblock->next->expr1,
+				       cblock->next->expr1, 0))
+	    return gfc_trans_where_3 (cblock, eblock);
+	}
+    }
+
+  gfc_start_block (&block);
+
+  gfc_trans_where_2 (code, NULL, false, NULL, &block);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* CYCLE a DO loop. The label decl has already been created by
+   gfc_trans_do(), it's in TREE_PURPOSE (backend_decl) of the gfc_code
+   node at the head of the loop. We must mark the label as used.  */
+
+tree
+gfc_trans_cycle (gfc_code * code)
+{
+  tree cycle_label;
+
+  cycle_label = code->ext.which_construct->cycle_label;
+  gcc_assert (cycle_label);
+
+  TREE_USED (cycle_label) = 1;
+  return build1_v (GOTO_EXPR, cycle_label);
+}
+
+
+/* EXIT a DO loop. Similar to CYCLE, but now the label is in
+   TREE_VALUE (backend_decl) of the gfc_code node at the head of the
+   loop.  */
+
+tree
+gfc_trans_exit (gfc_code * code)
+{
+  tree exit_label;
+
+  exit_label = code->ext.which_construct->exit_label;
+  gcc_assert (exit_label);
+
+  TREE_USED (exit_label) = 1;
+  return build1_v (GOTO_EXPR, exit_label);
+}
+
+
+/* Translate the ALLOCATE statement.  */
+
+tree
+gfc_trans_allocate (gfc_code * code)
+{
+  gfc_alloc *al;
+  gfc_expr *expr;
+  gfc_se se;
+  tree tmp;
+  tree parm;
+  tree stat;
+  tree pstat;
+  tree error_label;
+  tree memsz;
+  tree expr3;
+  tree slen3;
+  stmtblock_t block;
+  stmtblock_t post;
+  gfc_expr *sz;
+  gfc_se se_sz;
+
+  if (!code->ext.alloc.list)
+    return NULL_TREE;
+
+  pstat = stat = error_label = tmp = memsz = NULL_TREE;
+
+  gfc_init_block (&block);
+  gfc_init_block (&post);
+
+  /* Either STAT= and/or ERRMSG is present.  */
+  if (code->expr1 || code->expr2)
+    {
+      tree gfc_int4_type_node = gfc_get_int_type (4);
+
+      stat = gfc_create_var (gfc_int4_type_node, "stat");
+      pstat = gfc_build_addr_expr (NULL_TREE, stat);
+
+      error_label = gfc_build_label_decl (NULL_TREE);
+      TREE_USED (error_label) = 1;
+    }
+
+  expr3 = NULL_TREE;
+  slen3 = NULL_TREE;
+
+  for (al = code->ext.alloc.list; al != NULL; al = al->next)
+    {
+      expr = gfc_copy_expr (al->expr);
+
+      if (expr->ts.type == BT_CLASS)
+	gfc_add_data_component (expr);
+
+      gfc_init_se (&se, NULL);
+
+      se.want_pointer = 1;
+      se.descriptor_only = 1;
+      gfc_conv_expr (&se, expr);
+
+      if (!gfc_array_allocate (&se, expr, pstat))
+	{
+	  /* A scalar or derived type.  */
+
+	  /* Determine allocate size.  */
+	  if (al->expr->ts.type == BT_CLASS && code->expr3)
+	    {
+	      if (code->expr3->ts.type == BT_CLASS)
+		{
+		  sz = gfc_copy_expr (code->expr3);
+		  gfc_add_vptr_component (sz);
+		  gfc_add_size_component (sz);
+		  gfc_init_se (&se_sz, NULL);
+		  gfc_conv_expr (&se_sz, sz);
+		  gfc_free_expr (sz);
+		  memsz = se_sz.expr;
+		}
+	      else
+		memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->expr3->ts));
+	    }
+	  else if (al->expr->ts.type == BT_CHARACTER
+		     && al->expr->ts.deferred && code->expr3)
+	    {
+	      if (!code->expr3->ts.u.cl->backend_decl)
+		{
+		  /* Convert and use the length expression.  */
+		  gfc_init_se (&se_sz, NULL);
+		  if (code->expr3->expr_type == EXPR_VARIABLE
+			|| code->expr3->expr_type == EXPR_CONSTANT)
+		    {
+		      gfc_conv_expr (&se_sz, code->expr3);
+		      memsz = se_sz.string_length;
+		    }
+		  else if (code->expr3->mold
+			     && code->expr3->ts.u.cl
+			     && code->expr3->ts.u.cl->length)
+		    {
+		      gfc_conv_expr (&se_sz, code->expr3->ts.u.cl->length);
+		      gfc_add_block_to_block (&se.pre, &se_sz.pre);
+		      se_sz.expr = gfc_evaluate_now (se_sz.expr, &se.pre);
+		      gfc_add_block_to_block (&se.pre, &se_sz.post);
+		      memsz = se_sz.expr;
+		    }
+		  else
+		    {
+		      /* This is would be inefficient and possibly could
+			 generate wrong code if the result were not stored
+			 in expr3/slen3.  */
+		      if (slen3 == NULL_TREE)
+			{
+			  gfc_conv_expr (&se_sz, code->expr3);
+			  gfc_add_block_to_block (&se.pre, &se_sz.pre);
+			  expr3 = gfc_evaluate_now (se_sz.expr, &se.pre);
+			  gfc_add_block_to_block (&post, &se_sz.post);
+			  slen3 = gfc_evaluate_now (se_sz.string_length,
+						    &se.pre);
+			}
+		      memsz = slen3;
+		    }
+		}
+	      else
+		/* Otherwise use the stored string length.  */
+		memsz = code->expr3->ts.u.cl->backend_decl;
+	      tmp = al->expr->ts.u.cl->backend_decl;
+
+	      /* Store the string length.  */
+	      if (tmp && TREE_CODE (tmp) == VAR_DECL)
+		gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp),
+				memsz));
+
+	      /* Convert to size in bytes, using the character KIND.  */
+	      tmp = TREE_TYPE (gfc_typenode_for_spec (&al->expr->ts));
+	      tmp = TYPE_SIZE_UNIT (tmp);
+	      memsz = fold_build2_loc (input_location, MULT_EXPR,
+				       TREE_TYPE (tmp), tmp,
+				       fold_convert (TREE_TYPE (tmp), memsz));
+	    }
+          else if (al->expr->ts.type == BT_CHARACTER && al->expr->ts.deferred)
+	    {
+	      gcc_assert (code->ext.alloc.ts.u.cl && code->ext.alloc.ts.u.cl->length);
+	      gfc_init_se (&se_sz, NULL);
+	      gfc_conv_expr (&se_sz, code->ext.alloc.ts.u.cl->length);
+	      gfc_add_block_to_block (&se.pre, &se_sz.pre);
+	      se_sz.expr = gfc_evaluate_now (se_sz.expr, &se.pre);
+	      gfc_add_block_to_block (&se.pre, &se_sz.post);
+	      /* Store the string length.  */
+	      tmp = al->expr->ts.u.cl->backend_decl;
+	      gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp),
+			      se_sz.expr));
+              tmp = TREE_TYPE (gfc_typenode_for_spec (&code->ext.alloc.ts));
+              tmp = TYPE_SIZE_UNIT (tmp);
+	      memsz = fold_build2_loc (input_location, MULT_EXPR,
+				       TREE_TYPE (tmp), tmp,
+				       fold_convert (TREE_TYPE (se_sz.expr),
+						     se_sz.expr));
+	    }
+	  else if (code->ext.alloc.ts.type != BT_UNKNOWN)
+	    memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts));
+	  else
+	    memsz = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (se.expr)));
+
+	  if (expr->ts.type == BT_CHARACTER && memsz == NULL_TREE)
+	    {
+	      memsz = se.string_length;
+
+	      /* Convert to size in bytes, using the character KIND.  */
+	      tmp = TREE_TYPE (gfc_typenode_for_spec (&code->ext.alloc.ts));
+	      tmp = TYPE_SIZE_UNIT (tmp);
+	      memsz = fold_build2_loc (input_location, MULT_EXPR,
+				       TREE_TYPE (tmp), tmp,
+				       fold_convert (TREE_TYPE (tmp), memsz));
+	    }
+
+	  /* Allocate - for non-pointers with re-alloc checking.  */
+	  if (gfc_expr_attr (expr).allocatable)
+	    tmp = gfc_allocate_array_with_status (&se.pre, se.expr, memsz,
+						  pstat, expr);
+	  else
+	    tmp = gfc_allocate_with_status (&se.pre, memsz, pstat);
+
+	  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+				 se.expr,
+				 fold_convert (TREE_TYPE (se.expr), tmp));
+	  gfc_add_expr_to_block (&se.pre, tmp);
+
+	  if (code->expr1 || code->expr2)
+	    {
+	      tmp = build1_v (GOTO_EXPR, error_label);
+	      parm = fold_build2_loc (input_location, NE_EXPR,
+				      boolean_type_node, stat,
+				      build_int_cst (TREE_TYPE (stat), 0));
+	      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+				     parm, tmp,
+				     build_empty_stmt (input_location));
+	      gfc_add_expr_to_block (&se.pre, tmp);
+	    }
+
+	  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)
+	    {
+	      tmp = build_fold_indirect_ref_loc (input_location, se.expr);
+	      tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);
+	      gfc_add_expr_to_block (&se.pre, tmp);
+	    }
+	}
+
+      gfc_add_block_to_block (&block, &se.pre);
+
+      if (code->expr3 && !code->expr3->mold)
+	{
+	  /* Initialization via SOURCE block
+	     (or static default initializer).  */
+	  gfc_expr *rhs = gfc_copy_expr (code->expr3);
+	  if (al->expr->ts.type == BT_CLASS)
+	    {
+	      gfc_se call;
+	      gfc_actual_arglist *actual;
+	      gfc_expr *ppc;
+	      gfc_init_se (&call, NULL);
+	      /* Do a polymorphic deep copy.  */
+	      actual = gfc_get_actual_arglist ();
+	      actual->expr = gfc_copy_expr (rhs);
+	      if (rhs->ts.type == BT_CLASS)
+		gfc_add_data_component (actual->expr);
+	      actual->next = gfc_get_actual_arglist ();
+	      actual->next->expr = gfc_copy_expr (al->expr);
+	      gfc_add_data_component (actual->next->expr);
+	      if (rhs->ts.type == BT_CLASS)
+		{
+		  ppc = gfc_copy_expr (rhs);
+		  gfc_add_vptr_component (ppc);
+		}
+	      else
+		ppc = gfc_lval_expr_from_sym (gfc_find_derived_vtab (rhs->ts.u.derived));
+	      gfc_add_component_ref (ppc, "_copy");
+	      gfc_conv_procedure_call (&call, ppc->symtree->n.sym, actual,
+					ppc, NULL);
+	      gfc_add_expr_to_block (&call.pre, call.expr);
+	      gfc_add_block_to_block (&call.pre, &call.post);
+	      tmp = gfc_finish_block (&call.pre);
+	    }
+	  else if (expr3 != NULL_TREE)
+	    {
+	      tmp = build_fold_indirect_ref_loc (input_location, se.expr);
+	      gfc_trans_string_copy (&block, slen3, tmp, code->expr3->ts.kind,
+				     slen3, expr3, code->expr3->ts.kind);
+	      tmp = NULL_TREE;
+	    }
+	  else
+	    {
+	      /* Switch off automatic reallocation since we have just done
+		 the ALLOCATE.  */
+	      int realloc_lhs = gfc_option.flag_realloc_lhs;
+	      gfc_option.flag_realloc_lhs = 0;
+	      tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr),
+					  rhs, false, false);
+	      gfc_option.flag_realloc_lhs = realloc_lhs;
+	    }
+	  gfc_free_expr (rhs);
+	  gfc_add_expr_to_block (&block, tmp);
+	}
+      else if (code->expr3 && code->expr3->mold
+	    && code->expr3->ts.type == BT_CLASS)
+	{
+	  /* Default-initialization via MOLD (polymorphic).  */
+	  gfc_expr *rhs = gfc_copy_expr (code->expr3);
+	  gfc_se dst,src;
+	  gfc_add_vptr_component (rhs);
+	  gfc_add_def_init_component (rhs);
+	  gfc_init_se (&dst, NULL);
+	  gfc_init_se (&src, NULL);
+	  gfc_conv_expr (&dst, expr);
+	  gfc_conv_expr (&src, rhs);
+	  gfc_add_block_to_block (&block, &src.pre);
+	  tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
+	  gfc_add_expr_to_block (&block, tmp);
+	  gfc_free_expr (rhs);
+	}
+
+      /* Allocation of CLASS entities.  */
+      gfc_free_expr (expr);
+      expr = al->expr;
+      if (expr->ts.type == BT_CLASS)
+	{
+	  gfc_expr *lhs,*rhs;
+	  gfc_se lse;
+
+	  /* Initialize VPTR for CLASS objects.  */
+	  lhs = gfc_expr_to_initialize (expr);
+	  gfc_add_vptr_component (lhs);
+	  rhs = NULL;
+	  if (code->expr3 && code->expr3->ts.type == BT_CLASS)
+	    {
+	      /* Polymorphic SOURCE: VPTR must be determined at run time.  */
+	      rhs = gfc_copy_expr (code->expr3);
+	      gfc_add_vptr_component (rhs);
+	      tmp = gfc_trans_pointer_assignment (lhs, rhs);
+	      gfc_add_expr_to_block (&block, tmp);
+	      gfc_free_expr (rhs);
+	    }
+	  else
+	    {
+	      /* VPTR is fixed at compile time.  */
+	      gfc_symbol *vtab;
+	      gfc_typespec *ts;
+	      if (code->expr3)
+		ts = &code->expr3->ts;
+	      else if (expr->ts.type == BT_DERIVED)
+		ts = &expr->ts;
+	      else if (code->ext.alloc.ts.type == BT_DERIVED)
+		ts = &code->ext.alloc.ts;
+	      else if (expr->ts.type == BT_CLASS)
+		ts = &CLASS_DATA (expr)->ts;
+	      else
+		ts = &expr->ts;
+
+	      if (ts->type == BT_DERIVED)
+		{
+		  vtab = gfc_find_derived_vtab (ts->u.derived);
+		  gcc_assert (vtab);
+		  gfc_init_se (&lse, NULL);
+		  lse.want_pointer = 1;
+		  gfc_conv_expr (&lse, lhs);
+		  tmp = gfc_build_addr_expr (NULL_TREE,
+					     gfc_get_symbol_decl (vtab));
+		  gfc_add_modify (&block, lse.expr,
+			fold_convert (TREE_TYPE (lse.expr), tmp));
+		}
+	    }
+	  gfc_free_expr (lhs);
+	}
+
+    }
+
+  /* STAT block.  */
+  if (code->expr1)
+    {
+      tmp = build1_v (LABEL_EXPR, error_label);
+      gfc_add_expr_to_block (&block, tmp);
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_lhs (&se, code->expr1);
+      tmp = convert (TREE_TYPE (se.expr), stat);
+      gfc_add_modify (&block, se.expr, tmp);
+    }
+
+  /* ERRMSG block.  */
+  if (code->expr2)
+    {
+      /* A better error message may be possible, but not required.  */
+      const char *msg = "Attempt to allocate an allocated object";
+      tree errmsg, slen, dlen;
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_lhs (&se, code->expr2);
+
+      errmsg = gfc_create_var (pchar_type_node, "ERRMSG");
+
+      gfc_add_modify (&block, errmsg,
+		gfc_build_addr_expr (pchar_type_node,
+			gfc_build_localized_cstring_const (msg)));
+
+      slen = build_int_cst (gfc_charlen_type_node, ((int) strlen (msg)));
+      dlen = gfc_get_expr_charlen (code->expr2);
+      slen = fold_build2_loc (input_location, MIN_EXPR, TREE_TYPE (slen), dlen,
+			      slen);
+
+      dlen = build_call_expr_loc (input_location,
+			      built_in_decls[BUILT_IN_MEMCPY], 3,
+		gfc_build_addr_expr (pvoid_type_node, se.expr), errmsg, slen);
+
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, stat,
+			     build_int_cst (TREE_TYPE (stat), 0));
+
+      tmp = build3_v (COND_EXPR, tmp, dlen, build_empty_stmt (input_location));
+
+      gfc_add_expr_to_block (&block, tmp);
+    }
+
+  gfc_add_block_to_block (&block, &se.post);
+  gfc_add_block_to_block (&block, &post);
+
+  return gfc_finish_block (&block);
+}
+
+
+/* Translate a DEALLOCATE statement.  */
+
+tree
+gfc_trans_deallocate (gfc_code *code)
+{
+  gfc_se se;
+  gfc_alloc *al;
+  tree apstat, astat, pstat, stat, tmp;
+  stmtblock_t block;
+
+  pstat = apstat = stat = astat = tmp = NULL_TREE;
+
+  gfc_start_block (&block);
+
+  /* Count the number of failed deallocations.  If deallocate() was
+     called with STAT= , then set STAT to the count.  If deallocate
+     was called with ERRMSG, then set ERRMG to a string.  */
+  if (code->expr1 || code->expr2)
+    {
+      tree gfc_int4_type_node = gfc_get_int_type (4);
+
+      stat = gfc_create_var (gfc_int4_type_node, "stat");
+      pstat = gfc_build_addr_expr (NULL_TREE, stat);
+
+      /* Running total of possible deallocation failures.  */
+      astat = gfc_create_var (gfc_int4_type_node, "astat");
+      apstat = gfc_build_addr_expr (NULL_TREE, astat);
+
+      /* Initialize astat to 0.  */
+      gfc_add_modify (&block, astat, build_int_cst (TREE_TYPE (astat), 0));
+    }
+
+  for (al = code->ext.alloc.list; al != NULL; al = al->next)
+    {
+      gfc_expr *expr = gfc_copy_expr (al->expr);
+      gcc_assert (expr->expr_type == EXPR_VARIABLE);
+
+      if (expr->ts.type == BT_CLASS)
+	gfc_add_data_component (expr);
+
+      gfc_init_se (&se, NULL);
+      gfc_start_block (&se.pre);
+
+      se.want_pointer = 1;
+      se.descriptor_only = 1;
+      gfc_conv_expr (&se, expr);
+
+      if (expr->rank)
+	{
+	  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)
+	    {
+	      gfc_ref *ref;
+	      gfc_ref *last = NULL;
+	      for (ref = expr->ref; ref; ref = ref->next)
+		if (ref->type == REF_COMPONENT)
+		  last = ref;
+
+	      /* Do not deallocate the components of a derived type
+		ultimate pointer component.  */
+	      if (!(last && last->u.c.component->attr.pointer)
+		    && !(!last && expr->symtree->n.sym->attr.pointer))
+		{
+		  tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, se.expr,
+						  expr->rank);
+		  gfc_add_expr_to_block (&se.pre, tmp);
+		}
+	    }
+	  tmp = gfc_array_deallocate (se.expr, pstat, expr);
+	  gfc_add_expr_to_block (&se.pre, tmp);
+	}
+      else
+	{
+	  tmp = gfc_deallocate_scalar_with_status (se.expr, pstat, false,
+						   expr, expr->ts);
+	  gfc_add_expr_to_block (&se.pre, tmp);
+
+	  /* Set to zero after deallocation.  */
+	  tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+				 se.expr,
+				 build_int_cst (TREE_TYPE (se.expr), 0));
+	  gfc_add_expr_to_block (&se.pre, tmp);
+	  
+	  if (al->expr->ts.type == BT_CLASS)
+	    {
+	      /* Reset _vptr component to declared type.  */
+	      gfc_expr *rhs, *lhs = gfc_copy_expr (al->expr);
+	      gfc_symbol *vtab = gfc_find_derived_vtab (al->expr->ts.u.derived);
+	      gfc_add_vptr_component (lhs);
+	      rhs = gfc_lval_expr_from_sym (vtab);
+	      tmp = gfc_trans_pointer_assignment (lhs, rhs);
+	      gfc_add_expr_to_block (&se.pre, tmp);
+	      gfc_free_expr (lhs);
+	      gfc_free_expr (rhs);
+	    }
+	}
+
+      /* Keep track of the number of failed deallocations by adding stat
+	 of the last deallocation to the running total.  */
+      if (code->expr1 || code->expr2)
+	{
+	  apstat = fold_build2_loc (input_location, PLUS_EXPR,
+				    TREE_TYPE (stat), astat, stat);
+	  gfc_add_modify (&se.pre, astat, apstat);
+	}
+
+      tmp = gfc_finish_block (&se.pre);
+      gfc_add_expr_to_block (&block, tmp);
+      gfc_free_expr (expr);
+    }
+
+  /* Set STAT.  */
+  if (code->expr1)
+    {
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_lhs (&se, code->expr1);
+      tmp = convert (TREE_TYPE (se.expr), astat);
+      gfc_add_modify (&block, se.expr, tmp);
+    }
+
+  /* Set ERRMSG.  */
+  if (code->expr2)
+    {
+      /* A better error message may be possible, but not required.  */
+      const char *msg = "Attempt to deallocate an unallocated object";
+      tree errmsg, slen, dlen;
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr_lhs (&se, code->expr2);
+
+      errmsg = gfc_create_var (pchar_type_node, "ERRMSG");
+
+      gfc_add_modify (&block, errmsg,
+		gfc_build_addr_expr (pchar_type_node,
+                        gfc_build_localized_cstring_const (msg)));
+
+      slen = build_int_cst (gfc_charlen_type_node, ((int) strlen (msg)));
+      dlen = gfc_get_expr_charlen (code->expr2);
+      slen = fold_build2_loc (input_location, MIN_EXPR, TREE_TYPE (slen), dlen,
+			      slen);
+
+      dlen = build_call_expr_loc (input_location,
+			      built_in_decls[BUILT_IN_MEMCPY], 3,
+		gfc_build_addr_expr (pvoid_type_node, se.expr), errmsg, slen);
+
+      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, astat,
+			     build_int_cst (TREE_TYPE (astat), 0));
+
+      tmp = build3_v (COND_EXPR, tmp, dlen, build_empty_stmt (input_location));
+
+      gfc_add_expr_to_block (&block, tmp);
+    }
+
+  return gfc_finish_block (&block);
+}
+
+#include "gt-fortran-trans-stmt.h"
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
new file mode 100644
index 000000000..8b77750c5
--- /dev/null
+++ b/gcc/fortran/trans-stmt.h
@@ -0,0 +1,80 @@
+/* Header for statement translation functions
+   Copyright (C) 2002, 2003, 2006, 2007, 2008, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* Statement translators (gfc_trans_*) return a fully translated tree.
+   Calls gfc_trans_*.  */
+tree gfc_trans_code (gfc_code *);
+
+/* Wrapper function used to pass a check condition for implied DO loops.  */
+tree gfc_trans_code_cond (gfc_code *, tree);
+
+/* All other gfc_trans_* should only need be called by gfc_trans_code */
+
+/* trans-expr.c */
+tree gfc_trans_assign (gfc_code *);
+tree gfc_trans_pointer_assign (gfc_code *);
+tree gfc_trans_init_assign (gfc_code *);
+tree gfc_trans_class_init_assign (gfc_code *);
+tree gfc_trans_class_assign (gfc_expr *, gfc_expr *, gfc_exec_op);
+
+/* trans-stmt.c */
+tree gfc_trans_cycle (gfc_code *);
+tree gfc_trans_critical (gfc_code *);
+tree gfc_trans_exit (gfc_code *);
+tree gfc_trans_label_assign (gfc_code *);
+tree gfc_trans_label_here (gfc_code *);
+tree gfc_trans_goto (gfc_code *);
+tree gfc_trans_entry (gfc_code *);
+tree gfc_trans_pause (gfc_code *);
+tree gfc_trans_stop (gfc_code *, bool);
+tree gfc_trans_call (gfc_code *, bool, tree, tree, bool);
+tree gfc_trans_return (gfc_code *);
+tree gfc_trans_if (gfc_code *);
+tree gfc_trans_arithmetic_if (gfc_code *);
+tree gfc_trans_block_construct (gfc_code *);
+tree gfc_trans_do (gfc_code *, tree);
+tree gfc_trans_do_while (gfc_code *);
+tree gfc_trans_select (gfc_code *);
+tree gfc_trans_sync (gfc_code *, gfc_exec_op);
+tree gfc_trans_forall (gfc_code *);
+tree gfc_trans_where (gfc_code *);
+tree gfc_trans_allocate (gfc_code *);
+tree gfc_trans_deallocate (gfc_code *);
+tree gfc_trans_deallocate_array (tree);
+
+/* trans-openmp.c */
+tree gfc_trans_omp_directive (gfc_code *);
+
+/* trans-io.c */
+tree gfc_trans_open (gfc_code *);
+tree gfc_trans_close (gfc_code *);
+tree gfc_trans_read (gfc_code *);
+tree gfc_trans_write (gfc_code *);
+tree gfc_trans_iolength (gfc_code *);
+tree gfc_trans_backspace (gfc_code *);
+tree gfc_trans_endfile (gfc_code *);
+tree gfc_trans_inquire (gfc_code *);
+tree gfc_trans_rewind (gfc_code *);
+tree gfc_trans_flush (gfc_code *);
+
+tree gfc_trans_transfer (gfc_code *);
+tree gfc_trans_dt_end (gfc_code *);
+tree gfc_trans_wait (gfc_code *);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
new file mode 100644
index 000000000..fca2bb144
--- /dev/null
+++ b/gcc/fortran/trans-types.c
@@ -0,0 +1,2882 @@
+/* Backend support for Fortran 95 basic types and derived types.
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+   2010, 2011
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+   and Steven Bosscher <s.bosscher@student.tudelft.nl>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* trans-types.c -- gfortran backend types */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "langhooks.h"	/* For iso-c-bindings.def.  */
+#include "target.h"
+#include "ggc.h"
+#include "diagnostic-core.h"  /* For fatal_error.  */
+#include "toplev.h"	/* For rest_of_decl_compilation.  */
+#include "gfortran.h"
+#include "trans.h"
+#include "trans-types.h"
+#include "trans-const.h"
+#include "flags.h"
+#include "dwarf2out.h"	/* For struct array_descr_info.  */
+
+
+#if (GFC_MAX_DIMENSIONS < 10)
+#define GFC_RANK_DIGITS 1
+#define GFC_RANK_PRINTF_FORMAT "%01d"
+#elif (GFC_MAX_DIMENSIONS < 100)
+#define GFC_RANK_DIGITS 2
+#define GFC_RANK_PRINTF_FORMAT "%02d"
+#else
+#error If you really need >99 dimensions, continue the sequence above...
+#endif
+
+/* array of structs so we don't have to worry about xmalloc or free */
+CInteropKind_t c_interop_kinds_table[ISOCBINDING_NUMBER];
+
+tree gfc_array_index_type;
+tree gfc_array_range_type;
+tree gfc_character1_type_node;
+tree pvoid_type_node;
+tree prvoid_type_node;
+tree ppvoid_type_node;
+tree pchar_type_node;
+tree pfunc_type_node;
+
+tree gfc_charlen_type_node;
+
+tree float128_type_node = NULL_TREE;
+tree complex_float128_type_node = NULL_TREE;
+
+bool gfc_real16_is_float128 = false;
+
+static GTY(()) tree gfc_desc_dim_type;
+static GTY(()) tree gfc_max_array_element_size;
+static GTY(()) tree gfc_array_descriptor_base[2 * GFC_MAX_DIMENSIONS];
+
+/* Arrays for all integral and real kinds.  We'll fill this in at runtime
+   after the target has a chance to process command-line options.  */
+
+#define MAX_INT_KINDS 5
+gfc_integer_info gfc_integer_kinds[MAX_INT_KINDS + 1];
+gfc_logical_info gfc_logical_kinds[MAX_INT_KINDS + 1];
+static GTY(()) tree gfc_integer_types[MAX_INT_KINDS + 1];
+static GTY(()) tree gfc_logical_types[MAX_INT_KINDS + 1];
+
+#define MAX_REAL_KINDS 5
+gfc_real_info gfc_real_kinds[MAX_REAL_KINDS + 1];
+static GTY(()) tree gfc_real_types[MAX_REAL_KINDS + 1];
+static GTY(()) tree gfc_complex_types[MAX_REAL_KINDS + 1];
+
+#define MAX_CHARACTER_KINDS 2
+gfc_character_info gfc_character_kinds[MAX_CHARACTER_KINDS + 1];
+static GTY(()) tree gfc_character_types[MAX_CHARACTER_KINDS + 1];
+static GTY(()) tree gfc_pcharacter_types[MAX_CHARACTER_KINDS + 1];
+
+static tree gfc_add_field_to_struct_1 (tree, tree, tree, tree **);
+
+/* The integer kind to use for array indices.  This will be set to the
+   proper value based on target information from the backend.  */
+
+int gfc_index_integer_kind;
+
+/* The default kinds of the various types.  */
+
+int gfc_default_integer_kind;
+int gfc_max_integer_kind;
+int gfc_default_real_kind;
+int gfc_default_double_kind;
+int gfc_default_character_kind;
+int gfc_default_logical_kind;
+int gfc_default_complex_kind;
+int gfc_c_int_kind;
+
+/* The kind size used for record offsets. If the target system supports
+   kind=8, this will be set to 8, otherwise it is set to 4.  */
+int gfc_intio_kind; 
+
+/* The integer kind used to store character lengths.  */
+int gfc_charlen_int_kind;
+
+/* The size of the numeric storage unit and character storage unit.  */
+int gfc_numeric_storage_size;
+int gfc_character_storage_size;
+
+
+gfc_try
+gfc_check_any_c_kind (gfc_typespec *ts)
+{
+  int i;
+  
+  for (i = 0; i < ISOCBINDING_NUMBER; i++)
+    {
+      /* Check for any C interoperable kind for the given type/kind in ts.
+         This can be used after verify_c_interop to make sure that the
+         Fortran kind being used exists in at least some form for C.  */
+      if (c_interop_kinds_table[i].f90_type == ts->type &&
+          c_interop_kinds_table[i].value == ts->kind)
+        return SUCCESS;
+    }
+
+  return FAILURE;
+}
+
+
+static int
+get_real_kind_from_node (tree type)
+{
+  int i;
+
+  for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+    if (gfc_real_kinds[i].mode_precision == TYPE_PRECISION (type))
+      return gfc_real_kinds[i].kind;
+
+  return -4;
+}
+
+static int
+get_int_kind_from_node (tree type)
+{
+  int i;
+
+  if (!type)
+    return -2;
+
+  for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+    if (gfc_integer_kinds[i].bit_size == TYPE_PRECISION (type))
+      return gfc_integer_kinds[i].kind;
+
+  return -1;
+}
+
+/* Return a typenode for the "standard" C type with a given name.  */
+static tree
+get_typenode_from_name (const char *name)
+{
+  if (name == NULL || *name == '\0')
+    return NULL_TREE;
+
+  if (strcmp (name, "char") == 0)
+    return char_type_node;
+  if (strcmp (name, "unsigned char") == 0)
+    return unsigned_char_type_node;
+  if (strcmp (name, "signed char") == 0)
+    return signed_char_type_node;
+
+  if (strcmp (name, "short int") == 0)
+    return short_integer_type_node;
+  if (strcmp (name, "short unsigned int") == 0)
+    return short_unsigned_type_node;
+
+  if (strcmp (name, "int") == 0)
+    return integer_type_node;
+  if (strcmp (name, "unsigned int") == 0)
+    return unsigned_type_node;
+
+  if (strcmp (name, "long int") == 0)
+    return long_integer_type_node;
+  if (strcmp (name, "long unsigned int") == 0)
+    return long_unsigned_type_node;
+
+  if (strcmp (name, "long long int") == 0)
+    return long_long_integer_type_node;
+  if (strcmp (name, "long long unsigned int") == 0)
+    return long_long_unsigned_type_node;
+
+  gcc_unreachable ();
+}
+
+static int
+get_int_kind_from_name (const char *name)
+{
+  return get_int_kind_from_node (get_typenode_from_name (name));
+}
+
+
+/* Get the kind number corresponding to an integer of given size,
+   following the required return values for ISO_FORTRAN_ENV INT* constants:
+   -2 is returned if we support a kind of larger size, -1 otherwise.  */
+int
+gfc_get_int_kind_from_width_isofortranenv (int size)
+{
+  int i;
+
+  /* Look for a kind with matching storage size.  */
+  for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+    if (gfc_integer_kinds[i].bit_size == size)
+      return gfc_integer_kinds[i].kind;
+
+  /* Look for a kind with larger storage size.  */
+  for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+    if (gfc_integer_kinds[i].bit_size > size)
+      return -2;
+
+  return -1;
+}
+
+/* Get the kind number corresponding to a real of given storage size,
+   following the required return values for ISO_FORTRAN_ENV REAL* constants:
+   -2 is returned if we support a kind of larger size, -1 otherwise.  */
+int
+gfc_get_real_kind_from_width_isofortranenv (int size)
+{
+  int i;
+
+  size /= 8;
+
+  /* Look for a kind with matching storage size.  */
+  for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+    if (int_size_in_bytes (gfc_get_real_type (gfc_real_kinds[i].kind)) == size)
+      return gfc_real_kinds[i].kind;
+
+  /* Look for a kind with larger storage size.  */
+  for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+    if (int_size_in_bytes (gfc_get_real_type (gfc_real_kinds[i].kind)) > size)
+      return -2;
+
+  return -1;
+}
+
+
+
+static int
+get_int_kind_from_width (int size)
+{
+  int i;
+
+  for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+    if (gfc_integer_kinds[i].bit_size == size)
+      return gfc_integer_kinds[i].kind;
+
+  return -2;
+}
+
+static int
+get_int_kind_from_minimal_width (int size)
+{
+  int i;
+
+  for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+    if (gfc_integer_kinds[i].bit_size >= size)
+      return gfc_integer_kinds[i].kind;
+
+  return -2;
+}
+
+
+/* Generate the CInteropKind_t objects for the C interoperable
+   kinds.  */
+
+static
+void init_c_interop_kinds (void)
+{
+  int i;
+
+  /* init all pointers in the list to NULL */
+  for (i = 0; i < ISOCBINDING_NUMBER; i++)
+    {
+      /* Initialize the name and value fields.  */
+      c_interop_kinds_table[i].name[0] = '\0';
+      c_interop_kinds_table[i].value = -100;
+      c_interop_kinds_table[i].f90_type = BT_UNKNOWN;
+    }
+
+#define NAMED_INTCST(a,b,c,d) \
+  strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+  c_interop_kinds_table[a].f90_type = BT_INTEGER; \
+  c_interop_kinds_table[a].value = c;
+#define NAMED_REALCST(a,b,c) \
+  strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+  c_interop_kinds_table[a].f90_type = BT_REAL; \
+  c_interop_kinds_table[a].value = c;
+#define NAMED_CMPXCST(a,b,c) \
+  strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+  c_interop_kinds_table[a].f90_type = BT_COMPLEX; \
+  c_interop_kinds_table[a].value = c;
+#define NAMED_LOGCST(a,b,c) \
+  strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+  c_interop_kinds_table[a].f90_type = BT_LOGICAL; \
+  c_interop_kinds_table[a].value = c;
+#define NAMED_CHARKNDCST(a,b,c) \
+  strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+  c_interop_kinds_table[a].f90_type = BT_CHARACTER; \
+  c_interop_kinds_table[a].value = c;
+#define NAMED_CHARCST(a,b,c) \
+  strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+  c_interop_kinds_table[a].f90_type = BT_CHARACTER; \
+  c_interop_kinds_table[a].value = c;
+#define DERIVED_TYPE(a,b,c) \
+  strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+  c_interop_kinds_table[a].f90_type = BT_DERIVED; \
+  c_interop_kinds_table[a].value = c;
+#define PROCEDURE(a,b) \
+  strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+  c_interop_kinds_table[a].f90_type = BT_PROCEDURE; \
+  c_interop_kinds_table[a].value = 0;
+#include "iso-c-binding.def"
+#define NAMED_FUNCTION(a,b,c,d) \
+  strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
+  c_interop_kinds_table[a].f90_type = BT_PROCEDURE; \
+  c_interop_kinds_table[a].value = c;
+#include "iso-c-binding.def"
+}
+
+
+/* Query the target to determine which machine modes are available for
+   computation.  Choose KIND numbers for them.  */
+
+void
+gfc_init_kinds (void)
+{
+  unsigned int mode;
+  int i_index, r_index, kind;
+  bool saw_i4 = false, saw_i8 = false;
+  bool saw_r4 = false, saw_r8 = false, saw_r16 = false;
+
+  for (i_index = 0, mode = MIN_MODE_INT; mode <= MAX_MODE_INT; mode++)
+    {
+      int kind, bitsize;
+
+      if (!targetm.scalar_mode_supported_p ((enum machine_mode) mode))
+	continue;
+
+      /* The middle end doesn't support constants larger than 2*HWI.
+	 Perhaps the target hook shouldn't have accepted these either,
+	 but just to be safe...  */
+      bitsize = GET_MODE_BITSIZE (mode);
+      if (bitsize > 2*HOST_BITS_PER_WIDE_INT)
+	continue;
+
+      gcc_assert (i_index != MAX_INT_KINDS);
+
+      /* Let the kind equal the bit size divided by 8.  This insulates the
+	 programmer from the underlying byte size.  */
+      kind = bitsize / 8;
+
+      if (kind == 4)
+	saw_i4 = true;
+      if (kind == 8)
+	saw_i8 = true;
+
+      gfc_integer_kinds[i_index].kind = kind;
+      gfc_integer_kinds[i_index].radix = 2;
+      gfc_integer_kinds[i_index].digits = bitsize - 1;
+      gfc_integer_kinds[i_index].bit_size = bitsize;
+
+      gfc_logical_kinds[i_index].kind = kind;
+      gfc_logical_kinds[i_index].bit_size = bitsize;
+
+      i_index += 1;
+    }
+
+  /* Set the kind used to match GFC_INT_IO in libgfortran.  This is 
+     used for large file access.  */
+
+  if (saw_i8)
+    gfc_intio_kind = 8;
+  else
+    gfc_intio_kind = 4;
+
+  /* If we do not at least have kind = 4, everything is pointless.  */  
+  gcc_assert(saw_i4);  
+
+  /* Set the maximum integer kind.  Used with at least BOZ constants.  */
+  gfc_max_integer_kind = gfc_integer_kinds[i_index - 1].kind;
+
+  for (r_index = 0, mode = MIN_MODE_FLOAT; mode <= MAX_MODE_FLOAT; mode++)
+    {
+      const struct real_format *fmt =
+	REAL_MODE_FORMAT ((enum machine_mode) mode);
+      int kind;
+
+      if (fmt == NULL)
+	continue;
+      if (!targetm.scalar_mode_supported_p ((enum machine_mode) mode))
+	continue;
+
+      /* Only let float, double, long double and __float128 go through.
+	 Runtime support for others is not provided, so they would be
+	 useless.  */
+	if (mode != TYPE_MODE (float_type_node)
+	    && (mode != TYPE_MODE (double_type_node))
+	    && (mode != TYPE_MODE (long_double_type_node))
+#if defined(LIBGCC2_HAS_TF_MODE) && defined(ENABLE_LIBQUADMATH_SUPPORT)
+	    && (mode != TFmode)
+#endif
+	   )
+	continue;
+
+      /* Let the kind equal the precision divided by 8, rounding up.  Again,
+	 this insulates the programmer from the underlying byte size.
+
+	 Also, it effectively deals with IEEE extended formats.  There, the
+	 total size of the type may equal 16, but it's got 6 bytes of padding
+	 and the increased size can get in the way of a real IEEE quad format
+	 which may also be supported by the target.
+
+	 We round up so as to handle IA-64 __floatreg (RFmode), which is an
+	 82 bit type.  Not to be confused with __float80 (XFmode), which is
+	 an 80 bit type also supported by IA-64.  So XFmode should come out
+	 to be kind=10, and RFmode should come out to be kind=11.  Egads.  */
+
+      kind = (GET_MODE_PRECISION (mode) + 7) / 8;
+
+      if (kind == 4)
+	saw_r4 = true;
+      if (kind == 8)
+	saw_r8 = true;
+      if (kind == 16)
+	saw_r16 = true;
+
+      /* Careful we don't stumble a weird internal mode.  */
+      gcc_assert (r_index <= 0 || gfc_real_kinds[r_index-1].kind != kind);
+      /* Or have too many modes for the allocated space.  */
+      gcc_assert (r_index != MAX_REAL_KINDS);
+
+      gfc_real_kinds[r_index].kind = kind;
+      gfc_real_kinds[r_index].radix = fmt->b;
+      gfc_real_kinds[r_index].digits = fmt->p;
+      gfc_real_kinds[r_index].min_exponent = fmt->emin;
+      gfc_real_kinds[r_index].max_exponent = fmt->emax;
+      if (fmt->pnan < fmt->p)
+	/* This is an IBM extended double format (or the MIPS variant)
+	   made up of two IEEE doubles.  The value of the long double is
+	   the sum of the values of the two parts.  The most significant
+	   part is required to be the value of the long double rounded
+	   to the nearest double.  If we use emax of 1024 then we can't
+	   represent huge(x) = (1 - b**(-p)) * b**(emax-1) * b, because
+	   rounding will make the most significant part overflow.  */
+	gfc_real_kinds[r_index].max_exponent = fmt->emax - 1;
+      gfc_real_kinds[r_index].mode_precision = GET_MODE_PRECISION (mode);
+      r_index += 1;
+    }
+
+  /* Choose the default integer kind.  We choose 4 unless the user
+     directs us otherwise.  */
+  if (gfc_option.flag_default_integer)
+    {
+      if (!saw_i8)
+	fatal_error ("integer kind=8 not available for -fdefault-integer-8 option");
+      gfc_default_integer_kind = 8;
+
+      /* Even if the user specified that the default integer kind be 8,
+         the numeric storage size isn't 64.  In this case, a warning will
+	 be issued when NUMERIC_STORAGE_SIZE is used.  */
+      gfc_numeric_storage_size = 4 * 8;
+    }
+  else if (saw_i4)
+    {
+      gfc_default_integer_kind = 4;
+      gfc_numeric_storage_size = 4 * 8;
+    }
+  else
+    {
+      gfc_default_integer_kind = gfc_integer_kinds[i_index - 1].kind;
+      gfc_numeric_storage_size = gfc_integer_kinds[i_index - 1].bit_size;
+    }
+
+  /* Choose the default real kind.  Again, we choose 4 when possible.  */
+  if (gfc_option.flag_default_real)
+    {
+      if (!saw_r8)
+	fatal_error ("real kind=8 not available for -fdefault-real-8 option");
+      gfc_default_real_kind = 8;
+    }
+  else if (saw_r4)
+    gfc_default_real_kind = 4;
+  else
+    gfc_default_real_kind = gfc_real_kinds[0].kind;
+
+  /* Choose the default double kind.  If -fdefault-real and -fdefault-double 
+     are specified, we use kind=8, if it's available.  If -fdefault-real is
+     specified without -fdefault-double, we use kind=16, if it's available.
+     Otherwise we do not change anything.  */
+  if (gfc_option.flag_default_double && !gfc_option.flag_default_real)
+    fatal_error ("Use of -fdefault-double-8 requires -fdefault-real-8");
+
+  if (gfc_option.flag_default_real && gfc_option.flag_default_double && saw_r8)
+    gfc_default_double_kind = 8;
+  else if (gfc_option.flag_default_real && saw_r16)
+    gfc_default_double_kind = 16;
+  else if (saw_r4 && saw_r8)
+    gfc_default_double_kind = 8;
+  else
+    {
+      /* F95 14.6.3.1: A nonpointer scalar object of type double precision
+	 real ... occupies two contiguous numeric storage units.
+
+	 Therefore we must be supplied a kind twice as large as we chose
+	 for single precision.  There are loopholes, in that double
+	 precision must *occupy* two storage units, though it doesn't have
+	 to *use* two storage units.  Which means that you can make this
+	 kind artificially wide by padding it.  But at present there are
+	 no GCC targets for which a two-word type does not exist, so we
+	 just let gfc_validate_kind abort and tell us if something breaks.  */
+
+      gfc_default_double_kind
+	= gfc_validate_kind (BT_REAL, gfc_default_real_kind * 2, false);
+    }
+
+  /* The default logical kind is constrained to be the same as the
+     default integer kind.  Similarly with complex and real.  */
+  gfc_default_logical_kind = gfc_default_integer_kind;
+  gfc_default_complex_kind = gfc_default_real_kind;
+
+  /* We only have two character kinds: ASCII and UCS-4.
+     ASCII corresponds to a 8-bit integer type, if one is available.
+     UCS-4 corresponds to a 32-bit integer type, if one is available. */
+  i_index = 0;
+  if ((kind = get_int_kind_from_width (8)) > 0)
+    {
+      gfc_character_kinds[i_index].kind = kind;
+      gfc_character_kinds[i_index].bit_size = 8;
+      gfc_character_kinds[i_index].name = "ascii";
+      i_index++;
+    }
+  if ((kind = get_int_kind_from_width (32)) > 0)
+    {
+      gfc_character_kinds[i_index].kind = kind;
+      gfc_character_kinds[i_index].bit_size = 32;
+      gfc_character_kinds[i_index].name = "iso_10646";
+      i_index++;
+    }
+
+  /* Choose the smallest integer kind for our default character.  */
+  gfc_default_character_kind = gfc_character_kinds[0].kind;
+  gfc_character_storage_size = gfc_default_character_kind * 8;
+
+  /* Choose the integer kind the same size as "void*" for our index kind.  */
+  gfc_index_integer_kind = POINTER_SIZE / 8;
+  /* Pick a kind the same size as the C "int" type.  */
+  gfc_c_int_kind = INT_TYPE_SIZE / 8;
+
+  /* initialize the C interoperable kinds  */
+  init_c_interop_kinds();
+}
+
+/* Make sure that a valid kind is present.  Returns an index into the
+   associated kinds array, -1 if the kind is not present.  */
+
+static int
+validate_integer (int kind)
+{
+  int i;
+
+  for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+    if (gfc_integer_kinds[i].kind == kind)
+      return i;
+
+  return -1;
+}
+
+static int
+validate_real (int kind)
+{
+  int i;
+
+  for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+    if (gfc_real_kinds[i].kind == kind)
+      return i;
+
+  return -1;
+}
+
+static int
+validate_logical (int kind)
+{
+  int i;
+
+  for (i = 0; gfc_logical_kinds[i].kind; i++)
+    if (gfc_logical_kinds[i].kind == kind)
+      return i;
+
+  return -1;
+}
+
+static int
+validate_character (int kind)
+{
+  int i;
+
+  for (i = 0; gfc_character_kinds[i].kind; i++)
+    if (gfc_character_kinds[i].kind == kind)
+      return i;
+
+  return -1;
+}
+
+/* Validate a kind given a basic type.  The return value is the same
+   for the child functions, with -1 indicating nonexistence of the
+   type.  If MAY_FAIL is false, then -1 is never returned, and we ICE.  */
+
+int
+gfc_validate_kind (bt type, int kind, bool may_fail)
+{
+  int rc;
+
+  switch (type)
+    {
+    case BT_REAL:		/* Fall through */
+    case BT_COMPLEX:
+      rc = validate_real (kind);
+      break;
+    case BT_INTEGER:
+      rc = validate_integer (kind);
+      break;
+    case BT_LOGICAL:
+      rc = validate_logical (kind);
+      break;
+    case BT_CHARACTER:
+      rc = validate_character (kind);
+      break;
+
+    default:
+      gfc_internal_error ("gfc_validate_kind(): Got bad type");
+    }
+
+  if (rc < 0 && !may_fail)
+    gfc_internal_error ("gfc_validate_kind(): Got bad kind");
+
+  return rc;
+}
+
+
+/* Four subroutines of gfc_init_types.  Create type nodes for the given kind.
+   Reuse common type nodes where possible.  Recognize if the kind matches up
+   with a C type.  This will be used later in determining which routines may
+   be scarfed from libm.  */
+
+static tree
+gfc_build_int_type (gfc_integer_info *info)
+{
+  int mode_precision = info->bit_size;
+
+  if (mode_precision == CHAR_TYPE_SIZE)
+    info->c_char = 1;
+  if (mode_precision == SHORT_TYPE_SIZE)
+    info->c_short = 1;
+  if (mode_precision == INT_TYPE_SIZE)
+    info->c_int = 1;
+  if (mode_precision == LONG_TYPE_SIZE)
+    info->c_long = 1;
+  if (mode_precision == LONG_LONG_TYPE_SIZE)
+    info->c_long_long = 1;
+
+  if (TYPE_PRECISION (intQI_type_node) == mode_precision)
+    return intQI_type_node;
+  if (TYPE_PRECISION (intHI_type_node) == mode_precision)
+    return intHI_type_node;
+  if (TYPE_PRECISION (intSI_type_node) == mode_precision)
+    return intSI_type_node;
+  if (TYPE_PRECISION (intDI_type_node) == mode_precision)
+    return intDI_type_node;
+  if (TYPE_PRECISION (intTI_type_node) == mode_precision)
+    return intTI_type_node;
+
+  return make_signed_type (mode_precision);
+}
+
+tree
+gfc_build_uint_type (int size)
+{
+  if (size == CHAR_TYPE_SIZE)
+    return unsigned_char_type_node;
+  if (size == SHORT_TYPE_SIZE)
+    return short_unsigned_type_node;
+  if (size == INT_TYPE_SIZE)
+    return unsigned_type_node;
+  if (size == LONG_TYPE_SIZE)
+    return long_unsigned_type_node;
+  if (size == LONG_LONG_TYPE_SIZE)
+    return long_long_unsigned_type_node;
+
+  return make_unsigned_type (size);
+}
+
+
+static tree
+gfc_build_real_type (gfc_real_info *info)
+{
+  int mode_precision = info->mode_precision;
+  tree new_type;
+
+  if (mode_precision == FLOAT_TYPE_SIZE)
+    info->c_float = 1;
+  if (mode_precision == DOUBLE_TYPE_SIZE)
+    info->c_double = 1;
+  if (mode_precision == LONG_DOUBLE_TYPE_SIZE)
+    info->c_long_double = 1;
+  if (mode_precision != LONG_DOUBLE_TYPE_SIZE && mode_precision == 128)
+    {
+      info->c_float128 = 1;
+      gfc_real16_is_float128 = true;
+    }
+
+  if (TYPE_PRECISION (float_type_node) == mode_precision)
+    return float_type_node;
+  if (TYPE_PRECISION (double_type_node) == mode_precision)
+    return double_type_node;
+  if (TYPE_PRECISION (long_double_type_node) == mode_precision)
+    return long_double_type_node;
+
+  new_type = make_node (REAL_TYPE);
+  TYPE_PRECISION (new_type) = mode_precision;
+  layout_type (new_type);
+  return new_type;
+}
+
+static tree
+gfc_build_complex_type (tree scalar_type)
+{
+  tree new_type;
+
+  if (scalar_type == NULL)
+    return NULL;
+  if (scalar_type == float_type_node)
+    return complex_float_type_node;
+  if (scalar_type == double_type_node)
+    return complex_double_type_node;
+  if (scalar_type == long_double_type_node)
+    return complex_long_double_type_node;
+
+  new_type = make_node (COMPLEX_TYPE);
+  TREE_TYPE (new_type) = scalar_type;
+  layout_type (new_type);
+  return new_type;
+}
+
+static tree
+gfc_build_logical_type (gfc_logical_info *info)
+{
+  int bit_size = info->bit_size;
+  tree new_type;
+
+  if (bit_size == BOOL_TYPE_SIZE)
+    {
+      info->c_bool = 1;
+      return boolean_type_node;
+    }
+
+  new_type = make_unsigned_type (bit_size);
+  TREE_SET_CODE (new_type, BOOLEAN_TYPE);
+  TYPE_MAX_VALUE (new_type) = build_int_cst (new_type, 1);
+  TYPE_PRECISION (new_type) = 1;
+
+  return new_type;
+}
+
+
+#if 0
+/* Return the bit size of the C "size_t".  */
+
+static unsigned int
+c_size_t_size (void)
+{
+#ifdef SIZE_TYPE  
+  if (strcmp (SIZE_TYPE, "unsigned int") == 0)
+    return INT_TYPE_SIZE;
+  if (strcmp (SIZE_TYPE, "long unsigned int") == 0)
+    return LONG_TYPE_SIZE;
+  if (strcmp (SIZE_TYPE, "short unsigned int") == 0)
+    return SHORT_TYPE_SIZE;
+  gcc_unreachable ();
+#else
+  return LONG_TYPE_SIZE;
+#endif
+}
+#endif
+
+/* Create the backend type nodes. We map them to their
+   equivalent C type, at least for now.  We also give
+   names to the types here, and we push them in the
+   global binding level context.*/
+
+void
+gfc_init_types (void)
+{
+  char name_buf[18];
+  int index;
+  tree type;
+  unsigned n;
+  unsigned HOST_WIDE_INT hi;
+  unsigned HOST_WIDE_INT lo;
+
+  /* Create and name the types.  */
+#define PUSH_TYPE(name, node) \
+  pushdecl (build_decl (input_location, \
+			TYPE_DECL, get_identifier (name), node))
+
+  for (index = 0; gfc_integer_kinds[index].kind != 0; ++index)
+    {
+      type = gfc_build_int_type (&gfc_integer_kinds[index]);
+      /* Ensure integer(kind=1) doesn't have TYPE_STRING_FLAG set.  */
+      if (TYPE_STRING_FLAG (type))
+	type = make_signed_type (gfc_integer_kinds[index].bit_size);
+      gfc_integer_types[index] = type;
+      snprintf (name_buf, sizeof(name_buf), "integer(kind=%d)",
+		gfc_integer_kinds[index].kind);
+      PUSH_TYPE (name_buf, type);
+    }
+
+  for (index = 0; gfc_logical_kinds[index].kind != 0; ++index)
+    {
+      type = gfc_build_logical_type (&gfc_logical_kinds[index]);
+      gfc_logical_types[index] = type;
+      snprintf (name_buf, sizeof(name_buf), "logical(kind=%d)",
+		gfc_logical_kinds[index].kind);
+      PUSH_TYPE (name_buf, type);
+    }
+
+  for (index = 0; gfc_real_kinds[index].kind != 0; index++)
+    {
+      type = gfc_build_real_type (&gfc_real_kinds[index]);
+      gfc_real_types[index] = type;
+      snprintf (name_buf, sizeof(name_buf), "real(kind=%d)",
+		gfc_real_kinds[index].kind);
+      PUSH_TYPE (name_buf, type);
+
+      if (gfc_real_kinds[index].c_float128)
+	float128_type_node = type;
+
+      type = gfc_build_complex_type (type);
+      gfc_complex_types[index] = type;
+      snprintf (name_buf, sizeof(name_buf), "complex(kind=%d)",
+		gfc_real_kinds[index].kind);
+      PUSH_TYPE (name_buf, type);
+
+      if (gfc_real_kinds[index].c_float128)
+	complex_float128_type_node = type;
+    }
+
+  for (index = 0; gfc_character_kinds[index].kind != 0; ++index)
+    {
+      type = gfc_build_uint_type (gfc_character_kinds[index].bit_size);
+      type = build_qualified_type (type, TYPE_UNQUALIFIED);
+      snprintf (name_buf, sizeof(name_buf), "character(kind=%d)",
+		gfc_character_kinds[index].kind);
+      PUSH_TYPE (name_buf, type);
+      gfc_character_types[index] = type;
+      gfc_pcharacter_types[index] = build_pointer_type (type);
+    }
+  gfc_character1_type_node = gfc_character_types[0];
+
+  PUSH_TYPE ("byte", unsigned_char_type_node);
+  PUSH_TYPE ("void", void_type_node);
+
+  /* DBX debugging output gets upset if these aren't set.  */
+  if (!TYPE_NAME (integer_type_node))
+    PUSH_TYPE ("c_integer", integer_type_node);
+  if (!TYPE_NAME (char_type_node))
+    PUSH_TYPE ("c_char", char_type_node);
+
+#undef PUSH_TYPE
+
+  pvoid_type_node = build_pointer_type (void_type_node);
+  prvoid_type_node = build_qualified_type (pvoid_type_node, TYPE_QUAL_RESTRICT);
+  ppvoid_type_node = build_pointer_type (pvoid_type_node);
+  pchar_type_node = build_pointer_type (gfc_character1_type_node);
+  pfunc_type_node
+    = build_pointer_type (build_function_type_list (void_type_node, NULL_TREE));
+
+  gfc_array_index_type = gfc_get_int_type (gfc_index_integer_kind);
+  /* We cannot use gfc_index_zero_node in definition of gfc_array_range_type,
+     since this function is called before gfc_init_constants.  */
+  gfc_array_range_type
+	  = build_range_type (gfc_array_index_type,
+			      build_int_cst (gfc_array_index_type, 0),
+			      NULL_TREE);
+
+  /* The maximum array element size that can be handled is determined
+     by the number of bits available to store this field in the array
+     descriptor.  */
+
+  n = TYPE_PRECISION (gfc_array_index_type) - GFC_DTYPE_SIZE_SHIFT;
+  lo = ~ (unsigned HOST_WIDE_INT) 0;
+  if (n > HOST_BITS_PER_WIDE_INT)
+    hi = lo >> (2*HOST_BITS_PER_WIDE_INT - n);
+  else
+    hi = 0, lo >>= HOST_BITS_PER_WIDE_INT - n;
+  gfc_max_array_element_size
+    = build_int_cst_wide (long_unsigned_type_node, lo, hi);
+
+  boolean_type_node = gfc_get_logical_type (gfc_default_logical_kind);
+  boolean_true_node = build_int_cst (boolean_type_node, 1);
+  boolean_false_node = build_int_cst (boolean_type_node, 0);
+
+  /* ??? Shouldn't this be based on gfc_index_integer_kind or so?  */
+  gfc_charlen_int_kind = 4;
+  gfc_charlen_type_node = gfc_get_int_type (gfc_charlen_int_kind);
+}
+
+/* Get the type node for the given type and kind.  */
+
+tree
+gfc_get_int_type (int kind)
+{
+  int index = gfc_validate_kind (BT_INTEGER, kind, true);
+  return index < 0 ? 0 : gfc_integer_types[index];
+}
+
+tree
+gfc_get_real_type (int kind)
+{
+  int index = gfc_validate_kind (BT_REAL, kind, true);
+  return index < 0 ? 0 : gfc_real_types[index];
+}
+
+tree
+gfc_get_complex_type (int kind)
+{
+  int index = gfc_validate_kind (BT_COMPLEX, kind, true);
+  return index < 0 ? 0 : gfc_complex_types[index];
+}
+
+tree
+gfc_get_logical_type (int kind)
+{
+  int index = gfc_validate_kind (BT_LOGICAL, kind, true);
+  return index < 0 ? 0 : gfc_logical_types[index];
+}
+
+tree
+gfc_get_char_type (int kind)
+{
+  int index = gfc_validate_kind (BT_CHARACTER, kind, true);
+  return index < 0 ? 0 : gfc_character_types[index];
+}
+
+tree
+gfc_get_pchar_type (int kind)
+{
+  int index = gfc_validate_kind (BT_CHARACTER, kind, true);
+  return index < 0 ? 0 : gfc_pcharacter_types[index];
+}
+
+
+/* Create a character type with the given kind and length.  */
+
+tree
+gfc_get_character_type_len_for_eltype (tree eltype, tree len)
+{
+  tree bounds, type;
+
+  bounds = build_range_type (gfc_charlen_type_node, gfc_index_one_node, len);
+  type = build_array_type (eltype, bounds);
+  TYPE_STRING_FLAG (type) = 1;
+
+  return type;
+}
+
+tree
+gfc_get_character_type_len (int kind, tree len)
+{
+  gfc_validate_kind (BT_CHARACTER, kind, false);
+  return gfc_get_character_type_len_for_eltype (gfc_get_char_type (kind), len);
+}
+
+
+/* Get a type node for a character kind.  */
+
+tree
+gfc_get_character_type (int kind, gfc_charlen * cl)
+{
+  tree len;
+
+  len = (cl == NULL) ? NULL_TREE : cl->backend_decl;
+
+  return gfc_get_character_type_len (kind, len);
+}
+
+/* Covert a basic type.  This will be an array for character types.  */
+
+tree
+gfc_typenode_for_spec (gfc_typespec * spec)
+{
+  tree basetype;
+
+  switch (spec->type)
+    {
+    case BT_UNKNOWN:
+      gcc_unreachable ();
+
+    case BT_INTEGER:
+      /* We use INTEGER(c_intptr_t) for C_PTR and C_FUNPTR once the symbol
+         has been resolved.  This is done so we can convert C_PTR and
+         C_FUNPTR to simple variables that get translated to (void *).  */
+      if (spec->f90_type == BT_VOID)
+	{
+	  if (spec->u.derived
+	      && spec->u.derived->intmod_sym_id == ISOCBINDING_PTR)
+	    basetype = ptr_type_node;
+	  else
+	    basetype = pfunc_type_node;
+	}
+      else
+        basetype = gfc_get_int_type (spec->kind);
+      break;
+
+    case BT_REAL:
+      basetype = gfc_get_real_type (spec->kind);
+      break;
+
+    case BT_COMPLEX:
+      basetype = gfc_get_complex_type (spec->kind);
+      break;
+
+    case BT_LOGICAL:
+      basetype = gfc_get_logical_type (spec->kind);
+      break;
+
+    case BT_CHARACTER:
+#if 0
+      if (spec->deferred)
+	basetype = gfc_get_character_type (spec->kind, NULL);
+      else
+#endif
+	basetype = gfc_get_character_type (spec->kind, spec->u.cl);
+      break;
+
+    case BT_DERIVED:
+    case BT_CLASS:
+      basetype = gfc_get_derived_type (spec->u.derived);
+
+      /* If we're dealing with either C_PTR or C_FUNPTR, we modified the
+         type and kind to fit a (void *) and the basetype returned was a
+         ptr_type_node.  We need to pass up this new information to the
+         symbol that was declared of type C_PTR or C_FUNPTR.  */
+      if (spec->u.derived->attr.is_iso_c)
+        {
+          spec->type = spec->u.derived->ts.type;
+          spec->kind = spec->u.derived->ts.kind;
+          spec->f90_type = spec->u.derived->ts.f90_type;
+        }
+      break;
+    case BT_VOID:
+      /* This is for the second arg to c_f_pointer and c_f_procpointer
+         of the iso_c_binding module, to accept any ptr type.  */
+      basetype = ptr_type_node;
+      if (spec->f90_type == BT_VOID)
+	{
+	  if (spec->u.derived
+	      && spec->u.derived->intmod_sym_id == ISOCBINDING_PTR)
+	    basetype = ptr_type_node;
+	  else
+	    basetype = pfunc_type_node;
+	}
+       break;
+    default:
+      gcc_unreachable ();
+    }
+  return basetype;
+}
+
+/* Build an INT_CST for constant expressions, otherwise return NULL_TREE.  */
+
+static tree
+gfc_conv_array_bound (gfc_expr * expr)
+{
+  /* If expr is an integer constant, return that.  */
+  if (expr != NULL && expr->expr_type == EXPR_CONSTANT)
+    return gfc_conv_mpz_to_tree (expr->value.integer, gfc_index_integer_kind);
+
+  /* Otherwise return NULL.  */
+  return NULL_TREE;
+}
+
+tree
+gfc_get_element_type (tree type)
+{
+  tree element;
+
+  if (GFC_ARRAY_TYPE_P (type))
+    {
+      if (TREE_CODE (type) == POINTER_TYPE)
+        type = TREE_TYPE (type);
+      gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
+      element = TREE_TYPE (type);
+    }
+  else
+    {
+      gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+      element = GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
+
+      gcc_assert (TREE_CODE (element) == POINTER_TYPE);
+      element = TREE_TYPE (element);
+
+      gcc_assert (TREE_CODE (element) == ARRAY_TYPE);
+      element = TREE_TYPE (element);
+    }
+
+  return element;
+}
+
+/* Build an array.  This function is called from gfc_sym_type().
+   Actually returns array descriptor type.
+
+   Format of array descriptors is as follows:
+
+    struct gfc_array_descriptor
+    {
+      array *data
+      index offset;
+      index dtype;
+      struct descriptor_dimension dimension[N_DIM];
+    }
+
+    struct descriptor_dimension
+    {
+      index stride;
+      index lbound;
+      index ubound;
+    }
+
+   Translation code should use gfc_conv_descriptor_* rather than
+   accessing the descriptor directly.  Any changes to the array
+   descriptor type will require changes in gfc_conv_descriptor_* and
+   gfc_build_array_initializer.
+
+   This is represented internally as a RECORD_TYPE. The index nodes
+   are gfc_array_index_type and the data node is a pointer to the
+   data.  See below for the handling of character types.
+
+   The dtype member is formatted as follows:
+    rank = dtype & GFC_DTYPE_RANK_MASK // 3 bits
+    type = (dtype & GFC_DTYPE_TYPE_MASK) >> GFC_DTYPE_TYPE_SHIFT // 3 bits
+    size = dtype >> GFC_DTYPE_SIZE_SHIFT
+
+   I originally used nested ARRAY_TYPE nodes to represent arrays, but
+   this generated poor code for assumed/deferred size arrays.  These
+   require use of PLACEHOLDER_EXPR/WITH_RECORD_EXPR, which isn't part
+   of the GENERIC grammar.  Also, there is no way to explicitly set
+   the array stride, so all data must be packed(1).  I've tried to
+   mark all the functions which would require modification with a GCC
+   ARRAYS comment.
+
+   The data component points to the first element in the array.  The
+   offset field is the position of the origin of the array (i.e. element
+   (0, 0 ...)).  This may be outside the bounds of the array.
+
+   An element is accessed by
+    data[offset + index0*stride0 + index1*stride1 + index2*stride2]
+   This gives good performance as the computation does not involve the
+   bounds of the array.  For packed arrays, this is optimized further
+   by substituting the known strides.
+
+   This system has one problem: all array bounds must be within 2^31
+   elements of the origin (2^63 on 64-bit machines).  For example
+    integer, dimension (80000:90000, 80000:90000, 2) :: array
+   may not work properly on 32-bit machines because 80000*80000 >
+   2^31, so the calculation for stride2 would overflow.  This may
+   still work, but I haven't checked, and it relies on the overflow
+   doing the right thing.
+
+   The way to fix this problem is to access elements as follows:
+    data[(index0-lbound0)*stride0 + (index1-lbound1)*stride1]
+   Obviously this is much slower.  I will make this a compile time
+   option, something like -fsmall-array-offsets.  Mixing code compiled
+   with and without this switch will work.
+
+   (1) This can be worked around by modifying the upper bound of the
+   previous dimension.  This requires extra fields in the descriptor
+   (both real_ubound and fake_ubound).  */
+
+
+/* Returns true if the array sym does not require a descriptor.  */
+
+int
+gfc_is_nodesc_array (gfc_symbol * sym)
+{
+  gcc_assert (sym->attr.dimension);
+
+  /* We only want local arrays.  */
+  if (sym->attr.pointer || sym->attr.allocatable)
+    return 0;
+
+  /* We want a descriptor for associate-name arrays that do not have an
+     explicitely known shape already.  */
+  if (sym->assoc && sym->as->type != AS_EXPLICIT)
+    return 0;
+
+  if (sym->attr.dummy)
+    return sym->as->type != AS_ASSUMED_SHAPE;
+
+  if (sym->attr.result || sym->attr.function)
+    return 0;
+
+  gcc_assert (sym->as->type == AS_EXPLICIT || sym->as->cp_was_assumed);
+
+  return 1;
+}
+
+
+/* Create an array descriptor type.  */
+
+static tree
+gfc_build_array_type (tree type, gfc_array_spec * as,
+		      enum gfc_array_kind akind, bool restricted,
+		      bool contiguous)
+{
+  tree lbound[GFC_MAX_DIMENSIONS];
+  tree ubound[GFC_MAX_DIMENSIONS];
+  int n;
+
+  for (n = 0; n < as->rank; n++)
+    {
+      /* Create expressions for the known bounds of the array.  */
+      if (as->type == AS_ASSUMED_SHAPE && as->lower[n] == NULL)
+        lbound[n] = gfc_index_one_node;
+      else
+        lbound[n] = gfc_conv_array_bound (as->lower[n]);
+      ubound[n] = gfc_conv_array_bound (as->upper[n]);
+    }
+
+  if (as->type == AS_ASSUMED_SHAPE)
+    akind = contiguous ? GFC_ARRAY_ASSUMED_SHAPE_CONT
+		       : GFC_ARRAY_ASSUMED_SHAPE;
+  return gfc_get_array_type_bounds (type, as->rank, as->corank, lbound,
+				    ubound, 0, akind, restricted);
+}
+
+/* Returns the struct descriptor_dimension type.  */
+
+static tree
+gfc_get_desc_dim_type (void)
+{
+  tree type;
+  tree decl, *chain = NULL;
+
+  if (gfc_desc_dim_type)
+    return gfc_desc_dim_type;
+
+  /* Build the type node.  */
+  type = make_node (RECORD_TYPE);
+
+  TYPE_NAME (type) = get_identifier ("descriptor_dimension");
+  TYPE_PACKED (type) = 1;
+
+  /* Consists of the stride, lbound and ubound members.  */
+  decl = gfc_add_field_to_struct_1 (type,
+				    get_identifier ("stride"),
+				    gfc_array_index_type, &chain);
+  TREE_NO_WARNING (decl) = 1;
+
+  decl = gfc_add_field_to_struct_1 (type,
+				    get_identifier ("lbound"),
+				    gfc_array_index_type, &chain);
+  TREE_NO_WARNING (decl) = 1;
+
+  decl = gfc_add_field_to_struct_1 (type,
+				    get_identifier ("ubound"),
+				    gfc_array_index_type, &chain);
+  TREE_NO_WARNING (decl) = 1;
+
+  /* Finish off the type.  */
+  gfc_finish_type (type);
+  TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (type)) = 1;
+
+  gfc_desc_dim_type = type;
+  return type;
+}
+
+
+/* Return the DTYPE for an array.  This describes the type and type parameters
+   of the array.  */
+/* TODO: Only call this when the value is actually used, and make all the
+   unknown cases abort.  */
+
+tree
+gfc_get_dtype (tree type)
+{
+  tree size;
+  int n;
+  HOST_WIDE_INT i;
+  tree tmp;
+  tree dtype;
+  tree etype;
+  int rank;
+
+  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type));
+
+  if (GFC_TYPE_ARRAY_DTYPE (type))
+    return GFC_TYPE_ARRAY_DTYPE (type);
+
+  rank = GFC_TYPE_ARRAY_RANK (type);
+  etype = gfc_get_element_type (type);
+
+  switch (TREE_CODE (etype))
+    {
+    case INTEGER_TYPE:
+      n = BT_INTEGER;
+      break;
+
+    case BOOLEAN_TYPE:
+      n = BT_LOGICAL;
+      break;
+
+    case REAL_TYPE:
+      n = BT_REAL;
+      break;
+
+    case COMPLEX_TYPE:
+      n = BT_COMPLEX;
+      break;
+
+    /* We will never have arrays of arrays.  */
+    case RECORD_TYPE:
+      n = BT_DERIVED;
+      break;
+
+    case ARRAY_TYPE:
+      n = BT_CHARACTER;
+      break;
+
+    default:
+      /* TODO: Don't do dtype for temporary descriptorless arrays.  */
+      /* We can strange array types for temporary arrays.  */
+      return gfc_index_zero_node;
+    }
+
+  gcc_assert (rank <= GFC_DTYPE_RANK_MASK);
+  size = TYPE_SIZE_UNIT (etype);
+
+  i = rank | (n << GFC_DTYPE_TYPE_SHIFT);
+  if (size && INTEGER_CST_P (size))
+    {
+      if (tree_int_cst_lt (gfc_max_array_element_size, size))
+	internal_error ("Array element size too big");
+
+      i += TREE_INT_CST_LOW (size) << GFC_DTYPE_SIZE_SHIFT;
+    }
+  dtype = build_int_cst (gfc_array_index_type, i);
+
+  if (size && !INTEGER_CST_P (size))
+    {
+      tmp = build_int_cst (gfc_array_index_type, GFC_DTYPE_SIZE_SHIFT);
+      tmp  = fold_build2_loc (input_location, LSHIFT_EXPR,
+			      gfc_array_index_type,
+			      fold_convert (gfc_array_index_type, size), tmp);
+      dtype = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			       tmp, dtype);
+    }
+  /* If we don't know the size we leave it as zero.  This should never happen
+     for anything that is actually used.  */
+  /* TODO: Check this is actually true, particularly when repacking
+     assumed size parameters.  */
+
+  GFC_TYPE_ARRAY_DTYPE (type) = dtype;
+  return dtype;
+}
+
+
+/* Build an array type for use without a descriptor, packed according
+   to the value of PACKED.  */
+
+tree
+gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
+			   bool restricted)
+{
+  tree range;
+  tree type;
+  tree tmp;
+  int n;
+  int known_stride;
+  int known_offset;
+  mpz_t offset;
+  mpz_t stride;
+  mpz_t delta;
+  gfc_expr *expr;
+
+  mpz_init_set_ui (offset, 0);
+  mpz_init_set_ui (stride, 1);
+  mpz_init (delta);
+
+  /* We don't use build_array_type because this does not include include
+     lang-specific information (i.e. the bounds of the array) when checking
+     for duplicates.  */
+  type = make_node (ARRAY_TYPE);
+
+  GFC_ARRAY_TYPE_P (type) = 1;
+  TYPE_LANG_SPECIFIC (type)
+      = ggc_alloc_cleared_lang_type (sizeof (struct lang_type));
+
+  known_stride = (packed != PACKED_NO);
+  known_offset = 1;
+  for (n = 0; n < as->rank; n++)
+    {
+      /* Fill in the stride and bound components of the type.  */
+      if (known_stride)
+	tmp = gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
+      else
+        tmp = NULL_TREE;
+      GFC_TYPE_ARRAY_STRIDE (type, n) = tmp;
+
+      expr = as->lower[n];
+      if (expr->expr_type == EXPR_CONSTANT)
+        {
+          tmp = gfc_conv_mpz_to_tree (expr->value.integer,
+				      gfc_index_integer_kind);
+        }
+      else
+        {
+          known_stride = 0;
+          tmp = NULL_TREE;
+        }
+      GFC_TYPE_ARRAY_LBOUND (type, n) = tmp;
+
+      if (known_stride)
+	{
+          /* Calculate the offset.  */
+          mpz_mul (delta, stride, as->lower[n]->value.integer);
+          mpz_sub (offset, offset, delta);
+	}
+      else
+	known_offset = 0;
+
+      expr = as->upper[n];
+      if (expr && expr->expr_type == EXPR_CONSTANT)
+        {
+	  tmp = gfc_conv_mpz_to_tree (expr->value.integer,
+			          gfc_index_integer_kind);
+        }
+      else
+        {
+          tmp = NULL_TREE;
+          known_stride = 0;
+        }
+      GFC_TYPE_ARRAY_UBOUND (type, n) = tmp;
+
+      if (known_stride)
+        {
+          /* Calculate the stride.  */
+          mpz_sub (delta, as->upper[n]->value.integer,
+	           as->lower[n]->value.integer);
+          mpz_add_ui (delta, delta, 1);
+          mpz_mul (stride, stride, delta);
+        }
+
+      /* Only the first stride is known for partial packed arrays.  */
+      if (packed == PACKED_NO || packed == PACKED_PARTIAL)
+        known_stride = 0;
+    }
+
+  if (known_offset)
+    {
+      GFC_TYPE_ARRAY_OFFSET (type) =
+        gfc_conv_mpz_to_tree (offset, gfc_index_integer_kind);
+    }
+  else
+    GFC_TYPE_ARRAY_OFFSET (type) = NULL_TREE;
+
+  if (known_stride)
+    {
+      GFC_TYPE_ARRAY_SIZE (type) =
+        gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
+    }
+  else
+    GFC_TYPE_ARRAY_SIZE (type) = NULL_TREE;
+
+  GFC_TYPE_ARRAY_RANK (type) = as->rank;
+  GFC_TYPE_ARRAY_DTYPE (type) = NULL_TREE;
+  range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
+			    NULL_TREE);
+  /* TODO: use main type if it is unbounded.  */
+  GFC_TYPE_ARRAY_DATAPTR_TYPE (type) =
+    build_pointer_type (build_array_type (etype, range));
+  if (restricted)
+    GFC_TYPE_ARRAY_DATAPTR_TYPE (type) =
+      build_qualified_type (GFC_TYPE_ARRAY_DATAPTR_TYPE (type),
+			    TYPE_QUAL_RESTRICT);
+
+  if (known_stride)
+    {
+      mpz_sub_ui (stride, stride, 1);
+      range = gfc_conv_mpz_to_tree (stride, gfc_index_integer_kind);
+    }
+  else
+    range = NULL_TREE;
+
+  range = build_range_type (gfc_array_index_type, gfc_index_zero_node, range);
+  TYPE_DOMAIN (type) = range;
+
+  build_pointer_type (etype);
+  TREE_TYPE (type) = etype;
+
+  layout_type (type);
+
+  mpz_clear (offset);
+  mpz_clear (stride);
+  mpz_clear (delta);
+
+  /* Represent packed arrays as multi-dimensional if they have rank >
+     1 and with proper bounds, instead of flat arrays.  This makes for
+     better debug info.  */
+  if (known_offset)
+    {
+      tree gtype = etype, rtype, type_decl;
+
+      for (n = as->rank - 1; n >= 0; n--)
+	{
+	  rtype = build_range_type (gfc_array_index_type,
+				    GFC_TYPE_ARRAY_LBOUND (type, n),
+				    GFC_TYPE_ARRAY_UBOUND (type, n));
+	  gtype = build_array_type (gtype, rtype);
+	}
+      TYPE_NAME (type) = type_decl = build_decl (input_location,
+						 TYPE_DECL, NULL, gtype);
+      DECL_ORIGINAL_TYPE (type_decl) = gtype;
+    }
+
+  if (packed != PACKED_STATIC || !known_stride)
+    {
+      /* For dummy arrays and automatic (heap allocated) arrays we
+	 want a pointer to the array.  */
+      type = build_pointer_type (type);
+      if (restricted)
+	type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
+      GFC_ARRAY_TYPE_P (type) = 1;
+      TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type));
+    }
+  return type;
+}
+
+/* Return or create the base type for an array descriptor.  */
+
+static tree
+gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
+{
+  tree fat_type, decl, arraytype, *chain = NULL;
+  char name[16 + 2*GFC_RANK_DIGITS + 1 + 1];
+  int idx = 2 * (codimen + dimen - 1) + restricted;
+
+  gcc_assert (dimen >= 1 && codimen + dimen <= GFC_MAX_DIMENSIONS);
+  if (gfc_array_descriptor_base[idx])
+    return gfc_array_descriptor_base[idx];
+
+  /* Build the type node.  */
+  fat_type = make_node (RECORD_TYPE);
+
+  sprintf (name, "array_descriptor" GFC_RANK_PRINTF_FORMAT, dimen + codimen);
+  TYPE_NAME (fat_type) = get_identifier (name);
+  TYPE_NAMELESS (fat_type) = 1;
+
+  /* Add the data member as the first element of the descriptor.  */
+  decl = gfc_add_field_to_struct_1 (fat_type,
+				    get_identifier ("data"),
+				    (restricted
+				     ? prvoid_type_node
+				     : ptr_type_node), &chain);
+
+  /* Add the base component.  */
+  decl = gfc_add_field_to_struct_1 (fat_type,
+				    get_identifier ("offset"),
+				    gfc_array_index_type, &chain);
+  TREE_NO_WARNING (decl) = 1;
+
+  /* Add the dtype component.  */
+  decl = gfc_add_field_to_struct_1 (fat_type,
+				    get_identifier ("dtype"),
+				    gfc_array_index_type, &chain);
+  TREE_NO_WARNING (decl) = 1;
+
+  /* Build the array type for the stride and bound components.  */
+  arraytype =
+    build_array_type (gfc_get_desc_dim_type (),
+		      build_range_type (gfc_array_index_type,
+					gfc_index_zero_node,
+					gfc_rank_cst[codimen + dimen - 1]));
+
+  decl = gfc_add_field_to_struct_1 (fat_type,
+				    get_identifier ("dim"),
+				    arraytype, &chain);
+  TREE_NO_WARNING (decl) = 1;
+
+  /* Finish off the type.  */
+  gfc_finish_type (fat_type);
+  TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (fat_type)) = 1;
+
+  gfc_array_descriptor_base[idx] = fat_type;
+  return fat_type;
+}
+
+/* Build an array (descriptor) type with given bounds.  */
+
+tree
+gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound,
+			   tree * ubound, int packed,
+			   enum gfc_array_kind akind, bool restricted)
+{
+  char name[8 + 2*GFC_RANK_DIGITS + 1 + GFC_MAX_SYMBOL_LEN];
+  tree fat_type, base_type, arraytype, lower, upper, stride, tmp, rtype;
+  const char *type_name;
+  int n;
+
+  base_type = gfc_get_array_descriptor_base (dimen, codimen, restricted);
+  fat_type = build_distinct_type_copy (base_type);
+  /* Make sure that nontarget and target array type have the same canonical
+     type (and same stub decl for debug info).  */
+  base_type = gfc_get_array_descriptor_base (dimen, codimen, false);
+  TYPE_CANONICAL (fat_type) = base_type;
+  TYPE_STUB_DECL (fat_type) = TYPE_STUB_DECL (base_type);
+
+  tmp = TYPE_NAME (etype);
+  if (tmp && TREE_CODE (tmp) == TYPE_DECL)
+    tmp = DECL_NAME (tmp);
+  if (tmp)
+    type_name = IDENTIFIER_POINTER (tmp);
+  else
+    type_name = "unknown";
+  sprintf (name, "array" GFC_RANK_PRINTF_FORMAT "_%.*s", dimen + codimen,
+	   GFC_MAX_SYMBOL_LEN, type_name);
+  TYPE_NAME (fat_type) = get_identifier (name);
+  TYPE_NAMELESS (fat_type) = 1;
+
+  GFC_DESCRIPTOR_TYPE_P (fat_type) = 1;
+  TYPE_LANG_SPECIFIC (fat_type)
+    = ggc_alloc_cleared_lang_type (sizeof (struct lang_type));
+
+  GFC_TYPE_ARRAY_RANK (fat_type) = dimen;
+  GFC_TYPE_ARRAY_DTYPE (fat_type) = NULL_TREE;
+  GFC_TYPE_ARRAY_AKIND (fat_type) = akind;
+
+  /* Build an array descriptor record type.  */
+  if (packed != 0)
+    stride = gfc_index_one_node;
+  else
+    stride = NULL_TREE;
+  for (n = 0; n < dimen; n++)
+    {
+      GFC_TYPE_ARRAY_STRIDE (fat_type, n) = stride;
+
+      if (lbound)
+	lower = lbound[n];
+      else
+	lower = NULL_TREE;
+
+      if (lower != NULL_TREE)
+	{
+	  if (INTEGER_CST_P (lower))
+	    GFC_TYPE_ARRAY_LBOUND (fat_type, n) = lower;
+	  else
+	    lower = NULL_TREE;
+	}
+
+      upper = ubound[n];
+      if (upper != NULL_TREE)
+	{
+	  if (INTEGER_CST_P (upper))
+	    GFC_TYPE_ARRAY_UBOUND (fat_type, n) = upper;
+	  else
+	    upper = NULL_TREE;
+	}
+
+      if (upper != NULL_TREE && lower != NULL_TREE && stride != NULL_TREE)
+	{
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type, upper, lower);
+	  tmp = fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, tmp,
+				 gfc_index_one_node);
+	  stride = fold_build2_loc (input_location, MULT_EXPR,
+				    gfc_array_index_type, tmp, stride);
+	  /* Check the folding worked.  */
+	  gcc_assert (INTEGER_CST_P (stride));
+	}
+      else
+	stride = NULL_TREE;
+    }
+  GFC_TYPE_ARRAY_SIZE (fat_type) = stride;
+
+  /* TODO: known offsets for descriptors.  */
+  GFC_TYPE_ARRAY_OFFSET (fat_type) = NULL_TREE;
+
+  /* We define data as an array with the correct size if possible.
+     Much better than doing pointer arithmetic.  */
+  if (stride)
+    rtype = build_range_type (gfc_array_index_type, gfc_index_zero_node,
+			      int_const_binop (MINUS_EXPR, stride,
+					       integer_one_node, 0));
+  else
+    rtype = gfc_array_range_type;
+  arraytype = build_array_type (etype, rtype);
+  arraytype = build_pointer_type (arraytype);
+  if (restricted)
+    arraytype = build_qualified_type (arraytype, TYPE_QUAL_RESTRICT);
+  GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype;
+
+  /* This will generate the base declarations we need to emit debug
+     information for this type.  FIXME: there must be a better way to
+     avoid divergence between compilations with and without debug
+     information.  */
+  {
+    struct array_descr_info info;
+    gfc_get_array_descr_info (fat_type, &info);
+    gfc_get_array_descr_info (build_pointer_type (fat_type), &info);
+  }
+
+  return fat_type;
+}
+
+/* Build a pointer type. This function is called from gfc_sym_type().  */
+
+static tree
+gfc_build_pointer_type (gfc_symbol * sym, tree type)
+{
+  /* Array pointer types aren't actually pointers.  */
+  if (sym->attr.dimension)
+    return type;
+  else
+    return build_pointer_type (type);
+}
+
+static tree gfc_nonrestricted_type (tree t);
+/* Given two record or union type nodes TO and FROM, ensure
+   that all fields in FROM have a corresponding field in TO,
+   their type being nonrestrict variants.  This accepts a TO
+   node that already has a prefix of the fields in FROM.  */
+static void
+mirror_fields (tree to, tree from)
+{
+  tree fto, ffrom;
+  tree *chain;
+
+  /* Forward to the end of TOs fields.  */
+  fto = TYPE_FIELDS (to);
+  ffrom = TYPE_FIELDS (from);
+  chain = &TYPE_FIELDS (to);
+  while (fto)
+    {
+      gcc_assert (ffrom && DECL_NAME (fto) == DECL_NAME (ffrom));
+      chain = &DECL_CHAIN (fto);
+      fto = DECL_CHAIN (fto);
+      ffrom = DECL_CHAIN (ffrom);
+    }
+
+  /* Now add all fields remaining in FROM (starting with ffrom).  */
+  for (; ffrom; ffrom = DECL_CHAIN (ffrom))
+    {
+      tree newfield = copy_node (ffrom);
+      DECL_CONTEXT (newfield) = to;
+      /* The store to DECL_CHAIN might seem redundant with the
+	 stores to *chain, but not clearing it here would mean
+	 leaving a chain into the old fields.  If ever
+	 our called functions would look at them confusion
+	 will arise.  */
+      DECL_CHAIN (newfield) = NULL_TREE;
+      *chain = newfield;
+      chain = &DECL_CHAIN (newfield);
+
+      if (TREE_CODE (ffrom) == FIELD_DECL)
+	{
+	  tree elemtype = gfc_nonrestricted_type (TREE_TYPE (ffrom));
+	  TREE_TYPE (newfield) = elemtype;
+	}
+    }
+  *chain = NULL_TREE;
+}
+
+/* Given a type T, returns a different type of the same structure,
+   except that all types it refers to (recursively) are always
+   non-restrict qualified types.  */
+static tree
+gfc_nonrestricted_type (tree t)
+{
+  tree ret = t;
+
+  /* If the type isn't layed out yet, don't copy it.  If something
+     needs it for real it should wait until the type got finished.  */
+  if (!TYPE_SIZE (t))
+    return t;
+
+  if (!TYPE_LANG_SPECIFIC (t))
+    TYPE_LANG_SPECIFIC (t)
+      = ggc_alloc_cleared_lang_type (sizeof (struct lang_type));
+  /* If we're dealing with this very node already further up
+     the call chain (recursion via pointers and struct members)
+     we haven't yet determined if we really need a new type node.
+     Assume we don't, return T itself.  */
+  if (TYPE_LANG_SPECIFIC (t)->nonrestricted_type == error_mark_node)
+    return t;
+
+  /* If we have calculated this all already, just return it.  */
+  if (TYPE_LANG_SPECIFIC (t)->nonrestricted_type)
+    return TYPE_LANG_SPECIFIC (t)->nonrestricted_type;
+
+  /* Mark this type.  */
+  TYPE_LANG_SPECIFIC (t)->nonrestricted_type = error_mark_node;
+
+  switch (TREE_CODE (t))
+    {
+      default:
+	break;
+
+      case POINTER_TYPE:
+      case REFERENCE_TYPE:
+	{
+	  tree totype = gfc_nonrestricted_type (TREE_TYPE (t));
+	  if (totype == TREE_TYPE (t))
+	    ret = t;
+	  else if (TREE_CODE (t) == POINTER_TYPE)
+	    ret = build_pointer_type (totype);
+	  else
+	    ret = build_reference_type (totype);
+	  ret = build_qualified_type (ret,
+				      TYPE_QUALS (t) & ~TYPE_QUAL_RESTRICT);
+	}
+	break;
+
+      case ARRAY_TYPE:
+	{
+	  tree elemtype = gfc_nonrestricted_type (TREE_TYPE (t));
+	  if (elemtype == TREE_TYPE (t))
+	    ret = t;
+	  else
+	    {
+	      ret = build_variant_type_copy (t);
+	      TREE_TYPE (ret) = elemtype;
+	      if (TYPE_LANG_SPECIFIC (t)
+		  && GFC_TYPE_ARRAY_DATAPTR_TYPE (t))
+		{
+		  tree dataptr_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (t);
+		  dataptr_type = gfc_nonrestricted_type (dataptr_type);
+		  if (dataptr_type != GFC_TYPE_ARRAY_DATAPTR_TYPE (t))
+		    {
+		      TYPE_LANG_SPECIFIC (ret)
+			= ggc_alloc_cleared_lang_type (sizeof (struct
+							       lang_type));
+		      *TYPE_LANG_SPECIFIC (ret) = *TYPE_LANG_SPECIFIC (t);
+		      GFC_TYPE_ARRAY_DATAPTR_TYPE (ret) = dataptr_type;
+		    }
+		}
+	    }
+	}
+	break;
+
+      case RECORD_TYPE:
+      case UNION_TYPE:
+      case QUAL_UNION_TYPE:
+	{
+	  tree field;
+	  /* First determine if we need a new type at all.
+	     Careful, the two calls to gfc_nonrestricted_type per field
+	     might return different values.  That happens exactly when
+	     one of the fields reaches back to this very record type
+	     (via pointers).  The first calls will assume that we don't
+	     need to copy T (see the error_mark_node marking).  If there
+	     are any reasons for copying T apart from having to copy T,
+	     we'll indeed copy it, and the second calls to
+	     gfc_nonrestricted_type will use that new node if they
+	     reach back to T.  */
+	  for (field = TYPE_FIELDS (t); field; field = DECL_CHAIN (field))
+	    if (TREE_CODE (field) == FIELD_DECL)
+	      {
+		tree elemtype = gfc_nonrestricted_type (TREE_TYPE (field));
+		if (elemtype != TREE_TYPE (field))
+		  break;
+	      }
+	  if (!field)
+	    break;
+	  ret = build_variant_type_copy (t);
+	  TYPE_FIELDS (ret) = NULL_TREE;
+
+	  /* Here we make sure that as soon as we know we have to copy
+	     T, that also fields reaching back to us will use the new
+	     copy.  It's okay if that copy still contains the old fields,
+	     we won't look at them.  */
+	  TYPE_LANG_SPECIFIC (t)->nonrestricted_type = ret;
+	  mirror_fields (ret, t);
+	}
+        break;
+    }
+
+  TYPE_LANG_SPECIFIC (t)->nonrestricted_type = ret;
+  return ret;
+}
+
+
+/* Return the type for a symbol.  Special handling is required for character
+   types to get the correct level of indirection.
+   For functions return the return type.
+   For subroutines return void_type_node.
+   Calling this multiple times for the same symbol should be avoided,
+   especially for character and array types.  */
+
+tree
+gfc_sym_type (gfc_symbol * sym)
+{
+  tree type;
+  int byref;
+  bool restricted;
+
+  /* Procedure Pointers inside COMMON blocks.  */
+  if (sym->attr.proc_pointer && sym->attr.in_common)
+    {
+      /* Unset proc_pointer as gfc_get_function_type calls gfc_sym_type.  */
+      sym->attr.proc_pointer = 0;
+      type = build_pointer_type (gfc_get_function_type (sym));
+      sym->attr.proc_pointer = 1;
+      return type;
+    }
+
+  if (sym->attr.flavor == FL_PROCEDURE && !sym->attr.function)
+    return void_type_node;
+
+  /* In the case of a function the fake result variable may have a
+     type different from the function type, so don't return early in
+     that case.  */
+  if (sym->backend_decl && !sym->attr.function)
+    return TREE_TYPE (sym->backend_decl);
+
+  if (sym->ts.type == BT_CHARACTER
+      && ((sym->attr.function && sym->attr.is_bind_c)
+	  || (sym->attr.result
+	      && sym->ns->proc_name
+	      && sym->ns->proc_name->attr.is_bind_c)))
+    type = gfc_character1_type_node;
+  else
+    type = gfc_typenode_for_spec (&sym->ts);
+
+  if (sym->attr.dummy && !sym->attr.function && !sym->attr.value)
+    byref = 1;
+  else
+    byref = 0;
+
+  restricted = !sym->attr.target && !sym->attr.pointer
+               && !sym->attr.proc_pointer && !sym->attr.cray_pointee;
+  if (!restricted)
+    type = gfc_nonrestricted_type (type);
+
+  if (sym->attr.dimension)
+    {
+      if (gfc_is_nodesc_array (sym))
+        {
+	  /* If this is a character argument of unknown length, just use the
+	     base type.  */
+	  if (sym->ts.type != BT_CHARACTER
+	      || !(sym->attr.dummy || sym->attr.function)
+	      || sym->ts.u.cl->backend_decl)
+	    {
+	      type = gfc_get_nodesc_array_type (type, sym->as,
+						byref ? PACKED_FULL
+						      : PACKED_STATIC,
+						restricted);
+	      byref = 0;
+	    }
+
+	  if (sym->attr.cray_pointee)
+	    GFC_POINTER_TYPE_P (type) = 1;
+        }
+      else
+	{
+	  enum gfc_array_kind akind = GFC_ARRAY_UNKNOWN;
+	  if (sym->attr.pointer)
+	    akind = sym->attr.contiguous ? GFC_ARRAY_POINTER_CONT
+					 : GFC_ARRAY_POINTER;
+	  else if (sym->attr.allocatable)
+	    akind = GFC_ARRAY_ALLOCATABLE;
+	  type = gfc_build_array_type (type, sym->as, akind, restricted,
+				       sym->attr.contiguous);
+	}
+    }
+  else
+    {
+      if (sym->attr.allocatable || sym->attr.pointer
+	  || gfc_is_associate_pointer (sym))
+	type = gfc_build_pointer_type (sym, type);
+      if (sym->attr.pointer || sym->attr.cray_pointee)
+	GFC_POINTER_TYPE_P (type) = 1;
+    }
+
+  /* We currently pass all parameters by reference.
+     See f95_get_function_decl.  For dummy function parameters return the
+     function type.  */
+  if (byref)
+    {
+      /* We must use pointer types for potentially absent variables.  The
+	 optimizers assume a reference type argument is never NULL.  */
+      if (sym->attr.optional || sym->ns->proc_name->attr.entry_master)
+	type = build_pointer_type (type);
+      else
+	{
+	  type = build_reference_type (type);
+	  if (restricted)
+	    type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
+	}
+    }
+
+  return (type);
+}
+
+/* Layout and output debug info for a record type.  */
+
+void
+gfc_finish_type (tree type)
+{
+  tree decl;
+
+  decl = build_decl (input_location,
+		     TYPE_DECL, NULL_TREE, type);
+  TYPE_STUB_DECL (type) = decl;
+  layout_type (type);
+  rest_of_type_compilation (type, 1);
+  rest_of_decl_compilation (decl, 1, 0);
+}
+
+/* Add a field of given NAME and TYPE to the context of a UNION_TYPE
+   or RECORD_TYPE pointed to by CONTEXT.  The new field is chained
+   to the end of the field list pointed to by *CHAIN.
+
+   Returns a pointer to the new field.  */
+
+static tree
+gfc_add_field_to_struct_1 (tree context, tree name, tree type, tree **chain)
+{
+  tree decl = build_decl (input_location, FIELD_DECL, name, type);
+
+  DECL_CONTEXT (decl) = context;
+  DECL_CHAIN (decl) = NULL_TREE;
+  if (TYPE_FIELDS (context) == NULL_TREE)
+    TYPE_FIELDS (context) = decl;
+  if (chain != NULL)
+    {
+      if (*chain != NULL)
+	**chain = decl;
+      *chain = &DECL_CHAIN (decl);
+    }
+
+  return decl;
+}
+
+/* Like `gfc_add_field_to_struct_1', but adds alignment
+   information.  */
+
+tree
+gfc_add_field_to_struct (tree context, tree name, tree type, tree **chain)
+{
+  tree decl = gfc_add_field_to_struct_1 (context, name, type, chain);
+
+  DECL_INITIAL (decl) = 0;
+  DECL_ALIGN (decl) = 0;
+  DECL_USER_ALIGN (decl) = 0;
+
+  return decl;
+}
+
+
+/* Copy the backend_decl and component backend_decls if
+   the two derived type symbols are "equal", as described
+   in 4.4.2 and resolved by gfc_compare_derived_types.  */
+
+int
+gfc_copy_dt_decls_ifequal (gfc_symbol *from, gfc_symbol *to,
+			   bool from_gsym)
+{
+  gfc_component *to_cm;
+  gfc_component *from_cm;
+
+  if (from == to)
+    return 1;
+
+  if (from->backend_decl == NULL
+	|| !gfc_compare_derived_types (from, to))
+    return 0;
+
+  to->backend_decl = from->backend_decl;
+
+  to_cm = to->components;
+  from_cm = from->components;
+
+  /* Copy the component declarations.  If a component is itself
+     a derived type, we need a copy of its component declarations.
+     This is done by recursing into gfc_get_derived_type and
+     ensures that the component's component declarations have
+     been built.  If it is a character, we need the character 
+     length, as well.  */
+  for (; to_cm; to_cm = to_cm->next, from_cm = from_cm->next)
+    {
+      to_cm->backend_decl = from_cm->backend_decl;
+      if (from_cm->ts.type == BT_DERIVED
+	  && (!from_cm->attr.pointer || from_gsym))
+	gfc_get_derived_type (to_cm->ts.u.derived);
+      else if (from_cm->ts.type == BT_CLASS
+	       && (!CLASS_DATA (from_cm)->attr.class_pointer || from_gsym))
+	gfc_get_derived_type (to_cm->ts.u.derived);
+      else if (from_cm->ts.type == BT_CHARACTER)
+	to_cm->ts.u.cl->backend_decl = from_cm->ts.u.cl->backend_decl;
+    }
+
+  return 1;
+}
+
+
+/* Build a tree node for a procedure pointer component.  */
+
+tree
+gfc_get_ppc_type (gfc_component* c)
+{
+  tree t;
+
+  /* Explicit interface.  */
+  if (c->attr.if_source != IFSRC_UNKNOWN && c->ts.interface)
+    return build_pointer_type (gfc_get_function_type (c->ts.interface));
+
+  /* Implicit interface (only return value may be known).  */
+  if (c->attr.function && !c->attr.dimension && c->ts.type != BT_CHARACTER)
+    t = gfc_typenode_for_spec (&c->ts);
+  else
+    t = void_type_node;
+
+  return build_pointer_type (build_function_type_list (t, NULL_TREE));
+}
+
+
+/* Build a tree node for a derived type.  If there are equal
+   derived types, with different local names, these are built
+   at the same time.  If an equal derived type has been built
+   in a parent namespace, this is used.  */
+
+tree
+gfc_get_derived_type (gfc_symbol * derived)
+{
+  tree typenode = NULL, field = NULL, field_type = NULL;
+  tree canonical = NULL_TREE;
+  tree *chain = NULL;
+  bool got_canonical = false;
+  gfc_component *c;
+  gfc_dt_list *dt;
+  gfc_namespace *ns;
+
+  gcc_assert (derived && derived->attr.flavor == FL_DERIVED);
+
+  /* See if it's one of the iso_c_binding derived types.  */
+  if (derived->attr.is_iso_c == 1)
+    {
+      if (derived->backend_decl)
+	return derived->backend_decl;
+
+      if (derived->intmod_sym_id == ISOCBINDING_PTR)
+	derived->backend_decl = ptr_type_node;
+      else
+	derived->backend_decl = pfunc_type_node;
+
+      derived->ts.kind = gfc_index_integer_kind;
+      derived->ts.type = BT_INTEGER;
+      /* Set the f90_type to BT_VOID as a way to recognize something of type
+         BT_INTEGER that needs to fit a void * for the purpose of the
+         iso_c_binding derived types.  */
+      derived->ts.f90_type = BT_VOID;
+      
+      return derived->backend_decl;
+    }
+
+  /* If use associated, use the module type for this one.  */
+  if (gfc_option.flag_whole_file
+	&& derived->backend_decl == NULL
+	&& derived->attr.use_assoc
+	&& derived->module
+	&& gfc_get_module_backend_decl (derived))
+    goto copy_derived_types;
+
+  /* If a whole file compilation, the derived types from an earlier
+     namespace can be used as the the canonical type.  */
+  if (gfc_option.flag_whole_file
+	&& derived->backend_decl == NULL
+	&& !derived->attr.use_assoc
+	&& gfc_global_ns_list)
+    {
+      for (ns = gfc_global_ns_list;
+	   ns->translated && !got_canonical;
+	   ns = ns->sibling)
+	{
+	  dt = ns->derived_types;
+	  for (; dt && !canonical; dt = dt->next)
+	    {
+	      gfc_copy_dt_decls_ifequal (dt->derived, derived, true);
+	      if (derived->backend_decl)
+		got_canonical = true;
+	    }
+	}
+    }
+
+  /* Store up the canonical type to be added to this one.  */
+  if (got_canonical)
+    {
+      if (TYPE_CANONICAL (derived->backend_decl))
+	canonical = TYPE_CANONICAL (derived->backend_decl);
+      else
+	canonical = derived->backend_decl;
+
+      derived->backend_decl = NULL_TREE;
+    }
+
+  /* derived->backend_decl != 0 means we saw it before, but its
+     components' backend_decl may have not been built.  */
+  if (derived->backend_decl)
+    {
+      /* Its components' backend_decl have been built or we are
+	 seeing recursion through the formal arglist of a procedure
+	 pointer component.  */
+      if (TYPE_FIELDS (derived->backend_decl)
+	    || derived->attr.proc_pointer_comp)
+        return derived->backend_decl;
+      else
+        typenode = derived->backend_decl;
+    }
+  else
+    {
+      /* We see this derived type first time, so build the type node.  */
+      typenode = make_node (RECORD_TYPE);
+      TYPE_NAME (typenode) = get_identifier (derived->name);
+      TYPE_PACKED (typenode) = gfc_option.flag_pack_derived;
+      derived->backend_decl = typenode;
+    }
+
+  /* Go through the derived type components, building them as
+     necessary. The reason for doing this now is that it is
+     possible to recurse back to this derived type through a
+     pointer component (PR24092). If this happens, the fields
+     will be built and so we can return the type.  */
+  for (c = derived->components; c; c = c->next)
+    {
+      if (c->ts.type != BT_DERIVED && c->ts.type != BT_CLASS)
+	continue;
+
+      if ((!c->attr.pointer && !c->attr.proc_pointer)
+	  || c->ts.u.derived->backend_decl == NULL)
+	c->ts.u.derived->backend_decl = gfc_get_derived_type (c->ts.u.derived);
+
+      if (c->ts.u.derived && c->ts.u.derived->attr.is_iso_c)
+        {
+          /* Need to copy the modified ts from the derived type.  The
+             typespec was modified because C_PTR/C_FUNPTR are translated
+             into (void *) from derived types.  */
+          c->ts.type = c->ts.u.derived->ts.type;
+          c->ts.kind = c->ts.u.derived->ts.kind;
+          c->ts.f90_type = c->ts.u.derived->ts.f90_type;
+	  if (c->initializer)
+	    {
+	      c->initializer->ts.type = c->ts.type;
+	      c->initializer->ts.kind = c->ts.kind;
+	      c->initializer->ts.f90_type = c->ts.f90_type;
+	      c->initializer->expr_type = EXPR_NULL;
+	    }
+        }
+    }
+
+  if (TYPE_FIELDS (derived->backend_decl))
+    return derived->backend_decl;
+
+  /* Build the type member list. Install the newly created RECORD_TYPE
+     node as DECL_CONTEXT of each FIELD_DECL.  */
+  for (c = derived->components; c; c = c->next)
+    {
+      if (c->attr.proc_pointer)
+	field_type = gfc_get_ppc_type (c);
+      else if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
+        field_type = c->ts.u.derived->backend_decl;
+      else
+	{
+	  if (c->ts.type == BT_CHARACTER)
+	    {
+	      /* Evaluate the string length.  */
+	      gfc_conv_const_charlen (c->ts.u.cl);
+	      gcc_assert (c->ts.u.cl->backend_decl);
+	    }
+
+	  field_type = gfc_typenode_for_spec (&c->ts);
+	}
+
+      /* This returns an array descriptor type.  Initialization may be
+         required.  */
+      if (c->attr.dimension && !c->attr.proc_pointer)
+	{
+	  if (c->attr.pointer || c->attr.allocatable)
+	    {
+	      enum gfc_array_kind akind;
+	      if (c->attr.pointer)
+		akind = c->attr.contiguous ? GFC_ARRAY_POINTER_CONT
+					   : GFC_ARRAY_POINTER;
+	      else
+		akind = GFC_ARRAY_ALLOCATABLE;
+	      /* Pointers to arrays aren't actually pointer types.  The
+	         descriptors are separate, but the data is common.  */
+	      field_type = gfc_build_array_type (field_type, c->as, akind,
+						 !c->attr.target
+						 && !c->attr.pointer,
+						 c->attr.contiguous);
+	    }
+	  else
+	    field_type = gfc_get_nodesc_array_type (field_type, c->as,
+						    PACKED_STATIC,
+						    !c->attr.target);
+	}
+      else if ((c->attr.pointer || c->attr.allocatable)
+	       && !c->attr.proc_pointer)
+	field_type = build_pointer_type (field_type);
+
+      if (c->attr.pointer)
+	field_type = gfc_nonrestricted_type (field_type);
+
+      /* vtype fields can point to different types to the base type.  */
+      if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.vtype)
+	  field_type = build_pointer_type_for_mode (TREE_TYPE (field_type),
+						    ptr_mode, true);
+
+      field = gfc_add_field_to_struct (typenode,
+				       get_identifier (c->name),
+				       field_type, &chain);
+      if (c->loc.lb)
+	gfc_set_decl_location (field, &c->loc);
+      else if (derived->declared_at.lb)
+	gfc_set_decl_location (field, &derived->declared_at);
+
+      DECL_PACKED (field) |= TYPE_PACKED (typenode);
+
+      gcc_assert (field);
+      if (!c->backend_decl)
+	c->backend_decl = field;
+    }
+
+  /* Now lay out the derived type, including the fields.  */
+  if (canonical)
+    TYPE_CANONICAL (typenode) = canonical;
+
+  gfc_finish_type (typenode);
+  gfc_set_decl_location (TYPE_STUB_DECL (typenode), &derived->declared_at);
+  if (derived->module && derived->ns->proc_name
+      && derived->ns->proc_name->attr.flavor == FL_MODULE)
+    {
+      if (derived->ns->proc_name->backend_decl
+	  && TREE_CODE (derived->ns->proc_name->backend_decl)
+	     == NAMESPACE_DECL)
+	{
+	  TYPE_CONTEXT (typenode) = derived->ns->proc_name->backend_decl;
+	  DECL_CONTEXT (TYPE_STUB_DECL (typenode))
+	    = derived->ns->proc_name->backend_decl;
+	}
+    }
+
+  derived->backend_decl = typenode;
+
+copy_derived_types:
+
+  for (dt = gfc_derived_types; dt; dt = dt->next)
+    gfc_copy_dt_decls_ifequal (derived, dt->derived, false);
+
+  return derived->backend_decl;
+}
+
+
+int
+gfc_return_by_reference (gfc_symbol * sym)
+{
+  if (!sym->attr.function)
+    return 0;
+
+  if (sym->attr.dimension)
+    return 1;
+
+  if (sym->ts.type == BT_CHARACTER
+      && !sym->attr.is_bind_c
+      && (!sym->attr.result
+	  || !sym->ns->proc_name
+	  || !sym->ns->proc_name->attr.is_bind_c))
+    return 1;
+
+  /* Possibly return complex numbers by reference for g77 compatibility.
+     We don't do this for calls to intrinsics (as the library uses the
+     -fno-f2c calling convention), nor for calls to functions which always
+     require an explicit interface, as no compatibility problems can
+     arise there.  */
+  if (gfc_option.flag_f2c
+      && sym->ts.type == BT_COMPLEX
+      && !sym->attr.intrinsic && !sym->attr.always_explicit)
+    return 1;
+
+  return 0;
+}
+
+static tree
+gfc_get_mixed_entry_union (gfc_namespace *ns)
+{
+  tree type;
+  tree *chain = NULL;
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  gfc_entry_list *el, *el2;
+
+  gcc_assert (ns->proc_name->attr.mixed_entry_master);
+  gcc_assert (memcmp (ns->proc_name->name, "master.", 7) == 0);
+
+  snprintf (name, GFC_MAX_SYMBOL_LEN, "munion.%s", ns->proc_name->name + 7);
+
+  /* Build the type node.  */
+  type = make_node (UNION_TYPE);
+
+  TYPE_NAME (type) = get_identifier (name);
+
+  for (el = ns->entries; el; el = el->next)
+    {
+      /* Search for duplicates.  */
+      for (el2 = ns->entries; el2 != el; el2 = el2->next)
+	if (el2->sym->result == el->sym->result)
+	  break;
+
+      if (el == el2)
+	gfc_add_field_to_struct_1 (type,
+				   get_identifier (el->sym->result->name),
+				   gfc_sym_type (el->sym->result), &chain);
+    }
+
+  /* Finish off the type.  */
+  gfc_finish_type (type);
+  TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (type)) = 1;
+  return type;
+}
+
+/* Create a "fn spec" based on the formal arguments;
+   cf. create_function_arglist.  */
+
+static tree
+create_fn_spec (gfc_symbol *sym, tree fntype)
+{
+  char spec[150];
+  size_t spec_len;
+  gfc_formal_arglist *f;
+  tree tmp;
+
+  memset (&spec, 0, sizeof (spec));
+  spec[0] = '.';
+  spec_len = 1;
+
+  if (sym->attr.entry_master)
+    spec[spec_len++] = 'R';
+  if (gfc_return_by_reference (sym))
+    {
+      gfc_symbol *result = sym->result ? sym->result : sym;
+
+      if (result->attr.pointer || sym->attr.proc_pointer)
+	spec[spec_len++] = '.';
+      else
+	spec[spec_len++] = 'w';
+      if (sym->ts.type == BT_CHARACTER)
+	spec[spec_len++] = 'R';
+    }
+
+  for (f = sym->formal; f; f = f->next)
+    if (spec_len < sizeof (spec))
+      {
+	if (!f->sym || f->sym->attr.pointer || f->sym->attr.target
+	    || f->sym->attr.external || f->sym->attr.cray_pointer
+	    || (f->sym->ts.type == BT_DERIVED
+		&& (f->sym->ts.u.derived->attr.proc_pointer_comp
+		    || f->sym->ts.u.derived->attr.pointer_comp))
+	    || (f->sym->ts.type == BT_CLASS
+		&& (CLASS_DATA (f->sym)->ts.u.derived->attr.proc_pointer_comp
+		    || CLASS_DATA (f->sym)->ts.u.derived->attr.pointer_comp)))
+	  spec[spec_len++] = '.';
+	else if (f->sym->attr.intent == INTENT_IN)
+	  spec[spec_len++] = 'r';
+	else if (f->sym)
+	  spec[spec_len++] = 'w';
+      }
+
+  tmp = build_tree_list (NULL_TREE, build_string (spec_len, spec));
+  tmp = tree_cons (get_identifier ("fn spec"), tmp, TYPE_ATTRIBUTES (fntype));
+  return build_type_attribute_variant (fntype, tmp);
+}
+
+
+tree
+gfc_get_function_type (gfc_symbol * sym)
+{
+  tree type;
+  tree typelist;
+  gfc_formal_arglist *f;
+  gfc_symbol *arg;
+  int alternate_return;
+
+  /* Make sure this symbol is a function, a subroutine or the main
+     program.  */
+  gcc_assert (sym->attr.flavor == FL_PROCEDURE
+	      || sym->attr.flavor == FL_PROGRAM);
+
+  if (sym->backend_decl)
+    {
+      if (sym->attr.proc_pointer)
+	return TREE_TYPE (TREE_TYPE (sym->backend_decl));
+      return TREE_TYPE (sym->backend_decl);
+    }
+
+  alternate_return = 0;
+  typelist = NULL_TREE;
+
+  if (sym->attr.entry_master)
+    {
+      /* Additional parameter for selecting an entry point.  */
+      typelist = gfc_chainon_list (typelist, gfc_array_index_type);
+    }
+
+  if (sym->result)
+    arg = sym->result;
+  else
+    arg = sym;
+
+  if (arg->ts.type == BT_CHARACTER)
+    gfc_conv_const_charlen (arg->ts.u.cl);
+
+  /* Some functions we use an extra parameter for the return value.  */
+  if (gfc_return_by_reference (sym))
+    {
+      type = gfc_sym_type (arg);
+      if (arg->ts.type == BT_COMPLEX
+	  || arg->attr.dimension
+	  || arg->ts.type == BT_CHARACTER)
+	type = build_reference_type (type);
+
+      typelist = gfc_chainon_list (typelist, type);
+      if (arg->ts.type == BT_CHARACTER)
+	{
+	  if (!arg->ts.deferred)
+	    /* Transfer by value.  */
+	    typelist = gfc_chainon_list (typelist, gfc_charlen_type_node);
+	  else
+	    /* Deferred character lengths are transferred by reference
+	       so that the value can be returned.  */
+	    typelist = gfc_chainon_list (typelist,
+				build_pointer_type (gfc_charlen_type_node));
+	}
+    }
+
+  /* Build the argument types for the function.  */
+  for (f = sym->formal; f; f = f->next)
+    {
+      arg = f->sym;
+      if (arg)
+	{
+	  /* Evaluate constant character lengths here so that they can be
+	     included in the type.  */
+	  if (arg->ts.type == BT_CHARACTER)
+	    gfc_conv_const_charlen (arg->ts.u.cl);
+
+	  if (arg->attr.flavor == FL_PROCEDURE)
+	    {
+	      type = gfc_get_function_type (arg);
+	      type = build_pointer_type (type);
+	    }
+	  else
+	    type = gfc_sym_type (arg);
+
+	  /* Parameter Passing Convention
+
+	     We currently pass all parameters by reference.
+	     Parameters with INTENT(IN) could be passed by value.
+	     The problem arises if a function is called via an implicit
+	     prototype. In this situation the INTENT is not known.
+	     For this reason all parameters to global functions must be
+	     passed by reference.  Passing by value would potentially
+	     generate bad code.  Worse there would be no way of telling that
+	     this code was bad, except that it would give incorrect results.
+
+	     Contained procedures could pass by value as these are never
+	     used without an explicit interface, and cannot be passed as
+	     actual parameters for a dummy procedure.  */
+
+	  typelist = gfc_chainon_list (typelist, type);
+	}
+      else
+        {
+          if (sym->attr.subroutine)
+            alternate_return = 1;
+        }
+    }
+
+  /* Add hidden string length parameters.  */
+  for (f = sym->formal; f; f = f->next)
+    {
+      arg = f->sym;
+      if (arg && arg->ts.type == BT_CHARACTER && !sym->attr.is_bind_c)
+	{
+	  if (!arg->ts.deferred)
+	    /* Transfer by value.  */
+	    type = gfc_charlen_type_node;
+	  else
+	    /* Deferred character lengths are transferred by reference
+	       so that the value can be returned.  */
+	    type = build_pointer_type (gfc_charlen_type_node);
+
+	  typelist = gfc_chainon_list (typelist, type);
+	}
+    }
+
+  if (typelist)
+    typelist = chainon (typelist, void_list_node);
+  else if (sym->attr.is_main_program)
+    typelist = void_list_node;
+
+  if (alternate_return)
+    type = integer_type_node;
+  else if (!sym->attr.function || gfc_return_by_reference (sym))
+    type = void_type_node;
+  else if (sym->attr.mixed_entry_master)
+    type = gfc_get_mixed_entry_union (sym->ns);
+  else if (gfc_option.flag_f2c
+	   && sym->ts.type == BT_REAL
+	   && sym->ts.kind == gfc_default_real_kind
+	   && !sym->attr.always_explicit)
+    {
+      /* Special case: f2c calling conventions require that (scalar) 
+	 default REAL functions return the C type double instead.  f2c
+	 compatibility is only an issue with functions that don't
+	 require an explicit interface, as only these could be
+	 implemented in Fortran 77.  */
+      sym->ts.kind = gfc_default_double_kind;
+      type = gfc_typenode_for_spec (&sym->ts);
+      sym->ts.kind = gfc_default_real_kind;
+    }
+  else if (sym->result && sym->result->attr.proc_pointer)
+    /* Procedure pointer return values.  */
+    {
+      if (sym->result->attr.result && strcmp (sym->name,"ppr@") != 0)
+	{
+	  /* Unset proc_pointer as gfc_get_function_type
+	     is called recursively.  */
+	  sym->result->attr.proc_pointer = 0;
+	  type = build_pointer_type (gfc_get_function_type (sym->result));
+	  sym->result->attr.proc_pointer = 1;
+	}
+      else
+       type = gfc_sym_type (sym->result);
+    }
+  else
+    type = gfc_sym_type (sym);
+
+  type = build_function_type (type, typelist);
+  type = create_fn_spec (sym, type);
+
+  return type;
+}
+
+/* Language hooks for middle-end access to type nodes.  */
+
+/* Return an integer type with BITS bits of precision,
+   that is unsigned if UNSIGNEDP is nonzero, otherwise signed.  */
+
+tree
+gfc_type_for_size (unsigned bits, int unsignedp)
+{
+  if (!unsignedp)
+    {
+      int i;
+      for (i = 0; i <= MAX_INT_KINDS; ++i)
+	{
+	  tree type = gfc_integer_types[i];
+	  if (type && bits == TYPE_PRECISION (type))
+	    return type;
+	}
+
+      /* Handle TImode as a special case because it is used by some backends
+         (e.g. ARM) even though it is not available for normal use.  */
+#if HOST_BITS_PER_WIDE_INT >= 64
+      if (bits == TYPE_PRECISION (intTI_type_node))
+	return intTI_type_node;
+#endif
+    }
+  else
+    {
+      if (bits == TYPE_PRECISION (unsigned_intQI_type_node))
+        return unsigned_intQI_type_node;
+      if (bits == TYPE_PRECISION (unsigned_intHI_type_node))
+	return unsigned_intHI_type_node;
+      if (bits == TYPE_PRECISION (unsigned_intSI_type_node))
+	return unsigned_intSI_type_node;
+      if (bits == TYPE_PRECISION (unsigned_intDI_type_node))
+	return unsigned_intDI_type_node;
+      if (bits == TYPE_PRECISION (unsigned_intTI_type_node))
+	return unsigned_intTI_type_node;
+    }
+
+  return NULL_TREE;
+}
+
+/* Return a data type that has machine mode MODE.  If the mode is an
+   integer, then UNSIGNEDP selects between signed and unsigned types.  */
+
+tree
+gfc_type_for_mode (enum machine_mode mode, int unsignedp)
+{
+  int i;
+  tree *base;
+
+  if (GET_MODE_CLASS (mode) == MODE_FLOAT)
+    base = gfc_real_types;
+  else if (GET_MODE_CLASS (mode) == MODE_COMPLEX_FLOAT)
+    base = gfc_complex_types;
+  else if (SCALAR_INT_MODE_P (mode))
+    return gfc_type_for_size (GET_MODE_PRECISION (mode), unsignedp);
+  else if (VECTOR_MODE_P (mode))
+    {
+      enum machine_mode inner_mode = GET_MODE_INNER (mode);
+      tree inner_type = gfc_type_for_mode (inner_mode, unsignedp);
+      if (inner_type != NULL_TREE)
+        return build_vector_type_for_mode (inner_type, mode);
+      return NULL_TREE;
+    }
+  else
+    return NULL_TREE;
+
+  for (i = 0; i <= MAX_REAL_KINDS; ++i)
+    {
+      tree type = base[i];
+      if (type && mode == TYPE_MODE (type))
+	return type;
+    }
+
+  return NULL_TREE;
+}
+
+/* Return TRUE if TYPE is a type with a hidden descriptor, fill in INFO
+   in that case.  */
+
+bool
+gfc_get_array_descr_info (const_tree type, struct array_descr_info *info)
+{
+  int rank, dim;
+  bool indirect = false;
+  tree etype, ptype, field, t, base_decl;
+  tree data_off, dim_off, dim_size, elem_size;
+  tree lower_suboff, upper_suboff, stride_suboff;
+
+  if (! GFC_DESCRIPTOR_TYPE_P (type))
+    {
+      if (! POINTER_TYPE_P (type))
+	return false;
+      type = TREE_TYPE (type);
+      if (! GFC_DESCRIPTOR_TYPE_P (type))
+	return false;
+      indirect = true;
+    }
+
+  rank = GFC_TYPE_ARRAY_RANK (type);
+  if (rank >= (int) (sizeof (info->dimen) / sizeof (info->dimen[0])))
+    return false;
+
+  etype = GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
+  gcc_assert (POINTER_TYPE_P (etype));
+  etype = TREE_TYPE (etype);
+  gcc_assert (TREE_CODE (etype) == ARRAY_TYPE);
+  etype = TREE_TYPE (etype);
+  /* Can't handle variable sized elements yet.  */
+  if (int_size_in_bytes (etype) <= 0)
+    return false;
+  /* Nor non-constant lower bounds in assumed shape arrays.  */
+  if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE
+      || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT)
+    {
+      for (dim = 0; dim < rank; dim++)
+	if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE
+	    || TREE_CODE (GFC_TYPE_ARRAY_LBOUND (type, dim)) != INTEGER_CST)
+	  return false;
+    }
+
+  memset (info, '\0', sizeof (*info));
+  info->ndimensions = rank;
+  info->element_type = etype;
+  ptype = build_pointer_type (gfc_array_index_type);
+  base_decl = GFC_TYPE_ARRAY_BASE_DECL (type, indirect);
+  if (!base_decl)
+    {
+      base_decl = build_decl (input_location, VAR_DECL, NULL_TREE,
+			      indirect ? build_pointer_type (ptype) : ptype);
+      GFC_TYPE_ARRAY_BASE_DECL (type, indirect) = base_decl;
+    }
+  info->base_decl = base_decl;
+  if (indirect)
+    base_decl = build1 (INDIRECT_REF, ptype, base_decl);
+
+  if (GFC_TYPE_ARRAY_SPAN (type))
+    elem_size = GFC_TYPE_ARRAY_SPAN (type);
+  else
+    elem_size = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (etype));
+  field = TYPE_FIELDS (TYPE_MAIN_VARIANT (type));
+  data_off = byte_position (field);
+  field = DECL_CHAIN (field);
+  field = DECL_CHAIN (field);
+  field = DECL_CHAIN (field);
+  dim_off = byte_position (field);
+  dim_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (field)));
+  field = TYPE_FIELDS (TREE_TYPE (TREE_TYPE (field)));
+  stride_suboff = byte_position (field);
+  field = DECL_CHAIN (field);
+  lower_suboff = byte_position (field);
+  field = DECL_CHAIN (field);
+  upper_suboff = byte_position (field);
+
+  t = base_decl;
+  if (!integer_zerop (data_off))
+    t = build2 (POINTER_PLUS_EXPR, ptype, t, data_off);
+  t = build1 (NOP_EXPR, build_pointer_type (ptr_type_node), t);
+  info->data_location = build1 (INDIRECT_REF, ptr_type_node, t);
+  if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
+    info->allocated = build2 (NE_EXPR, boolean_type_node,
+			      info->data_location, null_pointer_node);
+  else if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
+	   || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)
+    info->associated = build2 (NE_EXPR, boolean_type_node,
+			       info->data_location, null_pointer_node);
+
+  for (dim = 0; dim < rank; dim++)
+    {
+      t = build2 (POINTER_PLUS_EXPR, ptype, base_decl,
+		  size_binop (PLUS_EXPR, dim_off, lower_suboff));
+      t = build1 (INDIRECT_REF, gfc_array_index_type, t);
+      info->dimen[dim].lower_bound = t;
+      t = build2 (POINTER_PLUS_EXPR, ptype, base_decl,
+		  size_binop (PLUS_EXPR, dim_off, upper_suboff));
+      t = build1 (INDIRECT_REF, gfc_array_index_type, t);
+      info->dimen[dim].upper_bound = t;
+      if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE
+	  || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_SHAPE_CONT)
+	{
+	  /* Assumed shape arrays have known lower bounds.  */
+	  info->dimen[dim].upper_bound
+	    = build2 (MINUS_EXPR, gfc_array_index_type,
+		      info->dimen[dim].upper_bound,
+		      info->dimen[dim].lower_bound);
+	  info->dimen[dim].lower_bound
+	    = fold_convert (gfc_array_index_type,
+			    GFC_TYPE_ARRAY_LBOUND (type, dim));
+	  info->dimen[dim].upper_bound
+	    = build2 (PLUS_EXPR, gfc_array_index_type,
+		      info->dimen[dim].lower_bound,
+		      info->dimen[dim].upper_bound);
+	}
+      t = build2 (POINTER_PLUS_EXPR, ptype, base_decl,
+		  size_binop (PLUS_EXPR, dim_off, stride_suboff));
+      t = build1 (INDIRECT_REF, gfc_array_index_type, t);
+      t = build2 (MULT_EXPR, gfc_array_index_type, t, elem_size);
+      info->dimen[dim].stride = t;
+      dim_off = size_binop (PLUS_EXPR, dim_off, dim_size);
+    }
+
+  return true;
+}
+
+#include "gt-fortran-trans-types.h"
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
new file mode 100644
index 000000000..57afd8cae
--- /dev/null
+++ b/gcc/fortran/trans-types.h
@@ -0,0 +1,104 @@
+/* Header for Fortran 95 types backend support.
+   Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+   and Steven Bosscher <s.bosscher@student.tudelft.nl>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+
+#ifndef GFC_BACKEND_H
+#define GFC_BACKEND_H
+
+extern GTY(()) tree gfc_array_index_type;
+extern GTY(()) tree gfc_array_range_type;
+extern GTY(()) tree gfc_character1_type_node;
+extern GTY(()) tree ppvoid_type_node;
+extern GTY(()) tree pvoid_type_node;
+extern GTY(()) tree prvoid_type_node;
+extern GTY(()) tree pchar_type_node;
+extern GTY(()) tree float128_type_node;
+extern GTY(()) tree complex_float128_type_node;
+
+/* This is the type used to hold the lengths of character variables.
+   It must be the same as the corresponding definition in gfortran.h.  */
+/* TODO: This is still hardcoded as kind=4 in some bits of the compiler
+   and runtime library.  */
+extern GTY(()) tree gfc_charlen_type_node;
+
+/* The following flags give us information on the correspondance of
+   real (and complex) kinds with C floating-point types long double
+   and __float128.  */
+extern bool gfc_real16_is_float128;
+
+typedef enum {
+  PACKED_NO = 0,
+  PACKED_PARTIAL,
+  PACKED_FULL,
+  PACKED_STATIC
+} gfc_packed;
+
+/* be-function.c */
+void gfc_convert_function_code (gfc_namespace *);
+
+/* trans-types.c */
+void gfc_init_kinds (void);
+void gfc_init_types (void);
+
+tree gfc_get_int_type (int);
+tree gfc_get_real_type (int);
+tree gfc_get_complex_type (int);
+tree gfc_get_logical_type (int);
+tree gfc_get_char_type (int);
+tree gfc_get_pchar_type (int);
+tree gfc_get_character_type (int, gfc_charlen *);
+tree gfc_get_character_type_len (int, tree);
+tree gfc_get_character_type_len_for_eltype (tree, tree);
+
+tree gfc_sym_type (gfc_symbol *);
+tree gfc_typenode_for_spec (gfc_typespec *);
+int gfc_copy_dt_decls_ifequal (gfc_symbol *, gfc_symbol *, bool);
+
+tree gfc_get_function_type (gfc_symbol *);
+
+tree gfc_type_for_size (unsigned, int);
+tree gfc_type_for_mode (enum machine_mode, int);
+tree gfc_build_uint_type (int);
+
+tree gfc_get_element_type (tree);
+tree gfc_get_array_type_bounds (tree, int, int, tree *, tree *, int,
+				enum gfc_array_kind, bool);
+tree gfc_get_nodesc_array_type (tree, gfc_array_spec *, gfc_packed, bool);
+
+/* Add a field of given name and type to a UNION_TYPE or RECORD_TYPE.  */
+tree gfc_add_field_to_struct (tree, tree, tree, tree **);
+
+/* Layout and output debugging info for a type.  */
+void gfc_finish_type (tree);
+
+/* Some functions have an extra parameter for the return value.  */
+int gfc_return_by_reference (gfc_symbol *);
+
+/* Returns true if the array sym does not require a descriptor.  */
+int gfc_is_nodesc_array (gfc_symbol *);
+
+/* Return the DTYPE for an array.  */
+tree gfc_get_dtype (tree);
+
+tree gfc_get_ppc_type (gfc_component *);
+
+#endif
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
new file mode 100644
index 000000000..0dc824098
--- /dev/null
+++ b/gcc/fortran/trans.c
@@ -0,0 +1,1555 @@
+/* Code translation -- generate GCC trees from gfc_code.
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "gimple.h"	/* For create_tmp_var_raw.  */
+#include "tree-iterator.h"
+#include "diagnostic-core.h"  /* For internal_error.  */
+#include "defaults.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "trans.h"
+#include "trans-stmt.h"
+#include "trans-array.h"
+#include "trans-types.h"
+#include "trans-const.h"
+
+/* Naming convention for backend interface code:
+
+   gfc_trans_*	translate gfc_code into STMT trees.
+
+   gfc_conv_*	expression conversion
+
+   gfc_get_*	get a backend tree representation of a decl or type  */
+
+static gfc_file *gfc_current_backend_file;
+
+const char gfc_msg_fault[] = N_("Array reference out of bounds");
+const char gfc_msg_wrong_return[] = N_("Incorrect function return value");
+
+
+/* Advance along TREE_CHAIN n times.  */
+
+tree
+gfc_advance_chain (tree t, int n)
+{
+  for (; n > 0; n--)
+    {
+      gcc_assert (t != NULL_TREE);
+      t = DECL_CHAIN (t);
+    }
+  return t;
+}
+
+
+/* Wrap a node in a TREE_LIST node and add it to the end of a list.  */
+
+tree
+gfc_chainon_list (tree list, tree add)
+{
+  tree l;
+
+  l = tree_cons (NULL_TREE, add, NULL_TREE);
+
+  return chainon (list, l);
+}
+
+
+/* Strip off a legitimate source ending from the input
+   string NAME of length LEN.  */
+
+static inline void
+remove_suffix (char *name, int len)
+{
+  int i;
+
+  for (i = 2; i < 8 && len > i; i++)
+    {
+      if (name[len - i] == '.')
+	{
+	  name[len - i] = '\0';
+	  break;
+	}
+    }
+}
+
+
+/* Creates a variable declaration with a given TYPE.  */
+
+tree
+gfc_create_var_np (tree type, const char *prefix)
+{
+  tree t;
+  
+  t = create_tmp_var_raw (type, prefix);
+
+  /* No warnings for anonymous variables.  */
+  if (prefix == NULL)
+    TREE_NO_WARNING (t) = 1;
+
+  return t;
+}
+
+
+/* Like above, but also adds it to the current scope.  */
+
+tree
+gfc_create_var (tree type, const char *prefix)
+{
+  tree tmp;
+
+  tmp = gfc_create_var_np (type, prefix);
+
+  pushdecl (tmp);
+
+  return tmp;
+}
+
+
+/* If the expression is not constant, evaluate it now.  We assign the
+   result of the expression to an artificially created variable VAR, and
+   return a pointer to the VAR_DECL node for this variable.  */
+
+tree
+gfc_evaluate_now_loc (location_t loc, tree expr, stmtblock_t * pblock)
+{
+  tree var;
+
+  if (CONSTANT_CLASS_P (expr))
+    return expr;
+
+  var = gfc_create_var (TREE_TYPE (expr), NULL);
+  gfc_add_modify_loc (loc, pblock, var, expr);
+
+  return var;
+}
+
+
+tree
+gfc_evaluate_now (tree expr, stmtblock_t * pblock)
+{
+  return gfc_evaluate_now_loc (input_location, expr, pblock);
+}
+
+
+/* Build a MODIFY_EXPR node and add it to a given statement block PBLOCK.  
+   A MODIFY_EXPR is an assignment:
+   LHS <- RHS.  */
+
+void
+gfc_add_modify_loc (location_t loc, stmtblock_t * pblock, tree lhs, tree rhs)
+{
+  tree tmp;
+
+#ifdef ENABLE_CHECKING
+  tree t1, t2;
+  t1 = TREE_TYPE (rhs);
+  t2 = TREE_TYPE (lhs);
+  /* Make sure that the types of the rhs and the lhs are the same
+     for scalar assignments.  We should probably have something
+     similar for aggregates, but right now removing that check just
+     breaks everything.  */
+  gcc_assert (t1 == t2
+	      || AGGREGATE_TYPE_P (TREE_TYPE (lhs)));
+#endif
+
+  tmp = fold_build2_loc (loc, MODIFY_EXPR, void_type_node, lhs,
+			 rhs);
+  gfc_add_expr_to_block (pblock, tmp);
+}
+
+
+void
+gfc_add_modify (stmtblock_t * pblock, tree lhs, tree rhs)
+{
+  gfc_add_modify_loc (input_location, pblock, lhs, rhs);
+}
+
+
+/* Create a new scope/binding level and initialize a block.  Care must be
+   taken when translating expressions as any temporaries will be placed in
+   the innermost scope.  */
+
+void
+gfc_start_block (stmtblock_t * block)
+{
+  /* Start a new binding level.  */
+  pushlevel (0);
+  block->has_scope = 1;
+
+  /* The block is empty.  */
+  block->head = NULL_TREE;
+}
+
+
+/* Initialize a block without creating a new scope.  */
+
+void
+gfc_init_block (stmtblock_t * block)
+{
+  block->head = NULL_TREE;
+  block->has_scope = 0;
+}
+
+
+/* Sometimes we create a scope but it turns out that we don't actually
+   need it.  This function merges the scope of BLOCK with its parent.
+   Only variable decls will be merged, you still need to add the code.  */
+
+void
+gfc_merge_block_scope (stmtblock_t * block)
+{
+  tree decl;
+  tree next;
+
+  gcc_assert (block->has_scope);
+  block->has_scope = 0;
+
+  /* Remember the decls in this scope.  */
+  decl = getdecls ();
+  poplevel (0, 0, 0);
+
+  /* Add them to the parent scope.  */
+  while (decl != NULL_TREE)
+    {
+      next = DECL_CHAIN (decl);
+      DECL_CHAIN (decl) = NULL_TREE;
+
+      pushdecl (decl);
+      decl = next;
+    }
+}
+
+
+/* Finish a scope containing a block of statements.  */
+
+tree
+gfc_finish_block (stmtblock_t * stmtblock)
+{
+  tree decl;
+  tree expr;
+  tree block;
+
+  expr = stmtblock->head;
+  if (!expr)
+    expr = build_empty_stmt (input_location);
+
+  stmtblock->head = NULL_TREE;
+
+  if (stmtblock->has_scope)
+    {
+      decl = getdecls ();
+
+      if (decl)
+	{
+	  block = poplevel (1, 0, 0);
+	  expr = build3_v (BIND_EXPR, decl, expr, block);
+	}
+      else
+	poplevel (0, 0, 0);
+    }
+
+  return expr;
+}
+
+
+/* Build an ADDR_EXPR and cast the result to TYPE.  If TYPE is NULL, the
+   natural type is used.  */
+
+tree
+gfc_build_addr_expr (tree type, tree t)
+{
+  tree base_type = TREE_TYPE (t);
+  tree natural_type;
+
+  if (type && POINTER_TYPE_P (type)
+      && TREE_CODE (base_type) == ARRAY_TYPE
+      && TYPE_MAIN_VARIANT (TREE_TYPE (type))
+	 == TYPE_MAIN_VARIANT (TREE_TYPE (base_type)))
+    {
+      tree min_val = size_zero_node;
+      tree type_domain = TYPE_DOMAIN (base_type);
+      if (type_domain && TYPE_MIN_VALUE (type_domain))
+        min_val = TYPE_MIN_VALUE (type_domain);
+      t = fold (build4_loc (input_location, ARRAY_REF, TREE_TYPE (type),
+			    t, min_val, NULL_TREE, NULL_TREE));
+      natural_type = type;
+    }
+  else
+    natural_type = build_pointer_type (base_type);
+
+  if (TREE_CODE (t) == INDIRECT_REF)
+    {
+      if (!type)
+	type = natural_type;
+      t = TREE_OPERAND (t, 0);
+      natural_type = TREE_TYPE (t);
+    }
+  else
+    {
+      tree base = get_base_address (t);
+      if (base && DECL_P (base))
+        TREE_ADDRESSABLE (base) = 1;
+      t = fold_build1_loc (input_location, ADDR_EXPR, natural_type, t);
+    }
+
+  if (type && natural_type != type)
+    t = convert (type, t);
+
+  return t;
+}
+
+
+/* Build an ARRAY_REF with its natural type.  */
+
+tree
+gfc_build_array_ref (tree base, tree offset, tree decl)
+{
+  tree type = TREE_TYPE (base);
+  tree tmp;
+
+  gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
+  type = TREE_TYPE (type);
+
+  if (DECL_P (base))
+    TREE_ADDRESSABLE (base) = 1;
+
+  /* Strip NON_LVALUE_EXPR nodes.  */
+  STRIP_TYPE_NOPS (offset);
+
+  /* If the array reference is to a pointer, whose target contains a
+     subreference, use the span that is stored with the backend decl
+     and reference the element with pointer arithmetic.  */
+  if (decl && (TREE_CODE (decl) == FIELD_DECL
+		 || TREE_CODE (decl) == VAR_DECL
+		 || TREE_CODE (decl) == PARM_DECL)
+	&& GFC_DECL_SUBREF_ARRAY_P (decl)
+	&& !integer_zerop (GFC_DECL_SPAN(decl)))
+    {
+      offset = fold_build2_loc (input_location, MULT_EXPR,
+				gfc_array_index_type,
+				offset, GFC_DECL_SPAN(decl));
+      tmp = gfc_build_addr_expr (pvoid_type_node, base);
+      tmp = fold_build2_loc (input_location, POINTER_PLUS_EXPR,
+			     pvoid_type_node, tmp,
+			     fold_convert (sizetype, offset));
+      tmp = fold_convert (build_pointer_type (type), tmp);
+      if (!TYPE_STRING_FLAG (type))
+	tmp = build_fold_indirect_ref_loc (input_location, tmp);
+      return tmp;
+    }
+  else
+    /* Otherwise use a straightforward array reference.  */
+    return build4_loc (input_location, ARRAY_REF, type, base, offset,
+		       NULL_TREE, NULL_TREE);
+}
+
+
+/* Generate a call to print a runtime error possibly including multiple
+   arguments and a locus.  */
+
+static tree
+trans_runtime_error_vararg (bool error, locus* where, const char* msgid,
+			    va_list ap)
+{
+  stmtblock_t block;
+  tree tmp;
+  tree arg, arg2;
+  tree *argarray;
+  tree fntype;
+  char *message;
+  const char *p;
+  int line, nargs, i;
+  location_t loc;
+
+  /* Compute the number of extra arguments from the format string.  */
+  for (p = msgid, nargs = 0; *p; p++)
+    if (*p == '%')
+      {
+	p++;
+	if (*p != '%')
+	  nargs++;
+      }
+
+  /* The code to generate the error.  */
+  gfc_start_block (&block);
+
+  if (where)
+    {
+      line = LOCATION_LINE (where->lb->location);
+      asprintf (&message, "At line %d of file %s",  line,
+		where->lb->file->filename);
+    }
+  else
+    asprintf (&message, "In file '%s', around line %d",
+	      gfc_source_file, input_line + 1);
+
+  arg = gfc_build_addr_expr (pchar_type_node,
+			     gfc_build_localized_cstring_const (message));
+  gfc_free(message);
+  
+  asprintf (&message, "%s", _(msgid));
+  arg2 = gfc_build_addr_expr (pchar_type_node,
+			      gfc_build_localized_cstring_const (message));
+  gfc_free(message);
+
+  /* Build the argument array.  */
+  argarray = XALLOCAVEC (tree, nargs + 2);
+  argarray[0] = arg;
+  argarray[1] = arg2;
+  for (i = 0; i < nargs; i++)
+    argarray[2 + i] = va_arg (ap, tree);
+  
+  /* Build the function call to runtime_(warning,error)_at; because of the
+     variable number of arguments, we can't use build_call_expr_loc dinput_location,
+     irectly.  */
+  if (error)
+    fntype = TREE_TYPE (gfor_fndecl_runtime_error_at);
+  else
+    fntype = TREE_TYPE (gfor_fndecl_runtime_warning_at);
+
+  loc = where ? where->lb->location : input_location;
+  tmp = fold_builtin_call_array (loc, TREE_TYPE (fntype),
+				 fold_build1_loc (loc, ADDR_EXPR,
+					     build_pointer_type (fntype),
+					     error
+					     ? gfor_fndecl_runtime_error_at
+					     : gfor_fndecl_runtime_warning_at),
+				 nargs + 2, argarray);
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
+
+
+tree
+gfc_trans_runtime_error (bool error, locus* where, const char* msgid, ...)
+{
+  va_list ap;
+  tree result;
+
+  va_start (ap, msgid);
+  result = trans_runtime_error_vararg (error, where, msgid, ap);
+  va_end (ap);
+  return result;
+}
+
+
+/* Generate a runtime error if COND is true.  */
+
+void
+gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
+			 locus * where, const char * msgid, ...)
+{
+  va_list ap;
+  stmtblock_t block;
+  tree body;
+  tree tmp;
+  tree tmpvar = NULL;
+
+  if (integer_zerop (cond))
+    return;
+
+  if (once)
+    {
+       tmpvar = gfc_create_var (boolean_type_node, "print_warning");
+       TREE_STATIC (tmpvar) = 1;
+       DECL_INITIAL (tmpvar) = boolean_true_node;
+       gfc_add_expr_to_block (pblock, tmpvar);
+    }
+
+  gfc_start_block (&block);
+
+  /* The code to generate the error.  */
+  va_start (ap, msgid);
+  gfc_add_expr_to_block (&block,
+			 trans_runtime_error_vararg (error, where,
+						     msgid, ap));
+
+  if (once)
+    gfc_add_modify (&block, tmpvar, boolean_false_node);
+
+  body = gfc_finish_block (&block);
+
+  if (integer_onep (cond))
+    {
+      gfc_add_expr_to_block (pblock, body);
+    }
+  else
+    {
+      /* Tell the compiler that this isn't likely.  */
+      if (once)
+	cond = fold_build2_loc (where->lb->location, TRUTH_AND_EXPR,
+				long_integer_type_node, tmpvar, cond);
+      else
+	cond = fold_convert (long_integer_type_node, cond);
+
+      tmp = build_int_cst (long_integer_type_node, 0);
+      cond = build_call_expr_loc (where->lb->location,
+			      built_in_decls[BUILT_IN_EXPECT], 2, cond, tmp);
+      cond = fold_convert (boolean_type_node, cond);
+
+      tmp = fold_build3_loc (where->lb->location, COND_EXPR, void_type_node,
+			     cond, body,
+			     build_empty_stmt (where->lb->location));
+      gfc_add_expr_to_block (pblock, tmp);
+    }
+}
+
+
+/* Call malloc to allocate size bytes of memory, with special conditions:
+      + if size == 0, return a malloced area of size 1,
+      + if malloc returns NULL, issue a runtime error.  */
+tree
+gfc_call_malloc (stmtblock_t * block, tree type, tree size)
+{
+  tree tmp, msg, malloc_result, null_result, res;
+  stmtblock_t block2;
+
+  size = gfc_evaluate_now (size, block);
+
+  if (TREE_TYPE (size) != TREE_TYPE (size_type_node))
+    size = fold_convert (size_type_node, size);
+
+  /* Create a variable to hold the result.  */
+  res = gfc_create_var (prvoid_type_node, NULL);
+
+  /* Call malloc.  */
+  gfc_start_block (&block2);
+
+  size = fold_build2_loc (input_location, MAX_EXPR, size_type_node, size,
+			  build_int_cst (size_type_node, 1));
+
+  gfc_add_modify (&block2, res,
+		  fold_convert (prvoid_type_node,
+				build_call_expr_loc (input_location,
+				   built_in_decls[BUILT_IN_MALLOC], 1, size)));
+
+  /* Optionally check whether malloc was successful.  */
+  if (gfc_option.rtcheck & GFC_RTCHECK_MEM)
+    {
+      null_result = fold_build2_loc (input_location, EQ_EXPR,
+				     boolean_type_node, res,
+				     build_int_cst (pvoid_type_node, 0));
+      msg = gfc_build_addr_expr (pchar_type_node,
+	      gfc_build_localized_cstring_const ("Memory allocation failed"));
+      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+			     null_result,
+	      build_call_expr_loc (input_location,
+				   gfor_fndecl_os_error, 1, msg),
+				   build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block2, tmp);
+    }
+
+  malloc_result = gfc_finish_block (&block2);
+
+  gfc_add_expr_to_block (block, malloc_result);
+
+  if (type != NULL)
+    res = fold_convert (type, res);
+  return res;
+}
+
+
+/* Allocate memory, using an optional status argument.
+ 
+   This function follows the following pseudo-code:
+
+    void *
+    allocate (size_t size, integer_type* stat)
+    {
+      void *newmem;
+    
+      if (stat)
+	*stat = 0;
+
+      newmem = malloc (MAX (size, 1));
+      if (newmem == NULL)
+      {
+        if (stat)
+          *stat = LIBERROR_ALLOCATION;
+        else
+	  runtime_error ("Allocation would exceed memory limit");
+      }
+      return newmem;
+    }  */
+tree
+gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
+{
+  stmtblock_t alloc_block;
+  tree res, tmp, msg, cond;
+  tree status_type = status ? TREE_TYPE (TREE_TYPE (status)) : NULL_TREE;
+
+  /* Evaluate size only once, and make sure it has the right type.  */
+  size = gfc_evaluate_now (size, block);
+  if (TREE_TYPE (size) != TREE_TYPE (size_type_node))
+    size = fold_convert (size_type_node, size);
+
+  /* Create a variable to hold the result.  */
+  res = gfc_create_var (prvoid_type_node, NULL);
+
+  /* Set the optional status variable to zero.  */
+  if (status != NULL_TREE && !integer_zerop (status))
+    {
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
+			     fold_build1_loc (input_location, INDIRECT_REF,
+					      status_type, status),
+			     build_int_cst (status_type, 0));
+      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+			     fold_build2_loc (input_location, NE_EXPR,
+					boolean_type_node, status,
+					build_int_cst (TREE_TYPE (status), 0)),
+			     tmp, build_empty_stmt (input_location));
+      gfc_add_expr_to_block (block, tmp);
+    }
+
+  /* The allocation itself.  */
+  gfc_start_block (&alloc_block);
+  gfc_add_modify (&alloc_block, res,
+		  fold_convert (prvoid_type_node,
+				build_call_expr_loc (input_location,
+				   built_in_decls[BUILT_IN_MALLOC], 1,
+					fold_build2_loc (input_location,
+					    MAX_EXPR, size_type_node, size,
+					    build_int_cst (size_type_node,
+							   1)))));
+
+  msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
+			     ("Allocation would exceed memory limit"));
+  tmp = build_call_expr_loc (input_location,
+			 gfor_fndecl_os_error, 1, msg);
+
+  if (status != NULL_TREE && !integer_zerop (status))
+    {
+      /* Set the status variable if it's present.  */
+      tree tmp2;
+
+      cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			      status, build_int_cst (TREE_TYPE (status), 0));
+      tmp2 = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
+			      fold_build1_loc (input_location, INDIRECT_REF,
+					       status_type, status),
+			      build_int_cst (status_type, LIBERROR_ALLOCATION));
+      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			     tmp, tmp2);
+    }
+
+  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+			 fold_build2_loc (input_location, EQ_EXPR,
+					  boolean_type_node, res,
+					  build_int_cst (prvoid_type_node, 0)),
+			 tmp, build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&alloc_block, tmp);
+  gfc_add_expr_to_block (block, gfc_finish_block (&alloc_block));
+
+  return res;
+}
+
+
+/* Generate code for an ALLOCATE statement when the argument is an
+   allocatable array.  If the array is currently allocated, it is an
+   error to allocate it again.
+ 
+   This function follows the following pseudo-code:
+  
+    void *
+    allocate_array (void *mem, size_t size, integer_type *stat)
+    {
+      if (mem == NULL)
+	return allocate (size, stat);
+      else
+      {
+	if (stat)
+	{
+	  free (mem);
+	  mem = allocate (size, stat);
+	  *stat = LIBERROR_ALLOCATION;
+	  return mem;
+	}
+	else
+	  runtime_error ("Attempting to allocate already allocated variable");
+      }
+    }
+    
+    expr must be set to the original expression being allocated for its locus
+    and variable name in case a runtime error has to be printed.  */
+tree
+gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size,
+				tree status, gfc_expr* expr)
+{
+  stmtblock_t alloc_block;
+  tree res, tmp, null_mem, alloc, error;
+  tree type = TREE_TYPE (mem);
+
+  if (TREE_TYPE (size) != TREE_TYPE (size_type_node))
+    size = fold_convert (size_type_node, size);
+
+  /* Create a variable to hold the result.  */
+  res = gfc_create_var (type, NULL);
+  null_mem = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, mem,
+			      build_int_cst (type, 0));
+
+  /* If mem is NULL, we call gfc_allocate_with_status.  */
+  gfc_start_block (&alloc_block);
+  tmp = gfc_allocate_with_status (&alloc_block, size, status);
+  gfc_add_modify (&alloc_block, res, fold_convert (type, tmp));
+  alloc = gfc_finish_block (&alloc_block);
+
+  /* Otherwise, we issue a runtime error or set the status variable.  */
+  if (expr)
+    {
+      tree varname;
+
+      gcc_assert (expr->expr_type == EXPR_VARIABLE && expr->symtree);
+      varname = gfc_build_cstring_const (expr->symtree->name);
+      varname = gfc_build_addr_expr (pchar_type_node, varname);
+
+      error = gfc_trans_runtime_error (true, &expr->where,
+				       "Attempting to allocate already"
+				       " allocated variable '%s'",
+				       varname);
+    }
+  else
+    error = gfc_trans_runtime_error (true, NULL,
+				     "Attempting to allocate already allocated"
+				     " variable");
+
+  if (status != NULL_TREE && !integer_zerop (status))
+    {
+      tree status_type = TREE_TYPE (TREE_TYPE (status));
+      stmtblock_t set_status_block;
+
+      gfc_start_block (&set_status_block);
+      tmp = build_call_expr_loc (input_location,
+			     built_in_decls[BUILT_IN_FREE], 1,
+			     fold_convert (pvoid_type_node, mem));
+      gfc_add_expr_to_block (&set_status_block, tmp);
+
+      tmp = gfc_allocate_with_status (&set_status_block, size, status);
+      gfc_add_modify (&set_status_block, res, fold_convert (type, tmp));
+
+      gfc_add_modify (&set_status_block,
+			   fold_build1_loc (input_location, INDIRECT_REF,
+					    status_type, status),
+			   build_int_cst (status_type, LIBERROR_ALLOCATION));
+
+      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+			     status, build_int_cst (status_type, 0));
+      error = fold_build3_loc (input_location, COND_EXPR, void_type_node, tmp,
+			       error, gfc_finish_block (&set_status_block));
+    }
+
+  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, null_mem,
+			 alloc, error);
+  gfc_add_expr_to_block (block, tmp);
+
+  return res;
+}
+
+
+/* Free a given variable, if it's not NULL.  */
+tree
+gfc_call_free (tree var)
+{
+  stmtblock_t block;
+  tree tmp, cond, call;
+
+  if (TREE_TYPE (var) != TREE_TYPE (pvoid_type_node))
+    var = fold_convert (pvoid_type_node, var);
+
+  gfc_start_block (&block);
+  var = gfc_evaluate_now (var, &block);
+  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, var,
+			  build_int_cst (pvoid_type_node, 0));
+  call = build_call_expr_loc (input_location,
+			      built_in_decls[BUILT_IN_FREE], 1, var);
+  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond, call,
+			 build_empty_stmt (input_location));
+  gfc_add_expr_to_block (&block, tmp);
+
+  return gfc_finish_block (&block);
+}
+
+
+
+/* User-deallocate; we emit the code directly from the front-end, and the
+   logic is the same as the previous library function:
+
+    void
+    deallocate (void *pointer, GFC_INTEGER_4 * stat)
+    {
+      if (!pointer)
+	{
+	  if (stat)
+	    *stat = 1;
+	  else
+	    runtime_error ("Attempt to DEALLOCATE unallocated memory.");
+	}
+      else
+	{
+	  free (pointer);
+	  if (stat)
+	    *stat = 0;
+	}
+    }
+
+   In this front-end version, status doesn't have to be GFC_INTEGER_4.
+   Moreover, if CAN_FAIL is true, then we will not emit a runtime error,
+   even when no status variable is passed to us (this is used for
+   unconditional deallocation generated by the front-end at end of
+   each procedure).
+   
+   If a runtime-message is possible, `expr' must point to the original
+   expression being deallocated for its locus and variable name.  */
+tree
+gfc_deallocate_with_status (tree pointer, tree status, bool can_fail,
+			    gfc_expr* expr)
+{
+  stmtblock_t null, non_null;
+  tree cond, tmp, error;
+
+  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer,
+			  build_int_cst (TREE_TYPE (pointer), 0));
+
+  /* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise
+     we emit a runtime error.  */
+  gfc_start_block (&null);
+  if (!can_fail)
+    {
+      tree varname;
+
+      gcc_assert (expr && expr->expr_type == EXPR_VARIABLE && expr->symtree);
+
+      varname = gfc_build_cstring_const (expr->symtree->name);
+      varname = gfc_build_addr_expr (pchar_type_node, varname);
+
+      error = gfc_trans_runtime_error (true, &expr->where,
+				       "Attempt to DEALLOCATE unallocated '%s'",
+				       varname);
+    }
+  else
+    error = build_empty_stmt (input_location);
+
+  if (status != NULL_TREE && !integer_zerop (status))
+    {
+      tree status_type = TREE_TYPE (TREE_TYPE (status));
+      tree cond2;
+
+      cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			       status, build_int_cst (TREE_TYPE (status), 0));
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
+			     fold_build1_loc (input_location, INDIRECT_REF,
+					      status_type, status),
+			     build_int_cst (status_type, 1));
+      error = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+			       cond2, tmp, error);
+    }
+
+  gfc_add_expr_to_block (&null, error);
+
+  /* When POINTER is not NULL, we free it.  */
+  gfc_start_block (&non_null);
+  tmp = build_call_expr_loc (input_location,
+			 built_in_decls[BUILT_IN_FREE], 1,
+			 fold_convert (pvoid_type_node, pointer));
+  gfc_add_expr_to_block (&non_null, tmp);
+
+  if (status != NULL_TREE && !integer_zerop (status))
+    {
+      /* We set STATUS to zero if it is present.  */
+      tree status_type = TREE_TYPE (TREE_TYPE (status));
+      tree cond2;
+
+      cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			       status, build_int_cst (TREE_TYPE (status), 0));
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
+			     fold_build1_loc (input_location, INDIRECT_REF,
+					      status_type, status),
+			     build_int_cst (status_type, 0));
+      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond2,
+			     tmp, build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&non_null, tmp);
+    }
+
+  return fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			  gfc_finish_block (&null),
+			  gfc_finish_block (&non_null));
+}
+
+
+/* Generate code for deallocation of allocatable scalars (variables or
+   components). Before the object itself is freed, any allocatable
+   subcomponents are being deallocated.  */
+
+tree
+gfc_deallocate_scalar_with_status (tree pointer, tree status, bool can_fail,
+				   gfc_expr* expr, gfc_typespec ts)
+{
+  stmtblock_t null, non_null;
+  tree cond, tmp, error;
+
+  cond = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, pointer,
+			  build_int_cst (TREE_TYPE (pointer), 0));
+
+  /* When POINTER is NULL, we set STATUS to 1 if it's present, otherwise
+     we emit a runtime error.  */
+  gfc_start_block (&null);
+  if (!can_fail)
+    {
+      tree varname;
+
+      gcc_assert (expr && expr->expr_type == EXPR_VARIABLE && expr->symtree);
+
+      varname = gfc_build_cstring_const (expr->symtree->name);
+      varname = gfc_build_addr_expr (pchar_type_node, varname);
+
+      error = gfc_trans_runtime_error (true, &expr->where,
+				       "Attempt to DEALLOCATE unallocated '%s'",
+				       varname);
+    }
+  else
+    error = build_empty_stmt (input_location);
+
+  if (status != NULL_TREE && !integer_zerop (status))
+    {
+      tree status_type = TREE_TYPE (TREE_TYPE (status));
+      tree cond2;
+
+      cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			       status, build_int_cst (TREE_TYPE (status), 0));
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
+			     fold_build1_loc (input_location, INDIRECT_REF,
+					      status_type, status),
+			     build_int_cst (status_type, 1));
+      error = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+			       cond2, tmp, error);
+    }
+
+  gfc_add_expr_to_block (&null, error);
+
+  /* When POINTER is not NULL, we free it.  */
+  gfc_start_block (&non_null);
+  
+  /* Free allocatable components.  */
+  if (ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp)
+    {
+      tmp = build_fold_indirect_ref_loc (input_location, pointer);
+      tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0);
+      gfc_add_expr_to_block (&non_null, tmp);
+    }
+  else if (ts.type == BT_CLASS
+	   && ts.u.derived->components->ts.u.derived->attr.alloc_comp)
+    {
+      tmp = build_fold_indirect_ref_loc (input_location, pointer);
+      tmp = gfc_deallocate_alloc_comp (ts.u.derived->components->ts.u.derived,
+				       tmp, 0);
+      gfc_add_expr_to_block (&non_null, tmp);
+    }
+  
+  tmp = build_call_expr_loc (input_location,
+			 built_in_decls[BUILT_IN_FREE], 1,
+			 fold_convert (pvoid_type_node, pointer));
+  gfc_add_expr_to_block (&non_null, tmp);
+
+  if (status != NULL_TREE && !integer_zerop (status))
+    {
+      /* We set STATUS to zero if it is present.  */
+      tree status_type = TREE_TYPE (TREE_TYPE (status));
+      tree cond2;
+
+      cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			       status, build_int_cst (TREE_TYPE (status), 0));
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type,
+			     fold_build1_loc (input_location, INDIRECT_REF,
+					      status_type, status),
+			     build_int_cst (status_type, 0));
+      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond2,
+			     tmp, build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&non_null, tmp);
+    }
+
+  return fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			  gfc_finish_block (&null),
+			  gfc_finish_block (&non_null));
+}
+
+
+/* Reallocate MEM so it has SIZE bytes of data.  This behaves like the
+   following pseudo-code:
+
+void *
+internal_realloc (void *mem, size_t size)
+{
+  res = realloc (mem, size);
+  if (!res && size != 0)
+    _gfortran_os_error ("Allocation would exceed memory limit");
+
+  return res;
+}  */
+tree
+gfc_call_realloc (stmtblock_t * block, tree mem, tree size)
+{
+  tree msg, res, nonzero, null_result, tmp;
+  tree type = TREE_TYPE (mem);
+
+  size = gfc_evaluate_now (size, block);
+
+  if (TREE_TYPE (size) != TREE_TYPE (size_type_node))
+    size = fold_convert (size_type_node, size);
+
+  /* Create a variable to hold the result.  */
+  res = gfc_create_var (type, NULL);
+
+  /* Call realloc and check the result.  */
+  tmp = build_call_expr_loc (input_location,
+			 built_in_decls[BUILT_IN_REALLOC], 2,
+			 fold_convert (pvoid_type_node, mem), size);
+  gfc_add_modify (block, res, fold_convert (type, tmp));
+  null_result = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+				 res, build_int_cst (pvoid_type_node, 0));
+  nonzero = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, size,
+			     build_int_cst (size_type_node, 0));
+  null_result = fold_build2_loc (input_location, TRUTH_AND_EXPR, boolean_type_node,
+				 null_result, nonzero);
+  msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
+			     ("Allocation would exceed memory limit"));
+  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+			 null_result,
+			 build_call_expr_loc (input_location,
+					      gfor_fndecl_os_error, 1, msg),
+			 build_empty_stmt (input_location));
+  gfc_add_expr_to_block (block, tmp);
+
+  return res;
+}
+
+
+/* Add an expression to another one, either at the front or the back.  */
+
+static void
+add_expr_to_chain (tree* chain, tree expr, bool front)
+{
+  if (expr == NULL_TREE || IS_EMPTY_STMT (expr))
+    return;
+
+  if (*chain)
+    {
+      if (TREE_CODE (*chain) != STATEMENT_LIST)
+	{
+	  tree tmp;
+
+	  tmp = *chain;
+	  *chain = NULL_TREE;
+	  append_to_statement_list (tmp, chain);
+	}
+
+      if (front)
+	{
+	  tree_stmt_iterator i;
+
+	  i = tsi_start (*chain);
+	  tsi_link_before (&i, expr, TSI_CONTINUE_LINKING);
+	}
+      else
+	append_to_statement_list (expr, chain);
+    }
+  else
+    *chain = expr;
+}
+
+
+/* Add a statement at the end of a block.  */
+
+void
+gfc_add_expr_to_block (stmtblock_t * block, tree expr)
+{
+  gcc_assert (block);
+  add_expr_to_chain (&block->head, expr, false);
+}
+
+
+/* Add a statement at the beginning of a block.  */
+
+void
+gfc_prepend_expr_to_block (stmtblock_t * block, tree expr)
+{
+  gcc_assert (block);
+  add_expr_to_chain (&block->head, expr, true);
+}
+
+
+/* Add a block the end of a block.  */
+
+void
+gfc_add_block_to_block (stmtblock_t * block, stmtblock_t * append)
+{
+  gcc_assert (append);
+  gcc_assert (!append->has_scope);
+
+  gfc_add_expr_to_block (block, append->head);
+  append->head = NULL_TREE;
+}
+
+
+/* Save the current locus.  The structure may not be complete, and should
+   only be used with gfc_restore_backend_locus.  */
+
+void
+gfc_save_backend_locus (locus * loc)
+{
+  loc->lb = XCNEW (gfc_linebuf);
+  loc->lb->location = input_location;
+  loc->lb->file = gfc_current_backend_file;
+}
+
+
+/* Set the current locus.  */
+
+void
+gfc_set_backend_locus (locus * loc)
+{
+  gfc_current_backend_file = loc->lb->file;
+  input_location = loc->lb->location;
+}
+
+
+/* Restore the saved locus. Only used in conjonction with
+   gfc_save_backend_locus, to free the memory when we are done.  */
+
+void
+gfc_restore_backend_locus (locus * loc)
+{
+  gfc_set_backend_locus (loc);
+  gfc_free (loc->lb);
+}
+
+
+/* Translate an executable statement. The tree cond is used by gfc_trans_do.
+   This static function is wrapped by gfc_trans_code_cond and
+   gfc_trans_code.  */
+
+static tree
+trans_code (gfc_code * code, tree cond)
+{
+  stmtblock_t block;
+  tree res;
+
+  if (!code)
+    return build_empty_stmt (input_location);
+
+  gfc_start_block (&block);
+
+  /* Translate statements one by one into GENERIC trees until we reach
+     the end of this gfc_code branch.  */
+  for (; code; code = code->next)
+    {
+      if (code->here != 0)
+	{
+	  res = gfc_trans_label_here (code);
+	  gfc_add_expr_to_block (&block, res);
+	}
+
+      gfc_set_backend_locus (&code->loc);
+
+      switch (code->op)
+	{
+	case EXEC_NOP:
+	case EXEC_END_BLOCK:
+	case EXEC_END_PROCEDURE:
+	  res = NULL_TREE;
+	  break;
+
+	case EXEC_ASSIGN:
+	  if (code->expr1->ts.type == BT_CLASS)
+	    res = gfc_trans_class_assign (code->expr1, code->expr2, code->op);
+	  else
+	    res = gfc_trans_assign (code);
+	  break;
+
+        case EXEC_LABEL_ASSIGN:
+          res = gfc_trans_label_assign (code);
+          break;
+
+	case EXEC_POINTER_ASSIGN:
+	  if (code->expr1->ts.type == BT_CLASS)
+	    res = gfc_trans_class_assign (code->expr1, code->expr2, code->op);
+	  else
+	    res = gfc_trans_pointer_assign (code);
+	  break;
+
+	case EXEC_INIT_ASSIGN:
+	  if (code->expr1->ts.type == BT_CLASS)
+	    res = gfc_trans_class_init_assign (code);
+	  else
+	    res = gfc_trans_init_assign (code);
+	  break;
+
+	case EXEC_CONTINUE:
+	  res = NULL_TREE;
+	  break;
+
+	case EXEC_CRITICAL:
+	  res = gfc_trans_critical (code);
+	  break;
+
+	case EXEC_CYCLE:
+	  res = gfc_trans_cycle (code);
+	  break;
+
+	case EXEC_EXIT:
+	  res = gfc_trans_exit (code);
+	  break;
+
+	case EXEC_GOTO:
+	  res = gfc_trans_goto (code);
+	  break;
+
+	case EXEC_ENTRY:
+	  res = gfc_trans_entry (code);
+	  break;
+
+	case EXEC_PAUSE:
+	  res = gfc_trans_pause (code);
+	  break;
+
+	case EXEC_STOP:
+	case EXEC_ERROR_STOP:
+	  res = gfc_trans_stop (code, code->op == EXEC_ERROR_STOP);
+	  break;
+
+	case EXEC_CALL:
+	  /* For MVBITS we've got the special exception that we need a
+	     dependency check, too.  */
+	  {
+	    bool is_mvbits = false;
+	    if (code->resolved_isym
+		&& code->resolved_isym->id == GFC_ISYM_MVBITS)
+	      is_mvbits = true;
+	    if (code->resolved_isym
+		&& code->resolved_isym->id == GFC_ISYM_MOVE_ALLOC)
+	      res = gfc_conv_intrinsic_move_alloc (code);
+	    else
+	      res = gfc_trans_call (code, is_mvbits, NULL_TREE,
+				    NULL_TREE, false);
+	  }
+	  break;
+
+	case EXEC_CALL_PPC:
+	  res = gfc_trans_call (code, false, NULL_TREE,
+				NULL_TREE, false);
+	  break;
+
+	case EXEC_ASSIGN_CALL:
+	  res = gfc_trans_call (code, true, NULL_TREE,
+				NULL_TREE, false);
+	  break;
+
+	case EXEC_RETURN:
+	  res = gfc_trans_return (code);
+	  break;
+
+	case EXEC_IF:
+	  res = gfc_trans_if (code);
+	  break;
+
+	case EXEC_ARITHMETIC_IF:
+	  res = gfc_trans_arithmetic_if (code);
+	  break;
+
+	case EXEC_BLOCK:
+	  res = gfc_trans_block_construct (code);
+	  break;
+
+	case EXEC_DO:
+	  res = gfc_trans_do (code, cond);
+	  break;
+
+	case EXEC_DO_WHILE:
+	  res = gfc_trans_do_while (code);
+	  break;
+
+	case EXEC_SELECT:
+	  res = gfc_trans_select (code);
+	  break;
+
+	case EXEC_SELECT_TYPE:
+	  /* Do nothing. SELECT TYPE statements should be transformed into
+	  an ordinary SELECT CASE at resolution stage.
+	  TODO: Add an error message here once this is done.  */
+	  res = NULL_TREE;
+	  break;
+
+	case EXEC_FLUSH:
+	  res = gfc_trans_flush (code);
+	  break;
+
+	case EXEC_SYNC_ALL:
+	case EXEC_SYNC_IMAGES:
+	case EXEC_SYNC_MEMORY:
+	  res = gfc_trans_sync (code, code->op);
+	  break;
+
+	case EXEC_FORALL:
+	  res = gfc_trans_forall (code);
+	  break;
+
+	case EXEC_WHERE:
+	  res = gfc_trans_where (code);
+	  break;
+
+	case EXEC_ALLOCATE:
+	  res = gfc_trans_allocate (code);
+	  break;
+
+	case EXEC_DEALLOCATE:
+	  res = gfc_trans_deallocate (code);
+	  break;
+
+	case EXEC_OPEN:
+	  res = gfc_trans_open (code);
+	  break;
+
+	case EXEC_CLOSE:
+	  res = gfc_trans_close (code);
+	  break;
+
+	case EXEC_READ:
+	  res = gfc_trans_read (code);
+	  break;
+
+	case EXEC_WRITE:
+	  res = gfc_trans_write (code);
+	  break;
+
+	case EXEC_IOLENGTH:
+	  res = gfc_trans_iolength (code);
+	  break;
+
+	case EXEC_BACKSPACE:
+	  res = gfc_trans_backspace (code);
+	  break;
+
+	case EXEC_ENDFILE:
+	  res = gfc_trans_endfile (code);
+	  break;
+
+	case EXEC_INQUIRE:
+	  res = gfc_trans_inquire (code);
+	  break;
+
+	case EXEC_WAIT:
+	  res = gfc_trans_wait (code);
+	  break;
+
+	case EXEC_REWIND:
+	  res = gfc_trans_rewind (code);
+	  break;
+
+	case EXEC_TRANSFER:
+	  res = gfc_trans_transfer (code);
+	  break;
+
+	case EXEC_DT_END:
+	  res = gfc_trans_dt_end (code);
+	  break;
+
+	case EXEC_OMP_ATOMIC:
+	case EXEC_OMP_BARRIER:
+	case EXEC_OMP_CRITICAL:
+	case EXEC_OMP_DO:
+	case EXEC_OMP_FLUSH:
+	case EXEC_OMP_MASTER:
+	case EXEC_OMP_ORDERED:
+	case EXEC_OMP_PARALLEL:
+	case EXEC_OMP_PARALLEL_DO:
+	case EXEC_OMP_PARALLEL_SECTIONS:
+	case EXEC_OMP_PARALLEL_WORKSHARE:
+	case EXEC_OMP_SECTIONS:
+	case EXEC_OMP_SINGLE:
+	case EXEC_OMP_TASK:
+	case EXEC_OMP_TASKWAIT:
+	case EXEC_OMP_WORKSHARE:
+	  res = gfc_trans_omp_directive (code);
+	  break;
+
+	default:
+	  internal_error ("gfc_trans_code(): Bad statement code");
+	}
+
+      gfc_set_backend_locus (&code->loc);
+
+      if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
+	{
+	  if (TREE_CODE (res) != STATEMENT_LIST)
+	    SET_EXPR_LOCATION (res, input_location);
+	    
+	  /* Add the new statement to the block.  */
+	  gfc_add_expr_to_block (&block, res);
+	}
+    }
+
+  /* Return the finished block.  */
+  return gfc_finish_block (&block);
+}
+
+
+/* Translate an executable statement with condition, cond.  The condition is
+   used by gfc_trans_do to test for IO result conditions inside implied
+   DO loops of READ and WRITE statements.  See build_dt in trans-io.c.  */
+
+tree
+gfc_trans_code_cond (gfc_code * code, tree cond)
+{
+  return trans_code (code, cond);
+}
+
+/* Translate an executable statement without condition.  */
+
+tree
+gfc_trans_code (gfc_code * code)
+{
+  return trans_code (code, NULL_TREE);
+}
+
+
+/* This function is called after a complete program unit has been parsed
+   and resolved.  */
+
+void
+gfc_generate_code (gfc_namespace * ns)
+{
+  ompws_flags = 0;
+  if (ns->is_block_data)
+    {
+      gfc_generate_block_data (ns);
+      return;
+    }
+
+  gfc_generate_function_code (ns);
+}
+
+
+/* This function is called after a complete module has been parsed
+   and resolved.  */
+
+void
+gfc_generate_module_code (gfc_namespace * ns)
+{
+  gfc_namespace *n;
+  struct module_htab_entry *entry;
+
+  gcc_assert (ns->proc_name->backend_decl == NULL);
+  ns->proc_name->backend_decl
+    = build_decl (ns->proc_name->declared_at.lb->location,
+		  NAMESPACE_DECL, get_identifier (ns->proc_name->name),
+		  void_type_node);
+  entry = gfc_find_module (ns->proc_name->name);
+  if (entry->namespace_decl)
+    /* Buggy sourcecode, using a module before defining it?  */
+    htab_empty (entry->decls);
+  entry->namespace_decl = ns->proc_name->backend_decl;
+
+  gfc_generate_module_vars (ns);
+
+  /* We need to generate all module function prototypes first, to allow
+     sibling calls.  */
+  for (n = ns->contained; n; n = n->sibling)
+    {
+      gfc_entry_list *el;
+
+      if (!n->proc_name)
+        continue;
+
+      gfc_create_function_decl (n, false);
+      DECL_CONTEXT (n->proc_name->backend_decl) = ns->proc_name->backend_decl;
+      gfc_module_add_decl (entry, n->proc_name->backend_decl);
+      for (el = ns->entries; el; el = el->next)
+	{
+	  DECL_CONTEXT (el->sym->backend_decl) = ns->proc_name->backend_decl;
+	  gfc_module_add_decl (entry, el->sym->backend_decl);
+	}
+    }
+
+  for (n = ns->contained; n; n = n->sibling)
+    {
+      if (!n->proc_name)
+        continue;
+
+      gfc_generate_function_code (n);
+    }
+}
+
+
+/* Initialize an init/cleanup block with existing code.  */
+
+void
+gfc_start_wrapped_block (gfc_wrapped_block* block, tree code)
+{
+  gcc_assert (block);
+
+  block->init = NULL_TREE;
+  block->code = code;
+  block->cleanup = NULL_TREE;
+}
+
+
+/* Add a new pair of initializers/clean-up code.  */
+
+void
+gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup)
+{
+  gcc_assert (block);
+
+  /* The new pair of init/cleanup should be "wrapped around" the existing
+     block of code, thus the initialization is added to the front and the
+     cleanup to the back.  */
+  add_expr_to_chain (&block->init, init, true);
+  add_expr_to_chain (&block->cleanup, cleanup, false);
+}
+
+
+/* Finish up a wrapped block by building a corresponding try-finally expr.  */
+
+tree
+gfc_finish_wrapped_block (gfc_wrapped_block* block)
+{
+  tree result;
+
+  gcc_assert (block);
+
+  /* Build the final expression.  For this, just add init and body together,
+     and put clean-up with that into a TRY_FINALLY_EXPR.  */
+  result = block->init;
+  add_expr_to_chain (&result, block->code, false);
+  if (block->cleanup)
+    result = build2_loc (input_location, TRY_FINALLY_EXPR, void_type_node,
+			 result, block->cleanup);
+  
+  /* Clear the block.  */
+  block->init = NULL_TREE;
+  block->code = NULL_TREE;
+  block->cleanup = NULL_TREE;
+
+  return result;
+}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
new file mode 100644
index 000000000..1536f2e80
--- /dev/null
+++ b/gcc/fortran/trans.h
@@ -0,0 +1,859 @@
+/* Header for code translation functions
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Free Software Foundation, Inc.
+   Contributed by Paul Brook
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#ifndef GFC_TRANS_H
+#define GFC_TRANS_H
+
+/* Mangled symbols take the form __module__name.  */
+#define GFC_MAX_MANGLED_SYMBOL_LEN  (GFC_MAX_SYMBOL_LEN*2+4)
+
+/* Struct for holding a block of statements.  It should be treated as an
+   opaque entity and not modified directly.  This allows us to change the
+   underlying representation of statement lists.  */
+typedef struct
+{
+  tree head;
+  unsigned int has_scope:1;
+}
+stmtblock_t;
+
+/* a simplified expression */
+typedef struct gfc_se
+{
+  /* Code blocks to be executed before and after using the value.  */
+  stmtblock_t pre;
+  stmtblock_t post;
+
+  /* the result of the expression */
+  tree expr;
+
+  /* The length of a character string value.  */
+  tree string_length;
+
+  /* If set gfc_conv_variable will return an expression for the array
+     descriptor. When set, want_pointer should also be set.
+     If not set scalarizing variables will be substituted.  */
+  unsigned descriptor_only:1;
+
+  /* When this is set gfc_conv_expr returns the address of a variable.  Only
+     applies to EXPR_VARIABLE nodes.
+     Also used by gfc_conv_array_parameter. When set this indicates a pointer
+     to the descriptor should be returned, rather than the descriptor itself.
+   */
+  unsigned want_pointer:1;
+
+  /* An array function call returning without a temporary.  Also used for array
+     pointer assignments.  */
+  unsigned direct_byref:1;
+
+  /* If direct_byref is set, do work out the descriptor as in that case but
+     do still create a new descriptor variable instead of using an
+     existing one.  This is useful for special pointer assignments like
+     rank remapping where we have to process the descriptor before
+     assigning to final one.  */
+  unsigned byref_noassign:1;
+
+  /* Ignore absent optional arguments.  Used for some intrinsics.  */
+  unsigned ignore_optional:1;
+
+  /* When this is set the data and offset fields of the returned descriptor
+     are NULL.  Used by intrinsic size.  */
+  unsigned data_not_needed:1;
+
+  /* If set, gfc_conv_procedure_call does not put byref calls into se->pre.  */
+  unsigned no_function_call:1;
+
+  /* If set, we will force the creation of a temporary. Useful to disable
+     non-copying procedure argument passing optimizations, when some function
+     args alias.  */
+  unsigned force_tmp:1;
+
+  /* Scalarization parameters.  */
+  struct gfc_se *parent;
+  struct gfc_ss *ss;
+  struct gfc_loopinfo *loop;
+}
+gfc_se;
+
+
+/* Scalarization State chain.  Created by walking an expression tree before
+   creating the scalarization loops. Then passed as part of a gfc_se structure
+   to translate the expression inside the loop.  Note that these chains are
+   terminated by gfc_se_terminator, not NULL.  A NULL pointer in a gfc_se
+   indicates to gfc_conv_* that this is a scalar expression.
+   Note that some member arrays correspond to scalarizer rank and others
+   are the variable rank.  */
+
+typedef struct gfc_ss_info
+{
+  int dimen;
+  /* The ref that holds information on this section.  */
+  gfc_ref *ref;
+  /* The descriptor of this array.  */
+  tree descriptor;
+  /* holds the pointer to the data array.  */
+  tree data;
+  /* To move some of the array index calculation out of the innermost loop.  */
+  tree offset;
+  tree saved_offset;
+  tree stride0;
+  /* Holds the SS for a subscript.  Indexed by actual dimension.  */
+  struct gfc_ss *subscript[GFC_MAX_DIMENSIONS];
+
+  /* stride and delta are used to access this inside a scalarization loop.
+     start is used in the calculation of these.  Indexed by scalarizer
+     dimension.  */
+  tree start[GFC_MAX_DIMENSIONS];
+  tree end[GFC_MAX_DIMENSIONS];
+  tree stride[GFC_MAX_DIMENSIONS];
+  tree delta[GFC_MAX_DIMENSIONS];
+
+  /* Translation from loop dimensions to actual dimensions.
+     actual_dim = dim[loop_dim]  */
+  int dim[GFC_MAX_DIMENSIONS];
+}
+gfc_ss_info;
+
+typedef enum
+{
+  /* A scalar value.  This will be evaluated before entering the
+     scalarization loop.  */
+  GFC_SS_SCALAR,
+
+  /* Like GFC_SS_SCALAR it evaluates the expression outside the
+     loop. Is always evaluated as a reference to the temporary.
+     Used for elemental function arguments.  */
+  GFC_SS_REFERENCE,
+
+  /* An array section.  Scalarization indices will be substituted during
+     expression translation.  */
+  GFC_SS_SECTION,
+
+  /* A non-elemental function call returning an array.  The call is executed
+     before entering the scalarization loop, storing the result in a
+     temporary.  This temporary is then used inside the scalarization loop.
+     Simple assignments, e.g. a(:) = fn(), are handled without a temporary
+     as a special case.  */
+  GFC_SS_FUNCTION,
+
+  /* An array constructor.  The current implementation is sub-optimal in
+     many cases.  It allocated a temporary, assigns the values to it, then
+     uses this temporary inside the scalarization loop.  */
+  GFC_SS_CONSTRUCTOR,
+
+  /* A vector subscript.  The vector's descriptor is cached in the
+     "descriptor" field of the associated gfc_ss_info.  */
+  GFC_SS_VECTOR,
+
+  /* A temporary array allocated by the scalarizer.  Its rank can be less
+     than that of the assignment expression.  */
+  GFC_SS_TEMP,
+
+  /* An intrinsic function call.  Many intrinsic functions which map directly
+     to library calls are created as GFC_SS_FUNCTION nodes.  */
+  GFC_SS_INTRINSIC,
+  
+  /* A component of a derived type.  */
+  GFC_SS_COMPONENT
+}
+gfc_ss_type;
+
+/* SS structures can only belong to a single loopinfo.  They must be added
+   otherwise they will not get freed.  */
+typedef struct gfc_ss
+{
+  gfc_ss_type type;
+  gfc_expr *expr;
+  mpz_t *shape;
+  tree string_length;
+  union
+  {
+    /* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE.  */
+    struct
+    {
+      tree expr;
+    }
+    scalar;
+
+    /* GFC_SS_TEMP.  */
+    struct
+    {
+      /* The rank of the temporary.  May be less than the rank of the
+         assigned expression.  */
+      int dimen;
+      tree type;
+    }
+    temp;
+    /* All other types.  */
+    gfc_ss_info info;
+  }
+  data;
+
+  /* All the SS in a loop and linked through loop_chain.  The SS for an
+     expression are linked by the next pointer.  */
+  struct gfc_ss *loop_chain;
+  struct gfc_ss *next;
+
+  /* This is used by assignments requiring temporaries. The bits specify which
+     loops the terms appear in.  This will be 1 for the RHS expressions,
+     2 for the LHS expressions, and 3(=1|2) for the temporary.  The bit
+     'where' suppresses precalculation of scalars in WHERE assignments.  */
+  unsigned useflags:2, where:1, is_alloc_lhs:1;
+}
+gfc_ss;
+#define gfc_get_ss() XCNEW (gfc_ss)
+
+/* The contents of this aren't actually used.  A NULL SS chain indicates a
+   scalar expression, so this pointer is used to terminate SS chains.  */
+extern gfc_ss * const gfc_ss_terminator;
+
+/* Holds information about an expression while it is being scalarized.  */
+typedef struct gfc_loopinfo
+{
+  stmtblock_t pre;
+  stmtblock_t post;
+
+  int dimen;
+
+  /* All the SS involved with this loop.  */
+  gfc_ss *ss;
+  /* The SS describing the temporary used in an assignment.  */
+  gfc_ss *temp_ss;
+
+  /* The scalarization loop index variables.  */
+  tree loopvar[GFC_MAX_DIMENSIONS];
+
+  /* The bounds of the scalarization loops.  */
+  tree from[GFC_MAX_DIMENSIONS];
+  tree to[GFC_MAX_DIMENSIONS];
+  gfc_ss *specloop[GFC_MAX_DIMENSIONS];
+
+  /* The code member contains the code for the body of the next outer loop.  */
+  stmtblock_t code[GFC_MAX_DIMENSIONS];
+
+  /* Order in which the dimensions should be looped, innermost first.  */
+  int order[GFC_MAX_DIMENSIONS];
+
+  /* Enum to control loop reversal.  */
+  gfc_reverse reverse[GFC_MAX_DIMENSIONS];
+
+  /* The number of dimensions for which a temporary is used.  */
+  int temp_dim;
+
+  /* If set we don't need the loop variables.  */
+  unsigned array_parameter:1;
+}
+gfc_loopinfo;
+
+
+/* Information about a symbol that has been shadowed by a temporary.  */
+typedef struct
+{
+  symbol_attribute attr;
+  tree decl;
+}
+gfc_saved_var;
+
+
+/* Store information about a block of code together with special
+   initialization and clean-up code.  This can be used to incrementally add
+   init and cleanup, and in the end put everything together to a
+   try-finally expression.  */
+typedef struct
+{
+  tree init;
+  tree cleanup;
+  tree code;
+}
+gfc_wrapped_block;
+
+
+/* Initialize an init/cleanup block.  */
+void gfc_start_wrapped_block (gfc_wrapped_block* block, tree code);
+/* Add a pair of init/cleanup code to the block.  Each one might be a
+   NULL_TREE if not required.  */
+void gfc_add_init_cleanup (gfc_wrapped_block* block, tree init, tree cleanup);
+/* Finalize the block, that is, create a single expression encapsulating the
+   original code together with init and clean-up code.  */
+tree gfc_finish_wrapped_block (gfc_wrapped_block* block);
+
+
+/* Advance the SS chain to the next term.  */
+void gfc_advance_se_ss_chain (gfc_se *);
+
+/* Call this to initialize a gfc_se structure before use
+   first parameter is structure to initialize, second is
+   parent to get scalarization data from, or NULL.  */
+void gfc_init_se (gfc_se *, gfc_se *);
+
+/* Create an artificial variable decl and add it to the current scope.  */
+tree gfc_create_var (tree, const char *);
+/* Like above but doesn't add it to the current scope.  */
+tree gfc_create_var_np (tree, const char *);
+
+/* Store the result of an expression in a temp variable so it can be used
+   repeatedly even if the original changes */
+void gfc_make_safe_expr (gfc_se * se);
+
+/* Makes sure se is suitable for passing as a function string parameter.  */
+void gfc_conv_string_parameter (gfc_se * se);
+
+/* Compare two strings.  */
+tree gfc_build_compare_string (tree, tree, tree, tree, int, enum tree_code);
+
+/* Add an item to the end of TREE_LIST.  */
+tree gfc_chainon_list (tree, tree);
+
+/* When using the gfc_conv_* make sure you understand what they do, i.e.
+   when a POST chain may be created, and what the returned expression may be
+   used for.  Note that character strings have special handling.  This
+   should not be a problem as most statements/operations only deal with
+   numeric/logical types.  See the implementations in trans-expr.c
+   for details of the individual functions.  */
+
+void gfc_conv_expr (gfc_se * se, gfc_expr * expr);
+void gfc_conv_expr_val (gfc_se * se, gfc_expr * expr);
+void gfc_conv_expr_lhs (gfc_se * se, gfc_expr * expr);
+void gfc_conv_expr_reference (gfc_se * se, gfc_expr *);
+void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree);
+
+/* trans-expr.c */
+void gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr);
+tree gfc_string_to_single_character (tree len, tree str, int kind);
+
+/* Find the decl containing the auxiliary variables for assigned variables.  */
+void gfc_conv_label_variable (gfc_se * se, gfc_expr * expr);
+/* If the value is not constant, Create a temporary and copy the value.  */
+tree gfc_evaluate_now_loc (location_t, tree, stmtblock_t *);
+tree gfc_evaluate_now (tree, stmtblock_t *);
+
+/* Find the appropriate variant of a math intrinsic.  */
+tree gfc_builtin_decl_for_float_kind (enum built_in_function, int);
+
+/* Intrinsic function handling.  */
+void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *);
+
+/* Is the intrinsic expanded inline.  */
+bool gfc_inline_intrinsic_function_p (gfc_expr *);
+
+/* Does an intrinsic map directly to an external library call
+   This is true for array-returning intrinsics, unless
+   gfc_inline_intrinsic_function_p returns true.  */
+int gfc_is_intrinsic_libcall (gfc_expr *);
+
+tree gfc_conv_intrinsic_move_alloc (gfc_code *);
+
+/* Used to call ordinary functions/subroutines
+   and procedure pointer components.  */
+int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *,
+			     gfc_expr *, VEC(tree,gc) *);
+
+void gfc_conv_subref_array_arg (gfc_se *, gfc_expr *, int, sym_intent, bool);
+
+/* gfc_trans_* shouldn't call push/poplevel, use gfc_push/pop_scope */
+
+/* Generate code for a scalar assignment.  */
+tree gfc_trans_scalar_assign (gfc_se *, gfc_se *, gfc_typespec, bool, bool,
+			      bool);
+
+/* Translate COMMON blocks.  */
+void gfc_trans_common (gfc_namespace *);
+
+/* Translate a derived type constructor.  */
+void gfc_conv_structure (gfc_se *, gfc_expr *, int);
+
+/* Return an expression which determines if a dummy parameter is present.  */
+tree gfc_conv_expr_present (gfc_symbol *);
+/* Convert a missing, dummy argument into a null or zero.  */
+void gfc_conv_missing_dummy (gfc_se *, gfc_expr *, gfc_typespec, int);
+
+/* Generate code to allocate a string temporary.  */
+tree gfc_conv_string_tmp (gfc_se *, tree, tree);
+/* Get the string length variable belonging to an expression.  */
+tree gfc_get_expr_charlen (gfc_expr *);
+/* Initialize a string length variable.  */
+void gfc_conv_string_length (gfc_charlen *, gfc_expr *, stmtblock_t *);
+/* Ensure type sizes can be gimplified.  */
+void gfc_trans_vla_type_sizes (gfc_symbol *, stmtblock_t *);
+
+/* Add an expression to the end of a block.  */
+void gfc_add_expr_to_block (stmtblock_t *, tree);
+/* Add an expression to the beginning of a block.  */
+void gfc_prepend_expr_to_block (stmtblock_t *, tree);
+/* Add a block to the end of a block.  */
+void gfc_add_block_to_block (stmtblock_t *, stmtblock_t *);
+/* Add a MODIFY_EXPR to a block.  */
+void gfc_add_modify_loc (location_t, stmtblock_t *, tree, tree);
+void gfc_add_modify (stmtblock_t *, tree, tree);
+
+/* Initialize a statement block.  */
+void gfc_init_block (stmtblock_t *);
+/* Start a new statement block.  Like gfc_init_block but also starts a new
+   variable scope.  */
+void gfc_start_block (stmtblock_t *);
+/* Finish a statement block.  Also closes the scope if the block was created
+   with gfc_start_block.  */
+tree gfc_finish_block (stmtblock_t *);
+/* Merge the scope of a block with its parent.  */
+void gfc_merge_block_scope (stmtblock_t * block);
+
+/* Return the backend label decl.  */
+tree gfc_get_label_decl (gfc_st_label *);
+
+/* Return the decl for an external function.  */
+tree gfc_get_extern_function_decl (gfc_symbol *);
+
+/* Return the decl for a function.  */
+tree gfc_get_function_decl (gfc_symbol *);
+
+/* Build an ADDR_EXPR.  */
+tree gfc_build_addr_expr (tree, tree);
+
+/* Build an ARRAY_REF.  */
+tree gfc_build_array_ref (tree, tree, tree);
+
+/* Creates a label.  Decl is artificial if label_id == NULL_TREE.  */
+tree gfc_build_label_decl (tree);
+
+/* Return the decl used to hold the function return value.
+   Do not use if the function has an explicit result variable.  */
+tree gfc_get_fake_result_decl (gfc_symbol *, int);
+
+/* Add a decl to the binding level for the current function.  */
+void gfc_add_decl_to_function (tree);
+
+/* Make prototypes for runtime library functions.  */
+void gfc_build_builtin_function_decls (void);
+
+/* Set the backend source location of a decl.  */
+void gfc_set_decl_location (tree, locus *);
+
+/* Get a module symbol backend_decl if possible.  */
+bool gfc_get_module_backend_decl (gfc_symbol *);
+
+/* Return the variable decl for a symbol.  */
+tree gfc_get_symbol_decl (gfc_symbol *);
+
+/* Build a static initializer.  */
+tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool, bool);
+
+/* Assign a default initializer to a derived type.  */
+void gfc_init_default_dt (gfc_symbol *, stmtblock_t *, bool);
+
+/* Substitute a temporary variable in place of the real one.  */
+void gfc_shadow_sym (gfc_symbol *, tree, gfc_saved_var *);
+
+/* Restore the original variable.  */
+void gfc_restore_sym (gfc_symbol *, gfc_saved_var *);
+
+/* Setting a decl assembler name, mangling it according to target rules
+   (like Windows @NN decorations).  */
+void gfc_set_decl_assembler_name (tree, tree);
+
+/* Returns true if a variable of specified size should go on the stack.  */
+int gfc_can_put_var_on_stack (tree);
+
+/* Allocate the lang-specific part of a decl node.  */
+void gfc_allocate_lang_decl (tree);
+
+/* Advance along a TREE_CHAIN.  */
+tree gfc_advance_chain (tree, int);
+
+/* Create a decl for a function.  */
+void gfc_create_function_decl (gfc_namespace *, bool);
+/* Generate the code for a function.  */
+void gfc_generate_function_code (gfc_namespace *);
+/* Output a BLOCK DATA program unit.  */
+void gfc_generate_block_data (gfc_namespace *);
+/* Output a decl for a module variable.  */
+void gfc_generate_module_vars (gfc_namespace *);
+/* Get the appropriate return statement for a procedure.  */
+tree gfc_generate_return (void);
+
+struct GTY(()) module_htab_entry {
+  const char *name;
+  tree namespace_decl;
+  htab_t GTY ((param_is (union tree_node))) decls;
+};
+
+struct module_htab_entry *gfc_find_module (const char *);
+void gfc_module_add_decl (struct module_htab_entry *, tree);
+
+/* Get and set the current location.  */
+void gfc_save_backend_locus (locus *);
+void gfc_set_backend_locus (locus *);
+void gfc_restore_backend_locus (locus *);
+
+/* Handle static constructor functions.  */
+extern GTY(()) tree gfc_static_ctors;
+void gfc_generate_constructors (void);
+
+/* Get the string length of an array constructor.  */
+bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor_base, tree *);
+
+/* Generate a runtime error call.  */
+tree gfc_trans_runtime_error (bool, locus*, const char*, ...);
+
+/* Generate a runtime warning/error check.  */
+void gfc_trans_runtime_check (bool, bool, tree, stmtblock_t *, locus *,
+			      const char *, ...);
+
+/* Generate a runtime check for same string length.  */
+void gfc_trans_same_strlen_check (const char*, locus*, tree, tree,
+				  stmtblock_t*);
+
+/* Generate a call to free() after checking that its arg is non-NULL.  */
+tree gfc_call_free (tree);
+
+/* Allocate memory after performing a few checks.  */
+tree gfc_call_malloc (stmtblock_t *, tree, tree);
+
+/* Build a memcpy call.  */
+tree gfc_build_memcpy_call (tree, tree, tree);
+
+/* Allocate memory for arrays, with optional status variable.  */
+tree gfc_allocate_array_with_status (stmtblock_t*, tree, tree, tree, gfc_expr*);
+
+/* Allocate memory, with optional status variable.  */
+tree gfc_allocate_with_status (stmtblock_t *, tree, tree);
+
+/* Generate code to deallocate an array.  */
+tree gfc_deallocate_with_status (tree, tree, bool, gfc_expr*);
+tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespec);
+
+/* Generate code to call realloc().  */
+tree gfc_call_realloc (stmtblock_t *, tree, tree);
+
+/* Generate code for an assignment, includes scalarization.  */
+tree gfc_trans_assignment (gfc_expr *, gfc_expr *, bool, bool);
+
+/* Generate code for a pointer assignment.  */
+tree gfc_trans_pointer_assignment (gfc_expr *, gfc_expr *);
+
+/* Initialize function decls for library functions.  */
+void gfc_build_intrinsic_lib_fndecls (void);
+/* Create function decls for IO library functions.  */
+void gfc_trans_io_runtime_check (tree, tree, int, const char *, stmtblock_t *);
+void gfc_build_io_library_fndecls (void);
+/* Build a function decl for a library function.  */
+tree gfc_build_library_function_decl (tree, tree, int, ...);
+tree gfc_build_library_function_decl_with_spec (tree name, const char *spec,
+						tree rettype, int nargs, ...);
+
+/* Process the local variable decls of a block construct.  */
+void gfc_process_block_locals (gfc_namespace*);
+
+/* Output initialization/clean-up code that was deferred.  */
+void gfc_trans_deferred_vars (gfc_symbol*, gfc_wrapped_block *);
+
+/* In f95-lang.c.  */
+tree pushdecl (tree);
+tree pushdecl_top_level (tree);
+void pushlevel (int);
+tree poplevel (int, int, int);
+tree getdecls (void);
+tree gfc_truthvalue_conversion (tree);
+tree gfc_builtin_function (tree);
+
+/* In trans-types.c.  */
+struct array_descr_info;
+bool gfc_get_array_descr_info (const_tree, struct array_descr_info *);
+
+/* In trans-openmp.c */
+bool gfc_omp_privatize_by_reference (const_tree);
+enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);
+tree gfc_omp_report_decl (tree);
+tree gfc_omp_clause_default_ctor (tree, tree, tree);
+tree gfc_omp_clause_copy_ctor (tree, tree, tree);
+tree gfc_omp_clause_assign_op (tree, tree, tree);
+tree gfc_omp_clause_dtor (tree, tree);
+bool gfc_omp_disregard_value_expr (tree, bool);
+bool gfc_omp_private_debug_clause (tree, bool);
+bool gfc_omp_private_outer_ref (tree);
+struct gimplify_omp_ctx;
+void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree);
+
+/* Runtime library function decls.  */
+extern GTY(()) tree gfor_fndecl_pause_numeric;
+extern GTY(()) tree gfor_fndecl_pause_string;
+extern GTY(()) tree gfor_fndecl_stop_numeric;
+extern GTY(()) tree gfor_fndecl_stop_numeric_f08;
+extern GTY(()) tree gfor_fndecl_stop_string;
+extern GTY(()) tree gfor_fndecl_error_stop_numeric;
+extern GTY(()) tree gfor_fndecl_error_stop_string;
+extern GTY(()) tree gfor_fndecl_runtime_error;
+extern GTY(()) tree gfor_fndecl_runtime_error_at;
+extern GTY(()) tree gfor_fndecl_runtime_warning_at;
+extern GTY(()) tree gfor_fndecl_os_error;
+extern GTY(()) tree gfor_fndecl_generate_error;
+extern GTY(()) tree gfor_fndecl_set_fpe;
+extern GTY(()) tree gfor_fndecl_set_options;
+extern GTY(()) tree gfor_fndecl_ttynam;
+extern GTY(()) tree gfor_fndecl_ctime;
+extern GTY(()) tree gfor_fndecl_fdate;
+extern GTY(()) tree gfor_fndecl_in_pack;
+extern GTY(()) tree gfor_fndecl_in_unpack;
+extern GTY(()) tree gfor_fndecl_associated;
+
+/* Math functions.  Many other math functions are handled in
+   trans-intrinsic.c.  */
+
+typedef struct GTY(()) gfc_powdecl_list {
+  tree integer;
+  tree real;
+  tree cmplx;
+}
+gfc_powdecl_list;
+
+extern GTY(()) gfc_powdecl_list gfor_fndecl_math_powi[4][3];
+extern GTY(()) tree gfor_fndecl_math_ishftc4;
+extern GTY(()) tree gfor_fndecl_math_ishftc8;
+extern GTY(()) tree gfor_fndecl_math_ishftc16;
+
+/* BLAS functions.  */
+extern GTY(()) tree gfor_fndecl_sgemm;
+extern GTY(()) tree gfor_fndecl_dgemm;
+extern GTY(()) tree gfor_fndecl_cgemm;
+extern GTY(()) tree gfor_fndecl_zgemm;
+
+/* String functions.  */
+extern GTY(()) tree gfor_fndecl_compare_string;
+extern GTY(()) tree gfor_fndecl_concat_string;
+extern GTY(()) tree gfor_fndecl_string_len_trim;
+extern GTY(()) tree gfor_fndecl_string_index;
+extern GTY(()) tree gfor_fndecl_string_scan;
+extern GTY(()) tree gfor_fndecl_string_verify;
+extern GTY(()) tree gfor_fndecl_string_trim;
+extern GTY(()) tree gfor_fndecl_string_minmax;
+extern GTY(()) tree gfor_fndecl_adjustl;
+extern GTY(()) tree gfor_fndecl_adjustr;
+extern GTY(()) tree gfor_fndecl_select_string;
+extern GTY(()) tree gfor_fndecl_compare_string_char4;
+extern GTY(()) tree gfor_fndecl_concat_string_char4;
+extern GTY(()) tree gfor_fndecl_string_len_trim_char4;
+extern GTY(()) tree gfor_fndecl_string_index_char4;
+extern GTY(()) tree gfor_fndecl_string_scan_char4;
+extern GTY(()) tree gfor_fndecl_string_verify_char4;
+extern GTY(()) tree gfor_fndecl_string_trim_char4;
+extern GTY(()) tree gfor_fndecl_string_minmax_char4;
+extern GTY(()) tree gfor_fndecl_adjustl_char4;
+extern GTY(()) tree gfor_fndecl_adjustr_char4;
+extern GTY(()) tree gfor_fndecl_select_string_char4;
+
+/* Conversion between character kinds.  */
+extern GTY(()) tree gfor_fndecl_convert_char1_to_char4;
+extern GTY(()) tree gfor_fndecl_convert_char4_to_char1;
+
+/* Other misc. runtime library functions.  */
+extern GTY(()) tree gfor_fndecl_size0;
+extern GTY(()) tree gfor_fndecl_size1;
+extern GTY(()) tree gfor_fndecl_iargc;
+
+/* Implemented in Fortran.  */
+extern GTY(()) tree gfor_fndecl_sc_kind;
+extern GTY(()) tree gfor_fndecl_si_kind;
+extern GTY(()) tree gfor_fndecl_sr_kind;
+
+
+/* True if node is an integer constant.  */
+#define INTEGER_CST_P(node) (TREE_CODE(node) == INTEGER_CST)
+
+/* gfortran-specific declaration information, the _CONT versions denote
+   arrays with CONTIGUOUS attribute.  */
+
+enum gfc_array_kind
+{
+  GFC_ARRAY_UNKNOWN,
+  GFC_ARRAY_ASSUMED_SHAPE,
+  GFC_ARRAY_ASSUMED_SHAPE_CONT,
+  GFC_ARRAY_ALLOCATABLE,
+  GFC_ARRAY_POINTER,
+  GFC_ARRAY_POINTER_CONT
+};
+
+/* Array types only.  */
+/* FIXME: the variable_size annotation here is needed because these types are
+   variable-sized in some other frontends.  Due to gengtype deficiency the GTY
+   options of such types have to agree across all frontends. */
+struct GTY((variable_size))	lang_type	 {
+  int rank;
+  enum gfc_array_kind akind;
+  tree lbound[GFC_MAX_DIMENSIONS];
+  tree ubound[GFC_MAX_DIMENSIONS];
+  tree stride[GFC_MAX_DIMENSIONS];
+  tree size;
+  tree offset;
+  tree dtype;
+  tree dataptr_type;
+  tree span;
+  tree base_decl[2];
+  tree nonrestricted_type;
+};
+
+struct GTY((variable_size)) lang_decl {
+  /* Dummy variables.  */
+  tree saved_descriptor;
+  /* Assigned integer nodes.  Stringlength is the IO format string's length.
+     Addr is the address of the string or the target label. Stringlength is
+     initialized to -2 and assigned to -1 when addr is assigned to the
+     address of target label.  */
+  tree stringlen;
+  tree addr;
+  tree span;
+};
+
+
+#define GFC_DECL_ASSIGN_ADDR(node) DECL_LANG_SPECIFIC(node)->addr
+#define GFC_DECL_STRING_LEN(node) DECL_LANG_SPECIFIC(node)->stringlen
+#define GFC_DECL_SPAN(node) DECL_LANG_SPECIFIC(node)->span
+#define GFC_DECL_SAVED_DESCRIPTOR(node) \
+  (DECL_LANG_SPECIFIC(node)->saved_descriptor)
+#define GFC_DECL_PACKED_ARRAY(node) DECL_LANG_FLAG_0(node)
+#define GFC_DECL_PARTIAL_PACKED_ARRAY(node) DECL_LANG_FLAG_1(node)
+#define GFC_DECL_ASSIGN(node) DECL_LANG_FLAG_2(node)
+#define GFC_DECL_COMMON_OR_EQUIV(node) DECL_LANG_FLAG_3(node)
+#define GFC_DECL_CRAY_POINTEE(node) DECL_LANG_FLAG_4(node)
+#define GFC_DECL_RESULT(node) DECL_LANG_FLAG_5(node)
+#define GFC_DECL_SUBREF_ARRAY_P(node) DECL_LANG_FLAG_6(node)
+
+/* An array descriptor.  */
+#define GFC_DESCRIPTOR_TYPE_P(node) TYPE_LANG_FLAG_1(node)
+/* An array without a descriptor.  */
+#define GFC_ARRAY_TYPE_P(node) TYPE_LANG_FLAG_2(node)
+/* Fortran POINTER type.  */
+#define GFC_POINTER_TYPE_P(node) TYPE_LANG_FLAG_3(node)
+/* The GFC_TYPE_ARRAY_* members are present in both descriptor and
+   descriptorless array types.  */
+#define GFC_TYPE_ARRAY_LBOUND(node, dim) \
+  (TYPE_LANG_SPECIFIC(node)->lbound[dim])
+#define GFC_TYPE_ARRAY_UBOUND(node, dim) \
+  (TYPE_LANG_SPECIFIC(node)->ubound[dim])
+#define GFC_TYPE_ARRAY_STRIDE(node, dim) \
+  (TYPE_LANG_SPECIFIC(node)->stride[dim])
+#define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank)
+#define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size)
+#define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset)
+#define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind)
+/* Code should use gfc_get_dtype instead of accessing this directly.  It may
+   not be known when the type is created.  */
+#define GFC_TYPE_ARRAY_DTYPE(node) (TYPE_LANG_SPECIFIC(node)->dtype)
+#define GFC_TYPE_ARRAY_DATAPTR_TYPE(node) \
+  (TYPE_LANG_SPECIFIC(node)->dataptr_type)
+#define GFC_TYPE_ARRAY_SPAN(node) (TYPE_LANG_SPECIFIC(node)->span)
+#define GFC_TYPE_ARRAY_BASE_DECL(node, internal) \
+  (TYPE_LANG_SPECIFIC(node)->base_decl[(internal)])
+
+
+/* Build an expression with void type.  */
+#define build1_v(code, arg) \
+	fold_build1_loc (input_location, code, void_type_node, arg)
+#define build2_v(code, arg1, arg2) \
+	fold_build2_loc (input_location, code, void_type_node, arg1, arg2)
+#define build3_v(code, arg1, arg2, arg3) \
+	fold_build3_loc (input_location, code, void_type_node, arg1, arg2, arg3)
+#define build4_v(code, arg1, arg2, arg3, arg4) \
+	build4_loc (input_location, code, void_type_node, arg1, arg2, \
+		    arg3, arg4)
+
+/* This group of functions allows a caller to evaluate an expression from
+   the callee's interface.  It establishes a mapping between the interface's
+   dummy arguments and the caller's actual arguments, then applies that
+   mapping to a given gfc_expr.
+
+   You can initialize a mapping structure like so:
+
+       gfc_interface_mapping mapping;
+       ...
+       gfc_init_interface_mapping (&mapping);
+
+   You should then evaluate each actual argument into a temporary
+   gfc_se structure, here called "se", and map the result to the
+   dummy argument's symbol, here called "sym":
+
+       gfc_add_interface_mapping (&mapping, sym, &se);
+
+   After adding all mappings, you should call:
+
+       gfc_finish_interface_mapping (&mapping, pre, post);
+
+   where "pre" and "post" are statement blocks for initialization
+   and finalization code respectively.  You can then evaluate an
+   interface expression "expr" as follows:
+
+       gfc_apply_interface_mapping (&mapping, se, expr);
+
+   Once you've evaluated all expressions, you should free
+   the mapping structure with:
+
+       gfc_free_interface_mapping (&mapping); */
+
+
+/* This structure represents a mapping from OLD to NEW, where OLD is a
+   dummy argument symbol and NEW is a symbol that represents the value
+   of an actual argument.  Mappings are linked together using NEXT
+   (in no particular order).  */
+typedef struct gfc_interface_sym_mapping
+{
+  struct gfc_interface_sym_mapping *next;
+  gfc_symbol *old;
+  gfc_symtree *new_sym;
+  gfc_expr *expr;
+}
+gfc_interface_sym_mapping;
+
+
+/* This structure is used by callers to evaluate an expression from
+   a callee's interface.  */
+typedef struct gfc_interface_mapping
+{
+  /* Maps the interface's dummy arguments to the values that the caller
+     is passing.  The whole list is owned by this gfc_interface_mapping.  */
+  gfc_interface_sym_mapping *syms;
+
+  /* A list of gfc_charlens that were needed when creating copies of
+     expressions.  The whole list is owned by this gfc_interface_mapping.  */
+  gfc_charlen *charlens;
+}
+gfc_interface_mapping;
+
+void gfc_init_interface_mapping (gfc_interface_mapping *);
+void gfc_free_interface_mapping (gfc_interface_mapping *);
+void gfc_add_interface_mapping (gfc_interface_mapping *,
+				gfc_symbol *, gfc_se *, gfc_expr *);
+void gfc_finish_interface_mapping (gfc_interface_mapping *,
+				   stmtblock_t *, stmtblock_t *);
+void gfc_apply_interface_mapping (gfc_interface_mapping *,
+				  gfc_se *, gfc_expr *);
+
+
+/* Standard error messages used in all the trans-*.c files.  */
+extern const char gfc_msg_fault[];
+extern const char gfc_msg_wrong_return[];
+
+#define OMPWS_WORKSHARE_FLAG	1	/* Set if in a workshare construct.  */
+#define OMPWS_CURR_SINGLEUNIT	2	/* Set if current gfc_code in workshare
+					   construct is not workshared.  */
+#define OMPWS_SCALARIZER_WS	4	/* Set if scalarizer should attempt
+					   to create parallel loops.  */
+#define OMPWS_NOWAIT		8	/* Use NOWAIT on OMP_FOR.  */
+extern int ompws_flags;
+
+#endif /* GFC_TRANS_H */
diff --git a/gcc/fortran/types.def b/gcc/fortran/types.def
new file mode 100644
index 000000000..5bcdb5261
--- /dev/null
+++ b/gcc/fortran/types.def
@@ -0,0 +1,154 @@
+/* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+   Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* This header contains a subset of ../builtin-types.def needed for
+   Fortran frontend builtins.
+
+   Before including this header, you must define the following macros:
+
+   DEF_PRIMITIVE_TYPE (ENUM, TYPE)
+
+     The ENUM is an identifier indicating which type is being defined.
+     TYPE is an expression for a `tree' that represents the type.
+
+   DEF_FUNCTION_TYPE_0 (ENUM, RETURN)
+   DEF_FUNCTION_TYPE_1 (ENUM, RETURN, ARG1)
+   DEF_FUNCTION_TYPE_2 (ENUM, RETURN, ARG1, ARG2)
+   DEF_FUNCTION_TYPE_3 (ENUM, RETURN, ARG1, ARG2, ARG3)
+   DEF_FUNCTION_TYPE_4 (ENUM, RETURN, ARG1, ARG2, ARG3, ARG4)
+   DEF_FUNCTION_TYPE_5 (ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5)
+   DEF_FUNCTION_TYPE_6 (ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6)
+   DEF_FUNCTION_TYPE_7 (ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7)
+
+     These macros describe function types.  ENUM is as above.  The
+     RETURN type is one of the enumerals already defined.  ARG1, ARG2,
+     and ARG3 give the types of the arguments, similarly.
+
+   DEF_FUNCTION_TYPE_VAR_0 (ENUM, RETURN)
+
+     Similar, but for function types that take variable arguments.
+
+  DEF_POINTER_TYPE (ENUM, TYPE)
+
+    This macro describes a pointer type.  ENUM is as above; TYPE is
+    the type pointed to.  */
+
+DEF_PRIMITIVE_TYPE (BT_VOID, void_type_node)
+DEF_PRIMITIVE_TYPE (BT_BOOL,
+		    (*lang_hooks.types.type_for_size) (BOOL_TYPE_SIZE, 1))
+DEF_PRIMITIVE_TYPE (BT_INT, integer_type_node)
+DEF_PRIMITIVE_TYPE (BT_UINT, unsigned_type_node)
+DEF_PRIMITIVE_TYPE (BT_LONG, long_integer_type_node)
+DEF_PRIMITIVE_TYPE (BT_ULONGLONG, long_long_unsigned_type_node)
+DEF_PRIMITIVE_TYPE (BT_WORD, (*lang_hooks.types.type_for_mode) (word_mode, 1))
+
+DEF_PRIMITIVE_TYPE (BT_I1, builtin_type_for_size (BITS_PER_UNIT*1, 1))
+DEF_PRIMITIVE_TYPE (BT_I2, builtin_type_for_size (BITS_PER_UNIT*2, 1))
+DEF_PRIMITIVE_TYPE (BT_I4, builtin_type_for_size (BITS_PER_UNIT*4, 1))
+DEF_PRIMITIVE_TYPE (BT_I8, builtin_type_for_size (BITS_PER_UNIT*8, 1))
+DEF_PRIMITIVE_TYPE (BT_I16, builtin_type_for_size (BITS_PER_UNIT*16, 1))
+
+DEF_PRIMITIVE_TYPE (BT_PTR, ptr_type_node)
+DEF_PRIMITIVE_TYPE (BT_CONST_PTR, const_ptr_type_node)
+DEF_PRIMITIVE_TYPE (BT_VOLATILE_PTR,
+                    build_pointer_type
+                     (build_qualified_type (void_type_node,
+                                            TYPE_QUAL_VOLATILE)))
+
+DEF_POINTER_TYPE (BT_PTR_LONG, BT_LONG)
+DEF_POINTER_TYPE (BT_PTR_ULONGLONG, BT_ULONGLONG)
+DEF_POINTER_TYPE (BT_PTR_PTR, BT_PTR)
+DEF_FUNCTION_TYPE_0 (BT_FN_BOOL, BT_BOOL)
+DEF_FUNCTION_TYPE_0 (BT_FN_PTR, BT_PTR)
+DEF_FUNCTION_TYPE_0 (BT_FN_INT, BT_INT)
+DEF_FUNCTION_TYPE_0 (BT_FN_UINT, BT_UINT)
+DEF_FUNCTION_TYPE_0 (BT_FN_VOID, BT_VOID)
+
+DEF_FUNCTION_TYPE_1 (BT_FN_VOID_PTR, BT_VOID, BT_PTR)
+DEF_FUNCTION_TYPE_1 (BT_FN_VOID_PTRPTR, BT_VOID, BT_PTR_PTR)
+DEF_FUNCTION_TYPE_1 (BT_FN_VOID_VPTR, BT_VOID, BT_VOLATILE_PTR)
+DEF_FUNCTION_TYPE_1 (BT_FN_UINT_UINT, BT_UINT, BT_UINT)
+DEF_FUNCTION_TYPE_1 (BT_FN_PTR_PTR, BT_PTR, BT_PTR)
+
+DEF_POINTER_TYPE (BT_PTR_FN_VOID_PTR, BT_FN_VOID_PTR)
+
+DEF_FUNCTION_TYPE_2 (BT_FN_BOOL_LONGPTR_LONGPTR,
+                     BT_BOOL, BT_PTR_LONG, BT_PTR_LONG)
+DEF_FUNCTION_TYPE_2 (BT_FN_BOOL_ULONGLONGPTR_ULONGLONGPTR,
+		     BT_BOOL, BT_PTR_ULONGLONG, BT_PTR_ULONGLONG)
+DEF_FUNCTION_TYPE_2 (BT_FN_I1_VPTR_I1, BT_I1, BT_VOLATILE_PTR, BT_I1)
+DEF_FUNCTION_TYPE_2 (BT_FN_I2_VPTR_I2, BT_I2, BT_VOLATILE_PTR, BT_I2)
+DEF_FUNCTION_TYPE_2 (BT_FN_I4_VPTR_I4, BT_I4, BT_VOLATILE_PTR, BT_I4)
+DEF_FUNCTION_TYPE_2 (BT_FN_I8_VPTR_I8, BT_I8, BT_VOLATILE_PTR, BT_I8)
+DEF_FUNCTION_TYPE_2 (BT_FN_I16_VPTR_I16, BT_I16, BT_VOLATILE_PTR, BT_I16)
+DEF_FUNCTION_TYPE_2 (BT_FN_VOID_PTR_PTR, BT_VOID, BT_PTR, BT_PTR)
+
+DEF_POINTER_TYPE (BT_PTR_FN_VOID_PTR_PTR, BT_FN_VOID_PTR_PTR)
+
+DEF_FUNCTION_TYPE_3 (BT_FN_BOOL_VPTR_I1_I1, BT_BOOL, BT_VOLATILE_PTR,
+                     BT_I1, BT_I1)
+DEF_FUNCTION_TYPE_3 (BT_FN_BOOL_VPTR_I2_I2, BT_BOOL, BT_VOLATILE_PTR,
+                     BT_I2, BT_I2)
+DEF_FUNCTION_TYPE_3 (BT_FN_BOOL_VPTR_I4_I4, BT_BOOL, BT_VOLATILE_PTR,
+                     BT_I4, BT_I4)
+DEF_FUNCTION_TYPE_3 (BT_FN_BOOL_VPTR_I8_I8, BT_BOOL, BT_VOLATILE_PTR,
+                     BT_I8, BT_I8)
+DEF_FUNCTION_TYPE_3 (BT_FN_BOOL_VPTR_I16_I16, BT_BOOL, BT_VOLATILE_PTR,
+                     BT_I16, BT_I16)
+DEF_FUNCTION_TYPE_3 (BT_FN_I1_VPTR_I1_I1, BT_I1, BT_VOLATILE_PTR, BT_I1, BT_I1)
+DEF_FUNCTION_TYPE_3 (BT_FN_I2_VPTR_I2_I2, BT_I2, BT_VOLATILE_PTR, BT_I2, BT_I2)
+DEF_FUNCTION_TYPE_3 (BT_FN_I4_VPTR_I4_I4, BT_I4, BT_VOLATILE_PTR, BT_I4, BT_I4)
+DEF_FUNCTION_TYPE_3 (BT_FN_I8_VPTR_I8_I8, BT_I8, BT_VOLATILE_PTR, BT_I8, BT_I8)
+DEF_FUNCTION_TYPE_3 (BT_FN_I16_VPTR_I16_I16, BT_I16, BT_VOLATILE_PTR,
+		     BT_I16, BT_I16)
+DEF_FUNCTION_TYPE_3 (BT_FN_VOID_OMPFN_PTR_UINT, BT_VOID, BT_PTR_FN_VOID_PTR,
+                     BT_PTR, BT_UINT)
+
+DEF_FUNCTION_TYPE_4 (BT_FN_VOID_OMPFN_PTR_UINT_UINT,
+                     BT_VOID, BT_PTR_FN_VOID_PTR, BT_PTR, BT_UINT, BT_UINT)
+DEF_FUNCTION_TYPE_4 (BT_FN_VOID_PTR_WORD_WORD_PTR,
+		     BT_VOID, BT_PTR, BT_WORD, BT_WORD, BT_PTR)
+
+DEF_FUNCTION_TYPE_5 (BT_FN_BOOL_LONG_LONG_LONG_LONGPTR_LONGPTR,
+                     BT_BOOL, BT_LONG, BT_LONG, BT_LONG,
+		     BT_PTR_LONG, BT_PTR_LONG)
+
+DEF_FUNCTION_TYPE_6 (BT_FN_BOOL_LONG_LONG_LONG_LONG_LONGPTR_LONGPTR,
+                     BT_BOOL, BT_LONG, BT_LONG, BT_LONG, BT_LONG,
+		     BT_PTR_LONG, BT_PTR_LONG)
+DEF_FUNCTION_TYPE_6 (BT_FN_VOID_OMPFN_PTR_UINT_LONG_LONG_LONG,
+                     BT_VOID, BT_PTR_FN_VOID_PTR, BT_PTR, BT_UINT,
+                     BT_LONG, BT_LONG, BT_LONG)
+DEF_FUNCTION_TYPE_6 (BT_FN_BOOL_BOOL_ULL_ULL_ULL_ULLPTR_ULLPTR,
+		     BT_BOOL, BT_BOOL, BT_ULONGLONG, BT_ULONGLONG,
+		     BT_ULONGLONG, BT_PTR_ULONGLONG, BT_PTR_ULONGLONG)
+
+DEF_FUNCTION_TYPE_7 (BT_FN_VOID_OMPFN_PTR_UINT_LONG_LONG_LONG_LONG,
+                     BT_VOID, BT_PTR_FN_VOID_PTR, BT_PTR, BT_UINT,
+                     BT_LONG, BT_LONG, BT_LONG, BT_LONG)
+DEF_FUNCTION_TYPE_7 (BT_FN_VOID_OMPFN_PTR_OMPCPYFN_LONG_LONG_BOOL_UINT,
+		     BT_VOID, BT_PTR_FN_VOID_PTR, BT_PTR,
+		     BT_PTR_FN_VOID_PTR_PTR, BT_LONG, BT_LONG,
+		     BT_BOOL, BT_UINT)
+DEF_FUNCTION_TYPE_7 (BT_FN_BOOL_BOOL_ULL_ULL_ULL_ULL_ULLPTR_ULLPTR,
+		     BT_BOOL, BT_BOOL, BT_ULONGLONG, BT_ULONGLONG,
+		     BT_ULONGLONG, BT_ULONGLONG,
+		     BT_PTR_ULONGLONG, BT_PTR_ULONGLONG)
+
+DEF_FUNCTION_TYPE_VAR_0 (BT_FN_VOID_VAR, BT_VOID)