re PR fortran/25162 (Issue with OpenMP COPYIN and gfortran)

gcc/fortran/
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.

gcc/testsuite/
2006-02-14  Jakub Jelinek  <jakub@redhat.com>
	    Diego Novillo  <dnovillo@redhat.com>
	    Uros Bizjak  <uros@kss-loka.si>

	* gfortran.dg/gomp: New directory.

libgomp/
2006-02-14  Jakub Jelinek  <jakub@redhat.com>

	* testsuite/libgomp.fortran/vla7.f90: Add -w to options.
	Remove tests for returning assumed character length arrays.

Co-Authored-By: Diego Novillo <dnovillo@redhat.com>
Co-Authored-By: Richard Henderson <rth@redhat.com>
Co-Authored-By: Uros Bizjak <uros@kss-loka.si>

From-SVN: r110984

177 files changed, 11249 insertions, 88 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d4a2720..7a36057 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,375 @@
+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>
 
diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index c7fa78f..74af449 100644
--- a/gcc/fortran/Make-lang.in
+++ b/gcc/fortran/Make-lang.in
@@ -1,6 +1,6 @@
 # -*- makefile -*-
 # Top level makefile fragment for GNU gfortran, the GNU Fortran 95 compiler.
-# Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+# Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
 # Contributed by Paul Brook <paul@nowt.org
 # and Steven Bosscher <s.bosscher@student.tudelft.nl>
 
@@ -65,15 +65,16 @@ F95_PARSER_OBJS = fortran/arith.o fortran/array.o fortran/bbt.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/options.o fortran/parse.o fortran/primary.o fortran/resolve.o \
-    fortran/scanner.o fortran/simplify.o fortran/st.o fortran/symbol.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
 
 F95_OBJS = $(F95_PARSER_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-stmt.o \
-    fortran/trans-types.o
+    fortran/trans-intrinsic.o fortran/trans-io.o fortran/trans-openmp.o \
+    fortran/trans-stmt.o fortran/trans-types.o
 
 # GFORTRAN uses GMP for its internal arithmetics.
 F95_LIBS = $(GMPLIBS) $(LIBS)
@@ -261,6 +262,7 @@ $(F95_PARSER_OBJS): fortran/gfortran.h fortran/intrinsic.h fortran/match.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/intrinsic.h fortran/trans-array.h \
     fortran/trans-const.h fortran/trans-const.h fortran/trans.h \
@@ -268,24 +270,26 @@ GFORTRAN_TRANS_DEPS = fortran/gfortran.h fortran/intrinsic.h fortran/trans-array
     $(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)
+  gt-fortran-f95-lang.h gtype-fortran.h cgraph.h $(TARGET_H) \
+  $(BUILTINS_DEF) fortran/types.def
 fortran/scanner.o: toplev.h
 fortran/convert.o: $(GFORTRAN_TRANS_DEPS)
 fortran/trans.o: $(GFORTRAN_TRANS_DEPS)
 fortran/trans-decl.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-decl.h \
-  cgraph.h $(TARGET_H) function.h $(FLAGS_H) tree-gimple.h \
+  cgraph.h $(TARGET_H) function.h $(FLAGS_H) $(RTL_H) tree-gimple.h \
   tree-dump.h
 fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \
   real.h toplev.h $(TARGET_H)
 fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS)
 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)
+fortran/trans-common.o: $(GFORTRAN_TRANS_DEPS) $(TARGET_H) $(RTL_H)
 fortran/resolve.o: fortran/dependency.h
 
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 644729c..06322d4 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -547,6 +547,8 @@ gfc_show_attr (symbol_attribute * attr)
     gfc_status (" POINTER");
   if (attr->save)
     gfc_status (" SAVE");
+  if (attr->threadprivate)
+    gfc_status (" THREADPRIVATE");
   if (attr->target)
     gfc_status (" TARGET");
   if (attr->dummy)
@@ -786,6 +788,202 @@ gfc_show_code (int level, gfc_code * c)
     gfc_show_code_node (level, c);
 }
 
+static void
+gfc_show_namelist (gfc_namelist *n)
+{
+  for (; n->next; n = n->next)
+    gfc_status ("%s,", n->sym->name);
+  gfc_status ("%s", n->sym->name);
+}
+
+/* Show a single OpenMP directive node and everything underneath it
+   if necessary.  */
+
+static void
+gfc_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_WORKSHARE: name = "WORKSHARE"; break;
+    default:
+      gcc_unreachable ();
+    }
+  gfc_status ("!$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:
+      omp_clauses = c->ext.omp_clauses;
+      break;
+    case EXEC_OMP_CRITICAL:
+      if (c->ext.omp_name)
+	gfc_status (" (%s)", c->ext.omp_name);
+      break;
+    case EXEC_OMP_FLUSH:
+      if (c->ext.omp_namelist)
+	{
+	  gfc_status (" (");
+	  gfc_show_namelist (c->ext.omp_namelist);
+	  gfc_status_char (')');
+	}
+      return;
+    case EXEC_OMP_BARRIER:
+      return;
+    default:
+      break;
+    }
+  if (omp_clauses)
+    {
+      int list_type;
+
+      if (omp_clauses->if_expr)
+	{
+	  gfc_status (" IF(");
+	  gfc_show_expr (omp_clauses->if_expr);
+	  gfc_status_char (')');
+	}
+      if (omp_clauses->num_threads)
+	{
+	  gfc_status (" NUM_THREADS(");
+	  gfc_show_expr (omp_clauses->num_threads);
+	  gfc_status_char (')');
+	}
+      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;
+	    default:
+	      gcc_unreachable ();
+	    }
+	  gfc_status (" SCHEDULE (%s", type);
+	  if (omp_clauses->chunk_size)
+	    {
+	      gfc_status_char (',');
+	      gfc_show_expr (omp_clauses->chunk_size);
+	    }
+	  gfc_status_char (')');
+	}
+      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_SCHED_RUNTIME: type = "RUNTIME"; break;
+	    default:
+	      gcc_unreachable ();
+	    }
+	  gfc_status (" DEFAULT(%s)", type);
+	}
+      if (omp_clauses->ordered)
+	gfc_status (" ORDERED");
+      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 ();
+		  }
+		gfc_status (" 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 ();
+		  }
+		gfc_status (" %s(", type);
+	      }
+	    gfc_show_namelist (omp_clauses->lists[list_type]);
+	    gfc_status_char (')');
+	  }
+    }
+  gfc_status_char ('\n');
+  if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
+    {
+      gfc_code *d = c->block;
+      while (d != NULL)
+	{
+	  gfc_show_code (level + 1, d->next);
+	  if (d->block == NULL)
+	    break;
+	  code_indent (level, 0);
+	  gfc_status ("!$OMP SECTION\n");
+	  d = d->block;
+	}
+    }
+  else
+    gfc_show_code (level + 1, c->block->next);
+  if (c->op == EXEC_OMP_ATOMIC)
+    return;
+  code_indent (level, 0);
+  gfc_status ("!$OMP END %s", name);
+  if (omp_clauses != NULL)
+    {
+      if (omp_clauses->lists[OMP_LIST_COPYPRIVATE])
+	{
+	  gfc_status (" COPYPRIVATE(");
+	  gfc_show_namelist (omp_clauses->lists[OMP_LIST_COPYPRIVATE]);
+	  gfc_status_char (')');
+	}
+      else if (omp_clauses->nowait)
+	gfc_status (" NOWAIT");
+    }
+  else if (c->op == EXEC_OMP_CRITICAL && c->ext.omp_name)
+    gfc_status (" (%s)", c->ext.omp_name);
+}
 
 /* Show a single code node and everything underneath it if necessary.  */
 
@@ -1448,6 +1646,23 @@ gfc_show_code_node (int level, gfc_code * c)
 	gfc_status (" 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_WORKSHARE:
+      gfc_show_omp_node (level, c);
+      break;
+
     default:
       gfc_internal_error ("gfc_show_code_node(): Bad statement code");
     }
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index a5d1161..6722117 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -1,6 +1,6 @@
 /* gfortran backend interface
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
-   Inc.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
    Contributed by Paul Brook.
 
 This file is part of GCC.
@@ -116,6 +116,11 @@ static void gfc_expand_function (tree);
 #undef LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
 #undef LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION
 #undef LANG_HOOKS_CLEAR_BINDING_STACK
+#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
+#undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
+#undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
+#undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
+#undef LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES
 
 /* Define lang hooks.  */
 #define LANG_HOOKS_NAME                 "GNU F95"
@@ -134,6 +139,12 @@ static void gfc_expand_function (tree);
 #define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE gfc_signed_or_unsigned_type
 #define LANG_HOOKS_CALLGRAPH_EXPAND_FUNCTION gfc_expand_function
 #define LANG_HOOKS_CLEAR_BINDING_STACK     gfc_clear_binding_stack
+#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_DISREGARD_VALUE_EXPR	gfc_omp_disregard_value_expr
+#define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE	gfc_omp_private_debug_clause
+#define LANG_HOOKS_OMP_FIRSTPRIVATIZE_TYPE_SIZES \
+  gfc_omp_firstprivatize_type_sizes
 
 const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
 
@@ -784,12 +795,53 @@ build_builtin_fntypes (tree * fntype, tree type)
   fntype[2] = build_function_type (type, tmp);
 }
 
+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;
+  enum
+  {
+    /* So far we need just these 2 attribute types.  */
+    ATTR_NOTHROW_LIST,
+    ATTR_CONST_NOTHROW_LIST
+  };
+
   tree mfunc_float[3];
   tree mfunc_double[3];
   tree mfunc_longdouble[3];
@@ -801,6 +853,7 @@ gfc_init_builtin_functions (void)
   tree func_clongdouble_longdouble;
   tree ftype;
   tree tmp;
+  tree builtin_types[(int) BT_LAST + 1];
 
   build_builtin_fntypes (mfunc_float, float_type_node);
   build_builtin_fntypes (mfunc_double, double_type_node);
@@ -882,6 +935,150 @@ gfc_init_builtin_functions (void)
   gfc_define_builtin ("__builtin_expect", ftype, BUILT_IN_EXPECT,
 		      "__builtin_expect", true);
 
+#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 (builtin_types[(int) RETURN],	\
+			   void_list_node);
+#define DEF_FUNCTION_TYPE_1(ENUM, RETURN, ARG1)				\
+  builtin_types[(int) ENUM]						\
+    = build_function_type (builtin_types[(int) RETURN],			\
+			   tree_cons (NULL_TREE,			\
+				      builtin_types[(int) ARG1],	\
+				      void_list_node));
+#define DEF_FUNCTION_TYPE_2(ENUM, RETURN, ARG1, ARG2)	\
+  builtin_types[(int) ENUM]				\
+    = build_function_type				\
+      (builtin_types[(int) RETURN],			\
+       tree_cons (NULL_TREE,				\
+		  builtin_types[(int) ARG1],		\
+		  tree_cons (NULL_TREE,			\
+			     builtin_types[(int) ARG2],	\
+			     void_list_node)));
+#define DEF_FUNCTION_TYPE_3(ENUM, RETURN, ARG1, ARG2, ARG3)		 \
+  builtin_types[(int) ENUM]						 \
+    = build_function_type						 \
+      (builtin_types[(int) RETURN],					 \
+       tree_cons (NULL_TREE,						 \
+		  builtin_types[(int) ARG1],				 \
+		  tree_cons (NULL_TREE,					 \
+			     builtin_types[(int) ARG2],			 \
+			     tree_cons (NULL_TREE,			 \
+					builtin_types[(int) ARG3],	 \
+					void_list_node))));
+#define DEF_FUNCTION_TYPE_4(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4)	\
+  builtin_types[(int) ENUM]						\
+    = build_function_type						\
+      (builtin_types[(int) RETURN],					\
+       tree_cons (NULL_TREE,						\
+		  builtin_types[(int) ARG1],				\
+		  tree_cons (NULL_TREE,					\
+			     builtin_types[(int) ARG2],			\
+			     tree_cons					\
+			     (NULL_TREE,				\
+			      builtin_types[(int) ARG3],		\
+			      tree_cons (NULL_TREE,			\
+					 builtin_types[(int) ARG4],	\
+					 void_list_node)))));
+#define DEF_FUNCTION_TYPE_5(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5)	\
+  builtin_types[(int) ENUM]						\
+    = build_function_type						\
+      (builtin_types[(int) RETURN],					\
+       tree_cons (NULL_TREE,						\
+		  builtin_types[(int) ARG1],				\
+		  tree_cons (NULL_TREE,					\
+			     builtin_types[(int) ARG2],			\
+			     tree_cons					\
+			     (NULL_TREE,				\
+			      builtin_types[(int) ARG3],		\
+			      tree_cons (NULL_TREE,			\
+					 builtin_types[(int) ARG4],	\
+					 tree_cons (NULL_TREE,		\
+					      builtin_types[(int) ARG5],\
+					      void_list_node))))));
+#define DEF_FUNCTION_TYPE_6(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
+			    ARG6)					\
+  builtin_types[(int) ENUM]						\
+    = build_function_type						\
+      (builtin_types[(int) RETURN],					\
+       tree_cons (NULL_TREE,						\
+		  builtin_types[(int) ARG1],				\
+		  tree_cons (NULL_TREE,					\
+			     builtin_types[(int) ARG2],			\
+			     tree_cons					\
+			     (NULL_TREE,				\
+			      builtin_types[(int) ARG3],		\
+			      tree_cons					\
+			      (NULL_TREE,				\
+			       builtin_types[(int) ARG4],		\
+			       tree_cons (NULL_TREE,			\
+					 builtin_types[(int) ARG5],	\
+					 tree_cons (NULL_TREE,		\
+					      builtin_types[(int) ARG6],\
+					      void_list_node)))))));
+#define DEF_FUNCTION_TYPE_7(ENUM, RETURN, ARG1, ARG2, ARG3, ARG4, ARG5, \
+			    ARG6, ARG7)					\
+  builtin_types[(int) ENUM]						\
+    = build_function_type						\
+      (builtin_types[(int) RETURN],					\
+       tree_cons (NULL_TREE,						\
+		  builtin_types[(int) ARG1],				\
+		  tree_cons (NULL_TREE,					\
+			     builtin_types[(int) ARG2],			\
+			     tree_cons					\
+			     (NULL_TREE,				\
+			      builtin_types[(int) ARG3],		\
+			      tree_cons					\
+			      (NULL_TREE,				\
+			       builtin_types[(int) ARG4],		\
+			       tree_cons (NULL_TREE,			\
+					 builtin_types[(int) ARG5],	\
+					 tree_cons (NULL_TREE,		\
+					      builtin_types[(int) ARG6],\
+					 tree_cons (NULL_TREE,		\
+					      builtin_types[(int) ARG6], \
+					      void_list_node))))))));
+#define DEF_FUNCTION_TYPE_VAR_0(ENUM, RETURN)				\
+  builtin_types[(int) ENUM]						\
+    = build_function_type (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 == ATTR_CONST_NOTHROW_LIST);
+#include "../sync-builtins.def"
+#undef DEF_SYNC_BUILTIN
+
+  if (gfc_option.flag_openmp)
+    {
+#undef DEF_GOMP_BUILTIN
+#define DEF_GOMP_BUILTIN(code, name, type, attr) \
+      gfc_define_builtin ("__builtin_" name, builtin_types[type], \
+			  code, name, attr == ATTR_CONST_NOTHROW_LIST);
+#include "../omp-builtins.def"
+#undef DEF_GOMP_BUILTIN
+    }
+
+  gfc_define_builtin ("__builtin_trap", builtin_types[BT_FN_VOID],
+		      BUILT_IN_TRAP, NULL, false);
+  TREE_THIS_VOLATILE (built_in_decls[BUILT_IN_TRAP]) = 1;
+
   build_common_builtin_nodes ();
   targetm.init_builtins ();
 }
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 46141b6..16f0a12 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -220,7 +220,16 @@ typedef enum
   ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, 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_NONE
+  ST_ENUM, ST_ENUMERATOR, ST_END_ENUM,
+  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_NONE
 }
 gfc_statement;
 
@@ -451,7 +460,7 @@ typedef struct
   /* Variable attributes.  */
   unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
     optional:1, pointer:1, save:1, target:1,
-    dummy:1, result:1, assign:1;
+    dummy:1, result:1, assign:1, threadprivate:1;
 
   unsigned data:1,		/* Symbol is named in a DATA statement.  */
     use_assoc:1;		/* Symbol has been use-associated.  */
@@ -678,6 +687,60 @@ gfc_namelist;
 
 #define gfc_get_namelist() gfc_getmem(sizeof(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.  */
+typedef struct gfc_omp_clauses
+{
+  struct gfc_expr *if_expr;
+  struct gfc_expr *num_threads;
+  gfc_namelist *lists[OMP_LIST_NUM];
+  enum
+    {
+      OMP_SCHED_NONE,
+      OMP_SCHED_STATIC,
+      OMP_SCHED_DYNAMIC,
+      OMP_SCHED_GUIDED,
+      OMP_SCHED_RUNTIME
+    } sched_kind;
+  struct gfc_expr *chunk_size;
+  enum
+    {
+      OMP_DEFAULT_UNKNOWN,
+      OMP_DEFAULT_NONE,
+      OMP_DEFAULT_PRIVATE,
+      OMP_DEFAULT_SHARED
+    } default_sharing;
+  bool nowait, ordered;
+}
+gfc_omp_clauses;
+
+#define gfc_get_omp_clauses() gfc_getmem(sizeof(gfc_omp_clauses))
+
 
 /* The gfc_st_label structure is a doubly linked list attached to a
    namespace that records the usage of statement labels within that
@@ -794,7 +857,7 @@ gfc_symbol;
 typedef struct gfc_common_head
 {
   locus where;
-  int use_assoc, saved;
+  char use_assoc, saved, threadprivate;
   char name[GFC_MAX_SYMBOL_LEN + 1];
   struct gfc_symbol *head;
 }
@@ -1402,7 +1465,13 @@ typedef enum
   EXEC_ALLOCATE, EXEC_DEALLOCATE,
   EXEC_OPEN, EXEC_CLOSE,
   EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
-  EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH
+  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
 }
 gfc_exec_op;
 
@@ -1436,6 +1505,10 @@ typedef struct gfc_code
     struct gfc_code *whichloop;
     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 */
 
@@ -1528,6 +1601,7 @@ typedef struct
   int flag_backslash;
   int flag_cray_pointer;
   int flag_d_lines;
+  int flag_openmp;
 
   int q_kind;
 
@@ -1722,6 +1796,7 @@ try gfc_add_cray_pointee (symbol_attribute *, locus *);
 try gfc_mod_pointee_as (gfc_array_spec *as);
 try gfc_add_result (symbol_attribute *, const char *, locus *);
 try gfc_add_save (symbol_attribute *, const char *, locus *);
+try gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
 try gfc_add_saved_common (symbol_attribute *, locus *);
 try gfc_add_target (symbol_attribute *, locus *);
 try gfc_add_dummy (symbol_attribute *, const char *, locus *);
@@ -1832,6 +1907,13 @@ void gfc_free_equiv (gfc_equiv *);
 void gfc_free_data (gfc_data *);
 void gfc_free_case_list (gfc_case *);
 
+/* openmp.c */
+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 *);
+
 /* expr.c */
 void gfc_free_actual_arglist (gfc_actual_arglist *);
 gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *);
@@ -1880,6 +1962,7 @@ void gfc_free_statements (gfc_code *);
 /* resolve.c */
 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_elemental (gfc_symbol *);
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 65a2542..908e05a 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1,7 +1,7 @@
 \input texinfo  @c -*-texinfo-*-
 @c %**start of header
 @setfilename gfortran.info
-@set copyrights-gfortran 1999-2005
+@set copyrights-gfortran 1999-2006
 
 @include gcc-common.texi
 
@@ -493,10 +493,6 @@ Option to initialize otherwise uninitialized integer and floating
 point variables.
 
 @item
-Support for OpenMP directives.  This also requires support from the runtime
-library and the rest of the compiler.
-
-@item
 Support for Fortran 200x. This includes several new features including
 floating point exceptions, extended use of allocatable arrays, C
 interoperability, Parameterizer data types and function pointers.
@@ -658,6 +654,7 @@ of extensions, and @option{-std=legacy} allows both without warning.
 * Hollerith constants support::
 * Cray pointers::
 * CONVERT specifier::
+* OpenMP::
 @end menu
 
 @node Old-style kind specifications
@@ -1049,6 +1046,22 @@ 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
+@section OpenMP
+@cindex OpenMP
+
+gfortran attempts to be OpenMP Application Program Interface v2.5
+compatible when invoked with the @code{-fopenmp} option.  gfortran
+then generates parallellized code according to the OpenMP directives
+used in the source.  The OpenMP Fortran runtime library
+routines are provided both in a form of Fortran 90 module named
+@code{omp_lib} and in a form of a Fortran @code{include} file named
+@code{omp_lib.h}.
+
+For details refer to the actual
+@uref{http://www.openmp.org/drupal/mp-documents/spec25.pdf,
+OpenMP Application Program Interface v2.5} specification.
+
 @c ---------------------------------------------------------------------
 @include intrinsic.texi
 @c ---------------------------------------------------------------------
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 8d7a1d5..c031cd4 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -1,11 +1,11 @@
-@c Copyright (C) 2004, 2005
+@c Copyright (C) 2004, 2005, 2006
 @c Free Software Foundation, Inc.
 @c This is part of the GFORTRAN manual.   
 @c For copying conditions, see the file gfortran.texi.
 
 @ignore
 @c man begin COPYRIGHT
-Copyright @copyright{} 2004, 2005
+Copyright @copyright{} 2004, 2005, 2006
 Free Software Foundation, Inc.
 
 Permission is granted to copy, distribute and/or modify this document
@@ -122,7 +122,7 @@ by type.  Explanations are in the following sections.
 -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 }
+-fcray-pointer  -fopenmp }
 
 @item Warning Options
 @xref{Warning Options,,Options to Request or Suppress Warnings}.
@@ -291,6 +291,16 @@ Specify that no implicit typing is allowed, unless overridden by explicit
 @item -fcray-pointer
 Enables the Cray pointer extension, which provides a C-like pointer.
 
+@cindex -fopenmp
+@cindex options, -fopenmp
+@item -fopenmp
+Enables handling of OpenMP @code{!$omp} directives in free form
+and @code{c$omp}, @code{*$omp} and @code{!$omp} directives in fixed form,
+enables @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.
+
 @cindex -std=@var{std} option
 @cindex option, -std=@var{std}
 @item -std=@var{std}
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 5ce2934..1752204 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -117,6 +117,10 @@ ffree-form
 Fortran RejectNegative
 Assume that the source file is free form
 
+fopenmp
+Fortran
+Enable OpenMP
+
 funderscoring
 Fortran
 Append underscores to externally visible names
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index a78cd02..a2b9c41 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1341,7 +1341,7 @@ cleanup:
 static match
 match_exit_cycle (gfc_statement st, gfc_exec_op op)
 {
-  gfc_state_data *p;
+  gfc_state_data *p, *o;
   gfc_symbol *sym;
   match m;
 
@@ -1368,9 +1368,11 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
 
   /* Find the loop mentioned specified by the label (or lack of a
      label).  */
-  for (p = gfc_state_stack; p; p = p->previous)
+  for (o = NULL, p = gfc_state_stack; p; p = p->previous)
     if (p->state == COMP_DO && (sym == NULL || sym == p->sym))
       break;
+    else if (o == NULL && p->state == COMP_OMP_STRUCTURED_BLOCK)
+      o = p;
 
   if (p == NULL)
     {
@@ -1384,6 +1386,25 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
       return MATCH_ERROR;
     }
 
+  if (o != NULL)
+    {
+      gfc_error ("%s statement at %C leaving OpenMP structured block",
+		 gfc_ascii_statement (st));
+      return MATCH_ERROR;
+    }
+  else if (st == ST_EXIT
+	   && p->previous != NULL
+	   && p->previous->state == COMP_OMP_STRUCTURED_BLOCK
+	   && (p->previous->head->op == EXEC_OMP_DO
+	       || p->previous->head->op == EXEC_OMP_PARALLEL_DO))
+    {
+      gcc_assert (p->previous->head->next != NULL);
+      gcc_assert (p->previous->head->next->op == EXEC_DO
+		  || p->previous->head->next->op == EXEC_DO_WHILE);
+      gfc_error ("EXIT statement at %C terminating !$OMP DO loop");
+      return MATCH_ERROR;
+    }
+
   /* Save the first statement in the loop - needed by the backend.  */
   new_st.ext.whichloop = p->head;
 
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 1c5115e..19340ce 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -90,6 +90,28 @@ match gfc_match_forall (gfc_statement *);
 
 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_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);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index c32fe0b..3c45e57 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1432,7 +1432,7 @@ typedef enum
   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_CRAY_POINTEE, AB_THREADPRIVATE
 }
 ab_attribute;
 
@@ -1446,6 +1446,7 @@ static const mstring attr_bits[] =
     minit ("POINTER", AB_POINTER),
     minit ("SAVE", AB_SAVE),
     minit ("TARGET", AB_TARGET),
+    minit ("THREADPRIVATE", AB_THREADPRIVATE),
     minit ("DUMMY", AB_DUMMY),
     minit ("RESULT", AB_RESULT),
     minit ("DATA", AB_DATA),
@@ -1515,6 +1516,8 @@ mio_symbol_attribute (symbol_attribute * attr)
 	MIO_NAME(ab_attribute) (AB_SAVE, 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)
@@ -1590,6 +1593,9 @@ mio_symbol_attribute (symbol_attribute * attr)
 	    case AB_TARGET:
 	      attr->target = 1;
 	      break;
+	    case AB_THREADPRIVATE:
+	      attr->threadprivate = 1;
+	      break;
 	    case AB_DUMMY:
 	      attr->dummy = 1;
 	      break;
@@ -2982,13 +2988,18 @@ load_commons(void)
 
   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 (&p->saved);
+      mio_integer (&flags);
+      if (flags & 1)
+	p->saved = 1;
+      if (flags & 2)
+	p->threadprivate = 1;
       p->use_assoc = 1;
 
       mio_rparen();
@@ -3385,6 +3396,7 @@ write_common (gfc_symtree *st)
 {
   gfc_common_head *p;
   const char * name;
+  int flags;
 
   if (st == NULL)
     return;
@@ -3401,7 +3413,9 @@ write_common (gfc_symtree *st)
 
   p = st->n.common;
   mio_symbol_ref(&p->head);
-  mio_integer(&p->saved);
+  flags = p->saved ? 1 : 0;
+  if (p->threadprivate) flags |= 2;
+  mio_integer(&flags);
 
   mio_rparen();
 }
@@ -3412,6 +3426,7 @@ static void
 write_blank_common (void)
 {
   const char * name = BLANK_COMMON_NAME;
+  int saved;
 
   if (gfc_current_ns->blank_common.head == NULL)
     return;
@@ -3421,7 +3436,8 @@ write_blank_common (void)
   mio_pool_string(&name);
 
   mio_symbol_ref(&gfc_current_ns->blank_common.head);
-  mio_integer(&gfc_current_ns->blank_common.saved);
+  saved = gfc_current_ns->blank_common.saved;
+  mio_integer(&saved);
 
   mio_rparen();
 }
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
new file mode 100644
index 0000000..312d5a1
--- /dev/null
+++ b/gcc/fortran/openmp.c
@@ -0,0 +1,1325 @@
+/* OpenMP directive matching and resolving.
+   Copyright (C) 2005, 2006 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 2, 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 COPYING.  If not, write to the Free
+Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.  */
+
+
+#include "config.h"
+#include "system.h"
+#include "flags.h"
+#include "gfortran.h"
+#include "match.h"
+#include "parse.h"
+#include "pointer-set.h"
+#include "target.h"
+#include "toplev.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;
+  int c;
+
+  old_loc = gfc_current_locus;
+  gfc_gobble_whitespace ();
+
+  c = gfc_next_char ();
+  switch (c)
+    {
+    case '!':
+      do
+	c = gfc_next_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)
+
+/* 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;
+	  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;
+	  if (c->sched_kind != OMP_SCHED_NONE)
+	    {
+	      match m = MATCH_NO;
+	      if (c->sched_kind != OMP_SCHED_RUNTIME)
+		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;
+	}
+
+      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)
+#define OMP_SECTIONS_CLAUSES \
+  (OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE				\
+   | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+
+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_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)
+    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_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;
+
+  if (!targetm.have_tls)
+    {
+      sorry ("threadprivate variables not supported in this target");
+      goto cleanup;
+    }
+
+  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)
+    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)
+    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)
+    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)
+    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)
+    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)
+    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;
+
+  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->attr.allocatable)
+		  gfc_error ("COPYIN clause object '%s' is ALLOCATABLE at %L",
+			     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->attr.allocatable)
+		  gfc_error ("COPYPRIVATE clause object '%s' is ALLOCATABLE"
+			     " at %L", 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);
+		    if (n->sym->attr.allocatable)
+		      gfc_error ("%s clause object '%s' is ALLOCATABLE 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' is %s at %L",
+				 list == OMP_LIST_PLUS ? '+'
+				 : list == OMP_LIST_MULT ? '*' : '-',
+				 n->sym->name, gfc_typename (&n->sym->ts),
+				 &code->loc);
+		    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;
+		  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->generic_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->expr->expr_type != EXPR_VARIABLE
+      || code->expr->symtree == NULL
+      || code->expr->rank != 0
+      || (code->expr->ts.type != BT_INTEGER
+	  && code->expr->ts.type != BT_REAL
+	  && code->expr->ts.type != BT_COMPLEX
+	  && code->expr->ts.type != BT_LOGICAL))
+    {
+      gfc_error ("!$OMP ATOMIC statement must set a scalar variable of"
+		 " intrinsic type at %L", &code->loc);
+      return;
+    }
+
+  var = code->expr->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.operator;
+      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.operator != op
+			 && e->value.op.operator != 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.operator)
+		{
+		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->generic_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;
+gfc_code *omp_current_do_code;
+
+void
+gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns)
+{
+  if (code->block->next && code->block->next->op == EXEC_DO)
+    omp_current_do_code = code->block->next;
+  gfc_resolve_blocks (code->block, ns);
+}
+
+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);
+}
+
+/* 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)
+{
+  struct omp_context *ctx;
+
+  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.  */
+  if (code == omp_current_do_code)
+    return;
+
+  for (ctx = omp_current_ctx; ctx; ctx = ctx->previous)
+    {
+      if (pointer_set_contains (ctx->sharing_clauses, sym))
+	continue;
+
+      if (! pointer_set_insert (ctx->private_iterators, sym))
+	{
+	  gfc_omp_clauses *omp_clauses = 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;
+  int list;
+  gfc_namelist *n;
+  gfc_symbol *dovar;
+
+  if (code->ext.omp_clauses)
+    resolve_omp_clauses (code);
+
+  do_code = code->block->next;
+  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);
+  else
+    {
+      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;
+		}
+    }
+}
+
+/* Resolve OpenMP directive clauses and check various requirements
+   of each directive.  */
+
+void
+gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
+{
+  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:
+      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
index 0b2f7b3..bf1da85 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -1,6 +1,6 @@
 /* Parse and display command line options.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
-   Inc.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
@@ -77,6 +77,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
   gfc_option.flag_backslash = 1;
   gfc_option.flag_cray_pointer = 0;
   gfc_option.flag_d_lines = -1;
+  gfc_option.flag_openmp = 0;
 
   gfc_option.q_kind = gfc_default_double_kind;
 
@@ -456,6 +457,10 @@ gfc_handle_option (size_t scode, const char *arg, int value)
       gfc_option.source_form = FORM_FREE;
       break;
 
+    case OPT_fopenmp:
+      gfc_option.flag_openmp = value;
+      break;
+
     case OPT_ffree_line_length_none:
       gfc_option.free_line_length = 0;
       break;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 4fb690b..8328482 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -300,6 +300,107 @@ decode_statement (void)
   return ST_NONE;
 }
 
+static gfc_statement
+decode_omp_directive (void)
+{
+  locus old_locus;
+  int c;
+
+#ifdef GFC_DEBUG
+  gfc_symbol_state ();
+#endif
+
+  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;
+    }
+
+  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_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 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 ("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;
+}
+
 #undef match
 
 
@@ -355,6 +456,22 @@ next_free (void)
 	    }
 	}
     }
+  else if (c == '!')
+    {
+      /* Comments have already been skipped by the time we get here,
+	 except for OpenMP directives.  */
+      if (gfc_option.flag_openmp)
+	{
+	  int i;
+
+	  c = gfc_next_char ();
+	  for (i = 0; i < 5; i++, c = gfc_next_char ())
+	    gcc_assert (c == "!$omp"[i]);
+
+	  gcc_assert (c == ' ');
+	  return decode_omp_directive ();
+	}
+    }
 
   return decode_statement ();
 }
@@ -405,7 +522,26 @@ next_fixed (void)
 	  digit_flag = 1;
 	  break;
 
-          /* Comments have already been skipped by the time we get
+	  /* Comments have already been skipped by the time we get
+	     here, except for OpenMP directives.  */
+	case '*':
+	  if (gfc_option.flag_openmp)
+	    {
+	      for (i = 0; i < 5; i++, c = gfc_next_char_literal (0))
+		gcc_assert (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:
@@ -534,18 +670,23 @@ next_statement (void)
   case ST_PAUSE: case ST_STOP: case ST_WRITE: case ST_ASSIGNMENT: \
   case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \
   case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
-  case ST_LABEL_ASSIGNMENT: case ST_FLUSH
+  case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
+  case ST_OMP_BARRIER
 
 /* Statements that mark other executable statements.  */
 
 #define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: case ST_IF_BLOCK: \
-  case ST_WHERE_BLOCK: case ST_SELECT_CASE
+  case ST_WHERE_BLOCK: case ST_SELECT_CASE: 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
 
 /* 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_TYPE: case ST_INTERFACE: case ST_OMP_THREADPRIVATE
 
 /* Block end statements.  Errors associated with interchanging these
    are detected in gfc_match_end().  */
@@ -963,6 +1104,87 @@ gfc_ascii_statement (gfc_statement st)
     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_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_THREADPRIVATE:
+      p = "!$OMP THREADPRIVATE";
+      break;
+    case ST_OMP_WORKSHARE:
+      p = "!$OMP WORKSHARE";
+      break;
     default:
       gfc_internal_error ("gfc_ascii_statement(): Bad statement code");
     }
@@ -2070,6 +2292,266 @@ loop:
 }
 
 
+/* 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 ();
+      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_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 ((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 ();
+  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
@@ -2083,9 +2565,8 @@ parse_executable (gfc_statement st)
   if (st == ST_NONE)
     st = next_statement ();
 
-  for (;; st = next_statement ())
+  for (;;)
     {
-
       close_flag = check_do_closure ();
       if (close_flag)
 	switch (st)
@@ -2125,38 +2606,62 @@ parse_executable (gfc_statement st)
 	  accept_statement (st);
 	  if (close_flag == 1)
 	    return ST_IMPLIED_ENDDO;
-	  continue;
+	  break;
 
 	case ST_IF_BLOCK:
 	  parse_if_block ();
-	  continue;
+	  break;
 
 	case ST_SELECT_CASE:
 	  parse_select_block ();
-	  continue;
+	  break;
 
 	case ST_DO:
 	  parse_do_block ();
 	  if (check_do_closure () == 1)
 	    return ST_IMPLIED_ENDDO;
-	  continue;
+	  break;
 
 	case ST_WHERE_BLOCK:
 	  parse_where_block ();
-	  continue;
+	  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:
+	  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;
 
-	default:
+	case ST_OMP_ATOMIC:
+	  parse_omp_atomic ();
 	  break;
+
+	default:
+	  return st;
 	}
 
-      break;
+      st = next_statement ();
     }
-
-  return st;
 }
 
 
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index 193e115..f3b12e1 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -1,5 +1,5 @@
 /* Parser header
-   Copyright (C) 2003 Free Software Foundation, Inc.
+   Copyright (C) 2003, 2005, 2006 Free Software Foundation, Inc.
    Contributed by Steven Bosscher
 
 This file is part of GCC.
@@ -30,7 +30,8 @@ typedef enum
 {
   COMP_NONE, COMP_PROGRAM, COMP_MODULE, COMP_SUBROUTINE, COMP_FUNCTION,
   COMP_BLOCK_DATA, COMP_INTERFACE, COMP_DERIVED, COMP_IF, COMP_DO,
-  COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM
+  COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM,
+  COMP_OMP_STRUCTURED_BLOCK
 }
 gfc_compile_state;
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 84d5c7b..61983d1 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -48,10 +48,14 @@ code_stack;
 static code_stack *cs_base = NULL;
 
 
-/* Nonzero if we're inside a FORALL block */
+/* 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;
@@ -1314,6 +1318,15 @@ resolve_function (gfc_expr * expr)
 	    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;
+    }
 
   else if (expr->value.function.actual != NULL
 	     && expr->value.function.isym != NULL
@@ -4036,7 +4049,7 @@ gfc_resolve_forall_body (gfc_code *code, int nvar, gfc_expr **var_expr)
           gfc_resolve_assign_in_forall (c, nvar, var_expr);
           break;
 
-        /* Because the resolve_blocks() will handle the nested FORALL,
+        /* Because the gfc_resolve_blocks() will handle the nested FORALL,
            there is no need to handle it here.  */
         case EXEC_FORALL:
           break;
@@ -4055,8 +4068,6 @@ gfc_resolve_forall_body (gfc_code *code, int nvar, gfc_expr **var_expr)
 /* Given a FORALL construct, first resolve the FORALL iterator, then call
    gfc_resolve_forall_body to resolve the FORALL body.  */
 
-static void resolve_blocks (gfc_code *, gfc_namespace *);
-
 static void
 gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
 {
@@ -4122,7 +4133,7 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
   gfc_resolve_forall_body (code, nvar, var_expr);
 
   /* May call gfc_resolve_forall to resolve the inner FORALL loop.  */
-  resolve_blocks (code->block, ns);
+  gfc_resolve_blocks (code->block, ns);
 
   /* Free VAR_EXPR after the whole FORALL construct resolved.  */
   for (i = 0; i < total_var; i++)
@@ -4139,8 +4150,8 @@ gfc_resolve_forall (gfc_code *code, gfc_namespace *ns, int forall_save)
 
 static void resolve_code (gfc_code *, gfc_namespace *);
 
-static void
-resolve_blocks (gfc_code * b, gfc_namespace * ns)
+void
+gfc_resolve_blocks (gfc_code * b, gfc_namespace * ns)
 {
   try t;
 
@@ -4183,6 +4194,20 @@ resolve_blocks (gfc_code * b, gfc_namespace * ns)
 	case EXEC_IOLENGTH:
 	  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_WORKSHARE:
+	  break;
+
 	default:
 	  gfc_internal_error ("resolve_block(): Bad block type");
 	}
@@ -4198,7 +4223,7 @@ resolve_blocks (gfc_code * b, gfc_namespace * ns)
 static void
 resolve_code (gfc_code * code, gfc_namespace * ns)
 {
-  int forall_save = 0;
+  int omp_workshare_save;
   code_stack frame;
   gfc_alloc *a;
   try t;
@@ -4213,15 +4238,44 @@ resolve_code (gfc_code * code, gfc_namespace * ns)
 
       if (code->op == EXEC_FORALL)
 	{
-	  forall_save = forall_flag;
+	  int forall_save = forall_flag;
+
 	  forall_flag = 1;
-          gfc_resolve_forall (code, ns, forall_save);
-        }
-      else
-        resolve_blocks (code->block, ns);
+	  gfc_resolve_forall (code, ns, forall_save);
+	  forall_flag = forall_save;
+	}
+      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:
+	      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_OMP_WORKSHARE:
+	      omp_workshare_save = omp_workshare_flag;
+	      omp_workshare_flag = 1;
+	      /* FALLTHROUGH */
+	    default:
+	      gfc_resolve_blocks (code->block, ns);
+	      break;
+	    }
 
-      if (code->op == EXEC_FORALL)
-	forall_flag = forall_save;
+	  if (omp_workshare_save != -1)
+	    omp_workshare_flag = omp_workshare_save;
+	}
 
       t = gfc_resolve_expr (code->expr);
       if (gfc_resolve_expr (code->expr2) == FAILURE)
@@ -4358,7 +4412,11 @@ resolve_code (gfc_code * code, gfc_namespace * ns)
 
 	case EXEC_DO:
 	  if (code->ext.iterator != NULL)
-	    gfc_resolve_iterator (code->ext.iterator, true);
+	    {
+	      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:
@@ -4456,6 +4514,29 @@ resolve_code (gfc_code * code, gfc_namespace * ns)
 	       &code->expr->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_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:
+	  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");
 	}
@@ -5133,6 +5214,14 @@ resolve_symbol (gfc_symbol * sym)
       gfc_resolve (sym->formal_ns);
       formal_ns_flag = formal_ns_save;
     }
+
+  /* Check threadprivate restrictions.  */
+  if (sym->attr.threadprivate && !sym->attr.save
+      && (!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);
 }
 
 
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 690d6d7..2aadc1c 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -1,5 +1,5 @@
 /* Character scanner.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
    Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
@@ -60,7 +60,8 @@ static gfc_directorylist *include_dirs;
 
 static gfc_file *file_head, *current_file;
 
-static int continue_flag, end_flag;
+static int continue_flag, end_flag, openmp_flag;
+static locus openmp_locus;
 
 gfc_source_form gfc_current_form;
 static gfc_linebuf *line_head, *line_tail;
@@ -328,17 +329,17 @@ skip_free_comments (void)
 {
   locus start;
   char c;
+  int at_bol;
 
   for (;;)
     {
+      at_bol = gfc_at_bol ();
       start = gfc_current_locus;
       if (gfc_at_eof ())
 	break;
 
       do
-	{
-	  c = next_char ();
-	}
+	c = next_char ();
       while (gfc_is_whitespace (c));
 
       if (c == '\n')
@@ -349,6 +350,46 @@ skip_free_comments (void)
 
       if (c == '!')
 	{
+	  /* 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.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')
+			  && ((c = next_char ()) == ' ' || 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;
+			    }
+			}
+		      gfc_current_locus = old_loc;
+		      next_char ();
+		      c = next_char ();
+		    }
+		  if (continue_flag || c == ' ')
+		    {
+		      gfc_current_locus = old_loc;
+		      next_char ();
+		      return;
+		    }
+		}
+	      gfc_current_locus = old_loc;
+	    }
 	  skip_comment_line ();
 	  continue;
 	}
@@ -356,6 +397,8 @@ skip_free_comments (void)
       break;
     }
 
+  if (openmp_flag && at_bol)
+    openmp_flag = 0;
   gfc_current_locus = start;
 }
 
@@ -372,6 +415,28 @@ skip_fixed_comments (void)
   int col;
   char 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;
@@ -387,6 +452,66 @@ skip_fixed_comments (void)
 
       if (c == '!' || c == 'c' || c == 'C' || c == '*')
 	{
+	  /* 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_option.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 == '0'))
+			    {
+			      c = next_char ();
+			      while (gfc_is_whitespace (c))
+				c = next_char ();
+			      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 < '0' || c > '9')
+			  break;
+			else
+			  digit_seen = 1;
+
+		      if (col == 6 && c != '\n'
+			  && ((continue_flag && !digit_seen)
+			      || c == ' ' || c == '0'))
+			{
+			  gfc_current_locus = start;
+			  start.nextc[0] = ' ';
+			  start.nextc[1] = ' ';
+			  continue;
+			}
+		    }
+		}
+	      gfc_current_locus = start;
+	    }
 	  skip_comment_line ();
 	  continue;
 	}
@@ -425,18 +550,17 @@ skip_fixed_comments (void)
       break;
     }
 
+  openmp_flag = 0;
   gfc_current_locus = start;
 }
 
 
-/* Skips the current line if it is a comment.  Assumes that we are at
-   the start of the current line.  */
+/* Skips the current line if it is a comment.  */
 
 void
 gfc_skip_comments (void)
 {
-
-  if (!gfc_at_bol () || gfc_current_form == FORM_FREE)
+  if (gfc_current_form == FORM_FREE)
     skip_free_comments ();
   else
     skip_fixed_comments ();
@@ -454,7 +578,7 @@ int
 gfc_next_char_literal (int in_string)
 {
   locus old_loc;
-  int i, c;
+  int i, c, prev_openmp_flag;
 
   continue_flag = 0;
 
@@ -465,9 +589,13 @@ restart:
 
   if (gfc_current_form == FORM_FREE)
     {
-
       if (!in_string && c == '!')
 	{
+	  if (openmp_flag
+	      && memcmp (&gfc_current_locus, &openmp_locus,
+		 sizeof (gfc_current_locus)) == 0)
+	    goto done;
+
 	  /* This line can't be continued */
 	  do
 	    {
@@ -485,7 +613,7 @@ restart:
 	goto done;
 
       /* If the next nonblank character is a ! or \n, we've got a
-         continuation line.  */
+	 continuation line.  */
       old_loc = gfc_current_locus;
 
       c = next_char ();
@@ -493,7 +621,7 @@ restart:
 	c = next_char ();
 
       /* Character constants to be continued cannot have commentary
-         after the '&'.  */
+	 after the '&'.  */
 
       if (in_string && c != '\n')
 	{
@@ -509,6 +637,7 @@ restart:
 	  goto done;
 	}
 
+      prev_openmp_flag = openmp_flag;
       continue_flag = 1;
       if (c == '!')
 	skip_comment_line ();
@@ -516,13 +645,21 @@ restart:
 	gfc_advance_line ();
 
       /* We've got a continuation line and need to find where it continues.
-         First eat any comment lines.  */
+	 First eat any comment lines.  */
       gfc_skip_comments ();
 
+      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.  */
+	 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;
 
@@ -530,9 +667,20 @@ restart:
       while (gfc_is_whitespace (c))
 	c = next_char ();
 
+      if (openmp_flag)
+	{
+	  for (i = 0; i < 5; i++, c = next_char ())
+	    {
+	      gcc_assert (TOLOWER (c) == "!$omp"[i]);
+	      if (i == 4)
+		old_loc = gfc_current_locus;
+	    }
+	  while (gfc_is_whitespace (c))
+	    c = next_char ();
+	}
+
       if (c != '&')
 	gfc_current_locus = old_loc;
-
     }
   else
     {
@@ -553,6 +701,7 @@ restart:
       if (c != '\n')
 	goto done;
 
+      prev_openmp_flag = openmp_flag;
       continue_flag = 1;
       old_loc = gfc_current_locus;
 
@@ -560,15 +709,29 @@ restart:
       gfc_skip_comments ();
 
       /* See if this line is a continuation line.  */
-      for (i = 0; i < 5; i++)
+      if (openmp_flag != prev_openmp_flag)
 	{
-	  c = next_char ();
-	  if (c != ' ')
-	    goto not_continuation;
+	  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 (TOLOWER (c) != "*$omp"[i])
+	      goto not_continuation;
+	  }
+
       c = next_char ();
-      if (c == '0' || c == ' ')
+      if (c == '0' || c == ' ' || c == '\n')
 	goto not_continuation;
     }
 
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index dc0a01e..e7461a7 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -1,5 +1,6 @@
 /* Build executable statement trees.
-   Copyright (C) 2000, 2001, 2002, 2004, 2005 Free Software Foundation, Inc.
+   Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006
+   Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
@@ -161,6 +162,33 @@ gfc_free_statement (gfc_code * p)
       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_WORKSHARE:
+    case EXEC_OMP_PARALLEL_WORKSHARE:
+      gfc_free_omp_clauses (p->ext.omp_clauses);
+      break;
+
+    case EXEC_OMP_CRITICAL:
+      gfc_free ((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:
+      break;
+
     default:
       gfc_internal_error ("gfc_free_statement(): Bad statement");
     }
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 111c692..7fc7ef1 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -265,6 +265,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
     *dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE",
     *use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
     *cray_pointee = "CRAY POINTEE", *data = "DATA";
+  static const char *threadprivate = "THREADPRIVATE";
 
   const char *a1, *a2;
 
@@ -308,6 +309,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
     }
 
   conf (dummy, save);
+  conf (dummy, threadprivate);
   conf (pointer, target);
   conf (pointer, external);
   conf (pointer, intrinsic);
@@ -347,6 +349,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
   conf (in_equivalence, result);
   conf (in_equivalence, entry);
   conf (in_equivalence, allocatable);
+  conf (in_equivalence, threadprivate);
 
   conf (in_namelist, pointer);
   conf (in_namelist, allocatable);
@@ -381,6 +384,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
   conf (cray_pointee, entry);
   conf (cray_pointee, in_common);
   conf (cray_pointee, in_equivalence);
+  conf (cray_pointee, threadprivate);
 
   conf (data, dummy);
   conf (data, function);
@@ -417,6 +421,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
       conf2 (optional);
       conf2 (function);
       conf2 (subroutine);
+      conf2 (threadprivate);
       break;
 
     case FL_VARIABLE:
@@ -435,6 +440,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
 	  conf2(result);
 	  conf2(in_namelist);
 	  conf2(function);
+	  conf2(threadprivate);
 	}
 
       switch (attr->proc)
@@ -452,6 +458,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
 	  conf2 (result);
 	  conf2 (in_common);
 	  conf2 (save);
+	  conf2 (threadprivate);
 	  break;
 
 	default:
@@ -472,6 +479,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
       conf2 (entry);
       conf2 (function);
       conf2 (subroutine);
+      conf2 (threadprivate);
 
       if (attr->intent != INTENT_UNKNOWN)
 	{
@@ -493,6 +501,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
       conf2 (dummy);
       conf2 (in_common);
       conf2 (save);
+      conf2 (threadprivate);
       break;
 
     default:
@@ -782,6 +791,23 @@ gfc_add_save (symbol_attribute * attr, const char *name, locus * where)
 
 
 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);
+}
+
+
+try
 gfc_add_target (symbol_attribute * attr, locus * where)
 {
 
@@ -1191,6 +1217,8 @@ gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where)
     goto fail;
   if (src->save && gfc_add_save (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)
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index ebd7f52..c8f92bd 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -1,5 +1,6 @@
 /* Common block and equivalence list handling
-   Copyright (C) 2000, 2003, 2004, 2005 Free Software Foundation, Inc.
+   Copyright (C) 2000, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
    Contributed by Canqun Yang <canqun@nudt.edu.cn>
 
 This file is part of GCC.
@@ -96,6 +97,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "config.h"
 #include "system.h"
 #include "coretypes.h"
+#include "target.h"
 #include "tree.h"
 #include "toplev.h"
 #include "tm.h"
@@ -103,6 +105,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "trans.h"
 #include "trans-types.h"
 #include "trans-const.h"
+#include "rtl.h"
 
 
 /* Holds a single variable in an equivalence set.  */
@@ -278,6 +281,7 @@ build_equiv_decl (tree union_type, bool is_init, bool is_saved)
     {
       decl = gfc_create_var (union_type, "equiv");
       TREE_STATIC (decl) = 1;
+      GFC_DECL_COMMON_OR_EQUIV (decl) = 1;
       return decl;
     }
 
@@ -292,6 +296,7 @@ build_equiv_decl (tree union_type, bool is_init, bool is_saved)
 
   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.  */
@@ -349,9 +354,13 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
       TREE_STATIC (decl) = 1;
       DECL_ALIGN (decl) = BIGGEST_ALIGNMENT;
       DECL_USER_ALIGN (decl) = 0;
+      GFC_DECL_COMMON_OR_EQUIV (decl) = 1;
 
       gfc_set_decl_location (decl, &com->where);
 
+      if (com->threadprivate && targetm.have_tls)
+	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);
@@ -493,6 +502,7 @@ create_common (gfc_common_head *com, segment_info * head, bool saw_equiv)
 			   build3 (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)
 	{
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 3d43c66..1def170 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -40,6 +40,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "trans-types.h"
 #include "trans-array.h"
 #include "trans-const.h"
+#include "rtl.h"
 /* Only for gfc_trans_code.  Shouldn't need to include this.  */
 #include "trans-stmt.h"
 
@@ -389,6 +390,7 @@ gfc_finish_cray_pointee (tree decl, gfc_symbol *sym)
 
   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;
 }
@@ -508,6 +510,11 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
       && INTEGER_CST_P (DECL_SIZE_UNIT (decl))
       && !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl)))
     TREE_STATIC (decl) = 1;
+
+  /* Handle threadprivate variables.  */
+  if (sym->attr.threadprivate && targetm.have_tls
+      && (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
+    DECL_TLS_MODEL (decl) = decl_default_tls_model (decl);
 }
 
 
@@ -1473,6 +1480,11 @@ gfc_gimplify_function (tree fndecl)
   gimplify_function_tree (fndecl);
   dump_function (TDI_generic, fndecl);
 
+  /* Generate errors for structured block violations.  */
+  /* ??? Could be done as part of resolve_labels.  */
+  if (flag_openmp)
+    diagnose_omp_structured_block_errors (fndecl);
+
   /* Convert all nested functions to GIMPLE now.  We do things in this order
      so that items like VLA sizes are expanded properly in the context of the
      correct function.  */
@@ -1755,6 +1767,7 @@ gfc_get_fake_result_decl (gfc_symbol * sym)
 			 NULL_TREE);
 	}
       var = gfc_create_var (TREE_TYPE (decl), sym->name);
+      GFC_DECL_RESULT (var) = 1;
       SET_DECL_VALUE_EXPR (var, decl);
       DECL_HAS_VALUE_EXPR_P (var) = 1;
       TREE_CHAIN (current_fake_result_decl)
@@ -1806,6 +1819,7 @@ gfc_get_fake_result_decl (gfc_symbol * sym)
       DECL_EXTERNAL (decl) = 0;
       TREE_PUBLIC (decl) = 0;
       TREE_USED (decl) = 1;
+      GFC_DECL_RESULT (decl) = 1;
 
       layout_decl (decl, 0);
 
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
new file mode 100644
index 0000000..44be1b7
--- /dev/null
+++ b/gcc/fortran/trans-openmp.c
@@ -0,0 +1,1203 @@
+/* OpenMP directive translation -- generate GCC trees from gfc_code.
+   Copyright (C) 2005, 2006 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 2, 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 COPYING.  If not, write to the Free
+Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.  */
+
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "tree-gimple.h"
+#include "ggc.h"
+#include "toplev.h"
+#include "real.h"
+#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"
+
+
+/* True if OpenMP should privatize what this DECL points to rather
+   than the DECL itself.  */
+
+bool
+gfc_omp_privatize_by_reference (tree decl)
+{
+  tree type = TREE_TYPE (decl);
+
+  if (TREE_CODE (type) == REFERENCE_TYPE)
+    return true;
+
+  if (TREE_CODE (type) == POINTER_TYPE)
+    {
+      /* POINTER/ALLOCATABLE have aggregate types, all user variables
+	 that have POINTER_TYPE type are supposed to be privatized
+	 by reference.  */
+      if (!DECL_ARTIFICIAL (decl))
+	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))
+    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;
+
+  /* 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 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);
+
+  /* Special case for assigning the return value of a function.
+     Self recursive functions must have an explicit return value.  */
+  if (t == current_function_decl && sym->attr.function
+      && (sym->result == sym))
+    t = gfc_get_fake_result_decl (sym);
+
+  /* Similarly for alternate entry points.  */
+  else if (sym->attr.function && sym->attr.entry
+	   && (sym->result == sym)
+	   && sym->ns->proc_name->backend_decl == current_function_decl)
+    {
+      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);
+	    break;
+	  }
+    }
+
+  else if (sym->attr.result
+	   && sym->ns->proc_name->backend_decl == current_function_decl
+	   && sym->ns->proc_name->attr.entry_master
+	   && !gfc_return_by_reference (sym->ns->proc_name))
+    t = gfc_get_fake_result_decl (sym);
+
+  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 (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;
+  locus old_loc = gfc_current_locus;
+  const char *iname;
+  try t;
+
+  decl = OMP_CLAUSE_DECL (c);
+  gfc_current_locus = where;
+
+  /* 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;
+  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.backend_decl = create_tmp_var_raw (TREE_TYPE (decl), NULL);
+
+  /* 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->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.  */
+  OMP_CLAUSE_REDUCTION_INIT (c) = gfc_trans_assignment (e1, e2);
+
+  /* Create the merge statement list.  */
+  OMP_CLAUSE_REDUCTION_MERGE (c) = gfc_trans_assignment (e3, e4);
+
+  /* And stick the placeholder VAR_DECL into the clause as well.  */
+  OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_sym.backend_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 (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, old_clauses;
+  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 ();
+	    }
+	  old_clauses = omp_clauses;
+	  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 (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 (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 (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;
+	default:
+	  gcc_unreachable ();
+	}
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
+    {
+      c = build_omp_clause (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;
+	default:
+	  gcc_unreachable ();
+	}
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  if (clauses->nowait)
+    {
+      c = build_omp_clause (OMP_CLAUSE_NOWAIT);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
+  if (clauses->ordered)
+    {
+      c = build_omp_clause (OMP_CLAUSE_ORDERED);
+      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->expr->symtree->n.sym;
+
+  gfc_init_se (&lse, NULL);
+  gfc_init_se (&rse, NULL);
+  gfc_start_block (&block);
+
+  gfc_conv_expr (&lse, code->expr);
+  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->generic_id == GFC_ISYM_CONVERSION)
+    expr2 = expr2->value.function.actual->expr;
+
+  if (expr2->expr_type == EXPR_OP)
+    {
+      gfc_expr *e;
+      switch (expr2->value.op.operator)
+	{
+	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->generic_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->generic_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->generic_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_expr (&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 (op, TREE_TYPE (accum), accum, rse.expr);
+	      gfc_add_modify_expr (&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 (lhsaddr));
+
+  if (var_on_left)
+    x = fold_build2 (op, TREE_TYPE (rhs), x, rhs);
+  else
+    x = fold_build2 (op, TREE_TYPE (rhs), rhs, x);
+
+  if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
+      && TREE_CODE (type) != COMPLEX_TYPE)
+    x = build1 (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_function_call_expr (decl, NULL);
+}
+
+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_v (OMP_CRITICAL, stmt, name);
+}
+
+static tree
+gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
+		  gfc_omp_clauses *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;
+  int simple = 0;
+  bool dovar_found = false;
+
+  code = code->block->next;
+  gcc_assert (code->op == EXEC_DO);
+
+  if (pblock == NULL)
+    {
+      gfc_start_block (&block);
+      pblock = &block;
+    }
+
+  omp_clauses = gfc_trans_omp_clauses (pblock, clauses, code->loc);
+  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)
+	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 = true;
+    }
+
+  /* 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);
+
+  /* Special case simple loops.  */
+  if (integer_onep (step))
+    simple = 1;
+  else if (tree_int_cst_equal (step, integer_minus_one_node))
+    simple = -1;
+
+  /* Loop body.  */
+  if (simple)
+    {
+      init = build2_v (MODIFY_EXPR, dovar, from);
+      cond = build2 (simple > 0 ? LE_EXPR : GE_EXPR, boolean_type_node,
+		     dovar, to);
+      incr = fold_build2 (PLUS_EXPR, type, dovar, step);
+      incr = fold_build2 (MODIFY_EXPR, type, dovar, incr);
+      if (pblock != &block)
+	{
+	  pushlevel (0);
+	  gfc_start_block (&block);
+	}
+      gfc_start_block (&body);
+    }
+  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 (MINUS_EXPR, type, step, from);
+      tmp = fold_build2 (PLUS_EXPR, type, to, tmp);
+      tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step);
+      tmp = gfc_evaluate_now (tmp, pblock);
+      count = gfc_create_var (type, "count");
+      init = build2_v (MODIFY_EXPR, count, build_int_cst (type, 0));
+      cond = build2 (LT_EXPR, boolean_type_node, count, tmp);
+      incr = fold_build2 (PLUS_EXPR, type, count, build_int_cst (type, 1));
+      incr = fold_build2 (MODIFY_EXPR, type, count, incr);
+
+      if (pblock != &block)
+	{
+	  pushlevel (0);
+	  gfc_start_block (&block);
+	}
+      gfc_start_block (&body);
+
+      /* Initialize DOVAR.  */
+      tmp = fold_build2 (MULT_EXPR, type, count, step);
+      tmp = build2 (PLUS_EXPR, type, from, tmp);
+      gfc_add_modify_expr (&body, dovar, tmp);
+    }
+
+  if (!dovar_found)
+    {
+      tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
+      OMP_CLAUSE_DECL (tmp) = dovar;
+      omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
+    }
+  if (!simple)
+    {
+      tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
+      OMP_CLAUSE_DECL (tmp) = count;
+      omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
+    }
+
+  /* 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. We put the
+     labels in a TREE_LIST node (because TREE_CHAIN is already
+     used). cycle_label goes in TREE_PURPOSE (backend_decl), exit
+     label in TREE_VALUE (backend_decl).  */
+
+  code->block->backend_decl = tree_cons (cycle_label, NULL, NULL);
+
+  /* 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_function_call_expr (decl, NULL);
+}
+
+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 = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
+  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;
+      parallel_clauses.sched_kind = OMP_SCHED_NONE;
+      parallel_clauses.chunk_size = NULL;
+      parallel_clauses.ordered = false;
+      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);
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
+  else
+    poplevel (0, 0, 0);
+  stmt = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
+  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 = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
+  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 = build4_v (OMP_PARALLEL, stmt, omp_clauses, NULL, NULL);
+  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 = build3_v (OMP_SECTIONS, stmt, omp_clauses, NULL);
+  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_v (OMP_SINGLE, stmt, omp_clauses);
+  return stmt;
+}
+
+static tree
+gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
+{
+  /* XXX */
+  return gfc_trans_omp_single (code, clauses);
+}
+
+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);
+    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_WORKSHARE:
+      return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
+    default:
+      gcc_unreachable ();
+    }
+}
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index f33d7ac..a71c8bf 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -51,6 +51,9 @@ 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 *);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index dff5065..a586932 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -583,6 +583,23 @@ gfc_trans_code (gfc_code * code)
 	  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_WORKSHARE:
+	  res = gfc_trans_omp_directive (code);
+	  break;
+
 	default:
 	  internal_error ("gfc_trans_code(): Bad statement code");
 	}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index c7c2301..82f74e0 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -439,6 +439,14 @@ tree gfc_truthvalue_conversion (tree);
 tree builtin_function (const char *, tree, int, enum built_in_class,
 		       const char *, tree);
 
+/* In trans-openmp.c */
+bool gfc_omp_privatize_by_reference (tree);
+enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);
+bool gfc_omp_disregard_value_expr (tree, bool);
+bool gfc_omp_private_debug_clause (tree, bool);
+struct gimplify_omp_ctx;
+void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree);
+
 /* Runtime library function decls.  */
 extern GTY(()) tree gfor_fndecl_internal_malloc;
 extern GTY(()) tree gfor_fndecl_internal_malloc64;
@@ -548,6 +556,9 @@ struct lang_decl		GTY(())
 #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)
 
 /* An array descriptor.  */
 #define GFC_DESCRIPTOR_TYPE_P(node) TYPE_LANG_FLAG_1(node)
@@ -580,6 +591,8 @@ struct lang_decl		GTY(())
                                           arg1, arg2)
 #define build3_v(code, arg1, arg2, arg3) build3(code, void_type_node, \
                                                 arg1, arg2, arg3)
+#define build4_v(code, arg1, arg2, arg3, arg4) build4(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
diff --git a/gcc/fortran/types.def b/gcc/fortran/types.def
new file mode 100644
index 0000000..5a3e5d7
--- /dev/null
+++ b/gcc/fortran/types.def
@@ -0,0 +1,132 @@
+/* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006
+   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 2, 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 COPYING.  If not, write to the Free
+Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.  */
+
+/* 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, boolean_type_node)
+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_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_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_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_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_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_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_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_VAR_0 (BT_FN_VOID_VAR, BT_VOID)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index daac3ab..d12f874 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2006-02-14  Jakub Jelinek  <jakub@redhat.com>
+	    Diego Novillo  <dnovillo@redhat.com>
+	    Uros Bizjak  <uros@kss-loka.si>
+
+	* gfortran.dg/gomp: New directory.
+
 2006-02-14  Richard Guenther  <rguenther@suse.de>
 
 	PR tree-optimization/26258
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.1.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.1.1.f90
new file mode 100644
index 0000000..fd83131
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.1.1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+      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
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.1.f90
new file mode 100644
index 0000000..eb8455e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+      SUBROUTINE A11_1(AA, BB, CC, DD, EE, FF, N)
+      INTEGER N
+      REAL AA(N,N), BB(N,N), CC(N,N), DD(N,N), EE(N,N), FF(N,N)
+!$OMP PARALLEL
+!$OMP WORKSHARE
+            AA = BB
+            CC = DD
+            EE = FF
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_1
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.2.f90
new file mode 100644
index 0000000..11fdc1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.2.f90
@@ -0,0 +1,16 @@
+! { do-do compile }
+
+      SUBROUTINE A11_2(AA, BB, CC, DD, EE, FF, N)
+      INTEGER N
+      REAL AA(N,N), BB(N,N), CC(N,N)
+      REAL DD(N,N), EE(N,N), FF(N,N)
+!$OMP PARALLEL
+!$OMP WORKSHARE
+            AA = BB
+            CC = DD
+!$OMP END WORKSHARE NOWAIT
+!$OMP WORKSHARE
+            EE = FF
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_2
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.3.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.3.f90
new file mode 100644
index 0000000..b87232f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+      SUBROUTINE A11_3(AA, BB, CC, DD, N)
+      INTEGER N
+      REAL AA(N,N), BB(N,N), CC(N,N), DD(N,N)
+      REAL R
+        R=0
+!$OMP PARALLEL
+!$OMP WORKSHARE
+             AA = BB
+!$OMP ATOMIC
+               R = R + SUM(AA)
+             CC = DD
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_3
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.4.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.4.f90
new file mode 100644
index 0000000..ae95c1f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.4.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+
+      SUBROUTINE A11_4(AA, BB, CC, DD, EE, FF, GG, HH, N)
+      INTEGER N
+      REAL AA(N,N), BB(N,N), CC(N,N)
+      REAL DD(N,N), EE(N,N), FF(N,N)
+      REAL GG(N,N), HH(N,N)
+!$OMP PARALLEL
+!$OMP WORKSHARE
+            AA = BB
+            CC = DD
+            WHERE (EE .ne. 0) FF = 1 / EE
+            GG = HH
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_4
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.5.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.5.f90
new file mode 100644
index 0000000..6b8e4fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.5.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+        SUBROUTINE A11_5(AA, BB, CC, DD, N)
+        INTEGER N
+        REAL AA(N,N), BB(N,N), CC(N,N), DD(N,N)
+        INTEGER SHR
+!$OMP PARALLEL SHARED(SHR)
+!$OMP WORKSHARE
+            AA = BB
+            SHR = 1
+            CC = DD * SHR
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_5
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.6.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.6.f90
new file mode 100644
index 0000000..fa31bcf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.6.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+
+      SUBROUTINE A11_6_WRONG(AA, BB, CC, DD, N)
+      INTEGER N
+      REAL AA(N,N), BB(N,N), CC(N,N), DD(N,N)
+        INTEGER PRI
+!$OMP PARALLEL PRIVATE(PRI)
+!$OMP WORKSHARE
+            AA = BB
+            PRI = 1
+            CC = DD * PRI
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_6_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.7.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.7.f90
new file mode 100644
index 0000000..86b8c7b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.11.7.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+      SUBROUTINE A11_7(AA, BB, CC, N)
+      INTEGER N
+      REAL AA(N), BB(N), CC(N)
+!$OMP PARALLEL
+!$OMP WORKSHARE
+            AA(1:50) = BB(11:60)
+            CC(11:20) = AA(1:10)
+!$OMP END WORKSHARE
+!$OMP END PARALLEL
+      END SUBROUTINE A11_7
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.12.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.12.1.f90
new file mode 100644
index 0000000..38389e4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.12.1.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+      SUBROUTINE A12( X, XOLD, N, TOL )
+      REAL X(*), XOLD(*), TOL
+      INTEGER N
+      INTEGER C, I, TOOBIG
+      REAL ERROR, Y, AVERAGE
+      EXTERNAL AVERAGE
+      C=0
+      TOOBIG = 1
+!$OMP PARALLEL
+        DO WHILE( TOOBIG > 0 )
+!$OMP DO PRIVATE(I)
+            DO I = 2, N-1
+               XOLD(I) = X(I)
+            ENDDO
+!$OMP SINGLE
+            TOOBIG = 0
+!$OMP END SINGLE
+!$OMP DO PRIVATE(I,Y,ERROR), REDUCTION(+:TOOBIG)
+            DO I = 2, N-1
+               Y = X(I)
+               X(I) = AVERAGE( XOLD(I-1), X(I), XOLD(I+1) )
+               ERROR = Y-X(I)
+               IF( ERROR > TOL .OR. ERROR < -TOL ) TOOBIG = TOOBIG+1
+            ENDDO
+!$OMP MASTER
+            C=C+1
+            PRINT *, "Iteration ", C, " TOOBIG=", TOOBIG
+!$OMP END MASTER
+        ENDDO
+!$OMP END PARALLEL
+      END SUBROUTINE A12
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.13.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.13.1.f90
new file mode 100644
index 0000000..57f5b89
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.13.1.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+        SUBROUTINE A13(X, Y)
+        REAL X(*), Y(*)
+        INTEGER IX_NEXT, IY_NEXT
+!$OMP PARALLEL SHARED(X, Y) PRIVATE(IX_NEXT, IY_NEXT)
+!$OMP CRITICAL(XAXIS)
+        CALL DEQUEUE(IX_NEXT, X)
+!$OMP END CRITICAL(XAXIS)
+        CALL WORK(IX_NEXT, X)
+!$OMP CRITICAL(YAXIS)
+        CALL DEQUEUE(IY_NEXT,Y)
+!$OMP END CRITICAL(YAXIS)
+        CALL WORK(IY_NEXT, Y)
+!$OMP END PARALLEL
+      END SUBROUTINE A13
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.14.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.14.1.f90
new file mode 100644
index 0000000..6db107a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.14.1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+      SUBROUTINE A14()
+        INTEGER I
+        I=1
+!$OMP PARALLEL SECTIONS
+!$OMP SECTION
+!$OMP CRITICAL (NAME)
+!$OMP PARALLEL
+!$OMP SINGLE
+                  I=I+1
+!$OMP END SINGLE
+!$OMP END PARALLEL
+!$OMP END CRITICAL (NAME)
+!$OMP END PARALLEL SECTIONS
+      END SUBROUTINE A14
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.1.f90
new file mode 100644
index 0000000..8fd6001
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.1.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+      SUBROUTINE A17_1_WRONG()
+        INTEGER:: I
+        REAL:: R
+        EQUIVALENCE(I,R)
+!$OMP PARALLEL
+!$OMP ATOMIC
+            I=I+1
+!$OMP ATOMIC
+            R = R + 1.0
+! incorrect because I and R reference the same location
+! but have different types
+!$OMP END PARALLEL
+        END SUBROUTINE A17_1_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.2.f90
new file mode 100644
index 0000000..a19db8c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.2.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+
+      SUBROUTINE SUB()
+        COMMON /BLK/ R
+        REAL R
+!$OMP ATOMIC
+        R = R + 1.0
+      END SUBROUTINE SUB
+
+      SUBROUTINE A17_2_WRONG()
+      COMMON /BLK/ I
+      INTEGER I
+!$OMP PARALLEL
+!$OMP ATOMIC
+            I=I+1
+          CALL SUB()
+!$OMP END PARALLEL
+      END SUBROUTINE A17_2_WRONG
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.3.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.3.f90
new file mode 100644
index 0000000..4f4f55c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.17.3.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+      SUBROUTINE A17_3_WRONG
+        INTEGER:: I
+        REAL:: R
+        EQUIVALENCE(I,R)
+!$OMP PARALLEL
+!$OMP ATOMIC
+            I=I+1
+! incorrect because I and R reference the same location
+! but have different types
+!$OMP END PARALLEL
+!$OMP PARALLEL
+!$OMP ATOMIC
+            R = R + 1.0
+! incorrect because I and R reference the same location
+! but have different types
+!$OMP END PARALLEL
+      END SUBROUTINE A17_3_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.21.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.21.2.f90
new file mode 100644
index 0000000..87359a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.21.2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+      SUBROUTINE WORK(I)
+      INTEGER I
+      END SUBROUTINE WORK
+      SUBROUTINE A21_WRONG(N)
+      INTEGER N
+        INTEGER I
+!$OMP DO ORDERED
+        DO I = 1, N
+! incorrect because an iteration may not execute more than one
+! ordered region
+!$OMP ORDERED
+            CALL WORK(I)
+!$OMP END ORDERED
+!$OMP ORDERED
+            CALL WORK(I+1)
+!$OMP END ORDERED
+        END DO
+      END SUBROUTINE A21_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.21.3.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.21.3.f90
new file mode 100644
index 0000000..97ca8f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.21.3.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+
+      SUBROUTINE A21_GOOD(N)
+      INTEGER N
+!$OMP DO ORDERED
+        DO I = 1,N
+          IF (I <= 10) THEN
+!$OMP ORDERED
+              CALL WORK(I)
+!$OMP END ORDERED
+          ENDIF
+          IF (I > 10) THEN
+!$OMP ORDERED
+              CALL WORK(I+1)
+!$OMP END ORDERED
+          ENDIF
+        ENDDO
+      END SUBROUTINE A21_GOOD
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.1.f90
new file mode 100644
index 0000000..cc94b14
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+      INTEGER FUNCTION INCREMENT_COUNTER()
+        COMMON/A22_COMMON/COUNTER
+!$OMP THREADPRIVATE(/A22_COMMON/)
+        COUNTER = COUNTER +1
+        INCREMENT_COUNTER = COUNTER
+        RETURN
+      END FUNCTION INCREMENT_COUNTER
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.4.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.4.f90
new file mode 100644
index 0000000..f769fc1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.4.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+      MODULE A22_MODULE
+      COMMON /T/ A
+      END MODULE A22_MODULE
+      SUBROUTINE A22_4_WRONG()
+        USE A22_MODULE
+!$OMP THREADPRIVATE(/T/)	! { dg-error "COMMON block" }
+      !non-conforming because /T/ not declared in A22_4_WRONG
+      END SUBROUTINE A22_4_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.5.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.5.f90
new file mode 100644
index 0000000..6531d82
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.5.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+      SUBROUTINE A22_5_WRONG()
+        COMMON /T/ A
+!$OMP THREADPRIVATE(/T/)
+        CONTAINS
+          SUBROUTINE A22_5S_WRONG()
+!$OMP PARALLEL COPYIN(/T/)	! { dg-error "COMMON block" }
+      !non-conforming because /T/ not declared in A22_5S_WRONG
+!$OMP END PARALLEL		! { dg-error "Unexpected" }
+          END SUBROUTINE A22_5S_WRONG
+      END SUBROUTINE A22_5_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.6.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.6.f90
new file mode 100644
index 0000000..0a2e6a6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.22.6.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+       SUBROUTINE A22_6_GOOD()
+             COMMON /T/ A
+!$OMP THREADPRIVATE(/T/)
+       CONTAINS
+         SUBROUTINE A22_6S_GOOD()
+           COMMON /T/ A
+!$OMP THREADPRIVATE(/T/)
+!$OMP PARALLEL COPYIN(/T/)
+!$OMP END PARALLEL
+        END SUBROUTINE A22_6S_GOOD
+      END SUBROUTINE A22_6_GOOD
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.1.f90
new file mode 100644
index 0000000..6eab687
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+      SUBROUTINE A23_1_GOOD()
+        COMMON /C/ X,Y
+        REAL X, Y
+!$OMP PARALLEL PRIVATE (/C/)
+          ! do work here
+!$OMP END PARALLEL
+!$OMP PARALLEL SHARED (X,Y)
+          ! do work here
+!$OMP END PARALLEL
+      END SUBROUTINE A23_1_GOOD
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.2.f90
new file mode 100644
index 0000000..ecfdbe5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.2.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+      SUBROUTINE A23_2_GOOD()
+         COMMON /C/ X,Y
+         REAL X, Y
+         INTEGER I
+!$OMP PARALLEL
+!$OMP DO PRIVATE(/C/)
+           DO I=1,1000
+             ! do work here
+           ENDDO
+!$OMP END DO
+!
+!$OMP DO PRIVATE(X)
+           DO I=1,1000
+             ! do work here
+           ENDDO
+!$OMP END DO
+!$OMP END PARALLEL
+       END SUBROUTINE A23_2_GOOD
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.3.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.3.f90
new file mode 100644
index 0000000..abd8041
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.3.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+
+      SUBROUTINE A23_3_GOOD()
+        COMMON /C/ X,Y
+!$OMP PARALLEL PRIVATE (/C/)
+          ! do work here
+!$OMP END PARALLEL
+!$OMP PARALLEL SHARED (/C/)
+          ! do work here
+!$OMP END PARALLEL
+      END SUBROUTINE A23_3_GOOD
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.4.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.4.f90
new file mode 100644
index 0000000..8c6e228
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.4.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+
+        SUBROUTINE A23_4_WRONG()
+        COMMON /C/ X,Y
+! Incorrect because X is a constituent element of C
+!$OMP PARALLEL PRIVATE(/C/), SHARED(X)	! { dg-error "Symbol 'x' present" }
+          ! do work here
+!$OMP END PARALLEL
+      END SUBROUTINE A23_4_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.5.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.5.f90
new file mode 100644
index 0000000..732c15f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.23.5.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+
+      SUBROUTINE A23_5_WRONG()
+        COMMON /C/ X,Y
+! Incorrect: common block C cannot be declared both
+! shared and private
+!$OMP PARALLEL PRIVATE (/C/), SHARED(/C/)
+          ! { dg-error "Symbol 'y' present" "" { target *-*-* } 7 }
+          ! { dg-error "Symbol 'x' present" "" { target *-*-* } 7 }
+          ! do work here
+!$OMP END PARALLEL
+      END SUBROUTINE A23_5_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.24.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.24.1.f90
new file mode 100644
index 0000000..e5b9545
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.24.1.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+      SUBROUTINE A24(A)
+      INTEGER A
+      INTEGER X, Y, Z(1000)
+      INTEGER OMP_GET_NUM_THREADS
+      COMMON/BLOCKX/X
+      COMMON/BLOCKY/Y
+      COMMON/BLOCKZ/Z
+!$OMP THREADPRIVATE(/BLOCKX/)
+      INTEGER I, J
+      i=1
+!$OMP PARALLEL DEFAULT(NONE) PRIVATE(A) SHARED(Z) PRIVATE(J)
+      J = OMP_GET_NUM_THREADS();
+               ! O.K. - J is listed in PRIVATE clause
+      A = Z(J) ! O.K. - A is listed in PRIVATE clause
+               !       - Z is listed in SHARED clause
+      X=1      ! O.K. - X is THREADPRIVATE
+      Z(I) = Y ! Error - cannot reference I or Y here
+! { dg-error "'i' not specified" "" { target *-*-* } 20 } */
+! { dg-error "enclosing parallel" "" { target *-*-* } 14 } */
+! { dg-error "'y' not specified" "" { target *-*-* } 20 }  */
+!$OMP DO firstprivate(y)
+      DO I = 1,10
+        Z(I) = Y ! O.K. - I is the loop iteration variable
+                 ! Y is listed in FIRSTPRIVATE clause
+      END DO
+      Z(I) = Y    ! Error - cannot reference I or Y here
+!$OMP END PARALLEL
+      END SUBROUTINE A24
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.25.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.25.1.f90
new file mode 100644
index 0000000..66bfba8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.25.1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+
+        SUBROUTINE A25
+        INTEGER OMP_GET_THREAD_NUM
+        REAL A(20)
+        INTEGER MYTHREAD
+        !$OMP PARALLEL SHARED(A) PRIVATE(MYTHREAD)
+        MYTHREAD = OMP_GET_THREAD_NUM()
+        IF (MYTHREAD .EQ. 0) THEN
+            CALL SUB(A(1:10)) ! compiler may introduce writes to A(6:10)
+        ELSE
+            A(6:10) = 12
+        ENDIF
+        !$OMP END PARALLEL
+        END SUBROUTINE A25
+        SUBROUTINE SUB(X)
+        REAL X(*)
+        X(1:5) = 4
+        END SUBROUTINE SUB
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.26.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.26.2.f90
new file mode 100644
index 0000000..97c14d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.26.2.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+
+       MODULE A26_2
+       REAL A
+       CONTAINS
+         SUBROUTINE G(K)
+           REAL K
+           A = K ! This is A in module A26_2, not the private
+                  ! A in F
+         END SUBROUTINE G
+         SUBROUTINE F(N)
+         INTEGER N
+         REAL A
+            INTEGER I
+!$OMP PARALLEL DO PRIVATE(A)
+              DO I = 1,N
+                A=I
+                CALL G(A*2)
+              ENDDO
+!$OMP END PARALLEL DO
+          END SUBROUTINE F
+      END MODULE A26_2
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.27.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.27.1.f90
new file mode 100644
index 0000000..f564bd3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.27.1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+
+       SUBROUTINE A27()
+         INTEGER I, A
+!$OMP PARALLEL PRIVATE(A)
+!$OMP PARALLEL DO PRIVATE(A)
+           DO I = 1, 10
+              ! do work here
+          END DO
+!$OMP END PARALLEL DO
+!$OMP END PARALLEL
+      END SUBROUTINE A27
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.30.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.30.1.f90
new file mode 100644
index 0000000..e62cbf8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.30.1.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+
+      SUBROUTINE A30(N, A, B)
+       INTEGER N
+       REAL A(*), B(*)
+        INTEGER I
+!$OMP PARALLEL
+!$OMP DO LASTPRIVATE(I)
+        DO I=1,N-1
+          A(I) = B(I) + B(I+1)
+        ENDDO
+!$OMP END PARALLEL
+        A(I) = B(I)      ! I has the value of N here
+      END SUBROUTINE A30
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.1.f90
new file mode 100644
index 0000000..294926b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+
+      SUBROUTINE A31_1(A, B, X, Y, N)
+        INTEGER N
+        REAL X(*), Y(*), A, B
+!$OMP PARALLEL DO PRIVATE(I) SHARED(X, N) REDUCTION(+:A)
+!$OMP& REDUCTION(MIN:B)
+        DO I=1,N
+           A = A + X(I)
+           B = MIN(B, Y(I))
+!  Note that some reductions can be expressed in
+!  other forms. For example, the MIN could be expressed as
+!  IF (B > Y(I)) B = Y(I)
+         END DO
+      END SUBROUTINE A31_1
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.2.f90
new file mode 100644
index 0000000..f78188c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+       SUBROUTINE A31_2 (A, B, X, Y, N)
+         INTEGER N
+         REAL X(*), Y(*), A, B, A_P, B_P
+!$OMP PARALLEL SHARED(X, Y, N, A, B) PRIVATE(A_P, B_P)
+        A_P = 0.0
+        B_P = HUGE(B_P)
+!$OMP DO PRIVATE(I)
+        DO I=1,N
+          A_P = A_P + X(I)
+          B_P = MIN(B_P, Y(I))
+        ENDDO
+!$OMP END DO
+!$OMP CRITICAL
+          A = A + A_P
+          B = MIN(B, B_P)
+!$OMP END CRITICAL
+!$OMP END PARALLEL
+      END SUBROUTINE A31_2
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90
new file mode 100644
index 0000000..f67c91c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.31.3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+        PROGRAM A31_3_WRONG
+        MAX = HUGE(0)
+        M=0
+        !$OMP PARALLEL DO REDUCTION(MAX: M) ! MAX is no longer the
+                                            ! intrinsic so this
+                                            ! is non-conforming
+! { dg-error "is not INTRINSIC procedure name" "" { target *-*-* } 5 } */
+        DO I = 1, 100
+        CALL SUB(M,I)
+        END DO
+        END PROGRAM A31_3_WRONG
+        SUBROUTINE SUB(M,I)
+        M = MAX(M,I)
+        END SUBROUTINE SUB
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.32.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.32.1.f90
new file mode 100644
index 0000000..8e0b5e0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.32.1.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+      MODULE M
+        REAL, POINTER, SAVE :: WORK(:)
+        INTEGER :: SIZE
+        REAL :: TOL
+!$OMP THREADPRIVATE(WORK,SIZE,TOL)
+      END MODULE M
+      SUBROUTINE A32( T, N )
+        USE M
+        REAL :: T
+        INTEGER :: N
+        TOL = T
+        SIZE = N
+!$OMP PARALLEL COPYIN(TOL,SIZE)
+        CALL BUILD
+!$OMP END PARALLEL
+      END SUBROUTINE A32
+      SUBROUTINE BUILD
+        USE M
+        ALLOCATE(WORK(SIZE))
+        WORK = TOL
+      END SUBROUTINE BUILD
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.1.f90
new file mode 100644
index 0000000..05145b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+      SUBROUTINE INIT(A,B)
+      REAL A, B
+        COMMON /XY/ X,Y
+!$OMP THREADPRIVATE (/XY/)
+!$OMP SINGLE
+          READ (11) A,B,X,Y
+!$OMP END SINGLE COPYPRIVATE (A,B,/XY/)
+      END SUBROUTINE INIT
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.2.f90
new file mode 100644
index 0000000..ced23c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.2.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+
+      REAL FUNCTION READ_NEXT()
+        REAL, POINTER :: TMP
+!$OMP SINGLE
+          ALLOCATE (TMP)
+!$OMP END SINGLE COPYPRIVATE (TMP) ! copies the pointer only
+!$OMP MASTER
+          READ (11) TMP
+!$OMP END MASTER
+!$OMP BARRIER
+          READ_NEXT = TMP
+!$OMP BARRIER
+!$OMP SINGLE
+          DEALLOCATE (TMP)
+!$OMP END SINGLE NOWAIT
+      END FUNCTION READ_NEXT
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.4.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.4.f90
new file mode 100644
index 0000000..9685b59
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.33.4.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+        SUBROUTINE S(N)
+        INTEGER N
+        REAL, DIMENSION(:), ALLOCATABLE :: A
+        REAL, DIMENSION(:), POINTER :: B
+        ALLOCATE (A(N))
+!$OMP SINGLE            ! { dg-error "COPYPRIVATE clause object 'a'" }
+            ALLOCATE (B(N))
+        READ (11) A,B
+!$OMP END SINGLE COPYPRIVATE(A,B)
+        ! Variable A designates a private object
+        !   which has the same value in each thread
+        ! Variable B designates a shared object
+!$OMP BARRIER
+!$OMP SINGLE
+          DEALLOCATE (B)
+!$OMP END SINGLE NOWAIT
+      END SUBROUTINE S
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.34.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.34.1.f90
new file mode 100644
index 0000000..29ea952
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.34.1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+      SUBROUTINE WORK(I, J)
+      INTEGER I, J
+      END SUBROUTINE WORK
+      SUBROUTINE GOOD_NESTING(N)
+      INTEGER N
+        INTEGER I
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+          DO I = 1, N
+!$OMP PARALLEL SHARED(I,N)
+!$OMP DO
+               DO J = 1, N
+                  CALL WORK(I,J)
+               END DO
+!$OMP END PARALLEL
+          END DO
+!$OMP END PARALLEL
+      END SUBROUTINE GOOD_NESTING
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.34.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.34.2.f90
new file mode 100644
index 0000000..980a623
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.34.2.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+      SUBROUTINE WORK(I, J)
+      INTEGER I, J
+      END SUBROUTINE WORK
+      SUBROUTINE WORK1(I, N)
+      INTEGER J
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+         DO J = 1, N
+           CALL WORK(I,J)
+         END DO
+!$OMP END PARALLEL
+      END SUBROUTINE WORK1
+      SUBROUTINE GOOD_NESTING2(N)
+      INTEGER N
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+      DO I = 1, N
+          CALL WORK1(I, N)
+      END DO
+!$OMP END PARALLEL
+      END SUBROUTINE GOOD_NESTING2
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.1.f90
new file mode 100644
index 0000000..7325e34
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.1.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+
+      SUBROUTINE WORK(I, J)
+      INTEGER I, J
+      END SUBROUTINE WORK
+      SUBROUTINE WRONG1(N)
+      INTEGER N
+        INTEGER I,J
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+          DO I = 1, N
+!$OMP DO              ! incorrect nesting of loop regions
+             DO J = 1, N
+                CALL WORK(I,J)
+             END DO
+          END DO
+!$OMP END PARALLEL
+      END SUBROUTINE WRONG1
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.2.f90
new file mode 100644
index 0000000..5fad2c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.2.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+
+      SUBROUTINE WORK1(I,N)
+      INTEGER I, N
+        INTEGER J
+!$OMP DO        ! incorrect nesting of loop regions
+        DO J = 1, N
+           CALL WORK(I,J)
+        END DO
+      END SUBROUTINE WORK1
+      SUBROUTINE WRONG2(N)
+      INTEGER N
+        INTEGER I
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+           DO I = 1, N
+              CALL WORK1(I,N)
+           END DO
+!$OMP END PARALLEL
+      END SUBROUTINE WRONG2
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.3.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.3.f90
new file mode 100644
index 0000000..63a558f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.3.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+
+      SUBROUTINE WRONG3(N)
+      INTEGER N
+        INTEGER I
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+          DO I = 1, N
+!$OMP SINGLE            ! incorrect nesting of regions
+               CALL WORK(I, 1)
+!$OMP END SINGLE
+          END DO
+!$OMP END PARALLEL
+      END SUBROUTINE WRONG3
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.4.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.4.f90
new file mode 100644
index 0000000..e449522
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.4.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+
+      SUBROUTINE WRONG4(N)
+      INTEGER N
+        INTEGER I
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP DO
+          DO I = 1, N
+             CALL WORK(I, 1)
+! incorrect nesting of barrier region in a loop region
+!$OMP BARRIER
+             CALL WORK(I, 2)
+          END DO
+!$OMP END PARALLEL
+      END SUBROUTINE WRONG4
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.5.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.5.f90
new file mode 100644
index 0000000..083c0b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.5.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+
+      SUBROUTINE WRONG5(N)
+      INTEGER N
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP CRITICAL
+            CALL WORK(N,1)
+! incorrect nesting of barrier region in a critical region
+!$OMP BARRIER
+            CALL WORK(N,2)
+!$OMP END CRITICAL
+!$OMP END PARALLEL
+      END SUBROUTINE WRONG5
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.6.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.6.f90
new file mode 100644
index 0000000..0488537
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.35.6.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+
+         SUBROUTINE WRONG6(N)
+         INTEGER N
+!$OMP PARALLEL DEFAULT(SHARED)
+!$OMP SINGLE
+           CALL WORK(N,1)
+! incorrect nesting of barrier region in a single region
+!$OMP BARRIER
+            CALL WORK(N,2)
+!$OMP END SINGLE
+!$OMP END PARALLEL
+      END SUBROUTINE WRONG6
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.36.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.36.1.f90
new file mode 100644
index 0000000..be68188
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.36.1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+
+      SUBROUTINE DO_BY_16(X, IAM, IPOINTS)
+        REAL X(*)
+        INTEGER IAM, IPOINTS
+      END SUBROUTINE DO_BY_16
+      SUBROUTINE SUBA36(X, NPOINTS)
+        INTEGER NPOINTS
+        REAL X(NPOINTS)
+        INTEGER IAM, IPOINTS
+        EXTERNAL OMP_SET_DYNAMIC, OMP_SET_NUM_THREADS
+        INTEGER OMP_GET_NUM_THREADS, OMP_GET_THREAD_NUM
+        CALL OMP_SET_DYNAMIC(.FALSE.)
+        CALL OMP_SET_NUM_THREADS(16)
+!$OMP PARALLEL SHARED(X,NPOINTS) PRIVATE(IAM, IPOINTS)
+          IF (OMP_GET_NUM_THREADS() .NE. 16) THEN
+            STOP
+          ENDIF
+          IAM = OMP_GET_THREAD_NUM()
+          IPOINTS = NPOINTS/16
+          CALL DO_BY_16(X,IAM,IPOINTS)
+!$OMP END PARALLEL
+      END SUBROUTINE SUBA36
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.37.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.37.1.f90
new file mode 100644
index 0000000..473c1fe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.37.1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+      SUBROUTINE WORK(I)
+      INTEGER I
+        I=I+1
+      END SUBROUTINE WORK
+      SUBROUTINE INCORRECT()
+        INTEGER OMP_GET_NUM_THREADS
+        INTEGER I, NP
+        NP = OMP_GET_NUM_THREADS()   !misplaced: will return 1
+!$OMP PARALLEL DO SCHEDULE(STATIC)
+          DO I = 0, NP-1
+            CALL WORK(I)
+          ENDDO
+!$OMP END PARALLEL DO
+      END SUBROUTINE INCORRECT
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.37.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.37.2.f90
new file mode 100644
index 0000000..c5fbcbb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.37.2.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+      SUBROUTINE WORK(I)
+        INTEGER I
+        I=I+1
+      END SUBROUTINE WORK
+      SUBROUTINE CORRECT()
+        INTEGER OMP_GET_THREAD_NUM
+        INTEGER I
+!$OMP PARALLEL PRIVATE(I)
+          I = OMP_GET_THREAD_NUM()
+          CALL WORK(I)
+!$OMP END PARALLEL
+      END SUBROUTINE CORRECT
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.1.f90
new file mode 100644
index 0000000..f1c6c65
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.1.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+
+      SUBROUTINE WORK(I, J)
+      INTEGER I,J
+      END SUBROUTINE WORK
+      SUBROUTINE A6_GOOD()
+        INTEGER I, J
+        REAL A(1000)
+        DO 100 I = 1,10
+!$OMP DO
+           DO 100 J = 1,10
+              CALL WORK(I,J)
+            100     CONTINUE        ! !$OMP ENDDO implied here
+!$OMP DO
+        DO 200 J = 1,10
+200        A(I) = I + 1
+!$OMP ENDDO
+!$OMP DO
+        DO 300 I = 1,10
+           DO 300 J = 1,10
+              CALL WORK(I,J)
+300     CONTINUE
+!$OMP ENDDO
+      END SUBROUTINE A6_GOOD
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.2.f90
new file mode 100644
index 0000000..e138808
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.2.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+
+        SUBROUTINE WORK(I, J)
+        INTEGER I,J
+        END SUBROUTINE WORK
+
+        SUBROUTINE A6_WRONG
+        INTEGER I, J
+        DO 100 I = 1,10
+!$OMP DO
+        DO 100 J = 1,10
+        CALL WORK(I,J)
+        100      CONTINUE
+!$OMP ENDDO	! { dg-error "Unexpected ..OMP END DO statement" }
+        END SUBROUTINE A6_WRONG
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.7.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.7.1.f90
new file mode 100644
index 0000000..9f3b08d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.7.1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+SUBROUTINE A7_1(A,N)
+INTEGER OMP_GET_THREAD_NUM
+REAL A(*)
+INTEGER I, MYOFFSET, N
+!$OMP PARALLEL PRIVATE(MYOFFSET)
+       MYOFFSET = OMP_GET_THREAD_NUM()*N
+       DO I = 1, N
+          A(MYOFFSET+I) = FLOAT(I)
+       ENDDO
+!$OMP END PARALLEL
+END SUBROUTINE A7_1
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.7.2.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.7.2.f90
new file mode 100644
index 0000000..23f2318
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.7.2.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+
+SUBROUTINE A7_2(A,B,N,I1,I2)
+REAL A(*), B(*)
+INTEGER I1, I2, N
+!$OMP PARALLEL SHARED(A,B,I1,I2)
+!$OMP SECTIONS
+!$OMP SECTION
+     DO I1 = I1, N
+       IF (A(I1).NE.0.0) EXIT
+     ENDDO
+!$OMP SECTION
+     DO I2 = I2, N
+       IF (B(I2).NE.0.0) EXIT
+     ENDDO
+!$OMP END SECTIONS
+!$OMP SINGLE
+    IF (I1.LE.N) PRINT *, "ITEMS IN A UP TO ", I1, " ARE ALL ZERO."
+    IF (I2.LE.N) PRINT *, "ITEMS IN B UP TO ", I2, " ARE ALL ZERO."
+!$OMP END SINGLE
+!$OMP END PARALLEL
+END SUBROUTINE A7_2
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.8.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.8.1.f90
new file mode 100644
index 0000000..f499e7f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.8.1.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+      SUBROUTINE A8(N, M, A, B, Y, Z)
+         INTEGER N, M
+         REAL A(*), B(*), Y(*), Z(*)
+         INTEGER I
+!$OMP PARALLEL
+!$OMP DO
+         DO I=2,N
+           B(I) = (A(I) + A(I-1)) / 2.0
+         ENDDO
+!$OMP END DO NOWAIT
+!$OMP DO
+         DO I=1,M
+           Y(I) = SQRT(Z(I))
+         ENDDO
+!$OMP END DO NOWAIT
+!$OMP END PARALLEL
+      END SUBROUTINE A8
diff --git a/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.9.1.f90 b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.9.1.f90
new file mode 100644
index 0000000..fc7b67d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/appendix-a/a.9.1.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+      SUBROUTINE A9()
+!$OMP PARALLEL SECTIONS
+!$OMP SECTION
+        CALL XAXIS()
+!$OMP SECTION
+        CALL YAXIS()
+!$OMP SECTION
+        CALL ZAXIS()
+!$OMP END PARALLEL SECTIONS
+      END SUBROUTINE A9
diff --git a/gcc/testsuite/gfortran.dg/gomp/block-1.f90 b/gcc/testsuite/gfortran.dg/gomp/block-1.f90
new file mode 100644
index 0000000..f03602a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/block-1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+
+!$omp parallel
+!$omp critical
+       goto 10		! { dg-error "invalid exit" }
+!$omp end critical
+ 10    x = 1
+!$omp end parallel
+
+       end
diff --git a/gcc/testsuite/gfortran.dg/gomp/crayptr1.f90 b/gcc/testsuite/gfortran.dg/gomp/crayptr1.f90
new file mode 100644
index 0000000..fca5606
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/crayptr1.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fcray-pointer" }
+
+  integer :: a, b, c, d, i
+  pointer (ip1, a)
+  pointer (ip2, b)
+  pointer (ip3, c)
+  pointer (ip4, d)
+
+!$omp parallel shared (a)	! { dg-error "Cray pointee 'a' in SHARED clause" }
+!$omp end parallel
+
+!$omp parallel private (b)	! { dg-error "Cray pointee 'b' in PRIVATE clause" }
+!$omp end parallel
+
+!$omp parallel firstprivate (c)	! { dg-error "Cray pointee 'c' in FIRSTPRIVATE clause" }
+!$omp end parallel
+
+!$omp parallel do lastprivate (d) ! { dg-error "Cray pointee 'd' in LASTPRIVATE clause" }
+  do i = 1, 10
+    if (i .eq. 10) d = 1
+  end do
+!$omp end parallel do
+
+!$omp parallel reduction (+: a)	! { dg-error "Cray pointee 'a' in REDUCTION clause" }
+!$omp end parallel
+
+  ip1 = loc (i)
+!$omp parallel shared (ip1)
+  a = 2
+!$omp end parallel
+
+!$omp parallel private (ip2, i)
+  ip2 = loc (i)
+  b = 1
+!$omp end parallel
+
+  ip3 = loc (i)
+!$omp parallel firstprivate (ip3) ! { dg-error "Cray pointer 'ip3' in FIRSTPRIVATE clause" }
+!$omp end parallel
+
+!$omp parallel do lastprivate (ip4) ! { dg-error "Cray pointer 'ip4' in LASTPRIVATE clause" }
+  do i = 1, 10
+    if (i .eq. 10) ip4 = loc (i)
+  end do
+!$omp end parallel do
+
+!$omp parallel reduction (+: ip1) ! { dg-error "Cray pointer 'ip1' in REDUCTION clause" }
+!$omp end parallel
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90 b/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90
new file mode 100644
index 0000000..476d7b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fcray-pointer" }
+! { dg-require-effective-target tls }
+
+module crayptr2
+  integer :: e		! { dg-error "CRAY POINTEE attribute conflicts with THREADPRIVATE" }
+  pointer (ip5, e)
+
+! The standard is not very clear about this.
+! Certainly, Cray pointees can't be SAVEd, nor they can be
+! in COMMON, so the only way to make threadprivate Cray pointees would
+! be if they are module variables.  But threadprivate pointees don't
+! make any sense anyway.
+
+!$omp threadprivate (e)
+
+end module crayptr2
diff --git a/gcc/testsuite/gfortran.dg/gomp/crayptr3.f90 b/gcc/testsuite/gfortran.dg/gomp/crayptr3.f90
new file mode 100644
index 0000000..be8f5a0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/crayptr3.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fcray-pointer" }
+
+  integer :: a, b
+  pointer (ip, a)
+
+  b = 2
+  ip = loc (b)
+!$omp parallel default (none) shared (ip)
+  a = 1
+!$omp end parallel
+
+!$omp parallel default (none) private (ip, b)
+  b = 3
+  ip = loc (b)
+  a = 1
+!$omp end parallel
+
+!$omp parallel default (none)	! { dg-error "enclosing parallel" }
+  a = 1		! { dg-error "'ip' not specified in enclosing parallel" }
+!$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/crayptr4.f90 b/gcc/testsuite/gfortran.dg/gomp/crayptr4.f90
new file mode 100644
index 0000000..d7da0bd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/crayptr4.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -fcray-pointer" }
+
+subroutine foo (n)
+  integer :: a, b (38), n
+  pointer (ip, a (n + 1))
+
+  b = 2
+  n = 36
+  ip = loc (b)
+!$omp parallel default (none) shared (ip)
+!$omp parallel default (none) shared (ip)
+  a = 1
+!$omp end parallel
+!$omp end parallel
+
+!$omp parallel default (none)
+!$omp parallel default (none) private (ip, b)
+  b = 3
+  ip = loc (b)
+  a = 1
+!$omp end parallel
+!$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/do-1.f90 b/gcc/testsuite/gfortran.dg/gomp/do-1.f90
new file mode 100644
index 0000000..a9c9cf1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/do-1.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-O -fopenmp -fdump-tree-omplower" }
+
+subroutine foo (i, j, k, s, a)
+  integer :: i, j, k, s, a(100), l
+!$omp parallel do schedule (dynamic, s * 2)
+  do 100, l = j, k
+100 a(l) = i
+!$omp parallel do schedule (dynamic, s * 2)
+  do 101, l = j, k, 3
+101 a(l) = i + 1
+end subroutine foo
+
+subroutine bar (i, j, k, s, a)
+  integer :: i, j, k, s, a(100), l
+!$omp parallel do schedule (guided, s * 2)
+  do 100, l = j, k
+100 a(l) = i
+!$omp parallel do schedule (guided, s * 2)
+  do 101, l = j, k, 3
+101 a(l) = i + 1
+end subroutine bar
+
+! { dg-final { scan-tree-dump-times "GOMP_parallel_loop_dynamic_start" 2 "omplower" { xfail *-*-* } } }
+! { dg-final { scan-tree-dump-times "GOMP_parallel_loop_guided_start" 2 "omplower" { xfail *-*-* } } }
+! { dg-final { cleanup-tree-dump "omplower" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/fixed-1.f b/gcc/testsuite/gfortran.dg/gomp/fixed-1.f
new file mode 100644
index 0000000..d61f2ba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/fixed-1.f
@@ -0,0 +1,22 @@
+C PR fortran/24493
+C { dg-do compile }
+C { dg-require-effective-target tls }
+      INTEGER I, J, K, L, M
+C$OMP THREADPRIVATE(I)
+C SOME COMMENT
+      SAVE I ! ANOTHER COMMENT
+C$OMP THREADPRIVATE
+C$OMP+(J) ! OMP DIRECTIVE COMMENT
+* NORMAL COMMENT
+c$OMP THREAD! COMMENT
+C$OMP&PRIVATE! COMMENT
+*$OMP+    (K)
+C$OMP THREADPRIVATE (L ! COMMENT
+*$OMP& , M)
+      SAVE J, K, L, M
+      I = 1
+      J = 2
+      K = 3
+      L = 4
+      M = 5
+      END
diff --git a/gcc/testsuite/gfortran.dg/gomp/free-1.f90 b/gcc/testsuite/gfortran.dg/gomp/free-1.f90
new file mode 100644
index 0000000..f6f9de4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/free-1.f90
@@ -0,0 +1,8 @@
+! { dg-require-effective-target tls }
+
+subroutine foo
+integer, save :: i ! Some comment
+!$omp threadpri&
+      !$omp&vate (i)
+i = 1
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/gomp.exp b/gcc/testsuite/gfortran.dg/gomp/gomp.exp
new file mode 100644
index 0000000..0cafd92
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/gomp.exp
@@ -0,0 +1,14 @@
+# GCC testsuite that uses the `dg.exp' driver.
+
+# Load support procs.
+load_lib gfortran-dg.exp
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+gfortran-dg-runtest [lsort \
+       [find $srcdir/$subdir *.\[fF\]{,90,95} ] ] " -fopenmp"
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_atomic1.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_atomic1.f90
new file mode 100644
index 0000000..247f8ae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_atomic1.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+subroutine test_atomic
+    integer (kind = 4) :: a
+    integer :: b
+    real :: c, f
+    double precision :: d
+    integer, dimension (10) :: e
+    a = 1
+    b = 2
+    c = 3
+    d = 4
+    e = 5
+    f = 6
+!$omp atomic
+    a = a + 4
+!$omp atomic
+    b = 4 - b
+!$omp atomic
+    c = c * 2
+!$omp atomic
+    d = 2 / d
+!$omp atomic
+    e = 1 ! { dg-error "must set a scalar variable" }
+!$omp atomic
+    a = a ** 8 ! { dg-error "assignment operator must be" }
+!$omp atomic
+    b = b + 3 + b ! { dg-error "cannot reference" }
+!$omp atomic
+    c = c - f + 1 ! { dg-error "not mathematically equivalent to" }
+!$omp atomic
+    a = ishft (a, 1) ! { dg-error "assignment intrinsic must be" }
+!$omp atomic
+    c = min (c, 2.1, c) ! { dg-error "intrinsic arguments except one" }
+!$omp atomic
+    a = max (b, e(1)) ! { dg-error "intrinsic argument must be 'a'" }
+!$omp atomic
+    d = 12 ! { dg-error "assignment must have an operator" }
+end subroutine test_atomic
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_clauses1.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_clauses1.f90
new file mode 100644
index 0000000..8851101
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_clauses1.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+      subroutine test1
+	integer :: i, j, k, l
+	common /b/ j, k
+!$omp parallel shared (i) private (/b/)
+!$omp end parallel
+!$omp parallel do shared (/b/), firstprivate (i), lastprivate (i)
+	do l = 1, 10
+	end do
+!$omp end parallel do
+!$omp parallel shared (j) private (/b/) ! { dg-error "'j' present on multiple clauses" }
+!$omp end parallel
+!$omp parallel shared (j, j) private (i) ! { dg-error "'j' present on multiple clauses" }
+!$omp end parallel
+!$omp parallel firstprivate (i, j, i) ! { dg-error "'i' present on multiple clauses" }
+!$omp end parallel
+!$omp parallel shared (i) private (/b/, /b/) ! { dg-error "'\[jk\]' present on multiple clauses" }
+!$omp end parallel
+!$omp parallel shared (i) reduction (+ : i, j) ! { dg-error "'i' present on multiple clauses" }
+!$omp end parallel
+!$omp parallel do shared (/b/), firstprivate (/b/), lastprivate (i) ! { dg-error "'\[jk\]' present on multiple clauses" }
+	do l = 1, 10
+	end do
+!$omp end parallel do
+      end subroutine test1
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_do1.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_do1.f90
new file mode 100644
index 0000000..3dfd43d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_do1.f90
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! { dg-options "-fopenmp -std=gnu" }
+subroutine foo
+  integer :: i, j
+  integer, dimension (30) :: a
+  double precision :: d
+  i = 0
+!$omp do private (i)
+  do 100 ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+    if (i .gt. 0) exit ! { dg-error "EXIT statement" }
+100 i = i + 1
+  i = 0
+!$omp do private (i)
+  do ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+    if (i .gt. 0) exit ! { dg-error "EXIT statement" }
+    i = i + 1
+  end do
+  i = 0
+!$omp do private (i)
+  do 200 while (i .lt. 4) ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+200 i = i + 1
+!$omp do private (i)
+  do while (i .lt. 8) ! { dg-error "cannot be a DO WHILE or DO without loop control" }
+    i = i + 1
+  end do
+!$omp do
+  do 300 d = 1, 30, 6 ! { dg-warning "Obsolete: REAL DO loop iterator" }
+    i = d
+300 a(i) = 1
+!$omp do
+  do d = 1, 30, 5 ! { dg-warning "Obsolete: REAL DO loop iterator" }
+    i = d
+    a(i) = 2
+  end do
+!$omp do
+  do i = 1, 30
+    if (i .eq. 16) exit ! { dg-error "EXIT statement" }
+  end do
+!$omp do
+outer: do i = 1, 30
+    do j = 5, 10
+      if (i .eq. 6 .and. j .eq. 7) exit outer ! { dg-error "EXIT statement" }
+    end do
+  end do outer
+last: do i = 1, 30
+!$omp parallel
+    if (i .eq. 21) exit last ! { dg-error "leaving OpenMP structured block" }
+!$omp end parallel
+  end do last
+!$omp parallel do shared (i)
+  do i = 1, 30, 2 ! { dg-error "iteration variable present on clause" }
+    a(i) = 5
+  end do
+!$omp end parallel do
+end subroutine
+! { dg-error "iteration variable must be of type integer" "" { target *-*-* } 27 }
+! { dg-error "iteration variable must be of type integer" "" { target *-*-* } 31 }
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_threadprivate1.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_threadprivate1.f90
new file mode 100644
index 0000000..55aad06
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_threadprivate1.f90
@@ -0,0 +1,17 @@
+! { dg-require-effective-target tls }
+      module omp_threadprivate1
+	common /T/ a
+      end module omp_threadprivate1
+      subroutine bad1
+	use omp_threadprivate1
+!$omp threadprivate (/T/)	! { dg-error "not found" }
+      end subroutine bad1
+      subroutine bad2
+	common /S/ b
+!$omp threadprivate (/S/)
+      contains
+	subroutine bad3
+!$omp parallel copyin (/T/)	! { dg-error "not found" }
+!$omp end parallel		! { dg-error "" }
+	end subroutine bad3
+      end subroutine bad2
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_threadprivate2.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_threadprivate2.f90
new file mode 100644
index 0000000..cd1ab5c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_threadprivate2.f90
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+      subroutine bad1
+	double precision :: d	! { dg-error "isn't SAVEd" }
+!$omp threadprivate (d)
+      end subroutine bad1
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction1.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction1.f90
new file mode 100644
index 0000000..b69714d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction1.f90
@@ -0,0 +1,131 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+subroutine foo (ia1)
+integer :: i1, i2, i3
+integer, dimension (*) :: ia1
+integer, dimension (10) :: ia2
+real :: r1
+real, dimension (5) :: ra1
+double precision :: d1
+double precision, dimension (4) :: da1
+complex :: c1
+complex, dimension (7) :: ca1
+logical :: l1
+logical, dimension (3) :: la1
+character (5) :: a1
+type t
+  integer :: i
+end type
+type(t) :: t1
+type(t), dimension (2) :: ta1
+real, pointer :: p1 => NULL()
+integer, allocatable :: aa1 (:,:)
+save i2
+!$omp threadprivate (i2)
+common /blk/ i1
+
+!$omp parallel reduction (+:i3, ia2, r1, ra1, d1, da1, c1, ca1)
+!$omp end parallel
+!$omp parallel reduction (*:i3, ia2, r1, ra1, d1, da1, c1, ca1)
+!$omp end parallel
+!$omp parallel reduction (-:i3, ia2, r1, ra1, d1, da1, c1, ca1)
+!$omp end parallel
+!$omp parallel reduction (.and.:l1, la1)
+!$omp end parallel
+!$omp parallel reduction (.or.:l1, la1)
+!$omp end parallel
+!$omp parallel reduction (.eqv.:l1, la1)
+!$omp end parallel
+!$omp parallel reduction (.neqv.:l1, la1)
+!$omp end parallel
+!$omp parallel reduction (min:i3, ia2, r1, ra1, d1, da1)
+!$omp end parallel
+!$omp parallel reduction (max:i3, ia2, r1, ra1, d1, da1)
+!$omp end parallel
+!$omp parallel reduction (iand:i3, ia2)
+!$omp end parallel
+!$omp parallel reduction (ior:i3, ia2)
+!$omp end parallel
+!$omp parallel reduction (ieor:i3, ia2)
+!$omp end parallel
+!$omp parallel reduction (+:/blk/)	! { dg-error "Syntax error" }
+!$omp end parallel			! { dg-error "Unexpected" }
+!$omp parallel reduction (+:i2)		! { dg-error "THREADPRIVATE object" }
+!$omp end parallel
+!$omp parallel reduction (*:p1)		! { dg-error "POINTER object" }
+!$omp end parallel
+!$omp parallel reduction (-:aa1)	! { dg-error "is ALLOCATABLE" }
+!$omp end parallel
+!$omp parallel reduction (*:ia1)	! { dg-error "Assumed size" }
+!$omp end parallel
+!$omp parallel reduction (+:l1)		! { dg-error "is LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (*:la1)	! { dg-error "is LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (-:a1)		! { dg-error "is CHARACTER" }
+!$omp end parallel
+!$omp parallel reduction (+:t1)		! { dg-error "is TYPE" }
+!$omp end parallel
+!$omp parallel reduction (*:ta1)	! { dg-error "is TYPE" }
+!$omp end parallel
+!$omp parallel reduction (.and.:i3)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.or.:ia2)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.eqv.:r1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.neqv.:ra1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.and.:d1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.or.:da1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.eqv.:c1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.neqv.:ca1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.and.:a1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.or.:t1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (.eqv.:ta1)	! { dg-error "must be LOGICAL" }
+!$omp end parallel
+!$omp parallel reduction (min:c1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (max:ca1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (max:l1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (min:la1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (max:a1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (min:t1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (max:ta1)	! { dg-error "must be INTEGER or REAL" }
+!$omp end parallel
+!$omp parallel reduction (iand:r1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ior:ra1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ieor:d1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ior:da1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (iand:c1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ior:ca1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ieor:l1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (iand:la1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ior:a1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (ieor:t1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+!$omp parallel reduction (iand:ta1)	! { dg-error "must be INTEGER" }
+!$omp end parallel
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction2.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction2.f90
new file mode 100644
index 0000000..f855d0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction2.f90
@@ -0,0 +1,33 @@
+! { dg-do compile }
+
+subroutine f1
+  integer :: i
+  i = 0
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+!$omp parallel reduction (ior:i)
+  i = ior (i, 16)
+!$omp end parallel
+end subroutine f1
+subroutine f2
+  integer :: i
+  i = ior (2, 4)
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f2
+subroutine f3
+  integer :: i
+  i = 6
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f3
+subroutine f4
+  integer :: i, ior
+  i = 6
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f4
diff --git a/gcc/testsuite/gfortran.dg/gomp/reduction3.f90 b/gcc/testsuite/gfortran.dg/gomp/reduction3.f90
new file mode 100644
index 0000000..1bb0e21
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/reduction3.f90
@@ -0,0 +1,69 @@
+! { dg-do compile }
+
+module mreduction3
+  interface
+    function ior (a, b)
+      integer :: ior, a, b
+    end function
+  end interface
+contains
+  function iand (a, b)
+    integer :: iand, a, b
+    iand = a + b
+  end function
+end module mreduction3
+subroutine f1
+  integer :: i, ior
+  ior = 6
+  i = 6
+!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" }
+!$omp end parallel
+end subroutine f1
+subroutine f2
+  integer :: i
+  interface
+    function ior (a, b)
+      integer :: ior, a, b
+    end function
+  end interface
+  i = 6
+!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" }
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f2
+subroutine f3
+  integer :: i
+  interface
+    function ior (a, b)
+      integer :: ior, a, b
+    end function
+  end interface
+  intrinsic ior
+  i = 6
+!$omp parallel reduction (ior:i)
+  i = ior (i, 3)
+!$omp end parallel
+end subroutine f3
+subroutine f4
+  integer :: i, ior
+  i = 6
+!$omp parallel reduction (ior:i)
+  ior = 4			 ! { dg-error "Expected VARIABLE" }
+!$omp end parallel
+end subroutine f4
+subroutine f5
+  use mreduction3
+  integer :: i
+  i = 6
+!$omp parallel reduction (ior:i) ! { dg-error "is not INTRINSIC procedure name" }
+  i = ior (i, 7)
+!$omp end parallel
+end subroutine f5
+subroutine f6
+  use mreduction3
+  integer :: i
+  i = 6
+!$omp parallel reduction (iand:i) ! { dg-error "is not INTRINSIC procedure name" }
+  i = iand (i, 18)
+!$omp end parallel
+end subroutine f6
diff --git a/gcc/testsuite/gfortran.dg/gomp/sharing-1.f90 b/gcc/testsuite/gfortran.dg/gomp/sharing-1.f90
new file mode 100644
index 0000000..7a107ff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/sharing-1.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-require-effective-target tls }
+
+  integer :: thrpriv, thr, i, j, s, g1, g2, m
+  integer, dimension (6) :: p
+  common /thrblk/ thr
+  common /gblk/ g1
+  save thrpriv, g2
+!$omp threadprivate (/thrblk/, thrpriv)
+  s = 1
+!$omp parallel do default (none) &
+!$omp & private (p) shared (s) ! { dg-error "enclosing parallel" }
+  do i = 1, 64
+    call foo (thrpriv)	! Predetermined - threadprivate
+    call foo (thr)	! Predetermined - threadprivate
+    call foo (i)	! Predetermined - omp do iteration var
+    do j = 1, 64	! Predetermined - sequential loop
+      call foo (j)	! iteration variable
+    end do
+    call bar ((/ (k * 4, k = 1, 8) /)) ! Predetermined - implied do
+    forall (l = 1 : i) &! Predetermined - forall indice
+      p(l) = 6		! Explicitly determined - private
+    call foo (s)	! Explicitly determined - shared
+    call foo (g1)	! { dg-error "not specified in" }
+    call foo (g2)	! { dg-error "not specified in" }
+    call foo (m)	! { dg-error "not specified in" }
+  end do
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/sharing-2.f90 b/gcc/testsuite/gfortran.dg/gomp/sharing-2.f90
new file mode 100644
index 0000000..aede06c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/sharing-2.f90
@@ -0,0 +1,84 @@
+  integer :: i, j, k, l
+  integer, dimension (10, 10) :: a
+!$omp parallel do default (none) shared (a)
+  do i = 1, 10
+    j = 4
+    do j = 1, 10
+      a(i, j) = i + j
+    end do
+    j = 8
+  end do
+!$omp end parallel do
+!$omp parallel default (none) shared (a) ! { dg-error "enclosing parallel" }
+  i = 1
+  j = 1
+  k = 1
+  l = 1		! { dg-error "not specified in" }
+  do i = 1, 10
+    a(i, 1) = 1
+  end do
+!$omp critical
+  do j = 1, 10
+    a(1, j) = j
+  end do
+!$omp end critical
+!$omp single
+  do k = 1, 10
+    a(k, k) = k
+  end do
+!$omp end single
+!$omp end parallel
+!$omp parallel default (none) shared (a)
+  i = 1
+  j = 1
+  k = 1
+!$omp parallel default (none) shared (a)
+  i = 1
+  j = 1
+  k = 1
+  do i = 1, 10
+    a(i, 1) = 1
+  end do
+!$omp critical
+  do j = 1, 10
+    a(1, j) = j
+  end do
+!$omp end critical
+!$omp single
+  do k = 1, 10
+    a(k, k) = k
+  end do
+!$omp end single
+!$omp end parallel
+  i = 1
+  j = 1
+  k = 1
+!$omp end parallel
+!$omp parallel default (none) shared (a) ! { dg-error "enclosing parallel" }
+  i = 1		! { dg-error "not specified in" }
+!$omp do
+  do i = 1, 10
+    a(i, 1) = i + 1
+  end do
+!$omp end parallel
+!$omp parallel default (none) shared (a) ! { dg-error "enclosing parallel" }
+  i = 1		! { dg-error "not specified in" }
+!$omp parallel do default (none) shared (a)
+  do i = 1, 10
+    a(i, 1) = i + 1
+  end do
+!$omp end parallel
+!$omp parallel default (none) shared (a)
+  i = 1
+!$omp parallel default (none) shared (a, i)
+  i = 2
+!$omp parallel default (none) shared (a)
+  do i = 1, 10
+    a(i, 1) = i
+  end do
+!$omp end parallel
+  i = 3
+!$omp end parallel
+  i = 4
+!$omp end parallel
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/workshare1.f90 b/gcc/testsuite/gfortran.dg/gomp/workshare1.f90
new file mode 100644
index 0000000..ffbb1db
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/workshare1.f90
@@ -0,0 +1,42 @@
+! { dg-do compile }
+
+interface
+  subroutine foo
+  end subroutine
+  function bar ()
+  integer :: bar
+  end function bar
+  elemental function baz ()
+  integer :: baz
+  end function baz
+end interface
+
+  integer :: i, j
+  real :: a, b (10), c
+  a = 0.5
+  b = 0.25
+!$omp parallel workshare
+  a = sin (a)
+  b = sin (b)
+  forall (i = 1:10) b(i) = cos (b(i)) - 0.5
+  j = baz ()
+!$omp parallel if (bar () .gt. 2) &
+!$omp & num_threads (bar () + 1)
+  i = bar ()
+!$omp end parallel
+!$omp parallel do schedule (static, bar () + 4)
+  do j = 1, 10
+    i = bar ()
+  end do
+!$omp end parallel do
+!$omp end parallel workshare
+!$omp parallel workshare
+  call foo			! { dg-error "CALL statement" }
+  i = bar ()			! { dg-error "non-ELEMENTAL" }
+!$omp critical
+  i = bar ()			! { dg-error "non-ELEMENTAL" }
+!$omp end critical
+!$omp atomic
+  j = j + bar ()		! { dg-error "non-ELEMENTAL" }
+!$omp end parallel workshare
+end
diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog
index 260d968..fd21de2 100644
--- a/libgomp/ChangeLog
+++ b/libgomp/ChangeLog
@@ -1,3 +1,8 @@
+2006-02-13  Jakub Jelinek  <jakub@redhat.com>
+
+	* testsuite/libgomp.fortran/vla7.f90: Add -w to options.
+	Remove tests for returning assumed character length arrays.
+
 2006-02-12  Roger Sayle  <roger@eyesopen.com>
 	    John David Anglin  <dave@hiauly1.hia.nrc.ca>
 
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.15.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.15.1.f90
new file mode 100644
index 0000000..3d95451
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.15.1.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+      SUBROUTINE WORK(N)
+        INTEGER N
+      END SUBROUTINE WORK
+      SUBROUTINE SUB3(N)
+      INTEGER N
+        CALL WORK(N)
+!$OMP BARRIER
+        CALL WORK(N)
+      END SUBROUTINE SUB3
+      SUBROUTINE SUB2(K)
+      INTEGER K
+!$OMP PARALLEL SHARED(K)
+          CALL SUB3(K)
+!$OMP END PARALLEL
+      END SUBROUTINE SUB2
+      SUBROUTINE SUB1(N)
+      INTEGER N
+        INTEGER I
+!$OMP PARALLEL PRIVATE(I) SHARED(N)
+!$OMP DO
+          DO I = 1, N
+             CALL SUB2(I)
+          END DO
+!$OMP END PARALLEL
+      END SUBROUTINE SUB1
+      PROGRAM A15
+        CALL SUB1(2)
+        CALL SUB2(2)
+        CALL SUB3(2)
+      END PROGRAM A15
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.16.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.16.1.f90
new file mode 100644
index 0000000..014d4fd
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.16.1.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+        REAL FUNCTION WORK1(I)
+            INTEGER I
+            WORK1 = 1.0 * I
+            RETURN
+        END FUNCTION WORK1
+
+        REAL FUNCTION WORK2(I)
+            INTEGER I
+            WORK2 = 2.0 * I
+            RETURN
+        END FUNCTION WORK2
+
+        SUBROUTINE SUBA16(X, Y, INDEX, N)
+        REAL X(*), Y(*)
+        INTEGER INDEX(*), N
+        INTEGER I
+!$OMP PARALLEL DO SHARED(X, Y, INDEX, N)
+          DO I=1,N
+!$OMP ATOMIC
+              X(INDEX(I)) = X(INDEX(I)) + WORK1(I)
+            Y(I) = Y(I) + WORK2(I)
+          ENDDO
+      END SUBROUTINE SUBA16
+
+      PROGRAM A16
+        REAL X(1000), Y(10000)
+        INTEGER INDEX(10000)
+        INTEGER I
+        DO I=1,10000
+          INDEX(I) = MOD(I, 1000) + 1
+          Y(I) = 0.0
+        ENDDO
+        DO I = 1,1000
+          X(I) = 0.0
+        ENDDO
+        CALL SUBA16(X, Y, INDEX, 10000)
+        DO I = 1,10
+          PRINT *, "X(", I, ") = ", X(I), ", Y(", I, ") = ", Y(I)
+        ENDDO
+      END PROGRAM A16
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90
new file mode 100644
index 0000000..3321485
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.18.1.f90
@@ -0,0 +1,59 @@
+! { dg-do run }
+! { dg-options "-ffixed-form" }
+      REAL FUNCTION FN1(I)
+        INTEGER I
+        FN1 = I * 2.0
+        RETURN
+      END FUNCTION FN1
+
+      REAL FUNCTION FN2(A, B)
+        REAL A, B
+        FN2 = A + B
+        RETURN
+      END FUNCTION FN2
+
+      PROGRAM A18
+      INCLUDE "omp_lib.h"     ! or USE OMP_LIB
+      INTEGER ISYNC(256)
+      REAL    WORK(256)
+      REAL    RESULT(256)
+      INTEGER IAM, NEIGHBOR
+!$OMP PARALLEL PRIVATE(IAM, NEIGHBOR) SHARED(WORK, ISYNC) NUM_THREADS(4)
+          IAM = OMP_GET_THREAD_NUM() + 1
+          ISYNC(IAM) = 0
+!$OMP BARRIER
+!     Do computation into my portion of work array
+          WORK(IAM) = FN1(IAM)
+!     Announce that I am done with my work.
+!     The first flush ensures that my work is made visible before
+!     synch. The second flush ensures that synch is made visible.
+!$OMP FLUSH(WORK,ISYNC)
+       ISYNC(IAM) = 1
+!$OMP FLUSH(ISYNC)
+
+!      Wait until neighbor is done. The first flush ensures that
+!      synch is read from memory, rather than from the temporary
+!      view of memory. The second flush ensures that work is read
+!      from memory, and is done so after the while loop exits.
+       IF (IAM .EQ. 1) THEN
+            NEIGHBOR = OMP_GET_NUM_THREADS()
+        ELSE
+            NEIGHBOR = IAM - 1
+        ENDIF
+        DO WHILE (ISYNC(NEIGHBOR) .EQ. 0)
+!$OMP FLUSH(ISYNC)
+        END DO
+!$OMP FLUSH(WORK, ISYNC)
+        RESULT(IAM) = FN2(WORK(NEIGHBOR), WORK(IAM))
+!$OMP END PARALLEL
+        DO I=1,4
+          IF (I .EQ. 1) THEN
+                NEIGHBOR = 4
+          ELSE
+                NEIGHBOR = I - 1
+          ENDIF
+          IF (RESULT(I) .NE. I * 2 + NEIGHBOR * 2) THEN
+            CALL ABORT
+          ENDIF
+        ENDDO
+        END PROGRAM A18
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90
new file mode 100644
index 0000000..1fe1c42
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.19.1.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+        SUBROUTINE F1(Q)
+        COMMON /DATA/ P, X
+        INTEGER, TARGET :: X
+        INTEGER, POINTER :: P
+        INTEGER Q
+        Q=1
+!$OMP FLUSH
+        ! X, P and Q are flushed
+        ! because they are shared and accessible
+      END SUBROUTINE F1
+      SUBROUTINE F2(Q)
+        COMMON /DATA/ P, X
+        INTEGER, TARGET :: X
+        INTEGER, POINTER :: P
+        INTEGER Q
+!$OMP BARRIER
+          Q=2
+!$OMP BARRIER
+          ! a barrier implies a flush
+          ! X, P and Q are flushed
+          ! because they are shared and accessible
+        END SUBROUTINE F2
+
+      INTEGER FUNCTION G(N)
+          COMMON /DATA/ P, X
+          INTEGER, TARGET :: X
+          INTEGER, POINTER :: P
+          INTEGER N
+          INTEGER I, J, SUM
+          I=1
+          SUM = 0
+          P=1
+!$OMP PARALLEL REDUCTION(+: SUM) NUM_THREADS(2)
+          CALL F1(J)
+                ! I, N and SUM were not flushed
+                !   because they were not accessible in F1
+                ! J was flushed because it was accessible
+          SUM = SUM + J
+          CALL F2(J)
+                ! I, N, and SUM were not flushed
+                ! because they were not accessible in f2
+                ! J was flushed because it was accessible
+          SUM = SUM + I + J + P + N
+!$OMP END PARALLEL
+          G = SUM
+      END FUNCTION G
+
+      PROGRAM A19
+        COMMON /DATA/ P, X
+        INTEGER, TARGET :: X
+        INTEGER, POINTER :: P
+        INTEGER RESULT, G
+        P => X
+        RESULT = G(10)
+        PRINT *, RESULT
+        IF (RESULT .NE. 30) THEN
+          CALL ABORT
+        ENDIF
+      END PROGRAM A19
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.2.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.2.1.f90
new file mode 100644
index 0000000..2b09f5b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.2.1.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+PROGRAM A2
+  INCLUDE "omp_lib.h"      ! or USE OMP_LIB
+  INTEGER X
+  X=2
+!$OMP PARALLEL NUM_THREADS(2) SHARED(X)
+    IF (OMP_GET_THREAD_NUM() .EQ. 0) THEN
+       X=5
+    ELSE
+    ! PRINT 1: The following read of x has a race
+      PRINT *,"1: THREAD# ", OMP_GET_THREAD_NUM(), "X = ", X
+    ENDIF
+!$OMP BARRIER
+    IF (OMP_GET_THREAD_NUM() .EQ. 0) THEN
+    ! PRINT 2
+      PRINT *,"2: THREAD# ", OMP_GET_THREAD_NUM(), "X = ", X
+    ELSE
+    ! PRINT 3
+      PRINT *,"3: THREAD# ", OMP_GET_THREAD_NUM(), "X = ", X
+    ENDIF
+!$OMP END PARALLEL
+END PROGRAM A2
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.21.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.21.1.f90
new file mode 100644
index 0000000..c22fa11
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.21.1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+      SUBROUTINE WORK(K)
+        INTEGER k
+!$OMP ORDERED
+        WRITE(*,*) K
+!$OMP END ORDERED
+      END SUBROUTINE WORK
+      SUBROUTINE SUBA21(LB, UB, STRIDE)
+        INTEGER LB, UB, STRIDE
+        INTEGER I
+!$OMP PARALLEL DO ORDERED SCHEDULE(DYNAMIC)
+        DO I=LB,UB,STRIDE
+          CALL WORK(I)
+        END DO
+!$OMP END PARALLEL DO
+      END SUBROUTINE SUBA21
+      PROGRAM A21
+        CALL SUBA21(1,100,5)
+      END PROGRAM A21
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.7.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.7.f90
new file mode 100644
index 0000000..fff4e6d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.7.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+
+      PROGRAM A22_7_GOOD
+        INTEGER, ALLOCATABLE, SAVE :: A(:)
+        INTEGER, POINTER, SAVE :: PTR
+        INTEGER, SAVE :: I
+        INTEGER, TARGET :: TARG
+        LOGICAL :: FIRSTIN = .TRUE.
+!$OMP THREADPRIVATE(A, I, PTR)
+        ALLOCATE (A(3))
+        A = (/1,2,3/)
+        PTR => TARG
+        I=5
+!$OMP PARALLEL COPYIN(I, PTR)
+!$OMP CRITICAL
+            IF (FIRSTIN) THEN
+              TARG = 4           ! Update target of ptr
+              I = I + 10
+              IF (ALLOCATED(A)) A = A + 10
+              FIRSTIN = .FALSE.
+            END IF
+            IF (ALLOCATED(A)) THEN
+              PRINT *, "a = ", A
+            ELSE
+              PRINT *, "A is not allocated"
+            END IF
+            PRINT *, "ptr = ", PTR
+            PRINT *, "i = ", I
+            PRINT *
+!$OMP END CRITICAL
+!$OMP END PARALLEL
+      END PROGRAM A22_7_GOOD
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.8.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.8.f90
new file mode 100644
index 0000000..cf6d90e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.22.8.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+       MODULE A22_MODULE8
+         REAL, POINTER :: WORK(:)
+         SAVE WORK
+!$OMP THREADPRIVATE(WORK)
+       END MODULE A22_MODULE8
+       SUBROUTINE SUB1(N)
+       USE A22_MODULE8
+!$OMP PARALLEL PRIVATE(THE_SUM)
+         ALLOCATE(WORK(N))
+         CALL SUB2(THE_SUM)
+        WRITE(*,*)THE_SUM
+!$OMP END PARALLEL
+       END SUBROUTINE SUB1
+       SUBROUTINE SUB2(THE_SUM)
+        USE A22_MODULE8
+        WORK(:) = 10
+        THE_SUM=SUM(WORK)
+        END SUBROUTINE SUB2
+        PROGRAM A22_8_GOOD
+        N = 10
+        CALL SUB1(N)
+        END PROGRAM A22_8_GOOD
+
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.26.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.26.1.f90
new file mode 100644
index 0000000..e9ebf87
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.26.1.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+       PROGRAM A26
+         INTEGER I, J
+         I=1
+         J=2
+!$OMP PARALLEL PRIVATE(I) FIRSTPRIVATE(J)
+           I=3
+           J=J+2
+!$OMP END PARALLEL
+          PRINT *, I, J ! I and J are undefined
+      END PROGRAM A26
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.1.f90
new file mode 100644
index 0000000..c271333
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.1.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+
+       SUBROUTINE SUB()
+       COMMON /BLOCK/ X
+       PRINT *,X              ! X is undefined
+       END SUBROUTINE SUB
+       PROGRAM A28_1
+         COMMON /BLOCK/ X
+         X = 1.0
+!$OMP PARALLEL PRIVATE (X)
+         X = 2.0
+         CALL SUB()
+!$OMP END PARALLEL
+      END PROGRAM A28_1
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.2.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.2.f90
new file mode 100644
index 0000000..1145e54
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.2.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+
+      PROGRAM A28_2
+        COMMON /BLOCK2/ X
+        X = 1.0
+!$OMP PARALLEL PRIVATE (X)
+          X = 2.0
+          CALL SUB()
+!$OMP END PARALLEL
+       CONTAINS
+        SUBROUTINE SUB()
+        COMMON /BLOCK2/ Y
+        PRINT *,X                 ! X is undefined
+        PRINT *,Y                 ! Y is undefined
+        END SUBROUTINE SUB
+      END PROGRAM A28_2
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.3.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.3.f90
new file mode 100644
index 0000000..a337f3b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.3.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+
+        PROGRAM A28_3
+        EQUIVALENCE (X,Y)
+        X = 1.0
+!$OMP PARALLEL PRIVATE(X)
+          PRINT *,Y         ! Y is undefined
+          Y = 10
+          PRINT *,X         ! X is undefined
+!$OMP END PARALLEL
+      END PROGRAM A28_3
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.4.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.4.f90
new file mode 100644
index 0000000..c5a5cd7
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.4.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+
+       PROGRAM A28_4
+         INTEGER I, J
+         INTEGER A(100), B(100)
+         EQUIVALENCE (A(51), B(1))
+!$OMP PARALLEL DO DEFAULT(PRIVATE) PRIVATE(I,J) LASTPRIVATE(A)
+           DO I=1,100
+               DO J=1,100
+                 B(J) = J - 1
+               ENDDO
+               DO J=1,100
+                 A(J) = J    ! B becomes undefined at this point
+               ENDDO
+               DO J=1,50
+                 B(J) = B(J) + 1 ! B is undefined
+                            ! A becomes undefined at this point
+               ENDDO
+           ENDDO
+!$OMP END PARALLEL DO          ! The LASTPRIVATE write for A has
+                               ! undefined results
+        PRINT *, B  ! B is undefined since the LASTPRIVATE
+                    ! write of A was not defined
+        END PROGRAM A28_4
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90
new file mode 100644
index 0000000..e377582
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.28.5.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }
+
+      SUBROUTINE SUB1(X)
+        DIMENSION X(10)
+        ! This use of X does not conform to the
+        ! specification. It would be legal Fortran 90,
+        ! but the OpenMP private directive allows the
+        ! compiler to break the sequence association that
+        ! A had with the rest of the common block.
+        FORALL (I = 1:10) X(I) = I
+      END SUBROUTINE SUB1
+      PROGRAM A28_5
+        COMMON /BLOCK5/ A
+        DIMENSION B(10)
+        EQUIVALENCE (A,B(1))
+        ! the common block has to be at least 10 words
+        A=0
+!$OMP PARALLEL PRIVATE(/BLOCK5/)
+          ! Without the private clause,
+          ! we would be passing a member of a sequence
+          ! that is at least ten elements long.
+          ! With the private clause, A may no longer be
+          ! sequence-associated.
+          CALL SUB1(A)
+!$OMP MASTER
+            PRINT *, A
+!$OMP END MASTER
+!$OMP END PARALLEL
+      END PROGRAM A28_5
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.3.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.3.1.f90
new file mode 100644
index 0000000..0a17572
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.3.1.f90
@@ -0,0 +1,6 @@
+! { dg-do run }
+! { dg-options "-ffixed-form" }
+      PROGRAM A3
+!234567890
+!$    PRINT *, "Compiled by an OpenMP-compliant implementation."
+      END PROGRAM A3
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.4.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.4.f90
new file mode 100644
index 0000000..69882c1
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.4.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+        MODULE M
+        INTRINSIC MAX
+        END MODULE M
+        PROGRAM A31_4
+        USE M, REN => MAX
+        N=0
+!$OMP PARALLEL DO REDUCTION(REN: N) ! still does MAX
+        DO I = 1, 100
+            N = MAX(N,I)
+        END DO
+        END PROGRAM A31_4
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.5.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.5.f90
new file mode 100644
index 0000000..91a97cd
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.31.5.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+            MODULE MOD
+            INTRINSIC MAX, MIN
+            END MODULE MOD
+            PROGRAM A31_5
+            USE MOD, MIN=>MAX, MAX=>MIN
+            REAL :: R
+            R = -HUGE(0.0)
+            !$OMP PARALLEL DO REDUCTION(MIN: R) ! still does MAX
+            DO I = 1, 1000
+                R = MIN(R, SIN(REAL(I)))
+            END DO
+            PRINT *, R
+            END PROGRAM A31_5
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.33.3.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.33.3.f90
new file mode 100644
index 0000000..adc493f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.33.3.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+
+      FUNCTION NEW_LOCK()
+      USE OMP_LIB       ! or INCLUDE "omp_lib.h"
+        INTEGER(OMP_LOCK_KIND), POINTER :: NEW_LOCK
+!$OMP SINGLE
+          ALLOCATE(NEW_LOCK)
+          CALL OMP_INIT_LOCK(NEW_LOCK)
+!$OMP END SINGLE COPYPRIVATE(NEW_LOCK)
+      END FUNCTION NEW_LOCK
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.38.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.38.1.f90
new file mode 100644
index 0000000..5554130
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.38.1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+
+      FUNCTION NEW_LOCKS()
+        USE OMP_LIB        ! or INCLUDE "omp_lib.h"
+        INTEGER(OMP_LOCK_KIND), DIMENSION(1000) :: NEW_LOCKS
+        INTEGER I
+!$OMP PARALLEL DO PRIVATE(I)
+          DO I=1,1000
+            CALL OMP_INIT_LOCK(NEW_LOCKS(I))
+          END DO
+!$OMP END PARALLEL DO
+      END FUNCTION NEW_LOCKS
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.39.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.39.1.f90
new file mode 100644
index 0000000..540d17f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.39.1.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+
+      SUBROUTINE SKIP(ID)
+      END SUBROUTINE SKIP
+      SUBROUTINE WORK(ID)
+      END SUBROUTINE WORK
+      PROGRAM A39
+        INCLUDE "omp_lib.h"      ! or USE OMP_LIB
+        INTEGER(OMP_LOCK_KIND) LCK
+        INTEGER ID
+        CALL OMP_INIT_LOCK(LCK)
+!$OMP PARALLEL SHARED(LCK) PRIVATE(ID)
+          ID = OMP_GET_THREAD_NUM()
+          CALL OMP_SET_LOCK(LCK)
+          PRINT *, "My thread id is ", ID
+          CALL OMP_UNSET_LOCK(LCK)
+          DO WHILE (.NOT. OMP_TEST_LOCK(LCK))
+            CALL SKIP(ID)     ! We do not yet have the lock
+                              ! so we must do something else
+          END DO
+          CALL WORK(ID)       ! We now have the lock
+                              ! and can do the work
+          CALL OMP_UNSET_LOCK( LCK )
+!$OMP END PARALLEL
+        CALL OMP_DESTROY_LOCK( LCK )
+        END PROGRAM A39
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.4.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.4.1.f90
new file mode 100644
index 0000000..3c2a74a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.4.1.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+      SUBROUTINE SUBDOMAIN(X, ISTART, IPOINTS)
+          INTEGER ISTART, IPOINTS
+          REAL X(*)
+          INTEGER I
+          DO 100 I=1,IPOINTS
+             X(ISTART+I) = 123.456
+ 100      CONTINUE
+      END SUBROUTINE SUBDOMAIN
+      SUBROUTINE SUB(X, NPOINTS)
+          INCLUDE "omp_lib.h"      ! or USE OMP_LIB
+          REAL X(*)
+          INTEGER NPOINTS
+          INTEGER IAM, NT, IPOINTS, ISTART
+!$OMP PARALLEL DEFAULT(PRIVATE) SHARED(X,NPOINTS)
+          IAM = OMP_GET_THREAD_NUM()
+          NT = OMP_GET_NUM_THREADS()
+          IPOINTS = NPOINTS/NT
+          ISTART = IAM * IPOINTS
+          IF (IAM .EQ. NT-1) THEN
+              IPOINTS = NPOINTS - ISTART
+          ENDIF
+          CALL SUBDOMAIN(X,ISTART,IPOINTS)
+!$OMP END PARALLEL
+      END SUBROUTINE SUB
+      PROGRAM A4
+          REAL ARRAY(10000)
+          CALL SUB(ARRAY, 10000)
+      END PROGRAM A4
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90
new file mode 100644
index 0000000..38fbca3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.40.1.f90
@@ -0,0 +1,52 @@
+! { dg-do compile }
+! { dg-options "-ffixed-form" }
+        MODULE DATA
+        USE OMP_LIB, ONLY: OMP_NEST_LOCK_KIND
+        TYPE LOCKED_PAIR
+        INTEGER A
+        INTEGER B
+        INTEGER (OMP_NEST_LOCK_KIND) LCK
+        END TYPE
+            END MODULE DATA
+        SUBROUTINE INCR_A(P, A)
+            ! called only from INCR_PAIR, no need to lock
+            USE DATA
+            TYPE(LOCKED_PAIR) :: P
+            INTEGER A
+            P%A = P%A + A
+        END SUBROUTINE INCR_A
+        SUBROUTINE INCR_B(P, B)
+            ! called from both INCR_PAIR and elsewhere,
+            ! so we need a nestable lock
+            USE OMP_LIB       ! or INCLUDE "omp_lib.h"
+            USE DATA
+            TYPE(LOCKED_PAIR) :: P
+            INTEGER B
+            CALL OMP_SET_NEST_LOCK(P%LCK)
+            P%B = P%B + B
+            CALL OMP_UNSET_NEST_LOCK(P%LCK)
+        END SUBROUTINE INCR_B
+        SUBROUTINE INCR_PAIR(P, A, B)
+            USE OMP_LIB         ! or INCLUDE "omp_lib.h"
+            USE DATA
+            TYPE(LOCKED_PAIR) :: P
+            INTEGER A
+            INTEGER B
+        CALL OMP_SET_NEST_LOCK(P%LCK)
+        CALL INCR_A(P, A)
+        CALL INCR_B(P, B)
+        CALL OMP_UNSET_NEST_LOCK(P%LCK)
+      END SUBROUTINE INCR_PAIR
+      SUBROUTINE A40(P)
+        USE OMP_LIB        ! or INCLUDE "omp_lib.h"
+        USE DATA
+        TYPE(LOCKED_PAIR) :: P
+        INTEGER WORK1, WORK2, WORK3
+        EXTERNAL WORK1, WORK2, WORK3
+!$OMP PARALLEL SECTIONS
+!$OMP SECTION
+          CALL INCR_PAIR(P, WORK1(), WORK2())
+!$OMP SECTION
+          CALL INCR_B(P, WORK3())
+!$OMP END PARALLEL SECTIONS
+      END SUBROUTINE A40
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a.5.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a.5.1.f90
new file mode 100644
index 0000000..13e451e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a.5.1.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+      PROGRAM A5
+        INCLUDE "omp_lib.h"      ! or USE OMP_LIB
+        CALL OMP_SET_DYNAMIC(.TRUE.)
+!$OMP PARALLEL NUM_THREADS(10)
+            ! do work here
+!$OMP END PARALLEL
+      END PROGRAM A5
diff --git a/libgomp/testsuite/libgomp.fortran/appendix-a/a10.1.f90 b/libgomp/testsuite/libgomp.fortran/appendix-a/a10.1.f90
new file mode 100644
index 0000000..c1564bf
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/appendix-a/a10.1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+      SUBROUTINE WORK1()
+      END SUBROUTINE WORK1
+      SUBROUTINE WORK2()
+      END SUBROUTINE WORK2
+      PROGRAM A10
+!$OMP PARALLEL
+!$OMP SINGLE
+        print *, "Beginning work1."
+!$OMP END SINGLE
+        CALL WORK1()
+!$OMP SINGLE
+        print *, "Finishing work1."
+!$OMP END SINGLE
+!$OMP SINGLE
+        print *, "Finished work1 and beginning work2."
+!$OMP END SINGLE NOWAIT
+        CALL WORK2()
+!$OMP END PARALLEL
+      END PROGRAM A10
diff --git a/libgomp/testsuite/libgomp.fortran/character1.f90 b/libgomp/testsuite/libgomp.fortran/character1.f90
new file mode 100644
index 0000000..f75ae27
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/character1.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+!$ use omp_lib
+
+  character (len = 8) :: h, i
+  character (len = 4) :: j, k
+  h = '01234567'
+  i = 'ABCDEFGH'
+  j = 'IJKL'
+  k = 'MN'
+  call test (h, j)
+contains
+  subroutine test (p, q)
+    character (len = 8) :: p
+    character (len = 4) :: q, r
+    character (len = 16) :: f
+    character (len = 32) :: g
+    integer, dimension (18) :: s
+    logical :: l
+    integer :: m
+    f = 'test16'
+    g = 'abcdefghijklmnopqrstuvwxyz'
+    r = ''
+    l = .false.
+    s = -6
+!$omp parallel firstprivate (f, p, s) private (r, m) reduction (.or.:l) &
+!$omp & num_threads (4)
+    m = omp_get_thread_num ()
+    if (any (s .ne. -6)) l = .true.
+    l = l .or. f .ne. 'test16' .or. p .ne. '01234567'
+    l = l .or. g .ne. 'abcdefghijklmnopqrstuvwxyz'
+    l = l .or. i .ne. 'ABCDEFGH' .or. q .ne. 'IJKL'
+    l = l .or. k .ne. 'MN'
+!$omp barrier
+    if (m .eq. 0) then
+      f = 'ffffffff0'
+      g = 'xyz'
+      i = '123'
+      k = '9876'
+      p = '_abc'
+      q = '_def'
+      r = '1_23'
+    else if (m .eq. 1) then
+      f = '__'
+      p = 'xxx'
+      r = '7575'
+    else if (m .eq. 2) then
+      f = 'ZZ'
+      p = 'm2'
+      r = 'M2'
+    else if (m .eq. 3) then
+      f = 'YY'
+      p = 'm3'
+      r = 'M3'
+    end if
+    s = m
+!$omp barrier
+    l = l .or. g .ne. 'xyz' .or. i .ne. '123' .or. k .ne. '9876'
+    l = l .or. q .ne. '_def'
+    if (any (s .ne. m)) l = .true.
+    if (m .eq. 0) then
+      l = l .or. f .ne. 'ffffffff0' .or. p .ne. '_abc' .or. r .ne. '1_23'
+    else if (m .eq. 1) then
+      l = l .or. f .ne. '__' .or. p .ne. 'xxx' .or. r .ne. '7575'
+    else if (m .eq. 2) then
+      l = l .or. f .ne. 'ZZ' .or. p .ne. 'm2' .or. r .ne. 'M2'
+    else if (m .eq. 3) then
+      l = l .or. f .ne. 'YY' .or. p .ne. 'm3' .or. r .ne. 'M3'
+    end if
+!$omp end parallel
+    if (l) call abort
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/character2.f90 b/libgomp/testsuite/libgomp.fortran/character2.f90
new file mode 100644
index 0000000..d59032b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/character2.f90
@@ -0,0 +1,61 @@
+! { dg-do run }
+!$ use omp_lib
+
+  character (len = 8) :: h
+  character (len = 9) :: i
+  h = '01234567'
+  i = 'ABCDEFGHI'
+  call test (h, i, 9)
+contains
+  subroutine test (p, q, n)
+    character (len = *) :: p
+    character (len = n) :: q
+    character (len = n) :: r
+    character (len = n) :: t
+    character (len = n) :: u
+    integer, dimension (n + 4) :: s
+    logical :: l
+    integer :: m
+    r = ''
+    if (n .gt. 8) r = 'jklmnopqr'
+    do m = 1, n + 4
+      s(m) = m
+    end do
+    u = 'abc'
+    l = .false.
+!$omp parallel firstprivate (p, q, r) private (t, m) reduction (.or.:l) &
+!$omp & num_threads (2)
+    do m = 1, 13
+      if (s(m) .ne. m) l = .true.
+    end do
+    m = omp_get_thread_num ()
+    l = l .or. p .ne. '01234567' .or. q .ne. 'ABCDEFGHI'
+    l = l .or. r .ne. 'jklmnopqr' .or. u .ne. 'abc'
+!$omp barrier
+    if (m .eq. 0) then
+      p = 'A'
+      q = 'B'
+      r = 'C'
+      t = '123'
+      u = '987654321'
+    else if (m .eq. 1) then
+      p = 'D'
+      q = 'E'
+      r = 'F'
+      t = '456'
+      s = m
+    end if
+!$omp barrier
+    l = l .or. u .ne. '987654321'
+    if (any (s .ne. 1)) l = .true.
+    if (m .eq. 0) then
+      l = l .or. p .ne. 'A' .or. q .ne. 'B' .or. r .ne. 'C'
+      l = l .or. t .ne. '123'
+    else
+      l = l .or. p .ne. 'D' .or. q .ne. 'E' .or. r .ne. 'F'
+      l = l .or. t .ne. '456'
+    end if
+!$omp end parallel
+    if (l) call abort
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/crayptr1.f90 b/libgomp/testsuite/libgomp.fortran/crayptr1.f90
new file mode 100644
index 0000000..57c59f7
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/crayptr1.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-options "-fopenmp -fcray-pointer" }
+
+  use omp_lib
+  integer :: a, b, c, p
+  logical :: l
+  pointer (ip, p)
+  a = 1
+  b = 2
+  c = 3
+  l = .false.
+  ip = loc (a)
+
+!$omp parallel num_threads (2) reduction (.or.:l)
+  l = p .ne. 1
+!$omp barrier
+!$omp master
+  ip = loc (b)
+!$omp end master
+!$omp barrier
+  l = l .or. p .ne. 2
+!$omp barrier
+  if (omp_get_thread_num () .eq. 1 .or. omp_get_num_threads () .lt. 2) &
+    ip = loc (c)
+!$omp barrier
+  l = l .or. p .ne. 3
+!$omp end parallel
+
+  if (l) call abort
+
+  l = .false.
+!$omp parallel num_threads (2) reduction (.or.:l) default (private)
+  ip = loc (a)
+  a = 3 * omp_get_thread_num () + 4
+  b = a + 1
+  c = a + 2
+  l = p .ne. 3 * omp_get_thread_num () + 4
+  ip = loc (c)
+  l = l .or. p .ne. 3 * omp_get_thread_num () + 6
+  ip = loc (b)
+  l = l .or. p .ne. 3 * omp_get_thread_num () + 5
+!$omp end parallel
+
+  if (l) call abort
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/do1.f90 b/libgomp/testsuite/libgomp.fortran/do1.f90
new file mode 100644
index 0000000..2a48c73
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/do1.f90
@@ -0,0 +1,179 @@
+! { dg-do run }
+
+  integer, dimension (128) :: a, b
+  integer :: i
+  a = -1
+  b = -1
+  do i = 1, 128
+    if (i .ge. 8 .and. i .le. 15) then
+      b(i) = 1 * 256 + i
+    else if (i .ge. 19 .and. i .le. 23) then
+      b(i) = 2 * 256 + i
+    else if (i .ge. 28 .and. i .le. 38) then
+      if (iand (i, 1) .eq. 0) b(i) = 3 * 256 + i
+    else if (i .ge. 59 .and. i .le. 79) then
+      if (iand (i - 59, 3) .eq. 0) b(i) = 4 * 256 + i
+    else if (i .ge. 101 .and. i .le. 125) then
+      if (mod (i - 101, 12) .eq. 0) b(i) = 5 * 256 + i
+    end if
+  end do
+
+!$omp parallel num_threads (4)
+
+!$omp do
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+  end do
+
+!$omp do
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+  end do
+
+!$omp do
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+  end do
+
+!$omp do
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+  end do
+
+!$omp do
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b)) call abort
+  a = -1
+
+!$omp parallel num_threads (4)
+
+!$omp do schedule (static)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+  end do
+
+!$omp do schedule (static, 1)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+  end do
+
+!$omp do schedule (static, 3)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+  end do
+
+!$omp do schedule (static, 6)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+  end do
+
+!$omp do schedule (static, 2)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b)) call abort
+  a = -1
+
+!$omp parallel num_threads (4)
+
+!$omp do schedule (dynamic)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+  end do
+
+!$omp do schedule (dynamic, 4)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+  end do
+
+!$omp do schedule (dynamic, 1)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+  end do
+
+!$omp do schedule (dynamic, 2)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+  end do
+
+!$omp do schedule (dynamic, 3)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b)) call abort
+  a = -1
+
+!$omp parallel num_threads (4)
+
+!$omp do schedule (guided)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+  end do
+
+!$omp do schedule (guided, 4)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+  end do
+
+!$omp do schedule (guided, 1)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+  end do
+
+!$omp do schedule (guided, 2)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+  end do
+
+!$omp do schedule (guided, 3)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b)) call abort
+  a = -1
+
+!$omp parallel num_threads (4)
+
+!$omp do schedule (runtime)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+  end do
+
+!$omp do schedule (runtime)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+  end do
+
+!$omp do schedule (runtime)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+  end do
+
+!$omp do schedule (runtime)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+  end do
+
+!$omp do schedule (runtime)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b)) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/do2.f90 b/libgomp/testsuite/libgomp.fortran/do2.f90
new file mode 100644
index 0000000..b90ccddd
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/do2.f90
@@ -0,0 +1,366 @@
+! { dg-do run }
+
+  integer, dimension (128) :: a, b
+  integer :: i, j
+  logical :: k
+  a = -1
+  b = -1
+  do i = 1, 128
+    if (i .ge. 8 .and. i .le. 15) then
+      b(i) = 1 * 256 + i
+    else if (i .ge. 19 .and. i .le. 23) then
+      b(i) = 2 * 256 + i
+    else if (i .ge. 28 .and. i .le. 38) then
+      if (iand (i, 1) .eq. 0) b(i) = 3 * 256 + i
+    else if (i .ge. 59 .and. i .le. 79) then
+      if (iand (i - 59, 3) .eq. 0) b(i) = 4 * 256 + i
+    else if (i .ge. 101 .and. i .le. 125) then
+      if (mod (i - 101, 12) .eq. 0) b(i) = 5 * 256 + i
+    end if
+  end do
+
+  k = .false.
+  j = 8
+!$omp parallel num_threads (4)
+
+!$omp do ordered
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 23
+!$omp end single
+
+!$omp do ordered
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 28
+!$omp end single
+
+!$omp do ordered
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 2
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 79
+!$omp end single
+
+!$omp do ordered
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 4
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 125
+!$omp end single
+
+!$omp do ordered
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 12
+!$omp end ordered
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b) .or. k) call abort
+  a = -1
+  k = .false.
+  j = 8
+!$omp parallel num_threads (4)
+
+!$omp do ordered schedule (static)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 23
+!$omp end single
+
+!$omp do ordered schedule (static, 1)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 28
+!$omp end single
+
+!$omp do ordered schedule (static, 3)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 2
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 79
+!$omp end single
+
+!$omp do ordered schedule (static, 6)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 4
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 125
+!$omp end single
+
+!$omp do ordered schedule (static, 2)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 12
+!$omp end ordered
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b) .or. k) call abort
+  a = -1
+  k = .false.
+  j = 8
+!$omp parallel num_threads (4)
+
+!$omp do ordered schedule (dynamic)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 23
+!$omp end single
+
+!$omp do ordered schedule (dynamic, 4)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 28
+!$omp end single
+
+!$omp do ordered schedule (dynamic, 1)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 2
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 79
+!$omp end single
+
+!$omp do ordered schedule (dynamic, 2)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 4
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 125
+!$omp end single
+
+!$omp do ordered schedule (dynamic, 3)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 12
+!$omp end ordered
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b) .or. k) call abort
+  a = -1
+  k = .false.
+  j = 8
+!$omp parallel num_threads (4)
+
+!$omp do ordered schedule (guided)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 23
+!$omp end single
+
+!$omp do ordered schedule (guided, 4)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 28
+!$omp end single
+
+!$omp do ordered schedule (guided, 1)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 2
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 79
+!$omp end single
+
+!$omp do ordered schedule (guided, 2)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 4
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 125
+!$omp end single
+
+!$omp do ordered schedule (guided, 3)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 12
+!$omp end ordered
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b) .or. k) call abort
+  a = -1
+  k = .false.
+  j = 8
+!$omp parallel num_threads (4)
+
+!$omp do ordered schedule (runtime)
+  do i = 8, 15
+    a(i) = 1 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 23
+!$omp end single
+
+!$omp do ordered schedule (runtime)
+  do i = 23, 19, -1
+    a(i) = 2 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 1
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 28
+!$omp end single
+
+!$omp do ordered schedule (runtime)
+  do i = 28, 39, 2
+    a(i) = 3 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j + 2
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 79
+!$omp end single
+
+!$omp do ordered schedule (runtime)
+  do i = 79, 59, -4
+    a(i) = 4 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 4
+!$omp end ordered
+  end do
+
+!$omp single
+  j = 125
+!$omp end single
+
+!$omp do ordered schedule (runtime)
+  do i = 125, 90, -12
+    a(i) = 5 * 256 + i
+!$omp ordered
+    if (i .ne. j) k = .true.
+    j = j - 12
+!$omp end ordered
+  end do
+
+!$omp end parallel
+
+  if (any (a .ne. b) .or. k) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/fortran.exp b/libgomp/testsuite/libgomp.fortran/fortran.exp
new file mode 100644
index 0000000..e7ee746
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/fortran.exp
@@ -0,0 +1,20 @@
+set lang_library_path	"../libgfortran/.libs"
+set lang_test_file	"${lang_library_path}/libgfortranbegin.a"
+set lang_link_flags	"-lgfortranbegin -lgfortran"
+
+load_lib libgomp-dg.exp
+
+# Initialize dg.
+dg-init
+
+if [file exists "${blddir}/${lang_test_file}"] {
+
+    # Gather a list of all tests.
+    set tests [lsort [find $srcdir/$subdir *.\[fF\]{,90,95}]]
+
+    # Main loop.
+    gfortran-dg-runtest $tests ""
+}
+
+# All done.
+dg-finish
diff --git a/libgomp/testsuite/libgomp.fortran/jacobi.f b/libgomp/testsuite/libgomp.fortran/jacobi.f
new file mode 100644
index 0000000..b27e20f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/jacobi.f
@@ -0,0 +1,261 @@
+* { dg-do run }
+
+      program main 
+************************************************************
+* program to solve a finite difference 
+* discretization of Helmholtz equation :  
+* (d2/dx2)u + (d2/dy2)u - alpha u = f 
+* using Jacobi iterative method. 
+*
+* Modified: Sanjiv Shah,       Kuck and Associates, Inc. (KAI), 1998
+* Author:   Joseph Robicheaux, Kuck and Associates, Inc. (KAI), 1998
+* 
+* Directives are used in this code to achieve paralleism. 
+* All do loops are parallized with default 'static' scheduling.
+* 
+* Input :  n - grid dimension in x direction 
+*          m - grid dimension in y direction
+*          alpha - Helmholtz constant (always greater than 0.0)
+*          tol   - error tolerance for iterative solver
+*          relax - Successice over relaxation parameter
+*          mits  - Maximum iterations for iterative solver
+*
+* On output 
+*       : u(n,m) - Dependent variable (solutions)
+*       : f(n,m) - Right hand side function 
+*************************************************************
+      implicit none 
+
+      integer n,m,mits,mtemp
+      include "omp_lib.h"
+      double precision tol,relax,alpha 
+
+      common /idat/ n,m,mits,mtemp
+      common /fdat/tol,alpha,relax
+* 
+* Read info 
+* 
+      write(*,*) "Input n,m - grid dimension in x,y direction " 
+      n = 64
+      m = 64
+*     read(5,*) n,m 
+      write(*,*) n, m
+      write(*,*) "Input alpha - Helmholts constant " 
+      alpha = 0.5
+*     read(5,*) alpha
+      write(*,*) alpha
+      write(*,*) "Input relax - Successive over-relaxation parameter"
+      relax = 0.9
+*     read(5,*) relax 
+      write(*,*) relax
+      write(*,*) "Input tol - error tolerance for iterative solver" 
+      tol = 1.0E-12
+*     read(5,*) tol 
+      write(*,*) tol
+      write(*,*) "Input mits - Maximum iterations for solver" 
+      mits = 100
+*     read(5,*) mits
+      write(*,*) mits
+
+      call omp_set_num_threads (2)
+
+*
+* Calls a driver routine 
+* 
+      call driver () 
+
+      stop
+      end 
+
+      subroutine driver ( ) 
+*************************************************************
+* Subroutine driver () 
+* This is where the arrays are allocated and initialzed. 
+*
+* Working varaibles/arrays 
+*     dx  - grid spacing in x direction 
+*     dy  - grid spacing in y direction 
+*************************************************************
+      implicit none 
+
+      integer n,m,mits,mtemp 
+      double precision tol,relax,alpha 
+
+      common /idat/ n,m,mits,mtemp
+      common /fdat/tol,alpha,relax
+
+      double precision u(n,m),f(n,m),dx,dy
+
+* Initialize data
+
+      call initialize (n,m,alpha,dx,dy,u,f)
+
+* Solve Helmholtz equation
+
+      call jacobi (n,m,dx,dy,alpha,relax,u,f,tol,mits)
+
+* Check error between exact solution
+
+      call  error_check (n,m,alpha,dx,dy,u,f)
+
+      return 
+      end 
+
+      subroutine initialize (n,m,alpha,dx,dy,u,f) 
+******************************************************
+* Initializes data 
+* Assumes exact solution is u(x,y) = (1-x^2)*(1-y^2)
+*
+******************************************************
+      implicit none 
+     
+      integer n,m
+      double precision u(n,m),f(n,m),dx,dy,alpha
+      
+      integer i,j, xx,yy
+      double precision PI 
+      parameter (PI=3.1415926)
+
+      dx = 2.0 / (n-1)
+      dy = 2.0 / (m-1)
+
+* Initilize initial condition and RHS
+
+!$omp parallel do private(xx,yy)
+      do j = 1,m
+         do i = 1,n
+            xx = -1.0 + dx * dble(i-1)        ! -1 < x < 1
+            yy = -1.0 + dy * dble(j-1)        ! -1 < y < 1
+            u(i,j) = 0.0 
+            f(i,j) = -alpha *(1.0-xx*xx)*(1.0-yy*yy) 
+     &           - 2.0*(1.0-xx*xx)-2.0*(1.0-yy*yy)
+         enddo
+      enddo
+!$omp end parallel do
+
+      return 
+      end 
+
+      subroutine jacobi (n,m,dx,dy,alpha,omega,u,f,tol,maxit)
+******************************************************************
+* Subroutine HelmholtzJ
+* Solves poisson equation on rectangular grid assuming : 
+* (1) Uniform discretization in each direction, and 
+* (2) Dirichlect boundary conditions 
+* 
+* Jacobi method is used in this routine 
+*
+* Input : n,m   Number of grid points in the X/Y directions 
+*         dx,dy Grid spacing in the X/Y directions 
+*         alpha Helmholtz eqn. coefficient 
+*         omega Relaxation factor 
+*         f(n,m) Right hand side function 
+*         u(n,m) Dependent variable/Solution
+*         tol    Tolerance for iterative solver 
+*         maxit  Maximum number of iterations 
+*
+* Output : u(n,m) - Solution 
+*****************************************************************
+      implicit none 
+      integer n,m,maxit
+      double precision dx,dy,f(n,m),u(n,m),alpha, tol,omega
+*
+* Local variables 
+* 
+      integer i,j,k,k_local 
+      double precision error,resid,rsum,ax,ay,b
+      double precision error_local, uold(n,m)
+
+      real ta,tb,tc,td,te,ta1,ta2,tb1,tb2,tc1,tc2,td1,td2
+      real te1,te2
+      real second
+      external second
+*
+* Initialize coefficients 
+      ax = 1.0/(dx*dx) ! X-direction coef 
+      ay = 1.0/(dy*dy) ! Y-direction coef
+      b  = -2.0/(dx*dx)-2.0/(dy*dy) - alpha ! Central coeff  
+
+      error = 10.0 * tol 
+      k = 1
+
+      do while (k.le.maxit .and. error.gt. tol) 
+
+         error = 0.0    
+
+* Copy new solution into old
+!$omp parallel
+
+!$omp do 
+         do j=1,m
+            do i=1,n
+               uold(i,j) = u(i,j) 
+            enddo
+         enddo
+
+* Compute stencil, residual, & update
+
+!$omp do private(resid) reduction(+:error)
+         do j = 2,m-1
+            do i = 2,n-1 
+*     Evaluate residual 
+               resid = (ax*(uold(i-1,j) + uold(i+1,j)) 
+     &                + ay*(uold(i,j-1) + uold(i,j+1))
+     &                 + b * uold(i,j) - f(i,j))/b
+* Update solution 
+               u(i,j) = uold(i,j) - omega * resid
+* Accumulate residual error
+               error = error + resid*resid 
+            end do
+         enddo
+!$omp enddo nowait
+
+!$omp end parallel
+
+* Error check 
+
+         k = k + 1
+
+         error = sqrt(error)/dble(n*m)
+*
+      enddo                     ! End iteration loop 
+*
+      print *, 'Total Number of Iterations ', k 
+      print *, 'Residual                   ', error 
+
+      return 
+      end 
+
+      subroutine error_check (n,m,alpha,dx,dy,u,f) 
+      implicit none 
+************************************************************
+* Checks error between numerical and exact solution 
+*
+************************************************************ 
+     
+      integer n,m
+      double precision u(n,m),f(n,m),dx,dy,alpha 
+      
+      integer i,j
+      double precision xx,yy,temp,error 
+
+      dx = 2.0 / (n-1)
+      dy = 2.0 / (m-1)
+      error = 0.0 
+
+!$omp parallel do private(xx,yy,temp) reduction(+:error)
+      do j = 1,m
+         do i = 1,n
+            xx = -1.0d0 + dx * dble(i-1)
+            yy = -1.0d0 + dy * dble(j-1)
+            temp  = u(i,j) - (1.0-xx*xx)*(1.0-yy*yy)
+            error = error + temp*temp 
+         enddo
+      enddo
+  
+      error = sqrt(error)/dble(n*m)
+
+      print *, 'Solution Error : ',error
+
+      return 
+      end 
diff --git a/libgomp/testsuite/libgomp.fortran/lib1.f90 b/libgomp/testsuite/libgomp.fortran/lib1.f90
new file mode 100644
index 0000000..8840018
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/lib1.f90
@@ -0,0 +1,76 @@
+! { dg-do run }
+
+  use omp_lib
+
+  double precision :: d, e
+  logical :: l
+  integer (kind = omp_lock_kind) :: lck
+  integer (kind = omp_nest_lock_kind) :: nlck
+
+  d = omp_get_wtime ()
+
+  call omp_init_lock (lck)
+  call omp_set_lock (lck)
+  if (omp_test_lock (lck)) call abort
+  call omp_unset_lock (lck)
+  if (.not. omp_test_lock (lck)) call abort
+  if (omp_test_lock (lck)) call abort
+  call omp_unset_lock (lck)
+  call omp_destroy_lock (lck)
+
+  call omp_init_nest_lock (nlck)
+  if (omp_test_nest_lock (nlck) .ne. 1) call abort
+  call omp_set_nest_lock (nlck)
+  if (omp_test_nest_lock (nlck) .ne. 3) call abort
+  call omp_unset_nest_lock (nlck)
+  call omp_unset_nest_lock (nlck)
+  if (omp_test_nest_lock (nlck) .ne. 2) call abort
+  call omp_unset_nest_lock (nlck)
+  call omp_unset_nest_lock (nlck)
+  call omp_destroy_nest_lock (nlck)
+
+  call omp_set_dynamic (.true.)
+  if (.not. omp_get_dynamic ()) call abort
+  call omp_set_dynamic (.false.)
+  if (omp_get_dynamic ()) call abort
+
+  call omp_set_nested (.true.)
+  if (.not. omp_get_nested ()) call abort
+  call omp_set_nested (.false.)
+  if (omp_get_nested ()) call abort
+
+  call omp_set_num_threads (5)
+  if (omp_get_num_threads () .ne. 1) call abort
+  if (omp_get_max_threads () .ne. 5) call abort
+  if (omp_get_thread_num () .ne. 0) call abort
+  call omp_set_num_threads (3)
+  if (omp_get_num_threads () .ne. 1) call abort
+  if (omp_get_max_threads () .ne. 3) call abort
+  if (omp_get_thread_num () .ne. 0) call abort
+  l = .false.
+!$omp parallel reduction (.or.:l)
+  l = omp_get_num_threads () .ne. 3
+  l = l .or. (omp_get_thread_num () .lt. 0)
+  l = l .or. (omp_get_thread_num () .ge. 3)
+!$omp master
+  l = l .or. (omp_get_thread_num () .ne. 0)
+!$omp end master
+!$omp end parallel
+  if (l) call abort
+
+  if (omp_get_num_procs () .le. 0) call abort
+  if (omp_in_parallel ()) call abort
+!$omp parallel reduction (.or.:l)
+  l = .not. omp_in_parallel ()
+!$omp end parallel
+!$omp parallel reduction (.or.:l) if (.true.)
+  l = .not. omp_in_parallel ()
+!$omp end parallel
+
+  e = omp_get_wtime ()
+  if (d .gt. e) call abort
+  d = omp_get_wtick ()
+  ! Negative precision is definitely wrong,
+  ! bigger than 1s clock resolution is also strange
+  if (d .le. 0 .or. d .gt. 1.) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/lib2.f b/libgomp/testsuite/libgomp.fortran/lib2.f
new file mode 100644
index 0000000..7551082
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/lib2.f
@@ -0,0 +1,76 @@
+C { dg-do run }
+
+      USE OMP_LIB
+
+      DOUBLE PRECISION :: D, E
+      LOGICAL :: L
+      INTEGER (KIND = OMP_LOCK_KIND) :: LCK
+      INTEGER (KIND = OMP_NEST_LOCK_KIND) :: NLCK
+
+      D = OMP_GET_WTIME ()
+
+      CALL OMP_INIT_LOCK (LCK)
+      CALL OMP_SET_LOCK (LCK)
+      IF (OMP_TEST_LOCK (LCK)) CALL ABORT
+      CALL OMP_UNSET_LOCK (LCK)
+      IF (.NOT. OMP_TEST_LOCK (LCK)) CALL ABORT
+      IF (OMP_TEST_LOCK (LCK)) CALL ABORT
+      CALL OMP_UNSET_LOCK (LCK)
+      CALL OMP_DESTROY_LOCK (LCK)
+
+      CALL OMP_INIT_NEST_LOCK (NLCK)
+      IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 1) CALL ABORT
+      CALL OMP_SET_NEST_LOCK (NLCK)
+      IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 3) CALL ABORT
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 2) CALL ABORT
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      CALL OMP_DESTROY_NEST_LOCK (NLCK)
+
+      CALL OMP_SET_DYNAMIC (.TRUE.)
+      IF (.NOT. OMP_GET_DYNAMIC ()) CALL ABORT
+      CALL OMP_SET_DYNAMIC (.FALSE.)
+      IF (OMP_GET_DYNAMIC ()) CALL ABORT
+
+      CALL OMP_SET_NESTED (.TRUE.)
+      IF (.NOT. OMP_GET_NESTED ()) CALL ABORT
+      CALL OMP_SET_NESTED (.FALSE.)
+      IF (OMP_GET_NESTED ()) CALL ABORT
+
+      CALL OMP_SET_NUM_THREADS (5)
+      IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT
+      IF (OMP_GET_MAX_THREADS () .NE. 5) CALL ABORT
+      IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT
+      CALL OMP_SET_NUM_THREADS (3)
+      IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT
+      IF (OMP_GET_MAX_THREADS () .NE. 3) CALL ABORT
+      IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT
+      L = .FALSE.
+C$OMP PARALLEL REDUCTION (.OR.:L)
+      L = OMP_GET_NUM_THREADS () .NE. 3
+      L = L .OR. (OMP_GET_THREAD_NUM () .LT. 0)
+      L = L .OR. (OMP_GET_THREAD_NUM () .GE. 3)
+C$OMP MASTER
+      L = L .OR. (OMP_GET_THREAD_NUM () .NE. 0)
+C$OMP END MASTER
+C$OMP END PARALLEL
+      IF (L) CALL ABORT
+
+      IF (OMP_GET_NUM_PROCS () .LE. 0) CALL ABORT
+      IF (OMP_IN_PARALLEL ()) CALL ABORT
+C$OMP PARALLEL REDUCTION (.OR.:L)
+      L = .NOT. OMP_IN_PARALLEL ()
+C$OMP END PARALLEL
+C$OMP PARALLEL REDUCTION (.OR.:L) IF (.TRUE.)
+      L = .NOT. OMP_IN_PARALLEL ()
+C$OMP END PARALLEL
+
+      E = OMP_GET_WTIME ()
+      IF (D .GT. E) CALL ABORT
+      D = OMP_GET_WTICK ()
+C Negative precision is definitely wrong,
+C bigger than 1s clock resolution is also strange
+      IF (D .LE. 0 .OR. D .GT. 1.) CALL ABORT
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/lib3.f b/libgomp/testsuite/libgomp.fortran/lib3.f
new file mode 100644
index 0000000..fa7b227
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/lib3.f
@@ -0,0 +1,76 @@
+C { dg-do run }
+
+      INCLUDE "omp_lib.h"
+
+      DOUBLE PRECISION :: D, E
+      LOGICAL :: L
+      INTEGER (KIND = OMP_LOCK_KIND) :: LCK
+      INTEGER (KIND = OMP_NEST_LOCK_KIND) :: NLCK
+
+      D = OMP_GET_WTIME ()
+
+      CALL OMP_INIT_LOCK (LCK)
+      CALL OMP_SET_LOCK (LCK)
+      IF (OMP_TEST_LOCK (LCK)) CALL ABORT
+      CALL OMP_UNSET_LOCK (LCK)
+      IF (.NOT. OMP_TEST_LOCK (LCK)) CALL ABORT
+      IF (OMP_TEST_LOCK (LCK)) CALL ABORT
+      CALL OMP_UNSET_LOCK (LCK)
+      CALL OMP_DESTROY_LOCK (LCK)
+
+      CALL OMP_INIT_NEST_LOCK (NLCK)
+      IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 1) CALL ABORT
+      CALL OMP_SET_NEST_LOCK (NLCK)
+      IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 3) CALL ABORT
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 2) CALL ABORT
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      CALL OMP_UNSET_NEST_LOCK (NLCK)
+      CALL OMP_DESTROY_NEST_LOCK (NLCK)
+
+      CALL OMP_SET_DYNAMIC (.TRUE.)
+      IF (.NOT. OMP_GET_DYNAMIC ()) CALL ABORT
+      CALL OMP_SET_DYNAMIC (.FALSE.)
+      IF (OMP_GET_DYNAMIC ()) CALL ABORT
+
+      CALL OMP_SET_NESTED (.TRUE.)
+      IF (.NOT. OMP_GET_NESTED ()) CALL ABORT
+      CALL OMP_SET_NESTED (.FALSE.)
+      IF (OMP_GET_NESTED ()) CALL ABORT
+
+      CALL OMP_SET_NUM_THREADS (5)
+      IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT
+      IF (OMP_GET_MAX_THREADS () .NE. 5) CALL ABORT
+      IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT
+      CALL OMP_SET_NUM_THREADS (3)
+      IF (OMP_GET_NUM_THREADS () .NE. 1) CALL ABORT
+      IF (OMP_GET_MAX_THREADS () .NE. 3) CALL ABORT
+      IF (OMP_GET_THREAD_NUM () .NE. 0) CALL ABORT
+      L = .FALSE.
+C$OMP PARALLEL REDUCTION (.OR.:L)
+      L = OMP_GET_NUM_THREADS () .NE. 3
+      L = L .OR. (OMP_GET_THREAD_NUM () .LT. 0)
+      L = L .OR. (OMP_GET_THREAD_NUM () .GE. 3)
+C$OMP MASTER
+      L = L .OR. (OMP_GET_THREAD_NUM () .NE. 0)
+C$OMP END MASTER
+C$OMP END PARALLEL
+      IF (L) CALL ABORT
+
+      IF (OMP_GET_NUM_PROCS () .LE. 0) CALL ABORT
+      IF (OMP_IN_PARALLEL ()) CALL ABORT
+C$OMP PARALLEL REDUCTION (.OR.:L)
+      L = .NOT. OMP_IN_PARALLEL ()
+C$OMP END PARALLEL
+C$OMP PARALLEL REDUCTION (.OR.:L) IF (.TRUE.)
+      L = .NOT. OMP_IN_PARALLEL ()
+C$OMP END PARALLEL
+
+      E = OMP_GET_WTIME ()
+      IF (D .GT. E) CALL ABORT
+      D = OMP_GET_WTICK ()
+C Negative precision is definitely wrong,
+C bigger than 1s clock resolution is also strange
+      IF (D .LE. 0 .OR. D .GT. 1.) CALL ABORT
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/nestedfn1.f90 b/libgomp/testsuite/libgomp.fortran/nestedfn1.f90
new file mode 100644
index 0000000..67dadd6
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/nestedfn1.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+
+  integer :: a, b, c
+  a = 1
+  b = 2
+  c = 3
+  call foo
+  if (a .ne. 7) call abort
+contains
+  subroutine foo
+    use omp_lib
+    logical :: l
+    l = .false.
+!$omp parallel shared (a) private (b) firstprivate (c) &
+!$omp num_threads (2) reduction (.or.:l)
+    if (a .ne. 1 .or. c .ne. 3) l = .true.
+!$omp barrier
+    if (omp_get_thread_num () .eq. 0) then
+      a = 4
+      b = 5
+      c = 6
+    end if
+!$omp barrier
+    if (omp_get_thread_num () .eq. 1) then
+      if (a .ne. 4 .or. c .ne. 3) l = .true.
+      a = 7
+      b = 8
+      c = 9
+    else if (omp_get_num_threads () .eq. 1) then
+      a = 7
+    end if
+!$omp barrier
+    if (omp_get_thread_num () .eq. 0) then
+      if (a .ne. 7 .or. b .ne. 5 .or. c .ne. 6) l = .true.
+    end if
+!$omp barrier
+    if (omp_get_thread_num () .eq. 1) then
+      if (a .ne. 7 .or. b .ne. 8 .or. c .ne. 9) l = .true.
+    end if
+!$omp end parallel
+    if (l) call abort
+  end subroutine foo
+end
diff --git a/libgomp/testsuite/libgomp.fortran/nestedfn2.f90 b/libgomp/testsuite/libgomp.fortran/nestedfn2.f90
new file mode 100644
index 0000000..dfb12ae
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/nestedfn2.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+
+  integer :: i
+  common /c/ i
+  i = -1
+!$omp parallel shared (i) num_threads (4)
+  call test1
+!$omp end parallel
+end
+subroutine test1
+  integer :: vari
+  call test2
+  call test3
+contains
+  subroutine test2
+    use omp_lib
+    integer :: i
+    common /c/ i
+!$omp single
+    i = omp_get_thread_num ()
+    call test4
+!$omp end single copyprivate (vari)
+  end subroutine test2
+  subroutine test3
+    integer :: i
+    common /c/ i
+    if (i .lt. 0 .or. i .ge. 4) call abort
+    if (i + 10 .ne. vari) call abort
+  end subroutine test3
+  subroutine test4
+    use omp_lib
+    vari = omp_get_thread_num () + 10
+  end subroutine test4
+end subroutine test1
diff --git a/libgomp/testsuite/libgomp.fortran/omp_atomic1.f90 b/libgomp/testsuite/libgomp.fortran/omp_atomic1.f90
new file mode 100644
index 0000000..f9ce94b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_atomic1.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+    integer (kind = 4) :: a
+    integer (kind = 2) :: b
+    real :: c, f
+    double precision :: d
+    integer, dimension (10) :: e
+    a = 1
+    b = 2
+    c = 3
+    d = 4
+    e = 5
+    f = 6
+!$omp atomic
+    a = a + 4
+!$omp atomic
+    b = 4 - b
+!$omp atomic
+    c = c * 2
+!$omp atomic
+    d = 2 / d
+    if (a .ne. 5 .or. b .ne. 2 .or. c .ne. 6 .or. d .ne. 0.5) call abort
+    d = 1.2
+!$omp atomic
+    a = a + c + d
+!$omp atomic
+    b = b - (a + c + d)
+    if (a .ne. 12 .or. b .ne. -17) call abort
+!$omp atomic
+    a = c + d + a
+!$omp atomic
+    b = a + c + d - b
+    if (a .ne. 19 .or. b .ne. 43) call abort
+!$omp atomic
+    b = (a + c + d) - b
+    a = 32
+!$omp atomic
+    a = a / 3.4
+    if (a .ne. 9 .or. b .ne. -16) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_atomic2.f90 b/libgomp/testsuite/libgomp.fortran/omp_atomic2.f90
new file mode 100644
index 0000000..1dea2c8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_atomic2.f90
@@ -0,0 +1,54 @@
+! { dg-do run }
+  real, dimension (20) :: r
+  integer, dimension (20) :: d
+  integer :: i, j, k, n
+  integer (kind = 2) :: a, b, c
+
+  do 10 i = 1, 20
+    r(i) = i
+10  d(i) = 21 - i
+
+  n = 20
+  call foo (r, d, n)
+
+  if (n .ne. 22) call abort
+  if (any (r .ne. 33)) call abort
+
+  i = 1
+  j = 18
+  k = 23
+!$omp atomic
+  i = min (i, j, k, n)
+  if (i .ne. 1) call abort
+!$omp atomic
+  i = max (j, n, k, i)
+  if (i .ne. 23) call abort
+
+  a = 1
+  b = 18
+  c = 23
+!$omp atomic
+  a = min (a, b, c)
+  if (a .ne. 1) call abort
+!$omp atomic
+  a = max (a, b, c)
+  if (a .ne. 23) call abort
+
+contains
+  function bar (i)
+    real bar
+    integer i
+    bar = 12.0 + i
+  end function bar
+
+  subroutine foo (x, y, n)
+    integer i, y (*), n
+    real x (*)
+    do i = 1, n
+!$omp atomic
+      x(y(i)) = x(y(i)) + bar (i)
+    end do
+!$omp atomic
+    n = n + 2
+  end subroutine foo
+end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_cond1.f b/libgomp/testsuite/libgomp.fortran/omp_cond1.f
new file mode 100644
index 0000000..b557d90
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_cond1.f
@@ -0,0 +1,22 @@
+C Test conditional compilation in fixed form if -fopenmp
+! { dg-options "-fopenmp" }
+   10 foo = 2
+     &56
+      if (foo.ne.256) call abort
+      bar = 26
+!$2 0 ba
+c$   +r = 42
+      !$ bar = 62
+!$    bar = bar + 1
+      if (bar.ne.43) call abort
+      baz = bar
+*$   0baz = 5
+C$   +12! Comment
+c$   !4
+!$   +!Another comment
+*$   &2
+!$ X  baz = 0 ! Not valid OpenMP conditional compilation lines
+! $   baz = 1
+c$ 10&baz = 2
+      if (baz.ne.51242) call abort
+      end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_cond2.f b/libgomp/testsuite/libgomp.fortran/omp_cond2.f
new file mode 100644
index 0000000..6df891c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_cond2.f
@@ -0,0 +1,22 @@
+c Test conditional compilation in fixed form if -fno-openmp
+! { dg-options "-fno-openmp" }
+   10 foo = 2
+     &56
+      if (foo.ne.256) call abort
+      bar = 26
+!$2 0 ba
+c$   +r = 42
+      !$ bar = 62
+!$    bar = bar + 1
+      if (bar.ne.26) call abort
+      baz = bar
+*$   0baz = 5
+C$   +12! Comment
+c$   !4
+!$   +!Another comment
+*$   &2
+!$ X  baz = 0 ! Not valid OpenMP conditional compilation lines
+! $   baz = 1
+c$ 10&baz = 2
+      if (baz.ne.26) call abort
+      end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_cond3.F90 b/libgomp/testsuite/libgomp.fortran/omp_cond3.F90
new file mode 100644
index 0000000..6c4e36e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_cond3.F90
@@ -0,0 +1,24 @@
+! Test conditional compilation in free form if -fopenmp
+! { dg-options "-fopenmp" }
+   10 foo = 2&
+  &56
+  if (foo.ne.256) call abort
+  bar = 26
+   !$  20 ba&
+!$   &r = 4&
+  !$2
+      !$bar = 62
+   !$ bar = bar + 2
+#ifdef _OPENMP
+bar = bar - 1
+#endif
+  if (bar.ne.43) call abort
+      baz = bar
+!$ 30 baz = 5&     ! Comment
+!$12  &  
+  !$ + 2
+!$X baz = 0 ! Not valid OpenMP conditional compilation lines
+! $   baz = 1
+baz = baz + 1 !$ baz = 2
+      if (baz.ne.515) call abort
+      end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_cond4.F90 b/libgomp/testsuite/libgomp.fortran/omp_cond4.F90
new file mode 100644
index 0000000..aa4c5cb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_cond4.F90
@@ -0,0 +1,24 @@
+! Test conditional compilation in free form if -fno-openmp
+! { dg-options "-fno-openmp" }
+   10 foo = 2&
+  &56
+  if (foo.ne.256) call abort
+  bar = 26
+   !$  20 ba&
+!$   &r = 4&
+  !$2
+      !$bar = 62
+   !$ bar = bar + 2
+#ifdef _OPENMP
+bar = bar - 1
+#endif
+  if (bar.ne.26) call abort
+      baz = bar
+!$ 30 baz = 5&     ! Comment
+!$12  &  
+  !$ + 2
+!$X baz = 0 ! Not valid OpenMP conditional compilation lines
+! $   baz = 1
+baz = baz + 1 !$ baz = 2
+      if (baz.ne.27) call abort
+      end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_hello.f b/libgomp/testsuite/libgomp.fortran/omp_hello.f
new file mode 100644
index 0000000..ba44531
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_hello.f
@@ -0,0 +1,36 @@
+C******************************************************************************
+C FILE: omp_hello.f
+C DESCRIPTION:
+C   OpenMP Example - Hello World - Fortran Version
+C   In this simple example, the master thread forks a parallel region.
+C   All threads in the team obtain their unique thread number and print it.
+C   The master thread only prints the total number of threads.  Two OpenMP
+C   library routines are used to obtain the number of threads and each
+C   thread's number.
+C AUTHOR: Blaise Barney  5/99
+C LAST REVISED:
+C******************************************************************************
+
+      PROGRAM HELLO
+
+      INTEGER NTHREADS, TID, OMP_GET_NUM_THREADS,
+     +        OMP_GET_THREAD_NUM
+
+C     Fork a team of threads giving them their own copies of variables
+!$OMP PARALLEL PRIVATE(NTHREADS, TID)
+
+
+C     Obtain thread number
+      TID = OMP_GET_THREAD_NUM()
+      PRINT *, 'Hello World from thread = ', TID
+
+C     Only master thread does this
+      IF (TID .EQ. 0) THEN
+        NTHREADS = OMP_GET_NUM_THREADS()
+        PRINT *, 'Number of threads = ', NTHREADS
+      END IF
+
+C     All threads join master thread and disband
+!$OMP END PARALLEL
+
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/omp_orphan.f b/libgomp/testsuite/libgomp.fortran/omp_orphan.f
new file mode 100644
index 0000000..7653c78
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_orphan.f
@@ -0,0 +1,44 @@
+C******************************************************************************
+C FILE: omp_orphan.f
+C DESCRIPTION:
+C   OpenMP Example - Parallel region with an orphaned directive - Fortran
+C   Version
+C   This example demonstrates a dot product being performed by an orphaned
+C   loop reduction construct.  Scoping of the reduction variable is critical.
+C AUTHOR: Blaise Barney  5/99
+C LAST REVISED:
+C******************************************************************************
+
+      PROGRAM ORPHAN
+      COMMON /DOTDATA/ A, B, SUM
+      INTEGER I, VECLEN
+      PARAMETER (VECLEN = 100)
+      REAL*8 A(VECLEN), B(VECLEN), SUM
+
+      DO I=1, VECLEN
+         A(I) = 1.0 * I
+         B(I) = A(I)
+      ENDDO
+      SUM = 0.0
+!$OMP PARALLEL
+      CALL DOTPROD
+!$OMP END PARALLEL
+      WRITE(*,*) "Sum = ", SUM
+      END
+
+
+
+      SUBROUTINE DOTPROD
+      COMMON /DOTDATA/ A, B, SUM
+      INTEGER I, TID, OMP_GET_THREAD_NUM, VECLEN
+      PARAMETER (VECLEN = 100)
+      REAL*8 A(VECLEN), B(VECLEN), SUM
+
+      TID = OMP_GET_THREAD_NUM()
+!$OMP DO REDUCTION(+:SUM)
+      DO I=1, VECLEN
+         SUM = SUM + (A(I)*B(I))
+         PRINT *, '  TID= ',TID,'I= ',I
+      ENDDO
+      RETURN
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/omp_parse1.f90 b/libgomp/testsuite/libgomp.fortran/omp_parse1.f90
new file mode 100644
index 0000000..9cd8cc2
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_parse1.f90
@@ -0,0 +1,185 @@
+! { dg-do run }
+use omp_lib
+  call test_parallel
+  call test_do
+  call test_sections
+  call test_single
+
+contains
+  subroutine test_parallel
+    integer :: a, b, c, e, f, g, i, j
+    integer, dimension (20) :: d
+    logical :: h
+    a = 6
+    b = 8
+    c = 11
+    d(:) = -1
+    e = 13
+    f = 24
+    g = 27
+    h = .false.
+    i = 1
+    j = 16
+!$omp para&
+!$omp&llel &
+!$omp if (a .eq. 6) private (b, c) shared (d) private (e) &
+  !$omp firstprivate(f) num_threads (a - 1) first&
+!$ompprivate(g)default (shared) reduction (.or. : h) &
+!$omp reduction(*:i)
+    if (i .ne. 1) h = .true.
+    i = 2
+    if (f .ne. 24) h = .true.
+    if (g .ne. 27) h = .true.
+    e = 7
+    b = omp_get_thread_num ()
+    if (b .eq. 0) j = 24
+    f = b
+    g = f
+    c = omp_get_num_threads ()
+    if (c .gt. a - 1 .or. c .le. 0) h = .true.
+    if (b .ge. c) h = .true.
+    d(b + 1) = c
+    if (f .ne. g .or. f .ne. b) h = .true.
+!$omp endparallel
+    if (h) call abort
+    if (a .ne. 6) call abort
+    if (j .ne. 24) call abort
+    if (d(1) .eq. -1) call abort
+    e = 1
+    do g = 1, d(1)
+      if (d(g) .ne. d(1)) call abort
+      e = e * 2
+    end do
+    if (e .ne. i) call abort
+  end subroutine test_parallel
+
+  subroutine test_do_orphan
+    integer :: k, l
+!$omp parallel do private (l)
+    do 600 k = 1, 16, 2
+600   l = k
+  end subroutine test_do_orphan
+
+  subroutine test_do
+    integer :: i, j, k, l, n
+    integer, dimension (64) :: d
+    logical :: m
+
+    j = 16
+    d(:) = -1
+    m = .true.
+    n = 24
+!$omp parallel num_threads (4) shared (i, k, d) private (l) &
+!$omp&reduction (.and. : m)
+    if (omp_get_thread_num () .eq. 0) then
+      k = omp_get_num_threads ()
+    end if
+    call test_do_orphan
+!$omp do schedule (static) firstprivate (n)
+    do 200 i = 1, j
+      if (i .eq. 1 .and. n .ne. 24) call abort
+      n = i
+200   d(n) = omp_get_thread_num ()
+!$omp enddo nowait
+
+!$omp do lastprivate (i) schedule (static, 5)
+    do 201 i = j + 1, 2 * j
+201   d(i) = omp_get_thread_num () + 1024
+    ! Implied omp end do here
+
+    if (i .ne. 33) m = .false.
+
+!$omp do private (j) schedule (dynamic)
+    do i = 33, 48
+      d(i) = omp_get_thread_num () + 2048
+    end do
+!$omp end do nowait
+
+!$omp do schedule (runtime)
+    do i = 49, 4 * j
+      d(i) = omp_get_thread_num () + 4096
+    end do
+    ! Implied omp end do here
+!$omp end parallel
+    if (.not. m) call abort
+
+    j = 0
+    do i = 1, 64
+      if (d(i) .lt. j .or. d(i) .ge. j + k) call abort
+      if (i .eq. 16) j = 1024
+      if (i .eq. 32) j = 2048
+      if (i .eq. 48) j = 4096
+    end do
+  end subroutine test_do
+
+  subroutine test_sections
+    integer :: i, j, k, l, m, n
+    i = 9
+    j = 10
+    k = 11
+    l = 0
+    m = 0
+    n = 30
+    call omp_set_dynamic (.false.)
+    call omp_set_num_threads (4)
+!$omp parallel num_threads (4)
+!$omp sections private (i) firstprivate (j, k) lastprivate (j) &
+!$omp& reduction (+ : l, m)
+!$omp section
+    i = 24
+    if (j .ne. 10 .or. k .ne. 11 .or. m .ne. 0) l = 1
+    m = m + 4
+!$omp section
+    i = 25
+    if (j .ne. 10 .or. k .ne. 11) l = 1
+    m = m + 6
+!$omp section
+    i = 26
+    if (j .ne. 10 .or. k .ne. 11) l = 1
+    m = m + 8
+!$omp section
+    i = 27
+    if (j .ne. 10 .or. k .ne. 11) l = 1
+    m = m + 10
+    j = 271
+!$omp end sections nowait
+!$omp sections lastprivate (n)
+!$omp section
+    n = 6
+!$omp section
+    n = 7
+!$omp endsections
+!$omp end parallel
+    if (j .ne. 271 .or. l .ne. 0) call abort
+    if (m .ne. 4 + 6 + 8 + 10) call abort
+    if (n .ne. 7) call abort
+  end subroutine test_sections
+
+  subroutine test_single
+    integer :: i, j, k, l
+    logical :: m
+    i = 200
+    j = 300
+    k = 400
+    l = 500
+    m = .false.
+!$omp parallel num_threads (4), private (i, j), reduction (.or. : m)
+    i = omp_get_thread_num ()
+    j = omp_get_thread_num ()
+!$omp single private (k)
+    k = 64
+!$omp end single nowait
+!$omp single private (k) firstprivate (l)
+    if (i .ne. omp_get_thread_num () .or. i .ne. j) then
+      j = -1
+    else
+      j = -2
+    end if
+    if (l .ne. 500) j = -1
+    l = 265
+!$omp end single copyprivate (j)
+    if (i .ne. omp_get_thread_num () .or. j .ne. -2) m = .true.
+!$omp endparallel
+    if (m) call abort
+  end subroutine test_single
+end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_parse2.f90 b/libgomp/testsuite/libgomp.fortran/omp_parse2.f90
new file mode 100644
index 0000000..da54a98
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_parse2.f90
@@ -0,0 +1,102 @@
+! { dg-do run }
+use omp_lib
+  call test_master
+  call test_critical
+  call test_barrier
+  call test_atomic
+
+contains
+  subroutine test_master
+    logical :: i, j
+    i = .false.
+    j = .false.
+!$omp parallel num_threads (4)
+!$omp master
+    i = .true.
+    j = omp_get_thread_num () .eq. 0
+!$omp endmaster
+!$omp end parallel
+    if (.not. (i .or. j)) call abort
+  end subroutine test_master
+
+  subroutine test_critical_1 (i, j)
+    integer :: i, j
+!$omp critical(critical_foo) 
+    i = i + 1
+!$omp end critical (critical_foo)
+!$omp critical
+    j = j + 1
+!$omp end critical
+    end subroutine test_critical_1
+
+  subroutine test_critical
+    integer :: i, j, n
+    n = -1
+    i = 0
+    j = 0
+!$omp parallel num_threads (4)
+    if (omp_get_thread_num () .eq. 0) n = omp_get_num_threads ()
+    call test_critical_1 (i, j)
+    call test_critical_1 (i, j)
+!$omp critical
+    j = j + 1
+!$omp end critical
+!$omp critical (critical_foo)
+    i = i + 1
+!$omp endcritical (critical_foo)
+!$omp end parallel
+    if (n .lt. 1 .or. i .ne. n * 3 .or. j .ne. n * 3) call abort
+  end subroutine test_critical
+
+  subroutine test_barrier
+    integer :: i
+    logical :: j
+    i = 23
+    j = .false.
+!$omp parallel num_threads (4)
+    if (omp_get_thread_num () .eq. 0) i = 5
+!$omp flush (i)
+!$omp barrier
+    if (i .ne. 5) then
+!$omp atomic
+      j = j .or. .true.
+    end if
+!$omp end parallel
+    if (i .ne. 5 .or. j) call abort
+  end subroutine test_barrier
+
+  subroutine test_atomic
+    integer :: a, b, c, d, e, f, g
+    a = 0
+    b = 1
+    c = 0
+    d = 1024
+    e = 1024
+    f = -1
+    g = -1
+!$omp parallel num_threads (8)
+!$omp atomic
+    a = a + 2 + 4
+!$omp atomic
+    b = 3 * b
+!$omp atomic
+    c = 8 - c
+!$omp atomic
+    d = d / 2
+!$omp atomic
+    e = min (e, omp_get_thread_num ())
+!$omp atomic
+    f = max (omp_get_thread_num (), f)
+    if (omp_get_thread_num () .eq. 0) g = omp_get_num_threads ()
+!$omp end parallel
+    if (g .le. 0 .or. g .gt. 8) call abort
+    if (a .ne. 6 * g .or. b .ne. 3 ** g) call abort
+    if (iand (g, 1) .eq. 1) then
+      if (c .ne. 8) call abort
+    else if (c .ne. 0) then
+      call abort
+    end if
+    if (d .ne. 1024 / (2 ** g)) call abort
+    if (e .ne. 0 .or. f .ne. g - 1) call abort
+  end subroutine test_atomic
+end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_parse3.f90 b/libgomp/testsuite/libgomp.fortran/omp_parse3.f90
new file mode 100644
index 0000000..98c94b9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_parse3.f90
@@ -0,0 +1,95 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+use omp_lib
+  common /tlsblock/ x, y
+  integer :: x, y, z
+  save z
+!$omp threadprivate (/tlsblock/, z)
+
+  call test_flush
+  call test_ordered
+  call test_threadprivate
+
+contains
+  subroutine test_flush
+    integer :: i, j
+    i = 0
+    j = 0
+!$omp parallel num_threads (4)
+    if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()
+    if (omp_get_thread_num () .eq. 0) j = j + 1
+!$omp flush (i, j)
+!$omp barrier
+    if (omp_get_thread_num () .eq. 1) j = j + 2
+!$omp flush
+!$omp barrier
+    if (omp_get_thread_num () .eq. 2) j = j + 3
+!$omp flush (i)
+!$omp flush (j)
+!$omp barrier
+    if (omp_get_thread_num () .eq. 3) j = j + 4
+!$omp end parallel
+  end subroutine test_flush
+
+  subroutine test_ordered
+    integer :: i, j
+    integer, dimension (100) :: d
+    d(:) = -1
+!$omp parallel do ordered schedule (dynamic) num_threads (4)
+    do i = 1, 100, 5
+!$omp ordered
+      d(i) = i
+!$omp end ordered
+    end do
+    j = 1
+    do 100 i = 1, 100
+      if (i .eq. j) then
+	if (d(i) .ne. i) call abort
+	j = i + 5
+      else
+	if (d(i) .ne. -1) call abort
+      end if
+100   d(i) = -1
+  end subroutine test_ordered
+
+  subroutine test_threadprivate
+    common /tlsblock/ x, y
+!$omp threadprivate (/tlsblock/)
+    integer :: i, j
+    logical :: m, n
+    call omp_set_num_threads (4)
+    call omp_set_dynamic (.false.)
+    i = -1
+    x = 6
+    y = 7
+    z = 8
+    n = .false.
+    m = .false.
+!$omp parallel copyin (/tlsblock/, z) reduction (.or.:m) &
+!$omp& num_threads (4)
+    if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads ()
+    if (x .ne. 6 .or. y .ne. 7 .or. z .ne. 8) call abort
+    x = omp_get_thread_num ()
+    y = omp_get_thread_num () + 1024
+    z = omp_get_thread_num () + 4096
+!$omp end parallel
+    if (x .ne. 0 .or. y .ne. 1024 .or. z .ne. 4096) call abort
+!$omp parallel num_threads (4), private (j) reduction (.or.:n)
+    if (omp_get_num_threads () .eq. i) then
+      j = omp_get_thread_num ()
+      if (x .ne. j .or. y .ne. j + 1024 .or. z .ne. j + 4096) &
+&       call abort
+    end if
+!$omp end parallel
+    m = m .or. n
+    n = .false.
+!$omp parallel num_threads (4), copyin (z) reduction (.or. : n)
+    if (z .ne. 4096) n = .true.
+    if (omp_get_num_threads () .eq. i) then
+      j = omp_get_thread_num ()
+      if (x .ne. j .or. y .ne. j + 1024) call abort
+    end if
+!$omp end parallel
+    if (m .or. n) call abort
+  end subroutine test_threadprivate
+end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_parse4.f90 b/libgomp/testsuite/libgomp.fortran/omp_parse4.f90
new file mode 100644
index 0000000..ba35bcb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_parse4.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+!$ use omp_lib
+  call test_workshare
+
+contains
+  subroutine test_workshare
+    integer :: i, j, k, l, m
+    double precision, dimension (64) :: d, e
+    integer, dimension (10) :: f, g
+    integer, dimension (16, 16) :: a, b, c
+    integer, dimension (16) :: n
+    d(:) = 1
+    e = 7
+    f = 10
+    l = 256
+    m = 512
+    g(1:3) = -1
+    g(4:6) = 0
+    g(7:8) = 5
+    g(9:10) = 10
+    forall (i = 1:16, j = 1:16) a (i, j) = i * 16 + j
+    forall (j = 1:16) n (j) = j
+!$omp parallel num_threads (4) private (j, k)
+!$omp barrier
+!$omp workshare
+    i = 6
+    e(:) = d(:)
+    where (g .lt. 0)
+      f = 100
+    elsewhere (g .eq. 0)
+      f = 200 + f
+    elsewhere
+      where (g .gt. 6) f = f + sum (g)
+      f = 300 + f
+    end where
+    where (f .gt. 210) g = 0
+!$omp end workshare nowait
+!$omp workshare
+    forall (j = 1:16, k = 1:16) b (k, j) = a (j, k)
+    forall (k = 1:16) c (k, 1:16) = a (1:16, k)
+    forall (j = 2:16, n (17 - j) / 4 * 4 .ne. n (17 - j))
+      n (j) = n (j - 1) * n (j)
+    end forall
+!$omp endworkshare
+!$omp workshare
+!$omp atomic
+    i = i + 8 + 6
+!$omp critical
+!$omp critical (critical_foox)
+    l = 128
+!$omp end critical (critical_foox)
+!$omp endcritical
+!$omp parallel num_threads (2)
+!$  if (omp_get_thread_num () .eq. 0) m = omp_get_num_threads ()
+!$omp atomic
+    l = 1 + l
+!$omp end parallel
+!$omp end workshare
+!$omp end parallel
+
+    if (any (f .ne. (/100, 100, 100, 210, 210, 210, 310, 310, 337, 337/))) &
+&     call abort
+    if (any (g .ne. (/-1, -1, -1, 0, 0, 0, 0, 0, 0, 0/))) call abort
+    if (i .ne. 20) call abort
+!$  if (l .ne. 128 + m) call abort
+    if (any (d .ne. 1 .or. e .ne. 1)) call abort
+    if (any (b .ne. transpose (a))) call abort
+    if (any (c .ne. b)) call abort
+    if (any (n .ne. (/1, 2, 6, 12, 5, 30, 42, 56, 9, 90, &
+&                     110, 132, 13, 182, 210, 240/))) call abort
+  end subroutine test_workshare
+end
diff --git a/libgomp/testsuite/libgomp.fortran/omp_reduction.f b/libgomp/testsuite/libgomp.fortran/omp_reduction.f
new file mode 100644
index 0000000..0560bd8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_reduction.f
@@ -0,0 +1,33 @@
+C******************************************************************************
+C FILE: omp_reduction.f
+C DESCRIPTION:
+C   OpenMP Example - Combined Parallel Loop Reduction - Fortran Version
+C   This example demonstrates a sum reduction within a combined parallel loop
+C   construct.  Notice that default data element scoping is assumed - there
+C   are no clauses specifying shared or private variables.  OpenMP will
+C   automatically make loop index variables private within team threads, and
+C   global variables shared.
+C AUTHOR: Blaise Barney  5/99
+C LAST REVISED:
+C******************************************************************************
+
+      PROGRAM REDUCTION
+
+      INTEGER I, N
+      REAL A(100), B(100), SUM
+
+!     Some initializations
+      N = 100
+      DO I = 1, N
+        A(I) = I *1.0
+        B(I) = A(I)
+      ENDDO
+      SUM = 0.0
+
+!$OMP PARALLEL DO REDUCTION(+:SUM)
+      DO I = 1, N
+        SUM = SUM + (A(I) * B(I))
+      ENDDO
+
+      PRINT *, '   Sum = ', SUM
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/omp_workshare1.f b/libgomp/testsuite/libgomp.fortran/omp_workshare1.f
new file mode 100644
index 0000000..8aef694
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_workshare1.f
@@ -0,0 +1,48 @@
+C******************************************************************************
+C FILE: omp_workshare1.f
+C DESCRIPTION:
+C   OpenMP Example - Loop Work-sharing - Fortran Version
+C   In this example, the iterations of a loop are scheduled dynamically
+C   across the team of threads.  A thread will perform CHUNK iterations
+C   at a time before being scheduled for the next CHUNK of work.
+C AUTHOR: Blaise Barney  5/99
+C LAST REVISED: 01/09/04
+C******************************************************************************
+
+      PROGRAM WORKSHARE1
+
+      INTEGER NTHREADS, TID, OMP_GET_NUM_THREADS,
+     +  OMP_GET_THREAD_NUM, N, CHUNKSIZE, CHUNK, I
+      PARAMETER (N=100)
+      PARAMETER (CHUNKSIZE=10)
+      REAL A(N), B(N), C(N)
+
+!     Some initializations
+      DO I = 1, N
+        A(I) = I * 1.0
+        B(I) = A(I)
+      ENDDO
+      CHUNK = CHUNKSIZE
+
+!$OMP PARALLEL SHARED(A,B,C,NTHREADS,CHUNK) PRIVATE(I,TID)
+
+      TID = OMP_GET_THREAD_NUM()
+      IF (TID .EQ. 0) THEN
+        NTHREADS = OMP_GET_NUM_THREADS()
+        PRINT *, 'Number of threads =', NTHREADS
+      END IF
+      PRINT *, 'Thread',TID,' starting...'
+
+!$OMP DO SCHEDULE(DYNAMIC,CHUNK)
+      DO I = 1, N
+        C(I) = A(I) + B(I)
+        WRITE(*,100) TID,I,C(I)
+ 100    FORMAT(' Thread',I2,': C(',I3,')=',F8.2)
+      ENDDO
+!$OMP END DO NOWAIT
+
+      PRINT *, 'Thread',TID,' done.'
+
+!$OMP END PARALLEL
+
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/omp_workshare2.f b/libgomp/testsuite/libgomp.fortran/omp_workshare2.f
new file mode 100644
index 0000000..9e61da9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp_workshare2.f
@@ -0,0 +1,56 @@
+C******************************************************************************
+C FILE: omp_workshare2.f
+C DESCRIPTION:
+C   OpenMP Example - Sections Work-sharing - Fortran Version
+C   In this example, the OpenMP SECTION directive is used to assign
+C   different array operations to threads that execute a SECTION. Each
+C   thread receives its own copy of the result array to work with.
+C AUTHOR: Blaise Barney  5/99
+C LAST REVISED: 01/09/04
+C******************************************************************************
+
+      PROGRAM WORKSHARE2
+
+      INTEGER N, I, NTHREADS, TID, OMP_GET_NUM_THREADS,
+     +        OMP_GET_THREAD_NUM
+      PARAMETER (N=50)
+      REAL A(N), B(N), C(N)
+
+!     Some initializations
+      DO I = 1, N
+        A(I) = I * 1.0
+        B(I) = A(I)
+      ENDDO
+
+!$OMP PARALLEL SHARED(A,B,NTHREADS), PRIVATE(C,I,TID)
+      TID = OMP_GET_THREAD_NUM()
+      IF (TID .EQ. 0) THEN
+        NTHREADS = OMP_GET_NUM_THREADS()
+        PRINT *, 'Number of threads =', NTHREADS
+      END IF
+      PRINT *, 'Thread',TID,' starting...'
+
+!$OMP SECTIONS
+
+!$OMP SECTION
+      PRINT *, 'Thread',TID,' doing section 1'
+      DO I = 1, N
+         C(I) = A(I) + B(I)
+         WRITE(*,100) TID,I,C(I)
+ 100     FORMAT(' Thread',I2,': C(',I2,')=',F8.2)
+      ENDDO
+
+!$OMP SECTION
+      PRINT *, 'Thread',TID,' doing section 2'
+      DO I = 1+N/2, N
+         C(I) = A(I) * B(I)
+         WRITE(*,100) TID,I,C(I)
+      ENDDO
+
+!$OMP END SECTIONS NOWAIT
+
+      PRINT *, 'Thread',TID,' done.'
+
+!$OMP END PARALLEL
+
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/pr25162.f b/libgomp/testsuite/libgomp.fortran/pr25162.f
new file mode 100644
index 0000000..a868ea4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/pr25162.f
@@ -0,0 +1,40 @@
+C PR fortran/25162
+C { dg-do run }
+C { dg-require-effective-target tls_runtime }
+      PROGRAM PR25162
+      CALL TEST1
+      CALL TEST2
+      END
+      SUBROUTINE TEST1
+      DOUBLE PRECISION BPRIM
+      COMMON /TESTCOM/ BPRIM(100)
+C$OMP THREADPRIVATE(/TESTCOM/)
+      INTEGER I
+      DO I = 1, 100
+         BPRIM( I ) = DBLE( I )
+      END DO
+      RETURN
+      END
+      SUBROUTINE TEST2
+      DOUBLE PRECISION BPRIM
+      COMMON /TESTCOM/ BPRIM(100)
+C$OMP THREADPRIVATE(/TESTCOM/)
+      INTEGER I, IDUM(50)
+      DO I = 1, 50
+         IDUM(I) = I
+      END DO
+C$OMP PARALLEL COPYIN(/TESTCOM/) NUM_THREADS(4)
+      CALL TEST3
+C$OMP END PARALLEL
+      RETURN
+      END
+      SUBROUTINE TEST3
+      DOUBLE PRECISION BPRIM
+      COMMON /TESTCOM/ BPRIM(100)
+C$OMP THREADPRIVATE(/TESTCOM/)
+      INTEGER K
+      DO K = 1, 10
+         IF (K.NE.BPRIM(K)) CALL ABORT
+      END DO
+      RETURN
+      END
diff --git a/libgomp/testsuite/libgomp.fortran/pr25219.f90 b/libgomp/testsuite/libgomp.fortran/pr25219.f90
new file mode 100644
index 0000000..7fe1a53
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/pr25219.f90
@@ -0,0 +1,15 @@
+! PR fortran/25219
+
+  implicit none
+  save
+  integer :: i, k
+  k = 3
+!$omp parallel
+!$omp do lastprivate (k)
+  do i = 1, 100
+    k = i
+  end do
+!$omp end do
+!$omp end parallel
+  if (k .ne. 100) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reduction1.f90 b/libgomp/testsuite/libgomp.fortran/reduction1.f90
new file mode 100644
index 0000000..d6ceb08
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reduction1.f90
@@ -0,0 +1,181 @@
+! { dg-do run }
+!$ use omp_lib
+
+  integer :: i, ia (6), n, cnt
+  real :: r, ra (4)
+  double precision :: d, da (5)
+  complex :: c, ca (3)
+  logical :: v
+
+  i = 1
+  ia = 2
+  r = 3
+  ra = 4
+  d = 5.5
+  da = 6.5
+  c = cmplx (7.5, 1.5)
+  ca = cmplx (8.5, -3.0)
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (+:i, ia, r, ra, d, da, c, ca)
+!$ if (i .ne. 0 .or. any (ia .ne. 0)) v = .true.
+!$ if (r .ne. 0 .or. any (ra .ne. 0)) v = .true.
+!$ if (d .ne. 0 .or. any (da .ne. 0)) v = .true.
+!$ if (c .ne. cmplx (0) .or. any (ca .ne. cmplx (0))) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    i = 4
+    ia(3:5) = -2
+    r = 5
+    ra(1:2) = 6.5
+    d = -2.5
+    da(2:4) = 8.5
+    c = cmplx (2.5, -3.5)
+    ca(1) = cmplx (4.5, 5)
+  else if (n .eq. 1) then
+    i = 2
+    ia(4:6) = 5
+    r = 1
+    ra(2:4) = -1.5
+    d = 8.5
+    da(1:3) = 2.5
+    c = cmplx (0.5, -3)
+    ca(2:3) = cmplx (-1, 6)
+  else
+    i = 1
+    ia = 1
+    r = -1
+    ra = -1
+    d = 1
+    da = -1
+    c = 1
+    ca = cmplx (-1, 0)
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (i .ne. 8 .or. any (ia .ne. (/3, 3, 1, 6, 6, 8/))) call abort
+    if (r .ne. 8 .or. any (ra .ne. (/9.5, 8.0, 1.5, 1.5/))) call abort
+    if (d .ne. 12.5 .or. any (da .ne. (/8.0, 16.5, 16.5, 14.0, 5.5/))) call abort
+    if (c .ne. cmplx (11.5, -5)) call abort
+    if (ca(1) .ne. cmplx (12, 2)) call abort
+    if (ca(2) .ne. cmplx (6.5, 3) .or. ca(2) .ne. ca(3)) call abort
+  end if
+
+  i = 1
+  ia = 2
+  r = 3
+  ra = 4
+  d = 5.5
+  da = 6.5
+  c = cmplx (7.5, 1.5)
+  ca = cmplx (8.5, -3.0)
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (-:i, ia, r, ra, d, da, c, ca)
+!$ if (i .ne. 0 .or. any (ia .ne. 0)) v = .true.
+!$ if (r .ne. 0 .or. any (ra .ne. 0)) v = .true.
+!$ if (d .ne. 0 .or. any (da .ne. 0)) v = .true.
+!$ if (c .ne. cmplx (0) .or. any (ca .ne. cmplx (0))) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    i = 4
+    ia(3:5) = -2
+    r = 5
+    ra(1:2) = 6.5
+    d = -2.5
+    da(2:4) = 8.5
+    c = cmplx (2.5, -3.5)
+    ca(1) = cmplx (4.5, 5)
+  else if (n .eq. 1) then
+    i = 2
+    ia(4:6) = 5
+    r = 1
+    ra(2:4) = -1.5
+    d = 8.5
+    da(1:3) = 2.5
+    c = cmplx (0.5, -3)
+    ca(2:3) = cmplx (-1, 6)
+  else
+    i = 1
+    ia = 1
+    r = -1
+    ra = -1
+    d = 1
+    da = -1
+    c = 1
+    ca = cmplx (-1, 0)
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (i .ne. 8 .or. any (ia .ne. (/3, 3, 1, 6, 6, 8/))) call abort
+    if (r .ne. 8 .or. any (ra .ne. (/9.5, 8.0, 1.5, 1.5/))) call abort
+    if (d .ne. 12.5 .or. any (da .ne. (/8.0, 16.5, 16.5, 14.0, 5.5/))) call abort
+    if (c .ne. cmplx (11.5, -5)) call abort
+    if (ca(1) .ne. cmplx (12, 2)) call abort
+    if (ca(2) .ne. cmplx (6.5, 3) .or. ca(2) .ne. ca(3)) call abort
+  end if
+
+  i = 1
+  ia = 2
+  r = 4
+  ra = 8
+  d = 16
+  da = 32
+  c = 2
+  ca = cmplx (0, 2)
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (*:i, ia, r, ra, d, da, c, ca)
+!$ if (i .ne. 1 .or. any (ia .ne. 1)) v = .true.
+!$ if (r .ne. 1 .or. any (ra .ne. 1)) v = .true.
+!$ if (d .ne. 1 .or. any (da .ne. 1)) v = .true.
+!$ if (c .ne. cmplx (1) .or. any (ca .ne. cmplx (1))) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    i = 3
+    ia(3:5) = 2
+    r = 0.5
+    ra(1:2) = 2
+    d = -1
+    da(2:4) = -2
+    c = 2.5
+    ca(1) = cmplx (-5, 0)
+  else if (n .eq. 1) then
+    i = 2
+    ia(4:6) = -2
+    r = 8
+    ra(2:4) = -0.5
+    da(1:3) = -1
+    c = -3
+    ca(2:3) = cmplx (0, -1)
+  else
+    ia = 2
+    r = 0.5
+    ra = 0.25
+    d = 2.5
+    da = -1
+    c = cmplx (0, -1)
+    ca = cmplx (-1, 0)
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (i .ne. 6 .or. any (ia .ne. (/4, 4, 8, -16, -16, -8/))) call abort
+    if (r .ne. 8 .or. any (ra .ne. (/4., -2., -1., -1./))) call abort
+    if (d .ne. -40 .or. any (da .ne. (/32., -64., -64., 64., -32./))) call abort
+    if (c .ne. cmplx (0, 15)) call abort
+    if (ca(1) .ne. cmplx (0, 10)) call abort
+    if (ca(2) .ne. cmplx (-2, 0) .or. ca(2) .ne. ca(3)) call abort
+  end if
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reduction2.f90 b/libgomp/testsuite/libgomp.fortran/reduction2.f90
new file mode 100644
index 0000000..9bdeb77
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reduction2.f90
@@ -0,0 +1,73 @@
+! { dg-do run }
+!$ use omp_lib
+
+  logical :: l, la (4), m, ma (4), v
+  integer :: n, cnt
+
+  l = .true.
+  la = (/.true., .false., .true., .true./)
+  m = .false.
+  ma = (/.false., .false., .false., .true./)
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (.and.:l, la) reduction (.or.:m, ma)
+!$ if (.not. l .or. any (.not. la)) v = .true.
+!$ if (m .or. any (ma)) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    l = .false.
+    la(3) = .false.
+    ma(2) = .true.
+  else if (n .eq. 1) then
+    l = .false.
+    la(4) = .false.
+    ma(1) = .true.
+  else
+    la(3) = .false.
+    m = .true.
+    ma(1) = .true.
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (l .or. any (la .neqv. (/.true., .false., .false., .false./))) call abort
+    if (.not. m .or. any (ma .neqv. (/.true., .true., .false., .true./))) call abort
+  end if
+
+  l = .true.
+  la = (/.true., .false., .true., .true./)
+  m = .false.
+  ma = (/.false., .false., .false., .true./)
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (.eqv.:l, la) reduction (.neqv.:m, ma)
+!$ if (.not. l .or. any (.not. la)) v = .true.
+!$ if (m .or. any (ma)) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    l = .false.
+    la(3) = .false.
+    ma(2) = .true.
+  else if (n .eq. 1) then
+    l = .false.
+    la(4) = .false.
+    ma(1) = .true.
+  else
+    la(3) = .false.
+    m = .true.
+    ma(1) = .true.
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (.not. l .or. any (la .neqv. (/.true., .false., .true., .false./))) call abort
+    if (.not. m .or. any (ma .neqv. (/.false., .true., .false., .true./))) call abort
+  end if
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reduction3.f90 b/libgomp/testsuite/libgomp.fortran/reduction3.f90
new file mode 100644
index 0000000..a0786ec
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reduction3.f90
@@ -0,0 +1,103 @@
+! { dg-do run }
+!$ use omp_lib
+
+  integer (kind = 4) :: i, ia (6), n, cnt
+  real :: r, ra (4)
+  double precision :: d, da (5)
+  logical :: v
+
+  i = 1
+  ia = 2
+  r = 3
+  ra = 4
+  d = 5.5
+  da = 6.5
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (max:i, ia, r, ra, d, da)
+!$ if (i .ne. -2147483648 .or. any (ia .ne. -2147483648)) v = .true.
+!$ if (r .ge. -1.0d38 .or. any (ra .ge. -1.0d38)) v = .true.
+!$ if (d .ge. -1.0d300 .or. any (da .ge. -1.0d300)) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    i = 4
+    ia(3:5) = -2
+    ia(1) = 7
+    r = 5
+    ra(1:2) = 6.5
+    d = -2.5
+    da(2:4) = 8.5
+  else if (n .eq. 1) then
+    i = 2
+    ia(4:6) = 5
+    r = 1
+    ra(2:4) = -1.5
+    d = 8.5
+    da(1:3) = 2.5
+  else
+    i = 1
+    ia = 1
+    r = -1
+    ra = -1
+    d = 1
+    da = -1
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (i .ne. 4 .or. any (ia .ne. (/7, 2, 2, 5, 5, 5/))) call abort
+    if (r .ne. 5 .or. any (ra .ne. (/6.5, 6.5, 4., 4./))) call abort
+    if (d .ne. 8.5 .or. any (da .ne. (/6.5, 8.5, 8.5, 8.5, 6.5/))) call abort
+  end if
+
+  i = 1
+  ia = 2
+  r = 3
+  ra = 4
+  d = 5.5
+  da = 6.5
+  v = .false.
+  cnt = -1
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (min:i, ia, r, ra, d, da)
+!$ if (i .ne. 2147483647 .or. any (ia .ne. 2147483647)) v = .true.
+!$ if (r .le. 1.0d38 .or. any (ra .le. 1.0d38)) v = .true.
+!$ if (d .le. 1.0d300 .or. any (da .le. 1.0d300)) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    i = 4
+    ia(3:5) = -2
+    ia(1) = 7
+    r = 5
+    ra(1:2) = 6.5
+    d = -2.5
+    da(2:4) = 8.5
+  else if (n .eq. 1) then
+    i = 2
+    ia(4:6) = 5
+    r = 1
+    ra(2:4) = -1.5
+    d = 8.5
+    da(1:3) = 2.5
+  else
+    i = 1
+    ia = 1
+    r = -1
+    ra = 7
+    ra(3) = -8.5
+    d = 1
+    da(1:4) = 6
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    if (i .ne. 1 .or. any (ia .ne. (/1, 1, -2, -2, -2, 1/))) call abort
+    if (r .ne. -1 .or. any (ra .ne. (/4., -1.5, -8.5, -1.5/))) call abort
+    if (d .ne. -2.5 .or. any (da .ne. (/2.5, 2.5, 2.5, 6., 6.5/))) call abort
+  end if
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reduction4.f90 b/libgomp/testsuite/libgomp.fortran/reduction4.f90
new file mode 100644
index 0000000..5a5e852
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reduction4.f90
@@ -0,0 +1,56 @@
+! { dg-do run }
+!$ use omp_lib
+
+  integer (kind = 4) :: i, ia (6), j, ja (6), k, ka (6), ta (6), n, cnt, x
+  logical :: v
+
+  i = Z'ffff0f'
+  ia = Z'f0ff0f'
+  j = Z'0f0000'
+  ja = Z'0f5a00'
+  k = Z'055aa0'
+  ka = Z'05a5a5'
+  v = .false.
+  cnt = -1
+  x = Z'ffffffff'
+
+!$omp parallel num_threads (3) private (n) reduction (.or.:v) &
+!$omp & reduction (iand:i, ia) reduction (ior:j, ja) reduction (ieor:k, ka)
+!$ if (i .ne. x .or. any (ia .ne. x)) v = .true.
+!$ if (j .ne. 0 .or. any (ja .ne. 0)) v = .true.
+!$ if (k .ne. 0 .or. any (ka .ne. 0)) v = .true.
+  n = omp_get_thread_num ()
+  if (n .eq. 0) then
+    cnt = omp_get_num_threads ()
+    i = Z'ff7fff'
+    ia(3:5) = Z'fffff1'
+    j = Z'078000'
+    ja(1:3) = 1
+    k = Z'78'
+    ka(3:6) = Z'f0f'
+  else if (n .eq. 1) then
+    i = Z'ffff77'
+    ia(2:5) = Z'ffafff'
+    j = Z'007800'
+    ja(2:5) = 8
+    k = Z'57'
+    ka(3:4) = Z'f0108'
+  else
+    i = Z'777fff'
+    ia(1:2) = Z'fffff3'
+    j = Z'000780'
+    ja(5:6) = Z'f00'
+    k = Z'1000'
+    ka(6:6) = Z'777'
+  end if
+!$omp end parallel
+  if (v) call abort
+  if (cnt .eq. 3) then
+    ta = (/Z'f0ff03', Z'f0af03', Z'f0af01', Z'f0af01', Z'f0af01', Z'f0ff0f'/)
+    if (i .ne. Z'777f07' .or. any (ia .ne. ta)) call abort
+    ta = (/Z'f5a01', Z'f5a09', Z'f5a09', Z'f5a08', Z'f5f08', Z'f5f00'/)
+    if (j .ne. Z'fff80' .or. any (ja .ne. ta)) call abort
+    ta = (/Z'5a5a5', Z'5a5a5', Z'aaba2', Z'aaba2', Z'5aaaa', Z'5addd'/)
+    if (k .ne. Z'54a8f' .or. any (ka .ne. ta)) call abort
+  end if
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reduction5.f90 b/libgomp/testsuite/libgomp.fortran/reduction5.f90
new file mode 100644
index 0000000..bfdd43a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reduction5.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+
+module reduction5
+  intrinsic ior, min, max
+end module reduction5
+
+  call test1
+  call test2
+contains
+  subroutine test1
+    use reduction5, bitwise_or => ior
+    integer :: n
+    n = Z'f'
+!$omp parallel sections num_threads (3) reduction (bitwise_or: n)
+    n = ior (n, Z'20')
+!$omp section
+    n = bitwise_or (Z'410', n)
+!$omp section
+    n = bitwise_or (n, Z'2000')
+!$omp end parallel sections
+    if (n .ne. Z'243f') call abort
+  end subroutine
+  subroutine test2
+    use reduction5, min => max, max => min
+    integer :: m, n
+    m = 8
+    n = 4
+!$omp parallel sections num_threads (3) reduction (min: n) &
+!$omp & reduction (max: m)
+    if (m .gt. 13) m = 13
+    if (n .lt. 11) n = 11
+!$omp section
+    if (m .gt. 5) m = 5
+    if (n .lt. 15) n = 15
+!$omp section
+    if (m .gt. 3) m = 3
+    if (n .lt. -1) n = -1
+!$omp end parallel sections
+    if (m .ne. 3 .or. n .ne. 15) call abort
+  end subroutine test2
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reduction6.f90 b/libgomp/testsuite/libgomp.fortran/reduction6.f90
new file mode 100644
index 0000000..9f3ec6c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reduction6.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+
+  integer, dimension (6, 6) :: a
+  character (36) :: c
+  integer nthreads
+  a = 9
+  nthreads = -1
+  call foo (a (2:4, 3:5), nthreads)
+  if (nthreads .eq. 3) then
+    write (c, '(36i1)') a
+    if (c .ne. '999999999999966699966699966699999999') call abort
+  end if
+contains
+  subroutine foo (b, nthreads)
+    use omp_lib
+    integer, dimension (3:, 5:) :: b
+    integer :: err, nthreads
+    b = 0
+    err = 0
+!$omp parallel num_threads (3) reduction (+:b)
+    if (any (b .ne. 0)) then
+!$omp atomic
+      err = err + 1
+    end if
+!$omp master
+    nthreads = omp_get_num_threads ()
+!$omp end master
+    b = 2
+!$omp end parallel
+    if (err .gt. 0) call abort
+  end subroutine foo
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reference1.f90 b/libgomp/testsuite/libgomp.fortran/reference1.f90
new file mode 100644
index 0000000..b959e27
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reference1.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+!$ use omp_lib
+
+  integer :: i, j, k
+  double precision :: d
+  i = 6
+  j = 19
+  k = 0
+  d = 24.5
+  call test (i, j, k, d)
+  if (i .ne. 38) call abort
+  if (iand (k, 255) .ne. 0) call abort
+  if (iand (k, 65280) .eq. 0) then
+    if (k .ne. 65536 * 4) call abort
+  end if
+contains
+  subroutine test (i, j, k, d)
+    integer :: i, j, k
+    double precision :: d
+
+!$omp parallel firstprivate (d) private (j) num_threads (4) reduction (+:k)
+    if (i .ne. 6 .or. d .ne. 24.5 .or. k .ne. 0) k = k + 1
+    if (omp_get_num_threads () .ne. 4) k = k + 256
+    d = d / 2
+    j = 8
+    k = k + 65536
+!$omp barrier
+    if (d .ne. 12.25 .or. j .ne. 8) k = k + 1
+!$omp single
+    i = i + 32
+!$omp end single nowait
+!$omp end parallel
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/reference2.f90 b/libgomp/testsuite/libgomp.fortran/reference2.f90
new file mode 100644
index 0000000..1232b69
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/reference2.f90
@@ -0,0 +1,21 @@
+! { dg-do run }
+  real, dimension (5) :: b
+  b = 5
+  call foo (b)
+contains
+  subroutine foo (a)
+    real, dimension (5) :: a
+    logical :: l
+    l = .false.
+!$omp parallel private (a) reduction (.or.:l)
+    a = 15
+    l = bar (a)
+!$omp end parallel
+    if (l) call abort
+  end subroutine
+  function bar (a)
+    real, dimension (5) :: a
+    logical :: bar
+    bar = any (a .ne. 15)
+  end function
+end
diff --git a/libgomp/testsuite/libgomp.fortran/retval1.f90 b/libgomp/testsuite/libgomp.fortran/retval1.f90
new file mode 100644
index 0000000..8bb07f8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/retval1.f90
@@ -0,0 +1,120 @@
+! { dg-do run }
+
+function f1 ()
+  use omp_lib
+  real :: f1
+  logical :: l
+  f1 = 6.5
+  l = .false.
+!$omp parallel firstprivate (f1) num_threads (2) reduction (.or.:l)
+  l = f1 .ne. 6.5
+  if (omp_get_thread_num () .eq. 0) f1 = 8.5
+  if (omp_get_thread_num () .eq. 1) f1 = 14.5
+!$omp barrier
+  l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 8.5)
+  l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 14.5)
+!$omp end parallel
+  if (l) call abort
+  f1 = -2.5
+end function f1
+function f2 ()
+  use omp_lib
+  real :: f2, e2
+  logical :: l
+entry e2 ()
+  f2 = 6.5
+  l = .false.
+!$omp parallel firstprivate (e2) num_threads (2) reduction (.or.:l)
+  l = e2 .ne. 6.5
+  if (omp_get_thread_num () .eq. 0) e2 = 8.5
+  if (omp_get_thread_num () .eq. 1) e2 = 14.5
+!$omp barrier
+  l = l .or. (omp_get_thread_num () .eq. 0 .and. e2 .ne. 8.5)
+  l = l .or. (omp_get_thread_num () .eq. 1 .and. e2 .ne. 14.5)
+!$omp end parallel
+  if (l) call abort
+  e2 = 7.5
+end function f2
+function f3 ()
+  use omp_lib
+  real :: f3, e3
+  logical :: l
+entry e3 ()
+  f3 = 6.5
+  l = .false.
+!$omp parallel firstprivate (f3, e3) num_threads (2) reduction (.or.:l)
+  l = e3 .ne. 6.5
+  l = l .or. f3 .ne. 6.5
+  if (omp_get_thread_num () .eq. 0) e3 = 8.5
+  if (omp_get_thread_num () .eq. 1) e3 = 14.5
+  f3 = e3 - 4.5
+!$omp barrier
+  l = l .or. (omp_get_thread_num () .eq. 0 .and. e3 .ne. 8.5)
+  l = l .or. (omp_get_thread_num () .eq. 1 .and. e3 .ne. 14.5)
+  l = l .or. f3 .ne. e3 - 4.5
+!$omp end parallel
+  if (l) call abort
+  e3 = 0.5
+end function f3
+function f4 () result (r4)
+  use omp_lib
+  real :: r4, s4
+  logical :: l
+entry e4 () result (s4)
+  r4 = 6.5
+  l = .false.
+!$omp parallel firstprivate (r4, s4) num_threads (2) reduction (.or.:l)
+  l = s4 .ne. 6.5
+  l = l .or. r4 .ne. 6.5
+  if (omp_get_thread_num () .eq. 0) s4 = 8.5
+  if (omp_get_thread_num () .eq. 1) s4 = 14.5
+  r4 = s4 - 4.5
+!$omp barrier
+  l = l .or. (omp_get_thread_num () .eq. 0 .and. s4 .ne. 8.5)
+  l = l .or. (omp_get_thread_num () .eq. 1 .and. s4 .ne. 14.5)
+  l = l .or. r4 .ne. s4 - 4.5
+!$omp end parallel
+  if (l) call abort
+  s4 = -0.5
+end function f4
+function f5 (is_f5)
+  use omp_lib
+  real :: f5
+  integer :: e5
+  logical :: l, is_f5
+entry e5 (is_f5)
+  if (is_f5) then
+    f5 = 6.5
+  else
+    e5 = 8
+  end if
+  l = .false.
+!$omp parallel firstprivate (f5, e5) shared (is_f5) num_threads (2) &
+!$omp reduction (.or.:l)
+  l = .not. is_f5 .and. e5 .ne. 8
+  l = l .or. (is_f5 .and. f5 .ne. 6.5)
+  if (omp_get_thread_num () .eq. 0) e5 = 8
+  if (omp_get_thread_num () .eq. 1) e5 = 14
+  f5 = e5 - 4.5
+!$omp barrier
+  l = l .or. (omp_get_thread_num () .eq. 0 .and. e5 .ne. 8)
+  l = l .or. (omp_get_thread_num () .eq. 1 .and. e5 .ne. 14)
+  l = l .or. f5 .ne. e5 - 4.5
+!$omp end parallel
+  if (l) call abort
+  if (is_f5) f5 = -2.5
+  if (.not. is_f5) e5 = 8
+end function f5
+
+  real :: f1, f2, e2, f3, e3, f4, e4, f5
+  integer :: e5
+  if (f1 () .ne. -2.5) call abort
+  if (f2 () .ne. 7.5) call abort
+  if (e2 () .ne. 7.5) call abort
+  if (f3 () .ne. 0.5) call abort
+  if (e3 () .ne. 0.5) call abort
+  if (f4 () .ne. -0.5) call abort
+  if (e4 () .ne. -0.5) call abort
+  if (f5 (.true.) .ne. -2.5) call abort
+  if (e5 (.false.) .ne. 8) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/sharing1.f90 b/libgomp/testsuite/libgomp.fortran/sharing1.f90
new file mode 100644
index 0000000..063e7db
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/sharing1.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+  use omp_lib
+  integer :: i, j, k
+  logical :: l
+  common /b/ i, j
+  i = 4
+  j = 8
+  l = .false.
+!$omp parallel private (k) firstprivate (i) shared (j) num_threads (2) &
+!$omp& reduction (.or.:l)
+  if (i .ne. 4 .or. j .ne. 8) l = .true.
+!$omp barrier
+  k = omp_get_thread_num ()
+  if (k .eq. 0) then
+    i = 14
+    j = 15
+  end if
+!$omp barrier
+  if (k .eq. 1) then
+    if (i .ne. 4 .or. j .ne. 15) l = .true.
+    i = 24
+    j = 25
+  end if
+!$omp barrier
+  if (j .ne. 25 .or. i .ne. (k * 10 + 14)) l = .true.
+!$omp end parallel
+  if (l .or. j .ne. 25) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/sharing2.f90 b/libgomp/testsuite/libgomp.fortran/sharing2.f90
new file mode 100644
index 0000000..266dd46
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/sharing2.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+
+  use omp_lib
+  integer :: i, j, k, m, n
+  logical :: l
+  equivalence (i, m)
+  equivalence (j, n)
+  i = 4
+  j = 8
+  l = .false.
+!$omp parallel private (k) firstprivate (i) shared (j) num_threads (2) &
+!$omp& reduction (.or.:l)
+  l = l .or. i .ne. 4
+  l = l .or. j .ne. 8
+!$omp barrier
+  k = omp_get_thread_num ()
+  if (k .eq. 0) then
+    i = 14
+    j = 15
+  end if
+!$omp barrier
+  if (k .eq. 1) then
+    if (i .ne. 4 .or. j .ne. 15) l = .true.
+    i = 24
+    j = 25
+  end if
+!$omp barrier
+  if (j .ne. 25 .or. i .ne. (k * 10 + 14)) l = .true.
+!$omp end parallel
+  if (l) call abort
+  if (j .ne. 25) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/threadprivate1.f90 b/libgomp/testsuite/libgomp.fortran/threadprivate1.f90
new file mode 100644
index 0000000..99a2018
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/threadprivate1.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+
+module threadprivate1
+  double precision :: d
+!$omp threadprivate (d)
+end module threadprivate1
+
+!$ use omp_lib
+  use threadprivate1
+  logical :: l
+  l = .false.
+!$omp parallel num_threads (4) reduction (.or.:l)
+  d = omp_get_thread_num () + 6.5
+!$omp barrier
+  if (d .ne. omp_get_thread_num () + 6.5) l = .true.
+!$omp end parallel
+  if (l) call abort ()
+end
diff --git a/libgomp/testsuite/libgomp.fortran/threadprivate2.f90 b/libgomp/testsuite/libgomp.fortran/threadprivate2.f90
new file mode 100644
index 0000000..f3a4af0
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/threadprivate2.f90
@@ -0,0 +1,94 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+
+module threadprivate2
+  integer, dimension(:,:), allocatable :: foo
+!$omp threadprivate (foo)
+end module threadprivate2
+
+  use omp_lib
+  use threadprivate2
+
+  integer, dimension(:), pointer :: bar1
+  integer, dimension(2), target :: bar2
+  common /thrc/ bar1, bar2
+!$omp threadprivate (/thrc/)
+
+  integer, dimension(:), pointer, save :: bar3 => NULL()
+!$omp threadprivate (bar3)
+
+  logical :: l
+  type tt
+    integer :: a
+    integer :: b = 32
+  end type tt
+  type (tt), save :: baz
+!$omp threadprivate (baz)
+
+  l = .false.
+  call omp_set_dynamic (.false.)
+  call omp_set_num_threads (4)
+
+!$omp parallel num_threads (4) reduction (.or.:l)
+  l = allocated (foo)
+  allocate (foo (6 + omp_get_thread_num (), 3))
+  l = l.or..not.allocated (foo)
+  l = l.or.size (foo).ne.(18 + 3 * omp_get_thread_num ())
+  foo = omp_get_thread_num () + 1
+
+  bar2 = omp_get_thread_num ()
+  l = l.or.associated (bar3)
+  bar1 => bar2
+  l = l.or..not.associated (bar1)
+  l = l.or..not.associated (bar1, bar2)
+  l = l.or.any (bar1.ne.omp_get_thread_num ())
+  nullify (bar1)
+  l = l.or.associated (bar1)
+  allocate (bar3 (4))
+  l = l.or..not.associated (bar3)
+  bar3 = omp_get_thread_num () - 2
+
+  l = l.or.(baz%b.ne.32)
+  baz%a = omp_get_thread_num () * 2
+  baz%b = omp_get_thread_num () * 2 + 1
+!$omp end parallel
+
+  if (l) call abort
+  if (.not.allocated (foo)) call abort
+  if (size (foo).ne.18) call abort
+  if (any (foo.ne.1)) call abort
+
+  if (associated (bar1)) call abort
+  if (.not.associated (bar3)) call abort
+  if (any (bar3 .ne. -2)) call abort
+  deallocate (bar3)
+  if (associated (bar3)) call abort
+
+!$omp parallel num_threads (4) reduction (.or.:l)
+  l = l.or..not.allocated (foo)
+  l = l.or.size (foo).ne.(18 + 3 * omp_get_thread_num ())
+  l = l.or.any (foo.ne.(omp_get_thread_num () + 1))
+  if (omp_get_thread_num () .ne. 0) then
+    deallocate (foo)
+    l = l.or.allocated (foo)
+  end if
+
+  l = l.or.associated (bar1)
+  if (omp_get_thread_num () .ne. 0) then
+    l = l.or..not.associated (bar3)
+    l = l.or.any (bar3 .ne. omp_get_thread_num () - 2)
+    deallocate (bar3)
+  end if
+  l = l.or.associated (bar3)
+
+  l = l.or.(baz%a.ne.(omp_get_thread_num () * 2))
+  l = l.or.(baz%b.ne.(omp_get_thread_num () * 2 + 1))
+!$omp end parallel
+
+  if (l) call abort
+  if (.not.allocated (foo)) call abort
+  if (size (foo).ne.18) call abort
+  if (any (foo.ne.1)) call abort
+  deallocate (foo)
+  if (allocated (foo)) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/threadprivate3.f90 b/libgomp/testsuite/libgomp.fortran/threadprivate3.f90
new file mode 100644
index 0000000..d20a652
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/threadprivate3.f90
@@ -0,0 +1,106 @@
+! { dg-do run }
+! { dg-require-effective-target tls_runtime }
+
+module threadprivate3
+  integer, dimension(:,:), pointer :: foo => NULL()
+!$omp threadprivate (foo)
+end module threadprivate3
+
+  use omp_lib
+  use threadprivate3
+
+  integer, dimension(:), pointer :: bar1
+  integer, dimension(2), target :: bar2, var
+  common /thrc/ bar1, bar2
+!$omp threadprivate (/thrc/)
+
+  integer, dimension(:), pointer, save :: bar3 => NULL()
+!$omp threadprivate (bar3)
+
+  logical :: l
+  type tt
+    integer :: a
+    integer :: b = 32
+  end type tt
+  type (tt), save :: baz
+!$omp threadprivate (baz)
+
+  l = .false.
+  call omp_set_dynamic (.false.)
+  call omp_set_num_threads (4)
+  var = 6
+
+!$omp parallel num_threads (4) reduction (.or.:l)
+  bar2 = omp_get_thread_num ()
+  l = associated (bar3)
+  bar1 => bar2
+  l = l.or..not.associated (bar1)
+  l = l.or..not.associated (bar1, bar2)
+  l = l.or.any (bar1.ne.omp_get_thread_num ())
+  nullify (bar1)
+  l = l.or.associated (bar1)
+  allocate (bar3 (4))
+  l = l.or..not.associated (bar3)
+  bar3 = omp_get_thread_num () - 2
+  if (omp_get_thread_num () .ne. 0) then
+    deallocate (bar3)
+    if (associated (bar3)) call abort
+  else
+    bar1 => var
+  end if
+  bar2 = omp_get_thread_num () * 6 + 130
+
+  l = l.or.(baz%b.ne.32)
+  baz%a = omp_get_thread_num () * 2
+  baz%b = omp_get_thread_num () * 2 + 1
+!$omp end parallel
+
+  if (l) call abort
+  if (.not.associated (bar1)) call abort
+  if (any (bar1.ne.6)) call abort
+  if (.not.associated (bar3)) call abort
+  if (any (bar3 .ne. -2)) call abort
+  deallocate (bar3)
+  if (associated (bar3)) call abort
+
+  allocate (bar3 (10))
+  bar3 = 17
+
+!$omp parallel copyin (bar1, bar2, bar3, baz) num_threads (4) &
+!$omp& reduction (.or.:l)
+  l = l.or..not.associated (bar1)
+  l = l.or.any (bar1.ne.6)
+  l = l.or.any (bar2.ne.130)
+  l = l.or..not.associated (bar3)
+  l = l.or.size (bar3).ne.10
+  l = l.or.any (bar3.ne.17)
+  allocate (bar1 (4))
+  bar1 = omp_get_thread_num ()
+  bar2 = omp_get_thread_num () + 8
+
+  l = l.or.(baz%a.ne.0)
+  l = l.or.(baz%b.ne.1)
+  baz%a = omp_get_thread_num () * 3 + 4
+  baz%b = omp_get_thread_num () * 3 + 5
+
+!$omp barrier
+  if (omp_get_thread_num () .eq. 0) then
+    deallocate (bar3)
+  end if
+  bar3 => bar2
+!$omp barrier
+
+  l = l.or..not.associated (bar1)
+  l = l.or..not.associated (bar3)
+  l = l.or.any (bar1.ne.omp_get_thread_num ())
+  l = l.or.size (bar1).ne.4
+  l = l.or.any (bar2.ne.omp_get_thread_num () + 8)
+  l = l.or.any (bar3.ne.omp_get_thread_num () + 8)
+  l = l.or.size (bar3).ne.2
+
+  l = l.or.(baz%a .ne. omp_get_thread_num () * 3 + 4)
+  l = l.or.(baz%b .ne. omp_get_thread_num () * 3 + 5)
+!$omp end parallel
+
+  if (l) call abort
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla1.f90 b/libgomp/testsuite/libgomp.fortran/vla1.f90
new file mode 100644
index 0000000..c22165e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla1.f90
@@ -0,0 +1,185 @@
+! { dg-do run }
+
+  call test
+contains
+  subroutine check (x, y, l)
+    integer :: x, y
+    logical :: l
+    l = l .or. x .ne. y
+  end subroutine check
+
+  subroutine foo (c, d, e, f, g, h, i, j, k, n)
+    use omp_lib
+    integer :: n
+    character (len = *) :: c
+    character (len = n) :: d
+    integer, dimension (2, 3:5, n) :: e
+    integer, dimension (2, 3:n, n) :: f
+    character (len = *), dimension (5, 3:n) :: g
+    character (len = n), dimension (5, 3:n) :: h
+    real, dimension (:, :, :) :: i
+    double precision, dimension (3:, 5:, 7:) :: j
+    integer, dimension (:, :, :) :: k
+    logical :: l
+    integer :: p, q, r
+    character (len = n) :: s
+    integer, dimension (2, 3:5, n) :: t
+    integer, dimension (2, 3:n, n) :: u
+    character (len = n), dimension (5, 3:n) :: v
+    character (len = 2 * n + 24) :: w
+    integer :: x
+    character (len = 1) :: y
+    s = 'PQRSTUV'
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
+    l = .false.
+!$omp parallel default (none) firstprivate (c, d, e, f, g, h, i, j, k) &
+!$omp & firstprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y)
+    l = l .or. c .ne. 'abcdefghijkl'
+    l = l .or. d .ne. 'ABCDEFG'
+    l = l .or. s .ne. 'PQRSTUV'
+    do 100, p = 1, 2
+      do 100, q = 3, 7
+	do 100, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
+100 continue
+    do 101, p = 3, 5
+      do 101, q = 2, 6
+	do 101, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
+101 continue
+    do 102, p = 1, 5
+      do 102, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
+102 continue
+    x = omp_get_thread_num ()
+    w = ''
+    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+    c = w(8:19)
+    d = w(1:7)
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
+    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
+    s = w(20:26)
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
+!$omp barrier
+    y = ''
+    if (x .eq. 0) y = '0'
+    if (x .eq. 1) y = '1'
+    if (x .eq. 2) y = '2'
+    if (x .eq. 3) y = '3'
+    if (x .eq. 4) y = '4'
+    if (x .eq. 5) y = '5'
+    l = l .or. w(7:7) .ne. y
+    l = l .or. w(19:19) .ne. y
+    l = l .or. w(26:26) .ne. y
+    l = l .or. w(38:38) .ne. y
+    l = l .or. c .ne. w(8:19)
+    l = l .or. d .ne. w(1:7)
+    l = l .or. s .ne. w(20:26)
+    do 103, p = 1, 2
+      do 103, q = 3, 7
+	do 103, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+103 continue
+    do 104, p = 3, 5
+      do 104, q = 2, 6
+	do 104, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+104 continue
+    do 105, p = 1, 5
+      do 105, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+105 continue
+    call check (size (e, 1), 2, l)
+    call check (size (e, 2), 3, l)
+    call check (size (e, 3), 7, l)
+    call check (size (e), 42, l)
+    call check (size (f, 1), 2, l)
+    call check (size (f, 2), 5, l)
+    call check (size (f, 3), 7, l)
+    call check (size (f), 70, l)
+    call check (size (g, 1), 5, l)
+    call check (size (g, 2), 5, l)
+    call check (size (g), 25, l)
+    call check (size (h, 1), 5, l)
+    call check (size (h, 2), 5, l)
+    call check (size (h), 25, l)
+    call check (size (i, 1), 3, l)
+    call check (size (i, 2), 5, l)
+    call check (size (i, 3), 7, l)
+    call check (size (i), 105, l)
+    call check (size (j, 1), 4, l)
+    call check (size (j, 2), 5, l)
+    call check (size (j, 3), 7, l)
+    call check (size (j), 140, l)
+    call check (size (k, 1), 5, l)
+    call check (size (k, 2), 1, l)
+    call check (size (k, 3), 3, l)
+    call check (size (k), 15, l)
+!$omp end parallel
+    if (l) call abort
+  end subroutine foo
+
+  subroutine test
+    character (len = 12) :: c
+    character (len = 7) :: d
+    integer, dimension (2, 3:5, 7) :: e
+    integer, dimension (2, 3:7, 7) :: f
+    character (len = 12), dimension (5, 3:7) :: g
+    character (len = 7), dimension (5, 3:7) :: h
+    real, dimension (3:5, 2:6, 1:7) :: i
+    double precision, dimension (3:6, 2:6, 1:7) :: j
+    integer, dimension (1:5, 7:7, 4:6) :: k
+    integer :: p, q, r
+    c = 'abcdefghijkl'
+    d = 'ABCDEFG'
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
+    forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
+    call foo (c, d, e, f, g, h, i, j, k, 7)
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla2.f90 b/libgomp/testsuite/libgomp.fortran/vla2.f90
new file mode 100644
index 0000000..a9510fd
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla2.f90
@@ -0,0 +1,142 @@
+! { dg-do run }
+
+  call test
+contains
+  subroutine check (x, y, l)
+    integer :: x, y
+    logical :: l
+    l = l .or. x .ne. y
+  end subroutine check
+
+  subroutine foo (c, d, e, f, g, h, i, j, k, n)
+    use omp_lib
+    integer :: n
+    character (len = *) :: c
+    character (len = n) :: d
+    integer, dimension (2, 3:5, n) :: e
+    integer, dimension (2, 3:n, n) :: f
+    character (len = *), dimension (5, 3:n) :: g
+    character (len = n), dimension (5, 3:n) :: h
+    real, dimension (:, :, :) :: i
+    double precision, dimension (3:, 5:, 7:) :: j
+    integer, dimension (:, :, :) :: k
+    logical :: l
+    integer :: p, q, r
+    character (len = n) :: s
+    integer, dimension (2, 3:5, n) :: t
+    integer, dimension (2, 3:n, n) :: u
+    character (len = n), dimension (5, 3:n) :: v
+    character (len = 2 * n + 24) :: w
+    integer :: x
+    character (len = 1) :: y
+    l = .false.
+!$omp parallel default (none) private (c, d, e, f, g, h, i, j, k) &
+!$omp & private (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y)
+    x = omp_get_thread_num ()
+    w = ''
+    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+    c = w(8:19)
+    d = w(1:7)
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
+    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
+    s = w(20:26)
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
+!$omp barrier
+    y = ''
+    if (x .eq. 0) y = '0'
+    if (x .eq. 1) y = '1'
+    if (x .eq. 2) y = '2'
+    if (x .eq. 3) y = '3'
+    if (x .eq. 4) y = '4'
+    if (x .eq. 5) y = '5'
+    l = l .or. w(7:7) .ne. y
+    l = l .or. w(19:19) .ne. y
+    l = l .or. w(26:26) .ne. y
+    l = l .or. w(38:38) .ne. y
+    l = l .or. c .ne. w(8:19)
+    l = l .or. d .ne. w(1:7)
+    l = l .or. s .ne. w(20:26)
+    do 103, p = 1, 2
+      do 103, q = 3, 7
+	do 103, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+103 continue
+    do 104, p = 3, 5
+      do 104, q = 2, 6
+	do 104, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+104 continue
+    do 105, p = 1, 5
+      do 105, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+105 continue
+    call check (size (e, 1), 2, l)
+    call check (size (e, 2), 3, l)
+    call check (size (e, 3), 7, l)
+    call check (size (e), 42, l)
+    call check (size (f, 1), 2, l)
+    call check (size (f, 2), 5, l)
+    call check (size (f, 3), 7, l)
+    call check (size (f), 70, l)
+    call check (size (g, 1), 5, l)
+    call check (size (g, 2), 5, l)
+    call check (size (g), 25, l)
+    call check (size (h, 1), 5, l)
+    call check (size (h, 2), 5, l)
+    call check (size (h), 25, l)
+    call check (size (i, 1), 3, l)
+    call check (size (i, 2), 5, l)
+    call check (size (i, 3), 7, l)
+    call check (size (i), 105, l)
+    call check (size (j, 1), 4, l)
+    call check (size (j, 2), 5, l)
+    call check (size (j, 3), 7, l)
+    call check (size (j), 140, l)
+    call check (size (k, 1), 5, l)
+    call check (size (k, 2), 1, l)
+    call check (size (k, 3), 3, l)
+    call check (size (k), 15, l)
+!$omp end parallel
+    if (l) call abort
+  end subroutine foo
+
+  subroutine test
+    character (len = 12) :: c
+    character (len = 7) :: d
+    integer, dimension (2, 3:5, 7) :: e
+    integer, dimension (2, 3:7, 7) :: f
+    character (len = 12), dimension (5, 3:7) :: g
+    character (len = 7), dimension (5, 3:7) :: h
+    real, dimension (3:5, 2:6, 1:7) :: i
+    double precision, dimension (3:6, 2:6, 1:7) :: j
+    integer, dimension (1:5, 7:7, 4:6) :: k
+    integer :: p, q, r
+    call foo (c, d, e, f, g, h, i, j, k, 7)
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla3.f90 b/libgomp/testsuite/libgomp.fortran/vla3.f90
new file mode 100644
index 0000000..bfafc4f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla3.f90
@@ -0,0 +1,191 @@
+! { dg-do run }
+
+  call test
+contains
+  subroutine check (x, y, l)
+    integer :: x, y
+    logical :: l
+    l = l .or. x .ne. y
+  end subroutine check
+
+  subroutine foo (c, d, e, f, g, h, i, j, k, n)
+    use omp_lib
+    integer :: n
+    character (len = *) :: c
+    character (len = n) :: d
+    integer, dimension (2, 3:5, n) :: e
+    integer, dimension (2, 3:n, n) :: f
+    character (len = *), dimension (5, 3:n) :: g
+    character (len = n), dimension (5, 3:n) :: h
+    real, dimension (:, :, :) :: i
+    double precision, dimension (3:, 5:, 7:) :: j
+    integer, dimension (:, :, :) :: k
+    logical :: l
+    integer :: p, q, r
+    character (len = n) :: s
+    integer, dimension (2, 3:5, n) :: t
+    integer, dimension (2, 3:n, n) :: u
+    character (len = n), dimension (5, 3:n) :: v
+    character (len = 2 * n + 24) :: w
+    integer :: x, z
+    character (len = 1) :: y
+    s = 'PQRSTUV'
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
+    l = .false.
+!$omp parallel default (none) shared (c, d, e, f, g, h, i, j, k) &
+!$omp & shared (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y)
+    l = l .or. c .ne. 'abcdefghijkl'
+    l = l .or. d .ne. 'ABCDEFG'
+    l = l .or. s .ne. 'PQRSTUV'
+    do 100, p = 1, 2
+      do 100, q = 3, 7
+	do 100, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
+100 continue
+    do 101, p = 3, 5
+      do 101, q = 2, 6
+	do 101, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
+101 continue
+    do 102, p = 1, 5
+      do 102, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
+102 continue
+    do 110 z = 0, omp_get_num_threads () - 1
+!$omp barrier
+      x = omp_get_thread_num ()
+      w = ''
+      if (z .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+      if (z .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+      if (z .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+      if (z .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+      if (z .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+      if (z .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+      if (x .eq. z) then
+	c = w(8:19)
+	d = w(1:7)
+	forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
+	forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
+	forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
+	forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
+	forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
+	forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
+	forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
+	forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
+	forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
+	s = w(20:26)
+	forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
+	forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
+	forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
+	forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
+      end if
+!$omp barrier
+      x = z
+      y = ''
+      if (x .eq. 0) y = '0'
+      if (x .eq. 1) y = '1'
+      if (x .eq. 2) y = '2'
+      if (x .eq. 3) y = '3'
+      if (x .eq. 4) y = '4'
+      if (x .eq. 5) y = '5'
+      l = l .or. w(7:7) .ne. y
+      l = l .or. w(19:19) .ne. y
+      l = l .or. w(26:26) .ne. y
+      l = l .or. w(38:38) .ne. y
+      l = l .or. c .ne. w(8:19)
+      l = l .or. d .ne. w(1:7)
+      l = l .or. s .ne. w(20:26)
+      do 103, p = 1, 2
+	do 103, q = 3, 7
+	  do 103, r = 1, 7
+	    if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	    l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	    if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	    l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+103   continue
+      do 104, p = 3, 5
+	do 104, q = 2, 6
+	  do 104, r = 1, 7
+	    l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	    l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+104   continue
+      do 105, p = 1, 5
+	do 105, q = 4, 6
+	  l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+105   continue
+110 continue
+    call check (size (e, 1), 2, l)
+    call check (size (e, 2), 3, l)
+    call check (size (e, 3), 7, l)
+    call check (size (e), 42, l)
+    call check (size (f, 1), 2, l)
+    call check (size (f, 2), 5, l)
+    call check (size (f, 3), 7, l)
+    call check (size (f), 70, l)
+    call check (size (g, 1), 5, l)
+    call check (size (g, 2), 5, l)
+    call check (size (g), 25, l)
+    call check (size (h, 1), 5, l)
+    call check (size (h, 2), 5, l)
+    call check (size (h), 25, l)
+    call check (size (i, 1), 3, l)
+    call check (size (i, 2), 5, l)
+    call check (size (i, 3), 7, l)
+    call check (size (i), 105, l)
+    call check (size (j, 1), 4, l)
+    call check (size (j, 2), 5, l)
+    call check (size (j, 3), 7, l)
+    call check (size (j), 140, l)
+    call check (size (k, 1), 5, l)
+    call check (size (k, 2), 1, l)
+    call check (size (k, 3), 3, l)
+    call check (size (k), 15, l)
+!$omp end parallel
+    if (l) call abort
+  end subroutine foo
+
+  subroutine test
+    character (len = 12) :: c
+    character (len = 7) :: d
+    integer, dimension (2, 3:5, 7) :: e
+    integer, dimension (2, 3:7, 7) :: f
+    character (len = 12), dimension (5, 3:7) :: g
+    character (len = 7), dimension (5, 3:7) :: h
+    real, dimension (3:5, 2:6, 1:7) :: i
+    double precision, dimension (3:6, 2:6, 1:7) :: j
+    integer, dimension (1:5, 7:7, 4:6) :: k
+    integer :: p, q, r
+    c = 'abcdefghijkl'
+    d = 'ABCDEFG'
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
+    forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
+    call foo (c, d, e, f, g, h, i, j, k, 7)
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla4.f90 b/libgomp/testsuite/libgomp.fortran/vla4.f90
new file mode 100644
index 0000000..58caabc
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla4.f90
@@ -0,0 +1,228 @@
+! { dg-do run }
+
+  call test
+contains
+  subroutine check (x, y, l)
+    integer :: x, y
+    logical :: l
+    l = l .or. x .ne. y
+  end subroutine check
+
+  subroutine foo (c, d, e, f, g, h, i, j, k, n)
+    use omp_lib
+    integer :: n
+    character (len = *) :: c
+    character (len = n) :: d
+    integer, dimension (2, 3:5, n) :: e
+    integer, dimension (2, 3:n, n) :: f
+    character (len = *), dimension (5, 3:n) :: g
+    character (len = n), dimension (5, 3:n) :: h
+    real, dimension (:, :, :) :: i
+    double precision, dimension (3:, 5:, 7:) :: j
+    integer, dimension (:, :, :) :: k
+    logical :: l
+    integer :: p, q, r
+    character (len = n) :: s
+    integer, dimension (2, 3:5, n) :: t
+    integer, dimension (2, 3:n, n) :: u
+    character (len = n), dimension (5, 3:n) :: v
+    character (len = 2 * n + 24) :: w
+    integer :: x, z, z2
+    character (len = 1) :: y
+    s = 'PQRSTUV'
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
+    l = .false.
+    call omp_set_dynamic (.false.)
+    call omp_set_num_threads (6)
+!$omp parallel do default (none) firstprivate (c, d, e, f, g, h, i, j, k) &
+!$omp & firstprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y) schedule (static) shared (z2) &
+!$omp lastprivate (c, d, e, f, g, h, i, j, k, s, t, u, v)
+    do 110 z = 0, omp_get_num_threads () - 1
+    if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads ()
+    l = l .or. c .ne. 'abcdefghijkl'
+    l = l .or. d .ne. 'ABCDEFG'
+    l = l .or. s .ne. 'PQRSTUV'
+    do 100, p = 1, 2
+      do 100, q = 3, 7
+	do 100, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. '0123456789AB'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. '9876543210ZY'
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. '0123456'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. '9876543'
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. '_+|/Oo_'
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. '///|||!'
+100 continue
+    do 101, p = 3, 5
+      do 101, q = 2, 6
+	do 101, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. 7.5 * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. 9.5 * p * q * r
+101 continue
+    do 102, p = 1, 5
+      do 102, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + p + 7 + 3 * q
+102 continue
+    x = omp_get_thread_num ()
+    w = ''
+    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+    c = w(8:19)
+    d = w(1:7)
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
+    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
+    s = w(20:26)
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
+!$omp barrier
+    y = ''
+    if (x .eq. 0) y = '0'
+    if (x .eq. 1) y = '1'
+    if (x .eq. 2) y = '2'
+    if (x .eq. 3) y = '3'
+    if (x .eq. 4) y = '4'
+    if (x .eq. 5) y = '5'
+    l = l .or. w(7:7) .ne. y
+    l = l .or. w(19:19) .ne. y
+    l = l .or. w(26:26) .ne. y
+    l = l .or. w(38:38) .ne. y
+    l = l .or. c .ne. w(8:19)
+    l = l .or. d .ne. w(1:7)
+    l = l .or. s .ne. w(20:26)
+    do 103, p = 1, 2
+      do 103, q = 3, 7
+	do 103, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+103 continue
+    do 104, p = 3, 5
+      do 104, q = 2, 6
+	do 104, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+104 continue
+    do 105, p = 1, 5
+      do 105, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+105 continue
+    call check (size (e, 1), 2, l)
+    call check (size (e, 2), 3, l)
+    call check (size (e, 3), 7, l)
+    call check (size (e), 42, l)
+    call check (size (f, 1), 2, l)
+    call check (size (f, 2), 5, l)
+    call check (size (f, 3), 7, l)
+    call check (size (f), 70, l)
+    call check (size (g, 1), 5, l)
+    call check (size (g, 2), 5, l)
+    call check (size (g), 25, l)
+    call check (size (h, 1), 5, l)
+    call check (size (h, 2), 5, l)
+    call check (size (h), 25, l)
+    call check (size (i, 1), 3, l)
+    call check (size (i, 2), 5, l)
+    call check (size (i, 3), 7, l)
+    call check (size (i), 105, l)
+    call check (size (j, 1), 4, l)
+    call check (size (j, 2), 5, l)
+    call check (size (j, 3), 7, l)
+    call check (size (j), 140, l)
+    call check (size (k, 1), 5, l)
+    call check (size (k, 2), 1, l)
+    call check (size (k, 3), 3, l)
+    call check (size (k), 15, l)
+110 continue
+!$omp end parallel do
+    if (l) call abort
+    if (z2 == 6) then
+      x = 5
+      w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+      y = '5'
+      l = l .or. w(7:7) .ne. y
+      l = l .or. w(19:19) .ne. y
+      l = l .or. w(26:26) .ne. y
+      l = l .or. w(38:38) .ne. y
+      l = l .or. c .ne. w(8:19)
+      l = l .or. d .ne. w(1:7)
+      l = l .or. s .ne. w(20:26)
+      do 113, p = 1, 2
+	do 113, q = 3, 7
+	  do 113, r = 1, 7
+	    if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	    l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	    if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	    l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+113   continue
+      do 114, p = 3, 5
+	do 114, q = 2, 6
+	  do 114, r = 1, 7
+	    l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	    l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+114   continue
+      do 115, p = 1, 5
+	do 115, q = 4, 6
+	  l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+115   continue
+      if (l) call abort
+    end if
+  end subroutine foo
+
+  subroutine test
+    character (len = 12) :: c
+    character (len = 7) :: d
+    integer, dimension (2, 3:5, 7) :: e
+    integer, dimension (2, 3:7, 7) :: f
+    character (len = 12), dimension (5, 3:7) :: g
+    character (len = 7), dimension (5, 3:7) :: h
+    real, dimension (3:5, 2:6, 1:7) :: i
+    double precision, dimension (3:6, 2:6, 1:7) :: j
+    integer, dimension (1:5, 7:7, 4:6) :: k
+    integer :: p, q, r
+    c = 'abcdefghijkl'
+    d = 'ABCDEFG'
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
+    forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
+    call foo (c, d, e, f, g, h, i, j, k, 7)
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla5.f90 b/libgomp/testsuite/libgomp.fortran/vla5.f90
new file mode 100644
index 0000000..5c889f9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla5.f90
@@ -0,0 +1,200 @@
+! { dg-do run }
+
+  call test
+contains
+  subroutine check (x, y, l)
+    integer :: x, y
+    logical :: l
+    l = l .or. x .ne. y
+  end subroutine check
+
+  subroutine foo (c, d, e, f, g, h, i, j, k, n)
+    use omp_lib
+    integer :: n
+    character (len = *) :: c
+    character (len = n) :: d
+    integer, dimension (2, 3:5, n) :: e
+    integer, dimension (2, 3:n, n) :: f
+    character (len = *), dimension (5, 3:n) :: g
+    character (len = n), dimension (5, 3:n) :: h
+    real, dimension (:, :, :) :: i
+    double precision, dimension (3:, 5:, 7:) :: j
+    integer, dimension (:, :, :) :: k
+    logical :: l
+    integer :: p, q, r
+    character (len = n) :: s
+    integer, dimension (2, 3:5, n) :: t
+    integer, dimension (2, 3:n, n) :: u
+    character (len = n), dimension (5, 3:n) :: v
+    character (len = 2 * n + 24) :: w
+    integer :: x, z, z2
+    character (len = 1) :: y
+    s = 'PQRSTUV'
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = '_+|/Oo_'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = '///|||!'
+    l = .false.
+    call omp_set_dynamic (.false.)
+    call omp_set_num_threads (6)
+!$omp parallel do default (none) lastprivate (c, d, e, f, g, h, i, j, k) &
+!$omp & lastprivate (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y) schedule (static) shared (z2)
+    do 110 z = 0, omp_get_num_threads () - 1
+    if (omp_get_thread_num () .eq. 0) z2 = omp_get_num_threads ()
+    x = omp_get_thread_num ()
+    w = ''
+    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+    c = w(8:19)
+    d = w(1:7)
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
+    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
+    s = w(20:26)
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
+!$omp barrier
+    y = ''
+    if (x .eq. 0) y = '0'
+    if (x .eq. 1) y = '1'
+    if (x .eq. 2) y = '2'
+    if (x .eq. 3) y = '3'
+    if (x .eq. 4) y = '4'
+    if (x .eq. 5) y = '5'
+    l = l .or. w(7:7) .ne. y
+    l = l .or. w(19:19) .ne. y
+    l = l .or. w(26:26) .ne. y
+    l = l .or. w(38:38) .ne. y
+    l = l .or. c .ne. w(8:19)
+    l = l .or. d .ne. w(1:7)
+    l = l .or. s .ne. w(20:26)
+    do 103, p = 1, 2
+      do 103, q = 3, 7
+	do 103, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+103 continue
+    do 104, p = 3, 5
+      do 104, q = 2, 6
+	do 104, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+104 continue
+    do 105, p = 1, 5
+      do 105, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+105 continue
+    call check (size (e, 1), 2, l)
+    call check (size (e, 2), 3, l)
+    call check (size (e, 3), 7, l)
+    call check (size (e), 42, l)
+    call check (size (f, 1), 2, l)
+    call check (size (f, 2), 5, l)
+    call check (size (f, 3), 7, l)
+    call check (size (f), 70, l)
+    call check (size (g, 1), 5, l)
+    call check (size (g, 2), 5, l)
+    call check (size (g), 25, l)
+    call check (size (h, 1), 5, l)
+    call check (size (h, 2), 5, l)
+    call check (size (h), 25, l)
+    call check (size (i, 1), 3, l)
+    call check (size (i, 2), 5, l)
+    call check (size (i, 3), 7, l)
+    call check (size (i), 105, l)
+    call check (size (j, 1), 4, l)
+    call check (size (j, 2), 5, l)
+    call check (size (j, 3), 7, l)
+    call check (size (j), 140, l)
+    call check (size (k, 1), 5, l)
+    call check (size (k, 2), 1, l)
+    call check (size (k, 3), 3, l)
+    call check (size (k), 15, l)
+110 continue
+!$omp end parallel do
+    if (l) call abort
+    if (z2 == 6) then
+      x = 5
+      w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+      y = '5'
+      l = l .or. w(7:7) .ne. y
+      l = l .or. w(19:19) .ne. y
+      l = l .or. w(26:26) .ne. y
+      l = l .or. w(38:38) .ne. y
+      l = l .or. c .ne. w(8:19)
+      l = l .or. d .ne. w(1:7)
+      l = l .or. s .ne. w(20:26)
+      do 113, p = 1, 2
+	do 113, q = 3, 7
+	  do 113, r = 1, 7
+	    if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	    l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	    if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	    l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	    if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	    if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+113   continue
+      do 114, p = 3, 5
+	do 114, q = 2, 6
+	  do 114, r = 1, 7
+	    l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	    l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+114   continue
+      do 115, p = 1, 5
+	do 115, q = 4, 6
+	  l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+115   continue
+      if (l) call abort
+    end if
+  end subroutine foo
+
+  subroutine test
+    character (len = 12) :: c
+    character (len = 7) :: d
+    integer, dimension (2, 3:5, 7) :: e
+    integer, dimension (2, 3:7, 7) :: f
+    character (len = 12), dimension (5, 3:7) :: g
+    character (len = 7), dimension (5, 3:7) :: h
+    real, dimension (3:5, 2:6, 1:7) :: i
+    double precision, dimension (3:6, 2:6, 1:7) :: j
+    integer, dimension (1:5, 7:7, 4:6) :: k
+    integer :: p, q, r
+    c = 'abcdefghijkl'
+    d = 'ABCDEFG'
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = '0123456789AB'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = '9876543210ZY'
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = '0123456'
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = '9876543'
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p, q, r) = 7.5 * p * q * r
+    forall (p = 3:6, q = 2:6, r = 1:7) j(p, q, r) = 9.5 * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q, r) = 19 + p + q + 3 * r
+    call foo (c, d, e, f, g, h, i, j, k, 7)
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla6.f90 b/libgomp/testsuite/libgomp.fortran/vla6.f90
new file mode 100644
index 0000000..bb9c491
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla6.f90
@@ -0,0 +1,191 @@
+! { dg-do run }
+
+  call test
+contains
+  subroutine check (x, y, l)
+    integer :: x, y
+    logical :: l
+    l = l .or. x .ne. y
+  end subroutine check
+
+  subroutine foo (c, d, e, f, g, h, i, j, k, n)
+    use omp_lib
+    integer :: n
+    character (len = *) :: c
+    character (len = n) :: d
+    integer, dimension (2, 3:5, n) :: e
+    integer, dimension (2, 3:n, n) :: f
+    character (len = *), dimension (5, 3:n) :: g
+    character (len = n), dimension (5, 3:n) :: h
+    real, dimension (:, :, :) :: i
+    double precision, dimension (3:, 5:, 7:) :: j
+    integer, dimension (:, :, :) :: k
+    logical :: l
+    integer :: p, q, r
+    character (len = n) :: s
+    integer, dimension (2, 3:5, n) :: t
+    integer, dimension (2, 3:n, n) :: u
+    character (len = n), dimension (5, 3:n) :: v
+    character (len = 2 * n + 24) :: w
+    integer :: x, z
+    character (len = 1) :: y
+    l = .false.
+!$omp parallel default (none) private (c, d, e, f, g, h, i, j, k) &
+!$omp & private (s, t, u, v) reduction (.or.:l) num_threads (6) &
+!$omp private (p, q, r, w, x, y) shared (z)
+    x = omp_get_thread_num ()
+    w = ''
+    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+    c = w(8:19)
+    d = w(1:7)
+    forall (p = 1:2, q = 3:5, r = 1:7) e(p, q, r) = 5 * x + p + q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) f(p, q, r) = 25 * x + p + q + 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) g(p, q) = w(8:19)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) g(p, q) = w(27:38)
+    forall (p = 1:5, q = 3:7, p + q .le. 8) h(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) h(p, q) = w(20:26)
+    forall (p = 3:5, q = 2:6, r = 1:7) i(p - 2, q - 1, r) = (7.5 + x) * p * q * r
+    forall (p = 3:5, q = 2:6, r = 1:7) j(p, q + 3, r + 6) = (9.5 + x) * p * q * r
+    forall (p = 1:5, q = 7:7, r = 4:6) k(p, q - 6, r - 3) = 19 + x + p + q + 3 * r
+    s = w(20:26)
+    forall (p = 1:2, q = 3:5, r = 1:7) t(p, q, r) = -10 + x + p - q + 2 * r
+    forall (p = 1:2, q = 3:7, r = 1:7) u(p, q, r) = 30 - x - p + q - 2 * r
+    forall (p = 1:5, q = 3:7, p + q .le. 8) v(p, q) = w(1:7)
+    forall (p = 1:5, q = 3:7, p + q .gt. 8) v(p, q) = w(20:26)
+!$omp barrier
+    y = ''
+    if (x .eq. 0) y = '0'
+    if (x .eq. 1) y = '1'
+    if (x .eq. 2) y = '2'
+    if (x .eq. 3) y = '3'
+    if (x .eq. 4) y = '4'
+    if (x .eq. 5) y = '5'
+    l = l .or. w(7:7) .ne. y
+    l = l .or. w(19:19) .ne. y
+    l = l .or. w(26:26) .ne. y
+    l = l .or. w(38:38) .ne. y
+    l = l .or. c .ne. w(8:19)
+    l = l .or. d .ne. w(1:7)
+    l = l .or. s .ne. w(20:26)
+    do 103, p = 1, 2
+      do 103, q = 3, 7
+	do 103, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+103 continue
+    do 104, p = 3, 5
+      do 104, q = 2, 6
+	do 104, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+104 continue
+    do 105, p = 1, 5
+      do 105, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+105 continue
+    call check (size (e, 1), 2, l)
+    call check (size (e, 2), 3, l)
+    call check (size (e, 3), 7, l)
+    call check (size (e), 42, l)
+    call check (size (f, 1), 2, l)
+    call check (size (f, 2), 5, l)
+    call check (size (f, 3), 7, l)
+    call check (size (f), 70, l)
+    call check (size (g, 1), 5, l)
+    call check (size (g, 2), 5, l)
+    call check (size (g), 25, l)
+    call check (size (h, 1), 5, l)
+    call check (size (h, 2), 5, l)
+    call check (size (h), 25, l)
+    call check (size (i, 1), 3, l)
+    call check (size (i, 2), 5, l)
+    call check (size (i, 3), 7, l)
+    call check (size (i), 105, l)
+    call check (size (j, 1), 4, l)
+    call check (size (j, 2), 5, l)
+    call check (size (j, 3), 7, l)
+    call check (size (j), 140, l)
+    call check (size (k, 1), 5, l)
+    call check (size (k, 2), 1, l)
+    call check (size (k, 3), 3, l)
+    call check (size (k), 15, l)
+!$omp single
+    z = omp_get_thread_num ()
+!$omp end single copyprivate (c, d, e, f, g, h, i, j, k, s, t, u, v)
+    w = ''
+    x = z
+    if (x .eq. 0) w = 'thread0thr_number_0THREAD0THR_NUMBER_0'
+    if (x .eq. 1) w = 'thread1thr_number_1THREAD1THR_NUMBER_1'
+    if (x .eq. 2) w = 'thread2thr_number_2THREAD2THR_NUMBER_2'
+    if (x .eq. 3) w = 'thread3thr_number_3THREAD3THR_NUMBER_3'
+    if (x .eq. 4) w = 'thread4thr_number_4THREAD4THR_NUMBER_4'
+    if (x .eq. 5) w = 'thread5thr_number_5THREAD5THR_NUMBER_5'
+    y = ''
+    if (x .eq. 0) y = '0'
+    if (x .eq. 1) y = '1'
+    if (x .eq. 2) y = '2'
+    if (x .eq. 3) y = '3'
+    if (x .eq. 4) y = '4'
+    if (x .eq. 5) y = '5'
+    l = l .or. w(7:7) .ne. y
+    l = l .or. w(19:19) .ne. y
+    l = l .or. w(26:26) .ne. y
+    l = l .or. w(38:38) .ne. y
+    l = l .or. c .ne. w(8:19)
+    l = l .or. d .ne. w(1:7)
+    l = l .or. s .ne. w(20:26)
+    do 113, p = 1, 2
+      do 113, q = 3, 7
+	do 113, r = 1, 7
+	  if (q .lt. 6) l = l .or. e(p, q, r) .ne. 5 * x + p + q + 2 * r
+	  l = l .or. f(p, q, r) .ne. 25 * x + p + q + 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. g(r, q) .ne. w(8:19)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. g(r, q) .ne. w(27:38)
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. h(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. h(r, q) .ne. w(20:26)
+	  if (q .lt. 6) l = l .or. t(p, q, r) .ne. -10 + x + p - q + 2 * r
+	  l = l .or. u(p, q, r) .ne. 30 - x - p + q - 2 * r
+	  if (r .lt. 6 .and. q + r .le. 8) l = l .or. v(r, q) .ne. w(1:7)
+	  if (r .lt. 6 .and. q + r .gt. 8) l = l .or. v(r, q) .ne. w(20:26)
+113 continue
+    do 114, p = 3, 5
+      do 114, q = 2, 6
+	do 114, r = 1, 7
+	  l = l .or. i(p - 2, q - 1, r) .ne. (7.5 + x) * p * q * r
+	  l = l .or. j(p, q + 3, r + 6) .ne. (9.5 + x) * p * q * r
+114 continue
+    do 115, p = 1, 5
+      do 115, q = 4, 6
+	l = l .or. k(p, 1, q - 3) .ne. 19 + x + p + 7 + 3 * q
+115 continue
+!$omp end parallel
+    if (l) call abort
+  end subroutine foo
+
+  subroutine test
+    character (len = 12) :: c
+    character (len = 7) :: d
+    integer, dimension (2, 3:5, 7) :: e
+    integer, dimension (2, 3:7, 7) :: f
+    character (len = 12), dimension (5, 3:7) :: g
+    character (len = 7), dimension (5, 3:7) :: h
+    real, dimension (3:5, 2:6, 1:7) :: i
+    double precision, dimension (3:6, 2:6, 1:7) :: j
+    integer, dimension (1:5, 7:7, 4:6) :: k
+    integer :: p, q, r
+    call foo (c, d, e, f, g, h, i, j, k, 7)
+  end subroutine test
+end
diff --git a/libgomp/testsuite/libgomp.fortran/vla7.f90 b/libgomp/testsuite/libgomp.fortran/vla7.f90
new file mode 100644
index 0000000..29a6696
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/vla7.f90
@@ -0,0 +1,143 @@
+! { dg-do run }
+! { dg-options "-w" }
+
+  character (6) :: c, f2
+  character (6) :: d(2)
+  c = f1 (6)
+  if (c .ne. 'opqrst') call abort
+  c = f2 (6)
+  if (c .ne. '_/!!/_') call abort
+  d = f3 (6)
+  if (d(1) .ne. 'opqrst' .or. d(2) .ne. 'a') call abort
+  d = f4 (6)
+  if (d(1) .ne. 'Opqrst' .or. d(2) .ne. 'A') call abort
+contains
+  function f1 (n)
+    use omp_lib
+    character (n) :: f1
+    logical :: l
+    f1 = 'abcdef'
+    l = .false.
+!$omp parallel firstprivate (f1) reduction (.or.:l) num_threads (2)
+    l = f1 .ne. 'abcdef'
+    if (omp_get_thread_num () .eq. 0) f1 = 'ijklmn'
+    if (omp_get_thread_num () .eq. 1) f1 = 'IJKLMN'
+!$omp barrier
+    l = l .or. (omp_get_thread_num () .eq. 0 .and. f1 .ne. 'ijklmn')
+    l = l .or. (omp_get_thread_num () .eq. 1 .and. f1 .ne. 'IJKLMN')
+!$omp end parallel
+    f1 = 'zZzz_z'
+!$omp parallel shared (f1) reduction (.or.:l) num_threads (2)
+    l = l .or. f1 .ne. 'zZzz_z'
+!$omp barrier
+!$omp master
+    f1 = 'abc'
+!$omp end master
+!$omp barrier
+    l = l .or. f1 .ne. 'abc'
+!$omp barrier
+    if (omp_get_thread_num () .eq. 1) f1 = 'def'
+!$omp barrier
+    l = l .or. f1 .ne. 'def'
+!$omp end parallel
+    if (l) call abort
+    f1 = 'opqrst'
+  end function f1
+  function f3 (n)
+    use omp_lib
+    character (n), dimension (2) :: f3
+    logical :: l
+    f3 = 'abcdef'
+    l = .false.
+!$omp parallel firstprivate (f3) reduction (.or.:l) num_threads (2)
+    l = any (f3 .ne. 'abcdef')
+    if (omp_get_thread_num () .eq. 0) f3 = 'ijklmn'
+    if (omp_get_thread_num () .eq. 1) f3 = 'IJKLMN'
+!$omp barrier
+    l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f3 .ne. 'ijklmn'))
+    l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f3 .ne. 'IJKLMN'))
+!$omp end parallel
+    f3 = 'zZzz_z'
+!$omp parallel shared (f3) reduction (.or.:l) num_threads (2)
+    l = l .or. any (f3 .ne. 'zZzz_z')
+!$omp barrier
+!$omp master
+    f3 = 'abc'
+!$omp end master
+!$omp barrier
+    l = l .or. any (f3 .ne. 'abc')
+!$omp barrier
+    if (omp_get_thread_num () .eq. 1) f3 = 'def'
+!$omp barrier
+    l = l .or. any (f3 .ne. 'def')
+!$omp end parallel
+    if (l) call abort
+    f3(1) = 'opqrst'
+    f3(2) = 'a'
+  end function f3
+  function f4 (n)
+    use omp_lib
+    character (n), dimension (n - 4) :: f4
+    logical :: l
+    f4 = 'abcdef'
+    l = .false.
+!$omp parallel firstprivate (f4) reduction (.or.:l) num_threads (2)
+    l = any (f4 .ne. 'abcdef')
+    if (omp_get_thread_num () .eq. 0) f4 = 'ijklmn'
+    if (omp_get_thread_num () .eq. 1) f4 = 'IJKLMN'
+!$omp barrier
+    l = l .or. (omp_get_thread_num () .eq. 0 .and. any (f4 .ne. 'ijklmn'))
+    l = l .or. (omp_get_thread_num () .eq. 1 .and. any (f4 .ne. 'IJKLMN'))
+    l = l .or. size (f4) .ne. 2
+!$omp end parallel
+    f4 = 'zZzz_z'
+!$omp parallel shared (f4) reduction (.or.:l) num_threads (2)
+    l = l .or. any (f4 .ne. 'zZzz_z')
+!$omp barrier
+!$omp master
+    f4 = 'abc'
+!$omp end master
+!$omp barrier
+    l = l .or. any (f4 .ne. 'abc')
+!$omp barrier
+    if (omp_get_thread_num () .eq. 1) f4 = 'def'
+!$omp barrier
+    l = l .or. any (f4 .ne. 'def')
+    l = l .or. size (f4) .ne. 2
+!$omp end parallel
+    if (l) call abort
+    f4(1) = 'Opqrst'
+    f4(2) = 'A'
+  end function f4
+end
+function f2 (n)
+  use omp_lib
+  character (*) :: f2
+  logical :: l
+  f2 = 'abcdef'
+  l = .false.
+!$omp parallel firstprivate (f2) reduction (.or.:l) num_threads (2)
+  l = f2 .ne. 'abcdef'
+  if (omp_get_thread_num () .eq. 0) f2 = 'ijklmn'
+  if (omp_get_thread_num () .eq. 1) f2 = 'IJKLMN'
+!$omp barrier
+  l = l .or. (omp_get_thread_num () .eq. 0 .and. f2 .ne. 'ijklmn')
+  l = l .or. (omp_get_thread_num () .eq. 1 .and. f2 .ne. 'IJKLMN')
+!$omp end parallel
+  f2 = 'zZzz_z'
+!$omp parallel shared (f2) reduction (.or.:l) num_threads (2)
+  l = l .or. f2 .ne. 'zZzz_z'
+!$omp barrier
+!$omp master
+  f2 = 'abc'
+!$omp end master
+!$omp barrier
+  l = l .or. f2 .ne. 'abc'
+!$omp barrier
+  if (omp_get_thread_num () .eq. 1) f2 = 'def'
+!$omp barrier
+  l = l .or. f2 .ne. 'def'
+!$omp end parallel
+  if (l) call abort
+  f2 = '_/!!/_'
+end function f2
diff --git a/libgomp/testsuite/libgomp.fortran/workshare1.f90 b/libgomp/testsuite/libgomp.fortran/workshare1.f90
new file mode 100644
index 0000000..a0e6ff9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/workshare1.f90
@@ -0,0 +1,30 @@
+function foo ()
+  integer :: foo
+  logical :: foo_seen
+  common /foo_seen/ foo_seen
+  foo_seen = .true.
+  foo = 3
+end
+function bar ()
+  integer :: bar
+  logical :: bar_seen
+  common /bar_seen/ bar_seen
+  bar_seen = .true.
+  bar = 3
+end
+  integer :: a (10), b (10), foo, bar
+  logical :: foo_seen, bar_seen
+  common /foo_seen/ foo_seen
+  common /bar_seen/ bar_seen
+
+  foo_seen = .false.
+  bar_seen = .false.
+!$omp parallel workshare if (foo () .gt. 2) num_threads (bar () + 1)
+  a = 10
+  b = 20
+  a(1:5) = max (a(1:5), b(1:5))
+!$omp end parallel workshare
+  if (any (a(1:5) .ne. 20)) call abort
+  if (any (a(6:10) .ne. 10)) call abort
+  if (.not. foo_seen .or. .not. bar_seen) call abort
+end