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

101 files changed, 6188 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